如何从诺模图中提取预测点分数并将其作为协变量包含在我的数据框中?

How can I extract predicted point scores from nomogram and include it as covariate in my dataframe?

请在下面找到我的数据样本 e

问题:如何提取列线图中生成的分数,然后将其作为协变量包含在我的数据框中? 我想包括每一行(即患者)的个性化分数。

我目前有

> head(e)
     rfs Ki67 WHO simpson age sex rad.dose recurrence
1  25.33  0.6   1       1  43   1        0          1
2 207.93  3.3   2       2  76   1        0          0
3  80.00  1.0   2       1  79   1        0          0
4  47.77  0.6   1       3  84   1        0          1
5 193.25  0.6   1       1  62   1        0          0
6   5.78  0.5   1       4  60   1        0          1

我想介绍一个新的协变量e$scoree$score 应根据协变量 e$Ki67e$simpsone$agee$sex 产生的分数在每个患者级别(即每一行)进行计算.

为此,我使用以下代码制作了这个列线图:

library(rms)
d <- datadist(e)
options(datadist="d")


e$simpson <- as.factor(e$simpson)
e$sex <- as.factor(e$sex)

a <- cph(Surv(rfs,recurrence)~Ki67+simpson+age+sex,data=e,surv=TRUE,x=TRUE,y=TRUE)

surv <- Survival(a)

nom <- nomogram(a, fun=list(function(x) surv(12, x),
                            function(x) surv(36, x),
                            function(x) surv(60, x)),
                funlabel=c("Probability of 1 year survival", 
                           "Probability of 3 years survival",
                           "Probability of 5 years survival"), lp=T)

plot(nom, xfrac=.2, 
     total.points.label="Sum of all points", 
     cex.axis = 1.05,
     #force.label = TRUE,
     tcl = 0.8,
     lmgp = 0.1,
     vnames="labels",
     col.grid=gray(c(0.85,0.95)))

那么,如何从 nom 中提取预测分数?我可以看到有一个线性预测器,我认为这可能有用,但我只是想不通。

所以 Ki67=1 (11 point)simpson=2 (34 point)age=45 (7 point)sex=0 (0 point) 的患者总分是 51,因此应该 e$score=51

> print(nom)
Points per unit of linear predictor: 34.35364 
Linear predictor units per point   : 0.029109 


 Ki67 Points
 0.0   0    
 0.5   6    
 1.0  11    
 1.5  17    
 2.0  22    
 2.5  28    
 3.0  34    
 3.5  39    
 4.0  45    
 4.5  50    
 5.0  56    
 5.5  61    
 6.0  67    
 6.5  73    


 simpson Points
 1         0   
 2        34   
 3       100   
 4        92   


 age Points
 25  11    
 30  10    
 35   9    
 40   8    
 45   7    
 50   6    
 55   5    
 60   5    
 65   4    
 70   3    
 75   2    
 80   1    
 85   0    


 sex Points
 0    0    
 1   34    


 Total Points Probability of 1 year survival
          188                           0.60
          182                           0.65
          175                           0.70
          168                           0.75
          159                           0.80
          148                           0.85
          133                           0.90
          109                           0.95


 Total Points Probability of 3 years survival
          182                             0.3
          173                             0.4
          163                             0.5
          153                             0.6
          140                             0.7
          124                             0.8
           98                             0.9


 Total Points Probability of 5 years survival
          182                             0.1
          170                             0.2
          160                             0.3
          151                             0.4
          141                             0.5
          131                             0.6
          118                             0.7
          102                             0.8
           76                             0.9

我的数据e

e <- structure(list(rfs = c(25.33, 207.93, 80, 47.77, 193.25, 5.78, 
6.08, 99.78, 0.69, 174.85, 30.75, 27.27, 162.27, 204.98, 122.81, 
2.79, 150.08, 200.02, 20.53, 22.28, 197.65, 94.23, 195.94, 92.19, 
6.93, 193.38, 14.09, 152.38, 49.15, 190.46, 50.56, 66.76, 188.58, 
188.42, 78.65, 125.77, 176.59, 185.69, 185.23, 184.71, 184.31, 
183.59, 181.49, 96.53, 180.63, 30.16, 65.71, 179.48, 111.47, 
122.61, 177.35, 176.66, 0.13, 67.15, 175.31, 5.78, 53.45, 86.74, 
174.65, 7.72, 169.53, 169.23, 41.99, 168.77, 167.69, 56.71, 163.84, 
163.81, 162.69, 162.63, 162.37, 119.59, 88.02, 160.1, 159.47, 
12.42, 155.56, 155.47, 155.27, 154.87, 56.18, 154.61, 9.33, 128.43, 
56.51, 150.67, 40.9, 50.79, 47.93, 147.91, 83.58, 146.1, 144.69, 
34.73, 142.82, 159.31, 140.58, 136.64, 135.52, 88.41), Ki67 = c(0.6, 
3.3, 1, 0.6, 0.6, 0.5, 3.7, 0.8, 1.4, 1.1, 1.8, 1.6, 0.7, 0.5, 
0.3, 0.2, 0.3, 0.9, 1.7, 0.5, 1.2, 4.1, 0.6, 1.4, 1.3, 1.8, 2.6, 
0.7, 0.8, 1, 0.7, 0.7, 2.1, 1.3, 2.7, 1.3, 0.8, 1.1, 1.8, 1.8, 
0.4, 0.9, 6.4, 1.7, 1.5, 0.6, 2.7, 0.4, 0.3, 1.5, 1.4, 1.8, 2.3, 
0.7, 2.4, 2.2, 2.8, 1.2, 0.6, 5.3, 0.8, 3, 4, 0.5, 1.2, 5.1, 
1.5, 0.6, 1.2, 1.7, 0.7, 1.4, 0.9, 2.7, 1.1, 0.9, 0.5, 0.7, 0.9, 
0.4, 1.2, 0.8, 0.7, 0.8, 0.5, 0.9, 3.3, 0.5, 1.2, 1.1, 1.4, 2.5, 
2.7, 0.7, 0.8, 4.2, 0.8, 0.5, 1.7, 1.2), WHO = c(1L, 2L, 2L, 
1L, 1L, 1L, 2L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 
1L, 1L, 2L, 2L, 2L, 1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 1L, 1L, 3L, 1L, 
1L, 2L, 1L, 1L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 2L, 1L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 1L, 1L, 
1L), simpson = structure(c(1L, 2L, 1L, 3L, 1L, 4L, 3L, 4L, 2L, 
2L, 2L, 2L, 2L, 1L, 2L, 4L, 4L, 4L, 2L, 1L, 2L, 1L, 2L, 2L, 2L, 
2L, 1L, 1L, 1L, 3L, 2L, 1L, 1L, 1L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 
2L, 2L, 2L, 3L, 3L, 2L, 2L, 4L, 2L, 2L, 1L, 2L, 1L, 2L, 4L, 4L, 
2L, 1L, 4L, 1L, 2L, 2L, 2L, 2L, 3L, 1L, 1L, 2L, 1L, 1L, 2L, 4L, 
2L, 1L, 3L, 1L, 2L, 2L, 3L, 4L, 1L, 4L, 1L, 2L, 1L, 4L, 3L, 3L, 
4L, 3L, 2L, 1L, 4L, 4L, 2L, 2L, 2L, 2L, 2L), .Label = c("1", 
"2", "3", "4"), class = "factor"), age = c(43, 76, 79, 84, 62, 
60, 71, 76, 75, 69, 53, 70, 56, 45, 77, 63, 36, 41, 72, 56, 59, 
84, 72, 83, 80, 49, 50, 68, 49, 46, 50, 73, 51, 45, 42, 73, 56, 
63, 30, 67, 56, 58, 72, 51, 49, 68, 65, 60, 73, 64, 52, 65, 76, 
78, 74, 79, 61, 39, 30, 77, 66, 58, 49, 67, 53, 69, 41, 42, 66, 
57, 52, 25, 79, 64, 48, 51, 47, 46, 44, 68, 58, 41, 64, 76, 65, 
60, 56, 46, 54, 50, 66, 42, 46, 66, 74, 83, 72, 54, 51, 77), 
    sex = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
    2L, 1L, 1L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 
    1L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 2L, 
    1L, 1L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 
    2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 2L, 1L, 2L, 2L, 
    2L, 2L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 2L, 2L, 2L, 1L, 
    1L, 1L, 2L, 2L, 2L, 2L, 1L, 2L, 2L, 2L, 1L, 2L, 1L, 1L, 1L
    ), .Label = c("0", "1"), class = "factor"), rad.dose = c(0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5.4, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5.4, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 5.4, 0, 0, 53.24, 5.4, 0, 0, 0, 0, 0, 0, 5.4, 
    0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5.4, 0, 0, 
    5.4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5.4, 0, 0, 5.4, 0, 0, 
    0, 0, 5.4, 0, 0, 0, 0, 0), recurrence = c(1L, 0L, 0L, 1L, 
    0L, 1L, 1L, 1L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 1L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 0L, 
    0L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 
    0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 0L, 0L, 1L, 
    0L, 0L, 0L, 0L, 0L, 1L)), row.names = c(NA, 100L), class = "data.frame")

我们可以子集 nom 起诉 $ 然后使用 apply

e$score <- apply(e, 1, function(x) 
                         nom$simpson$points[nom$simpson$simpson==x['simpson']] + 
                         nom$sex$points[nom$sex$sex==x['sex']] +
                         nom$age$points[nom$age$age==as.numeric(x['age'])] +
                         nom$Ki67$points[round(nom$Ki67$Ki67, 1)==round(as.numeric(x['Ki67']), 1)])

# the default for class 'nomogram' for print is dec=0, 
# so dec=1 will print the actual value of points, e.g.
print(nom, dec=1)

Points per unit of linear predictor: 34.35364 
Linear predictor units per point   : 0.029109 


 Ki67 Points
 0.2   0.0  
 0.3   1.1  
 0.4   2.2  
 0.5   3.4  
 0.6   4.5