R語言生存分析

自己整理編寫的R語言常用數據分析模型的模板，原文件爲Rmd格式，直接複製粘貼過來，作爲個人學習筆記保存和分享。部分參考薛毅的《統計建模與R軟件》和《R語言實戰》

生存分析是研究生存時間的分佈規律，以及生存時間和相關因素之間關係的一種統計分析方法。生存分析在醫學科學研究中具有廣泛而重要的應用價值，它對人羣壽命的研究，各種慢性疾病的現場追蹤研究，臨牀療效試驗和動物試驗等研究中隨訪資料的處理騎着舉足輕重的作用。

I. 生存曲線

例. 某醫生收集到35例白血病患者治療後的生存時間t（月），仔細觀察後發現這些病人中有一部分出現了白細胞（WBC）倍增的現象。現將他們按是否出現WBC倍增分成兩組如下（注：負值代表刪失數據），試用壽命表法分析患者有無WBC倍增，對其生存時間長短有無顯著影響。

輸入data，變爲表格形式：

A=data.frame()
#輸入變量
x=c(2, -2.5, 3.5, 4, 4, -5, 6, -6, 7, -7, 8, -9, 10.5, 12.5, 19, 2.5, 5, 7, -8.5, 9, -10, 11, -11, 12, 13, -14, 15, -16, 17, -18, 19, -20, 21, 24, 32)
#若survt小於0(代表數據刪失)，則變量censor賦值爲1，否則，賦值爲0
for (i in 1:length(x))
{
  A[i,1]=x[i]
  if(A[i,1]<0)
    A[i,2]=1
  else
    A[i,2]=0
}
#分爲high-wbc和low-wbc兩組
A[,3] <- c(rep("high",15),rep("low",20))
A[,1] <- abs(x)
#變量命名
names(A) <- c("survt","censor","wbc")

---

1. 估計生存函數，觀察不同組間的區別

# 建立生存對象
library(survival)
Surv(A$survt,A$censor==1)

# 估計KM生存曲線(Kaplan–Meier estimator乘積極限法)
y <- Surv(A$survt,A$censor==1)
kmfit1 <- survfit(y~1)
summary(kmfit1)
plot(kmfit1)

# 根據wbc分組估計KM生存曲線
kmfit2 <- survfit(y~A$wbc)
plot(kmfit2, lty = c('solid', 'dashed'), col=c('black','blue'),
     xlab='survival time in days',ylab='survival probabilities')
legend('topright', c('wbc high','wbc low'), lty=c('solid','dashed'),
       col=c('black','blue'))

# 檢驗顯著性,rho=0爲log-rank法或Mantel Haenszel法，rho=1爲Wilcoxon法
survdiff(Surv(survt,censor)~wbc, data=A,rho = 0)
survdiff(Surv(survt,censor)~wbc, data=A,rho = 1)

#設置不同函數的不同參數，選擇不同的檢驗方法
survreg(Surv(survt,censor)~wbc, data=A,dist="weibull")
survreg(Surv(survt,censor)~wbc, data=A,dist="logistic")
survreg(Surv(survt,censor)~wbc, data=A,dist="lognormal")

#-logS(p)對生存時間t的散點圖
kmfit3=kmfit2
kmfit3$surv=-log(kmfit3$surv)
b1=data.frame(kmfit3$time[1:12],kmfit3$surv[1:12])
b2=data.frame(kmfit3$time[13:31],kmfit3$surv[13:31])
plot(b1,type="b",col="black",main="估計生存函數的負數對數")
lines(b2,type="b",col="blue")
legend('bottomright', c('wbc high','wbc low'), lty=c('solid','dashed'),
       col=c('black','blue'))

此資料不服從指數分佈，近似服從Weibull分佈，故宜選用對數秩法或Wilcoxon法檢驗的結果，兩條生存曲線分佈有顯著性差異（p<0.05）。結果顯示：兩條生存曲線Wilcoxon檢驗的結果爲p=0.025<0.05，兩條生存曲線分佈有顯著差異，無WBC倍增的白血病患者的生存時間顯著長於有WBC倍增的白血病患者。

生存函數圖，橫軸爲生存時間t（治療後生存的月份），縱軸爲生存概率。High-WBC（有WBC倍增）在第20個月終止，low-WBC（無WBC倍增）在第32個月終止。其第一組的生存率下降速度顯著快於第二組，說明無WBC倍增的患者比有WBC倍增患者的生存時間長。

上述-logS(p)對生存時間t的散點圖，呈非直線趨勢，說明生存時間不呈指數分佈。

#log（-logS(t)）對log(t)的散點圖
kmfit4=kmfit3
kmfit4$surv=log(kmfit4$surv)
C1=data.frame(kmfit4$time[1:12],kmfit4$surv[1:12])
C2=data.frame(kmfit4$time[13:31],kmfit4$surv[13:31])
plot(C1,type="b",col="black",main="估計生存函數的負數對數的對數")
lines(C2,type="b",col="blue")
legend('bottomright', c('wbc high','wbc low'), lty=c('solid','dashed'),
       col=c('black','blue'))

上述爲log（-logS(t)）對log(t)的散點圖，兩條線分別近似直線，說明生存時間近似呈Weibull分佈。

# 由word文件裏的公式--（n.risk差值）/（n.risk*time差值），畫出wbc分別爲high和low的死亡風險函數圖
summary(kmfit2)
B =data.frame(kmfit2$time[1:12],kmfit2$n.risk[1:12])
B$rr= 0
for (i in 2:12)
{
  B[i,3]=(B[i-1,2]-B[i,2])/(B[i-1,2]*(B[i,1]-B[i-1,1]))
}

plot(B$rr~B$kmfit2.time.1.12.,xlab = "t",ylab = "死亡率",col="black",type="l",main="死亡風險函數")
legend('topright', c('wbc high','wbc low'), lty=c('solid','dashed'),
       col=c('black','blue'))

C =data.frame(kmfit2$time[13:31],kmfit2$n.risk[13:31])
C$rr= 0
for (i in 2:19)
{
  C[i,3]=(C[i-1,2]-C[i,2])/(C[i-1,2]*(C[i,1]-C[i-1,1]))
}

lines(C$rr~C$kmfit2.time.13.31.,col="blue",type="l")

給出生存時間T對應的死亡風險函數。黑色曲線表現的是high-WBC組對應的風險率，藍色曲線表現的是low-WBC對應的風險率，從圖中看出：體內WBC倍增的病人死亡的風險率更高。

---

2. 用圖形方法檢驗PH假設 （與1.中對數圖相似）

plot(kmfit2,fun='cloglog',xlab='time in days using logarithmic
     scale',ylab='log-log survival', main='log-log curves by wbc')

不平行，不符合PH假設

---

3. 構建COX PH迴歸模型

#cox模型
y <- Surv(A$survt,A$censor == 1)
coxmodel <- coxph(y~wbc,data=A)
summary(coxmodel)

# 此例中只有wbc一個變量，不涉及到兩模型選擇問題。假如有多個變量，可以選擇y~x1+x2+x3,y~x1+x2+x3+x3*x2+x3*x1這兩個模型
mod1 <- coxph(y ~ wbc,data=A)
#再用anova函數比較兩個模型
#anova(mod1,mod2)
#step(mod2)
# 簡潔模型更好
# 風險預測
predict(mod1,type='risk')

## 此例中只有wbc一個變量，不涉及到兩模型選擇問題。假如有多個變量，可以選擇y~x1+x2+x3,y~x1+x2+x3+x3*x2+x3*x1這兩個模型
#構建一個stratified Cox model.
# 當PH假設在clinic不成立，控制這個變量
#mod3 <- coxph(y ~ prison + dose + strata(clinic),data=addicts)
#summary(mod3)

對PH假設進行統計檢驗

mod1 <- coxph(y ~ wbc,data=A)
cox.zph(mod1,transform=rank)
# P值小顯示PH假設不符合
# 顯示係數變化圖
plot(cox.zph(mod1,transform=rank),se=F)

得到COX調整後生存曲線

mod1 <- coxph(y ~ wbc,data=A)
pattern1 <- data.frame(wbc = 'low')
summary(survfit(mod1,newdata=pattern1))
plot(survfit(mod1,newdata=pattern1),conf.int=F)

mod2 <- coxph(y ~ strata(wbc),data=A)
pattern2 <- data.frame(wbc = 'high')

構建參數模型

modpar1 <- survreg(Surv(A$survt)~wbc,data=A,dist='exponential')
summary(modpar1)