r-使用flexsurv从应用危险率的危险函数生成随机生存时间



请考虑以下事项:

我的目标是从一个灵活的参数多状态模型中提取随机生存时间,该模型拟合flexsurvreg(更具体地说是msfit.flexsurvreg(并应用一些风险比(HR,在本例中设置为0.2(

我在这里找到了一个使用任何危险函数生成随机生存时间的例子。这也是我申请的HR。

问题
根据实际数据,一旦HR低于0.2:Error in uniroot((function(x) { : no sign change found in 1000 iterations的值,我就会收到一个错误。

在下面的可复制示例中不会发生这种情况。


问题
在应用HR时,是否有比下面更好的方法来绘制随机生存时间?

有人能指出为什么";无符号变化";错误可能发生,如何修复?

非常感谢您的帮助!


最小可重复示例

# Load package
library(flexsurv)
#> Loading required package: survival
# Load data
data("bosms4")
# Define hazard ratio
hr <- 0.2
# Fit model (weibull)
crwei <- flexsurvreg(formula = Surv(years, status) ~ trans + shape(trans), 
data = bosms3, dist = "weibull")
# Create transition matrix
Q <- rbind(c(NA,1,2),c(NA,NA,3), c(NA,NA,NA))
# Capture parameters
pars <- pars.fmsm(crwei, trans=Q, newdata=data.frame(trans=1:3))
# Code from https://eurekastatistics.com/generating-random-survival-times-from-any-hazard-function/ ----
inverse = function(fn, min_x, max_x){
# Returns the inverse of a function for a given range.
# E.g. inverse(sin, 0, pi/2)(sin(pi/4)) equals pi/4 because 0 <= pi/4 <= pi/2
fn_inv = function(y){
uniroot((function(x){fn(x) - y}), lower=min_x, upper=max_x)[1]$root
}
return(Vectorize(fn_inv))
}
integrate_from_0 = function(fn, t){
int_fn = function(t) integrate(fn, 0, t)
result = sapply(t, int_fn)
value  = unlist(result["value",])
msg    = unlist(result["message",])
value[which(msg != "OK")] = NA
return(value)
}
random_survival_times = function(hazard_fn, n, max_time=10000){
# Given a hazard function, returns n random time-to-event observations.
cumulative_density_fn = function(t) 1 - exp(-integrate_from_0(hazard_fn, t))
inverse_cumulative_density_fn = inverse(cumulative_density_fn, 0, max_time)
return(inverse_cumulative_density_fn(runif(n)))
}
# Run with data ----
random_survival_times(hazard_fn = function(t){crwei$dfns$h(t, pars[[1]][1],                                        pars[[1]][2]) * hr}, n = 100)
#> Error in integrate(fn, 0, t): non-finite function value
# Adapt random_survival time function replacing 0 with 0.1 ----
random_survival_times <- function(hazard_fn, n, max_time=10000){
# Given a hazard function, returns n random time-to-event observations.
cumulative_density_fn = function(t) 1 - exp(-integrate_from_0(hazard_fn, t))
inverse_cumulative_density_fn = inverse(cumulative_density_fn, 0.1, max_time) 
return(inverse_cumulative_density_fn(runif(n)))
}
# Run again with data ----
random_survival_times(hazard_fn = function(t){crwei$dfns$h(t, pars[[1]][1], pars[[1]][2]) * hr}, n = 100)
#> Error in uniroot((function(x) {: f() values at end points not of opposite sign
# Adapt inverse adding extendedInt = "yes" ----
inverse <- function(fn, min_x, max_x){
# Returns the inverse of a function for a given range.
# E.g. inverse(sin, 0, pi/2)(sin(pi/4)) equals pi/4 because 0 <= pi/4 <= pi/2
fn_inv <- function(y){
uniroot((function(x){fn(x) - y}), lower=min_x, upper=max_x,
extendInt = "yes" # extendInt added because of error on some distributions: "Error in uniroot((function(x) { : f() values at end points not of opposite sign. Solution found here: https://stackoverflow.com/questions/38961221/uniroot-solution-in-r
)[1]$root
}
return(Vectorize(fn_inv))
}
# Run again with data ----
res <- random_survival_times(hazard_fn = function(t){crwei$dfns$h(t, pars[[1]][1],                                        pars[[1]][2]) * hr}, n = 100)
res[1:5]
#> [1]   1.074281  13.688663  30.896637 159.643827  15.805103

创建于2022-10-18与reprex v2.0.2

这种采样生存时间的方法基本上是通过对随机一致(0,1(个数的p进行采样,并找到生存概率为pxuniroot步骤用于通过数值搜索来求解S(x(=p。在您的情况下,经过1000步后很难找到解决方案。

我已经看到了这种情况,并通过添加例如uniroot(..., maxiter=10000)来修复,以告诉它要更加努力地找到解决方案。在我的测试中,这已经足够了,尽管这些可能是有限的。如果这不起作用,我建议手动挖掘并检查你试图反转的生存曲线——由于某些参数值极端,它可能无效。

(这种事情是在flexsurv包中的函数qgeneric中完成的,尽管它从rstpm2包中借用了uniroot的矢量化版本,后者更快。(

最新更新