r-statistics-fanの日記

統計好きの現場の臨床医の覚書のようなもの

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

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

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

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

Bという癌があり、術後だが2年生存率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))

plot of chunk unnamed-chunk-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のみの影響 24ヶ月生存率
## [1] 0.1724
sum(data$sur9 > 24)/N  #AK opなし  24ヶ月生存率
## [1] 0.1551

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

一方で、BKも術後2年生存していると、その後の3年生存率は 50%に改善すると分かっている。 仮に2年後に生存しているとして計算する。

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))

plot of chunk unnamed-chunk-3

 

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

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のみの影響 24ヶ月生存率
## [1] 0.6277
sum(data$sur9 > 24)/N  #AK opなし  24ヶ月生存率
## [1] 0.5647

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

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

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