Как я могу извлечь прогнозируемые баллы из номограммы и включить ее в качестве ковариации в мой массив данных? - PullRequest
1 голос
/ 15 марта 2020

Пожалуйста, найдите мой образец данных 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$score. e$score следует рассчитывать на каждом уровне пациента, т.е. в каждой строке, на основе балльной оценки, полученной из ковариат e$Ki67, e$simpson, e$age и e$sex.

. Я создал эту номограмму со следующим кодом:

enter image description here

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")

1 Ответ

1 голос
/ 15 марта 2020

Мы можем подмножество 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  
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...