がんもどき。予後の異なる二重ガンの一方を放置すると

がんもどき。予後の異なる二重ガンの一方を放置すると

Rによるシミュレーションを実施臨床に役立てた。

Aという癌があり、２年生存率が90％である。手術すれば100％治癒とする。

Bという癌があり、術後だが２年生存率17.4％である。

Aという癌の治療方針についてコンサルトがあった。

Aは早期がんであり、検査して手術すれば、ほぼ確実に治癒する。 はたしてAに対して侵襲的な検査を行い、手術すべきか。

Rでシミュレートする

library(survival)

## Loading required package: splines

set.seed(1)
N <- 1e+05  #全症例
NAK <- N%/%2  #cont N
NBK <- N - NAK  #treat N

AK <- 0.9  #survival rate at AKT
AKT <- 24  #x Months survive
BK <- 0.174  #urvival rate at BKT
BKT <- 24

test <- rep(1, N)
data <- data.frame(test = test)

# ミュレーション
niter <- 500  # のシミュレーション回数

event <- matrix(0, niter, 1)

AKk <- -log(AK)/AKT  #AKのk値
BKk <- -log(BK)/BKT  #BKのk値

data$AK <- rexp(N, rate = AKk)
data$BK <- rexp(N, rate = BKk)  #指数分布で

L <- data$AK
P <- data$BK

data2 <- data.frame(L = L, P = P)
data$sur9 <- apply(data2, MARGIN = 1, min)  #死亡までの期間
data$wh <- apply(data2, MARGIN = 1, which.min)  #　　1がAK死亡　2がBK死亡
data$AKmBK <- data$BK - data$AK  #AKがなかったら生存していたはずの期間 マイナスでAK無いのと一緒　＋ならAK死亡

res1 <- survfit(Surv(BK, test) ~ 1, data = data, conf.type = "none")  #BK死亡　AK治療
res2 <- survfit(Surv(AK, test) ~ 1, data = data, conf.type = "none")  #AK死亡　BK治癒
res3 <- survfit(Surv(sur9, test) ~ 1, data = data, conf.type = "none")  #どっちかで死亡　AK放置

plot(res2, xlim = c(0, 50), ylim = c(0, 1))
par(new = T)
plot(res1, xlim = c(0, 50), ylim = c(0, 1))
par(new = T)
plot(res3, xlim = c(0, 50), ylim = c(0, 1))

ほとんど放置しても生存曲線に差がない

sum(data$wh == 1)/N  #放置したことによってAKで死亡する人の割合

## [1] 0.05722

sum(data$AKmBK > 6)/N  #手術によって6ヶ月以上寿命が伸びる人の割合

## [1] 0.03667

sum(data$BK > 24)/N  #AK opしてBKのみの影響　２４ヶ月生存率

## [1] 0.1724

sum(data$sur9 > 24)/N  #AK opなし　　２４ヶ月生存率

## [1] 0.1551

つまり、６ヶ月以上寿命が伸びることを手術の価値があると考えれば わずか3.6％の人しか利益を受けない。しかもこれは、手術死亡ゼロ といういささか無理のある仮定での話である。実際は術後に寝たきり になったり死亡するリスクも十分あり、限りなく０％に近い。

一方で、BKも術後２年生存していると、その後の３年生存率は ５０％に改善すると分かっている。 仮に２年後に生存しているとして計算する。

library(survival)
set.seed(1)
N <- 1e+05  #全症例
NAK <- N%/%2  #cont N
NBK <- N - NAK  #treat N

AK <- 0.9  #survival rate at AKT
AKT <- 24  #x Months survive
BK <- 0.5  #urvival rate at BKT
BKT <- 36

test <- rep(1, N)
data <- data.frame(test = test)

# ミュレーション
niter <- 500  # のシミュレーション回数

event <- matrix(0, niter, 1)

AKk <- -log(AK)/AKT  #AKのk値
BKk <- -log(BK)/BKT  #BKのk値

data$AK <- rexp(N, rate = AKk)
data$BK <- rexp(N, rate = BKk)  #指数分布で

L <- data$AK
P <- data$BK

data2 <- data.frame(L = L, P = P)
data$sur9 <- apply(data2, MARGIN = 1, min)  #死亡までの期間
data$wh <- apply(data2, MARGIN = 1, which.min)  #　　1がAK死亡　2がBK死亡
data$AKmBK <- data$BK - data$AK  #AKがなかったら生存していたはずの期間 マイナスでAK無いのと一緒　＋ならAK死亡

res1 <- survfit(Surv(BK, test) ~ 1, data = data, conf.type = "none")  #BK死亡　AK治療
res2 <- survfit(Surv(AK, test) ~ 1, data = data, conf.type = "none")  #AK死亡　BK治癒
res3 <- survfit(Surv(sur9, test) ~ 1, data = data, conf.type = "none")  #どっちかで死亡　AK放置

plot(res2, xlim = c(0, 50), ylim = c(0, 1))
par(new = T)
plot(res1, xlim = c(0, 50), ylim = c(0, 1))
par(new = T)
plot(res3, xlim = c(0, 50), ylim = c(0, 1))

今度はそれなりに差がある

sum(data$wh == 1)/N  #放置したことによってAKで死亡する人の割合

## [1] 0.1848

sum(data$AKmBK > 6)/N  #手術によって6ヶ月以上寿命が伸びる人の割合

## [1] 0.1646

sum(data$BK > 24)/N  #AK opしてBKのみの影響　２４ヶ月生存率

## [1] 0.6277

sum(data$sur9 > 24)/N  #AK opなし　　２４ヶ月生存率

## [1] 0.5647

今度は16％の人が、Aの手術で６ヶ月以上寿命が伸びる。

A癌が１－２年で手術不能になるとは考えにくいことから、 １－２年後でもBの癌がコントロールされており、 手術できる体力が保たれているならば、侵襲的検査の 上、手術を検討するのが妥当と考えた。 当然最終的には本人と家族の意向が優先である。

と、いうわけでRは臨床の現場でも意思決定の補助に 役立つのである。