ggplotまたは格子でサバントオブジェクトを利用します
質問
生存分析を行う際にGGPLOTや格子を利用する方法を知っている人はいますか?トレリスやファセットのようなサバイバルグラフを行うといいでしょう。
結局、私は遊んで、カプラン・マイヤーのプロットの解決策を見つけました。リスト要素をデータフレームに取り入れる際の厄介なコードをお詫びしますが、別の方法を理解することはできませんでした。
注:2つのレベルの階層でのみ動作します。誰かが私がどのように使用できるか知っているなら x<-length(stratum)
これを行うには、私に知らせてください(STATAでは、これがRでどのように機能するかをマクロ非sureに追加できます)。
ggkm<-function(time,event,stratum) {
m2s<-Surv(time,as.numeric(event))
fit <- survfit(m2s ~ stratum)
f$time <- fit$time
f$surv <- fit$surv
f$strata <- c(rep(names(fit$strata[1]),fit$strata[1]),
rep(names(fit$strata[2]),fit$strata[2]))
f$upper <- fit$upper
f$lower <- fit$lower
r <- ggplot (f, aes(x=time, y=surv, fill=strata, group=strata))
+geom_line()+geom_ribbon(aes(ymin=lower,ymax=upper),alpha=0.3)
return(r)
}
解決
次のコードを使用しています lattice
. 。最初の関数は1つのグループにKMカーブを描画し、通常は次のように使用されます panel.group
機能、2番目はパネル全体のログランクテストp値を追加します。
km.panel <- function(x,y,type,mark.time=T,...){
na.part <- is.na(x)|is.na(y)
x <- x[!na.part]
y <- y[!na.part]
if (length(x)==0) return()
fit <- survfit(Surv(x,y)~1)
if (mark.time){
cens <- which(fit$time %in% x[y==0])
panel.xyplot(fit$time[cens], fit$surv[cens], type="p",...)
}
panel.xyplot(c(0,fit$time), c(1,fit$surv),type="s",...)
}
logrank.panel <- function(x,y,subscripts,groups,...){
lr <- survdiff(Surv(x,y)~groups[subscripts])
otmp <- lr$obs
etmp <- lr$exp
df <- (sum(1 * (etmp > 0))) - 1
p <- 1 - pchisq(lr$chisq, df)
p.text <- paste("p=", signif(p, 2))
grid.text(p.text, 0.95, 0.05, just=c("right","bottom"))
panel.superpose(x=x,y=y,subscripts=subscripts,groups=groups,...)
}
このコードが機能するには、検閲インジケーターが0-1でなければなりません。使用法は次の行に沿って行われます。
library(survival)
library(lattice)
library(grid)
data(colon) #built-in example data set
xyplot(status~time, data=colon, groups=rx, panel.groups=km.panel, panel=logrank.panel)
「panel = panel.superpose」を使用するだけの場合、p値は取得されません。
他のヒント
更新された回答で使用するアプローチをほぼ正確にフォローし始めました。しかし、サバフィットについて刺激しているのは、それぞれのティックではなく変化のみをマークすることです。 %、3-88%。それをGGPLOTに供給すると、ラインは平らなままにして3でまっすぐ下に落ちるのではなく、0から3に傾斜します。アプリケーションと仮定によっては問題ないかもしれませんが、古典的なKMプロットではありません。これが私がさまざまな数の階層を処理した方法です:
groupvec <- c()
for(i in seq_along(x$strata)){
groupvec <- append(groupvec, rep(x = names(x$strata[i]), times = x$strata[i]))
}
f$strata <- groupvec
それが価値があることのために、これは私がそれをする方法です - しかし、これは実際にはKMプロットではありません。なぜなら、私はKMの推定自体を計算していないからです(私は検閲がないので、これは同等です。 .. 私は信じている)。
survcurv <- function(surv.time, group = NA) {
#Must be able to coerce surv.time and group to vectors
if(!is.vector(as.vector(surv.time)) | !is.vector(as.vector(group))) {stop("surv.time and group must be coercible to vectors.")}
#Make sure that the surv.time is numeric
if(!is.numeric(surv.time)) {stop("Survival times must be numeric.")}
#Group can be just about anything, but must be the same length as surv.time
if(length(surv.time) != length(group)) {stop("The vectors passed to the surv.time and group arguments must be of equal length.")}
#What is the maximum number of ticks recorded?
max.time <- max(surv.time)
#What is the number of groups in the data?
n.groups <- length(unique(group))
#Use the number of ticks (plus one for t = 0) times the number of groups to
#create an empty skeleton of the results.
curves <- data.frame(tick = rep(0:max.time, n.groups), group = NA, surv.prop = NA)
#Add the group names - R will reuse the vector so that equal numbers of rows
#are labeled with each group.
curves$group <- unique(group)
#For each row, calculate the number of survivors in group[i] at tick[i]
for(i in seq_len(nrow(curves))){
curves$surv.prop[i] <- sum(surv.time[group %in% curves$group[i]] > curves$tick[i]) /
length(surv.time[group %in% curves$group[i]])
}
#Return the results, ordered by group and tick - easier for humans to read.
return(curves[order(curves$group, curves$tick), ])
}