Расчет показателя Бриера и интегрированного показателя Бриера с использованием пакета Ranger R

Я хочу рассчитать оценку Бриера и интегрированную оценку Бриера для моего анализа с использованием R-пакета «рейнджер».

В качестве примера использую данные ветерана из пакета "Survival" следующим образом

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

Как рассчитать балл Бриера и интегрированный балл Бриера?


r machine-learning regression random-forest survival-analysis
person Khan    schedule 14.07.2017    source источник

Ответы (1)


arrow_upward
2
arrow_downward

Интегрированный показатель Бриера (IBS) можно рассчитать с помощью функции pec пакета pec, но вам необходимо определить команду predictSurvProb для извлечения прогнозов вероятности выживания из подхода ranger моделирования (?pec:::predictSurvProb для списка доступных моделей).
A возможное решение:

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
}

Эту функцию можно использовать следующим образом:

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)

IBS можно оценить с помощью команды print.pec, указав в times моменты времени, в которые следует показывать 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
person Marco Sandri    schedule 16.07.2017