数学いらずの医科統計学PART6 CHAPTER29の生存曲線の比較で、ウィル・ロジャース現象に触れている。
これは、2群の生存解析において、新しい検査法の出現により、悪性腫瘍がさらに早期に発見できるようになると
非腫瘍群(腫瘍が見つかっていなかった人)が、新しい検査法により腫瘍が見つかって、腫瘍群(腫瘍が見つかった人)に割りつけられる
→その人は腫瘍が見つかったので、普通にしていたら腫瘍ができることを意味していて、非腫瘍群のなかにいたら、早めに死ぬことが期待される
→その人の除外(というか他群への割付)は、非腫瘍群の生存を伸ばすだろう
逆に、
非腫瘍群にいた人が、腫瘍群に移ってくる
→とはいってもこの人は早期の病変なので、既存の検査で腫瘍群に割りつけられた人よりかは長生きすることが期待される
→その人の加入は、腫瘍群の生存を伸ばすだろう
ということが逆説的に観測される。
前立線癌は、Gleason Scoreによって5段階の悪性度評価を付けられるが、スコア付けでこの現象が見られたとかなんとか。
J Natl Cancer Inst. 2005 Sep 7;97(17):1248-53.
良性・中間・悪性の生存曲線を用意して、割り付けの仕方でどうなるかをシミュレーションする。
3群に分かれることがわかっていれば(神様しかいないけど)、黒の生存曲線になる。このうち、中間群が悪性/良性のどちらかにランダムに割り振られているなら、
良性群については、良性の人たちより長生きしなさそうな中間の人が紛れ込むので、生存は短縮している
悪性群については、悪性の人たちより長生きしそうな中間の人が紛れ込むので、生存は延長している
ことがわかる。実際に観測できるのはこの赤の生存曲線である。
ウィル・ロジャース現象的には、ランダムな場合から、良性群に割り付けられていた人たちを悪性群にいれてしまうことなので、青の生存曲線を見るといい。
すると、青の曲線は赤の曲線より右側、つまり生存が延長する方向に動く。
s50 <- c(2, 4, 6) # 50%生存率的な x <- 10000 # 数を増やして近似する g0 <- mapply(runif, 2 * s50, n=x, min=0) # 一様分布から生死を発生させる g1 <- matrix(sample(0:1, size=length(g0), replace=TRUE), nc=length(s50)) library(survival) # 3群独立 group0 <- rep(seq(s50), each=x) surv0 <- survfit(Surv(c(g0), c(g1)) ~ group0) plot(surv0, mark.time=FALSE, col=1, lwd=3) legend("topright", legend=c("独立", "ランダム", "良性側", "悪性側"), bty="n", lty=1, lwd=5, col=1:4, cex=2)
# 中間群がランダムに悪性群、良性群に分布 group1 <- replace(group0, which(group0 == 2), sample(c(1, 3), size=x, replace=TRUE)) surv1 <- survfit(Surv(c(g0), c(g1)) ~ group1) plot(surv1, mark.time=FALSE, col=2, lwd=3) legend("topright", legend=c("独立", "ランダム", "良性側", "悪性側"), bty="n", lty=1, lwd=5, col=1:4, cex=2)
# 中間群が良性群に分布 group2 <- replace(group0, which(group0 == 2), 3) surv2 <- survfit(Surv(c(g0), c(g1)) ~ group2) plot(surv2, mark.time=FALSE, col=3, lwd=3) legend("topright", legend=c("独立", "ランダム", "良性側", "悪性側"), bty="n", lty=1, lwd=5, col=1:4, cex=2)
# 中間群が悪性群に分布 group3 <- replace(group0, which(group0 == 2), 1) surv3 <- survfit(Surv(c(g0), c(g1)) ~ group3) plot(surv3, mark.time=FALSE, col=4, lwd=3) legend("topright", legend=c("独立", "ランダム", "良性側", "悪性側"), bty="n", lty=1, lwd=5, col=1:4, cex=2)
group4 <- c(group0, group1, group2, group3) + rep(3*(0:3), each=length(group0)) surv4 <- survfit(Surv(rep(c(g0), 4), rep(c(g1), 4)) ~ group4) cols <- unlist(mapply(rep, 1:4, c(3,2,2,2))) plot(surv4, mark.time=FALSE, col=cols, lwd=3) legend("topright", legend=c("独立", "ランダム", "良性側", "悪性側"), bty="n", lty=1, lwd=5, col=1:4, cex=2)
