Calcul du score Brier et du score Brier intégré à l'aide du package Ranger

Question

Je souhaite calculer le score Brier et le score Brier intégré pour mon analyse à l'aide du package «ranger» R.

À titre d'exemple, j'utilise les données vétérans du paquet « de survie » comme suit

install.packages("ranger") 
library(ranger) 
install.packages("survival") 
library(survival) 
#load veteran data 
data(veteran) 
data <- veteran 
# training and test data 
n <- nrow(data) 
testind <- sample(1:n,n*0.7) 
trainind <- (1:n)[-testind] 
#train ranger 
rg <- ranger(Surv(time, status) ~ ., data = data[trainind,]) 
# use rg to predict test data 
pred <- predict(rg,data=data[testind,],num.trees=rg$num.trees) 
#cummulative hazard function for each sample 
pred$chf 
#survival probability for each sample 
pred$survival 

Comment puis-je calculer le score Brier et intégré score de Brier?

Answer 1

Le intégré Brier Score (IBS) peut être calculée en utilisant la fonction pec du paquet pec mais vous devez définir une commande predictSurvProb pour extraire les prévisions de probabilité de survie de l'approche de modélisation ranger (?pec:::predictSurvProb pour une liste des modèles disponibles).
Une solution possibile est:

predictSurvProb.ranger <- function (object, newdata, times, ...) { 
    ptemp <- ranger:::predict.ranger(object, data = newdata, importance = "none")$survival 
    pos <- prodlim::sindex(jump.times = object$unique.death.times, 
     eval.times = times) 
    p <- cbind(1, ptemp)[, pos + 1, drop = FALSE] 
    if (NROW(p) != NROW(newdata) || NCOL(p) != length(times)) 
     stop(paste("\nPrediction matrix has wrong dimensions:\nRequested newdata x times: ", 
      NROW(newdata), " x ", length(times), "\nProvided prediction matrix: ", 
      NROW(p), " x ", NCOL(p), "\n\n", sep = "")) 
    p 
} 

Cette fonction peut être utilisée comme suit:

library(ranger) 
library(survival) 
data(veteran) 
dts <- veteran 
n <- nrow(dts) 
set.seed(1) 
testind <- sample(1:n,n*0.7) 
trainind <- (1:n)[-testind] 
rg <- ranger(Surv(time, status) ~ ., data = dts[trainind,]) 

# A formula to be inputted into the pec command 
frm <- as.formula(paste("Surv(time, status)~", 
     paste(rg$forest$independent.variable.names, collapse="+"))) 

library(pec) 
# Using pec for IBS estimation 
PredError <- pec(object=rg, 
    formula = frm, cens.model="marginal", 
    data=dts[testind,], verbose=F, maxtime=200) 

L'IBS peut être évaluée en utilisant la commande print.pec, ce qui indique en times les points de temps au cours de laquelle pour afficher le IBS:

print(PredError, times=seq(10,200,50)) 

# ... 
# Integrated Brier score (crps): 
# 
#   IBS[0;time=10) IBS[0;time=60) IBS[0;time=110) IBS[0;time=160) 
# Reference   0.043   0.183   0.212   0.209 
# ranger    0.041   0.144   0.166   0.176