-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path列线图
97 lines (85 loc) · 3.5 KB
/
列线图
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
gene='CDC20'
setwd('D:\\KIRC\\CDC20')
rt<-read.csv('merge.csv')
res.cut <- surv_cutpoint(rt, time = "month", event = "Event", variables = c("CDC20"))
group=ifelse(rt[,gene]> res.cut[["cutpoint"]][["cutpoint"]],"high","low")
rt$CDC20group<-group
for (i in c(5:10,14,17,23)){
rt[,i] <- as.factor(rt[,i])
}
f_cph <- cph(Surv(month,Event) ~ gender+Stage+CDC20+serum_calcium_result,
x=T, y=T, surv=T,
data=rt)
print(f_cph)
ddist <- datadist(rt)
options(datadist='ddist')
med <- Quantile(f_cph)
surv <- Survival(f_cph)
plot(nomogram(f_cph, fun=list(function(x) surv(12, x),
function(x) surv(12*3, x),
function(x) surv(12*5, x)),
funlabel=c("1-year Survival Probability",
"3-year Survival Probability",
"5-year Survival Probability")),cex=1.5,cex.lab=1.5, cex.axis=1.5, cex.main=1.5, cex.sub=1.5
)
pred_f_training<-predict(f_cph,rt,type="lp")#!!!type="lp",是他没错
data_table<-data.frame(time=rt[,"month"],status=rt[,"Event"],score=pred_f_training)
library(timeROC)
time_roc_res <- timeROC(
T = data_table$time,
delta = data_table$status,
marker = data_table$score,
cause = 1,
weighting="marginal",
times = c(12, 3*12, 5*12),
ROC = TRUE,
iid = TRUE
)
time_ROC_df <- data.frame(
TP_1year = time_roc_res$TP[, 1],
FP_1year = time_roc_res$FP[, 1],
TP_3year = time_roc_res$TP[, 2],
FP_3year = time_roc_res$FP[, 2],
TP_5year = time_roc_res$TP[, 3],
FP_5year = time_roc_res$FP[, 3]
)
pdf(file=paste(output_dir, "\\ROC_135_year_training.pdf", sep = ""),width=6,height=6)
ggplot(data = time_ROC_df) +
geom_line(aes(x = FP_1year, y = TP_1year), size = 1, color = "#BC3C29FF") +
geom_line(aes(x = FP_3year, y = TP_3year), size = 1, color = "#0072B5FF") +
geom_line(aes(x = FP_5year, y = TP_5year), size = 1, color = "#E18727FF") +
geom_abline(slope = 1, intercept = 0, color = "grey", size = 1, linetype = 2) +
theme_bw() +
annotate("text",
x = 0.75, y = 0.25, size = 4.5,
label = paste0("AUC at 1 year = ", sprintf("%.3f", time_roc_res$AUC[[1]])), color = "#BC3C29FF"
) +
annotate("text",
x = 0.75, y = 0.15, size = 4.5,
label = paste0("AUC at 3 years = ", sprintf("%.3f", time_roc_res$AUC[[2]])), color = "#0072B5FF"
) +
annotate("text",
x = 0.75, y = 0.05, size = 4.5,
label = paste0("AUC at 5 years = ", sprintf("%.3f", time_roc_res$AUC[[3]])), color = "#E18727FF"
) +
labs(x = "False positive rate", y = "True positive rate") +
theme(
axis.text = element_text(face = "bold", size = 11, color = "black"),
axis.title.x = element_text(face = "bold", size = 14, color = "black", margin = margin(c(15, 0, 0, 0))),
axis.title.y = element_text(face = "bold", size = 14, color = "black", margin = margin(c(0, 15, 0, 0)))
)
dev.off()
f<- coxph(Surv(month,Event) ~ gender+Stage+CDC20+serum_calcium_result,
data=rt)
sum.surv<-summary(f)
c_index<-sum.surv$concordance
cal<-calibrate(f_cph, cmethod = 'KM', method = 'boot', u = 60, m = 100, B = 100)
plot(cal,lwd=2,lty=1,errbar.col=c(rgb(0,118,192,maxColorValue=255)),
xlim=c(0.6,1),ylim=c(0.6,1),
xlab='Nomogram-Predicted Probability of 5-Year OS',
ylab='Actual 5-Year OS(proportion)',
col=c(rgb(192,98,83,maxColorValue=255)))
lines(cal[,c('mean.predicted','KM')],
type='b',lwd=2, col=c(rgb(192,98,83,maxColorValue=255)),
pch=16)
abline(0,1,lty=3,lwd=2,col=c(rgb(0,118,192,maxColorValue=255)))