Cumulative baseline hazard can be estimated non-parametrically through a Breslow estimator. Must take note that we are assuming a semi-markov process in these transitions. The cumulative hazards obtained through the times specified by 180 points.
# Semi-parametric models
#Since there are tied event times, we need to specify ties="breslow" in order to obtain the Aalen-Johansen estimator of
fitform2 <- Surv(time, status) ~ factor(tipo_de_plan_res_1)
n_trans <- max(trans_matrix, na.rm = T)
n_trans2 <- max(trans_matrix, na.rm = T)
n_trans2_9s <- max(trans_matrix2, na.rm = T)
Time for this code chunk to run: 0 minutes
As seen in the formula above, we included the transition-specific covariables regarding the time that arrived to the state into the models.
#m2_1_ggam m2_2_ggam m2_3_ggam m2_4_logn
#m2_1_rp5 m2_2_rp4 m2_3_rp2 m2_4_rp3
#defined a series of Royston-Parmar models with a function of restricted cubic splines, in which the knots (#df -1) are defined in each percentile of the distribution.
fits_c_logn2 <- vector(mode = "list", length = n_trans2)
fits_c_ggam2 <- vector(mode = "list", length = n_trans2)
fits_c_ggam_orig2 <- vector(mode = "list", length = n_trans2)
fits_c_rp042 <- vector(mode = "list", length = n_trans2)
fits_c_rp032 <- vector(mode = "list", length = n_trans2)
fits_c_rp012 <- vector(mode = "list", length = n_trans2)
fits_c_rp022 <- vector(mode = "list", length = n_trans2)
ms_d_match_surv$arrival<-ms_d_match_surv$Tstart
#APR 2022, had to center the variable to avoid convergence issues
ms_d_match_surv_exp<-ms_d_match_surv
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
no_attempts <- 30
form<-
function(i=1){
f<-dplyr::case_when(i==4~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]],i==3~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]],i==2~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]],T~paste0("Surv(time, status) ~ ",fitform2,"")[[3]])
return(f)
}
for (i in 1:3){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula=as.formula(form(i)),
data = subset(dplyr::mutate(ms_d_match_surv_exp,arrival=scale(arrival, scale=F)), trans == i),
dist = "gengamma.orig")
)
}
fits_c_ggam_orig2[[i]] <- r
}
for (i in 1:3){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula=as.formula(form(i)),
data = subset(dplyr::mutate(ms_d_match_surv_exp,arrival=scale(arrival, scale=F)), trans == i),
dist = "gengamma")
)
}
fits_c_ggam2[[i]] <- r
}
for (i in 4){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula=as.formula(form(i)),
data = subset(dplyr::mutate(ms_d_match_surv_exp,arrival=scale(arrival, scale=F)), trans == i),
dist = "lnorm")
)
}
fits_c_logn2[[i]] <- r
}
for (i in 1){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula=as.formula(form(i)),
k=4,
data = subset(ms_d_match_surv_exp, trans == i))
)
}
fits_c_rp042[[i]] <- r
}
for (i in 2){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula=as.formula(form(i)),
k=3,
data = subset(ms_d_match_surv_exp, trans == i))
)
}
fits_c_rp032[[i]] <- r
}
for (i in 3){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula=as.formula(form(i)),
k=1,
data = subset(ms_d_match_surv_exp, trans == i))
)
}
fits_c_rp012[[i]] <- r
}
for (i in 4){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula=as.formula(form(i)),
k=2,
data = subset(ms_d_match_surv_exp, trans == i))
)
}
fits_c_rp022[[i]] <- r
}
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
Time for this code chunk to run: 0 minutes
# m2_1_gom m2_2_gom m2_3_logn m2_4_ggam m2_5_logn m2_6_ggam m2_7_ggam m2_8_ggam
#m2_1_rp9 m2_2_rp10 m2_3_rp10 m2_4_rp7 m2_5_rp3 m2_6_rp4 m2_7_rp4 m2_8_rp2
fits_c_gomp3 <- vector(mode = "list", length = n_trans2_9s)
fits_c_logn3 <- vector(mode = "list", length = n_trans2_9s)
fits_c_ggam3 <- vector(mode = "list", length = n_trans2_9s)
fits_c_ggam_orig3 <- vector(mode = "list", length = n_trans2_9s)
fits_c_rp083 <- vector(mode = "list", length = n_trans2_9s)
fits_c_rp093 <- vector(mode = "list", length = n_trans2_9s)
fits_c_rp063 <- vector(mode = "list", length = n_trans2_9s)
fits_c_rp023 <- vector(mode = "list", length = n_trans2_9s)
fits_c_rp033 <- vector(mode = "list", length = n_trans2_9s)
fits_c_rp013 <- vector(mode = "list", length = n_trans2_9s)
ms_d_match_surv_oct_2022$arrival<-ms_d_match_surv_oct_2022$Tstart
#APR 2022, had to center the variable to avoid convergence issues
ms_d_match_surv_oct_2022_exp<-ms_d_match_surv_oct_2022
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
no_attempts <- 30
form_9s<-
function(i=1){
f<-dplyr::case_when(i==9~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]], i==8~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]], i==7~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]], i==6~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]], i==5~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]], i==4~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]],i==3~paste0("Surv(time, status) ~ ",fitform2," + arrival")[[3]],i==2~paste0("Surv(time, status) ~ ",fitform2,"")[[3]],T~paste0("Surv(time, status) ~ ",fitform2,"")[[3]])
return(f)
}
#It looks like the hazard is decreasing for a large portion of the follow-up, so the best fitting shape parameter is negative, and positive shape parameters give zero likelihood. I managed to get it to fit using
#https://treeage.zendesk.com/hc/en-us/articles/360002682794-Gompertz-distribution-with-negative-shape-parameter-
#Some implementations of the Gompertz restrict a to be strictly positive, which ensures that the
#probability of survival decreases to zero as x increases to infinity. The more flexible implementation
#given here is consistent with streg in Stata
#Gompertz distribution with unrestricted shape parameter,
for (i in 1:2){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula= as.formula(form_9s(i)),
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i), inits=c(-1, 1/mean(subset(ms_d_match_surv_oct_2022_exp, trans == i)[["time"]])),
# control=list(reltol=1e-16,fnscale = 16e2),
dist = "gompertz")
)
}
fits_c_gomp3[[i]] <- r
}
options(warn=0)
for (i in c(3,5)){
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula= as.formula(form_9s(i)),
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
dist = "lnorm")
)
}
fits_c_logn3[[i]] <- r
}
for (i in c(4,6,7,8)){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula= as.formula(form_9s(i)),
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16,fnscale = 16e2, trace=100),
dist = "gengamma.orig", )
)
}
fits_c_ggam_orig3[[i]] <- r
}
## initial value 26.486558
## iter 10 value 22.852706
## iter 20 value 22.832333
## iter 30 value 22.820315
## iter 40 value 22.811104
## iter 50 value 22.808577
## iter 60 value 22.806071
## iter 70 value 22.803390
## iter 80 value 22.800994
## iter 90 value 22.799291
## iter 100 value 22.798912
## final value 22.798912
## stopped after 100 iterations
## initial value 8.284789
## iter 10 value 7.469907
## final value 7.465570
## converged
## initial value 0.823551
## iter 10 value 0.727668
## final value 0.724608
## converged
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
## initial value 2.735506
## iter 10 value 2.504116
## final value 2.501762
## converged
## Error in flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp, :
## (convertido del aviso) Optimisation has probably not converged to the maximum likelihood - Hessian is not positive definite.
options(warn=0)
for (i in c(4,6,7,8)){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvreg(formula= as.formula(form_9s(i)),
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16,fnscale = 16e2, trace=100),
dist = "gengamma")
)
}
fits_c_ggam3[[i]] <- r
}
## initial value 26.128908
## iter 10 value 22.801817
## iter 20 value 22.771902
## iter 30 value 22.771502
## iter 40 value 22.771501
## final value 22.771501
## converged
## initial value 8.246908
## iter 10 value 7.408580
## final value 7.408111
## converged
## initial value 0.813966
## final value -20807.645072
## converged
## initial value 2.715623
## iter 10 value 2.478881
## iter 20 value 2.476830
## final value 2.476796
## converged
options(warn=0)
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("RP")
#method: SANN, "Nelder-Mead", "CG", L-BFGS-B y BFGS Brent
#file:///C:/Users/CISSFO~1/AppData/Local/Temp/MicrosoftEdgeDownloads/0a14410e-d817-4ad6-a810-99e535568c58/RumenickPereiraDaSilva_DISSERT.pdf
fits_c_rp073[[1]] <- flexsurvspline(Surv(time, status)~ factor(tipo_de_plan_res_1),
k=7,#k is equivalent to df-1 in the notation of stpm for Stata
data = subset(ms_d_match_surv_oct_2022_exp, trans == 1),
# knots=
#inits=c(-1, 1/mean(subset(ms_d_match_surv_oct_2022_exp, trans == i)[["time"]])),
#control=list(reltol=1e-16, fnscale=16e4, maxit = 4e3, trace=3e2, abstol=1e-16),
#en STATA, -41654.94 log-likelihood
#control= list(trace=3e2, maxit = 4e3, reltol=1e-16, abstol=1e-16), #lower = -Inf, upper = 41654
hessian=T#,
#method = "SANN",
#control = list(maxit = 2e4, temp = 20, trace=1e1) # para SANN
# knots = log(c(4,12))
)
## Warning in flexsurvreg(formula = Surv(time, status) ~
## factor(tipo_de_plan_res_1), : Optimisation has probably not converged to the
## maximum likelihood - Hessian is not positive definite.
## Error in fits_c_rp073[[1]] <- flexsurvspline(Surv(time, status) ~ factor(tipo_de_plan_res_1), : objeto 'fits_c_rp073' no encontrado
fits_c_rp083[[2]] <- flexsurvspline(Surv(time, status)~ factor(tipo_de_plan_res_1),
k=8,#k is equivalent to df-1 in the notation of stpm for Stata
data = subset(ms_d_match_surv_oct_2022_exp, trans == 2),
# knots=
#inits=c(-1, 1/mean(subset(ms_d_match_surv_oct_2022_exp, trans == i)[["time"]])),
#control=list(reltol=1e-16,fnscale=-16e4, maxit = 4e3, trace=3e2),
#en STATA, -41654.94 log-likelihood
#control= list(trace=3e2, maxit = 4e3, reltol=1e-16, abstol=1e-16), #lower = -Inf, upper = 41654
hessian=T#,
#method = "SANN",
#control = list(maxit = 2e4, temp = 20, trace=1e1) # para SANN
# knots = log(c(4,12))
)
## Warning in flexsurvreg(formula = Surv(time, status) ~
## factor(tipo_de_plan_res_1), : Optimisation has probably not converged to the
## maximum likelihood - Hessian is not positive definite.
for (i in c(3)){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula= Surv(time, status) ~ factor(tipo_de_plan_res_1) + arrival,
k=9,
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16, trace=3e2, maxit = 1e3, reltol=1e-16, abstol=1e-16) #fnscale = 1600
))
}
fits_c_rp093[[i]] <- r
}
## initial value 20328.716621
## iter 10 value 14391.711902
## iter 20 value 13877.869092
## iter 30 value 13877.862912
## iter 40 value 13877.862912
## final value 13877.862912
## converged
options(warn = 0)
for (i in 4){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula= as.formula(form_9s(i)),
k=5,
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16,fnscale = 16e2, trace=3e2)
))
}
fits_c_rp063[[i]] <- r
}
## initial value 33.233092
## iter 10 value 22.841030
## iter 20 value 22.778953
## iter 30 value 22.778953
## final value 22.778953
## converged
options(warn = 0)
for (i in 5){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula= as.formula(form_9s(i)),
k=1,
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16,fnscale = 16e2, trace=3e2)
))
}
fits_c_rp023[[i]] <- r
}
## initial value 3.525742
## iter 10 value 2.561575
## iter 20 value 2.560053
## iter 30 value 2.558692
## iter 40 value 2.557811
## iter 50 value 2.556941
## iter 60 value 2.556154
## iter 70 value 2.554859
## iter 80 value 2.554448
## iter 90 value 2.553994
## iter 100 value 2.553564
## final value 2.553564
## stopped after 100 iterations
options(warn = 0)
for (i in c(6,7)){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula= as.formula(form_9s(i)),
k=2,
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16,fnscale = 16e2, trace=3e2)
))
}
fits_c_rp033[[i]] <- r
}
## initial value 10.139025
## iter 10 value 7.393558
## iter 20 value 7.393254
## iter 30 value 7.389455
## iter 40 value 7.389245
## iter 50 value 7.389221
## iter 60 value 7.389200
## iter 70 value 7.389189
## iter 80 value 7.389185
## iter 90 value 7.389182
## iter 100 value 7.389180
## final value 7.389180
## stopped after 100 iterations
## initial value 0.972015
## iter 10 value 0.714250
## iter 20 value 0.713039
## iter 30 value 0.713024
## iter 40 value 0.713024
## iter 50 value 0.713024
## iter 60 value 0.713024
## iter 70 value 0.713024
## iter 80 value 0.713024
## iter 90 value 0.713024
## iter 100 value 0.713024
## final value 0.713024
## stopped after 100 iterations
options(warn = 0)
for (i in 8){
options(warn = 2)
r <- NULL
attempt <- 0
while( is.null(r) && attempt <= no_attempts ) {
attempt <- attempt + 1
try(
r <- flexsurvspline(formula= as.formula(form_9s(i)),
k=0,
data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,arrival=scale(arrival, scale=F)), trans == i),
control=list(reltol=1e-16,fnscale = 16e2, trace=3e2)
))
}
fits_c_rp013[[i]] <- r
}
## initial value 3.084199
## iter 10 value 2.503741
## iter 20 value 2.497120
## iter 30 value 2.496260
## iter 40 value 2.496257
## iter 50 value 2.496254
## iter 60 value 2.496254
## iter 70 value 2.496254
## iter 80 value 2.496254
## final value 2.496254
## converged
options(warn = 0)
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
Time for this code chunk to run: 0 minutes
The scale of arival is centered is set in 269.7 days for the 5 states model, and 145.6 for the 9 states model.
#https://wilmarigl.de/wp-content/uploads/2018/01/tutorial_hr_parsurvmodels.pdf
#> ### First fix a patient with reference values for the covariates
#> ### and 0 for all the time-dependent covariates; this will give the
#> ### baseline hazards
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
# Database to contrast adjustments
newdat_a <- data.table::data.table(tipo_de_plan_res_1= factor(c(rep(1,1*n_trans2))),
arrival=rep(0,),
strata= rep(1:n_trans2,1)
)
newdat_b <- data.table::data.table(tipo_de_plan_res_1= factor(c(rep(0,1*n_trans2))),
arrival=rep(0,),
strata= rep(1:n_trans2,1)
)
newdat_c <- data.table::data.table(tipo_de_plan_res_1= factor(c(rep(1,1*n_trans2_9s))),
arrival=rep(0,),
strata= rep(1:n_trans2_9s,1)
)
newdat_d <- data.table::data.table(tipo_de_plan_res_1= factor(c(rep(0,1*n_trans2_9s))),
arrival=rep(0,),
strata= rep(1:n_trans2_9s,1)
)
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#APR 2022- SCALING
newdat_a_sc<-mutate(newdat_a,arrival=scale(1096- attr(scale(ms_d_match_surv_exp$arrival,scale=F),"scaled:center"),scale=F))
newdat_b_sc<-mutate(newdat_b,arrival=scale(1096- attr(scale(ms_d_match_surv_exp$arrival,scale=F),"scaled:center"),scale=F))
newdat_c_sc<-mutate(newdat_c,arrival=scale(731- attr(scale(ms_d_match_surv_oct_2022_exp$arrival,scale=F),"scaled:center"),scale=F))
newdat_d_sc<-mutate(newdat_d,arrival=scale(731- attr(scale(ms_d_match_surv_oct_2022_exp$arrival,scale=F),"scaled:center"),scale=F))
newdat_a$arrival<-ifelse(newdat_a$arrival==0,1096,newdat_a$arrival)
newdat_b$arrival<-ifelse(newdat_b$arrival==0,1096,newdat_b$arrival)
newdat_c$arrival<-ifelse(newdat_c$arrival==0,1096,newdat_c$arrival)
newdat_d$arrival<-ifelse(newdat_d$arrival==0,1096,newdat_d$arrival)
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
fitted_flexsurvreg2<-data.frame()
fit_flexsurvreg2<-data.frame()
#7 distributions
#4 transitions
dists_w_covs_5s_w_arrival<-cbind.data.frame(covs=rep("fits_c_",(7*n_trans)),
formal=rep(c("Generalized gamma", "Generalized gamma (original)", "Lognormal", paste0("RP0",1:4)),1*n_trans2),
dist=rep(c("gengamma","gengamma.orig", "lnorm", rep("no dist",4)),n_trans2),
model=rep(c("ggam2", "ggam_orig2", "logn2", paste0("rp0",1:4,2)),1*n_trans2),
trans=rep(1:n_trans2, each=7))
dists_w_covs_5s_w_arrival<-dists_w_covs_5s_w_arrival %>%
dplyr::filter(model %in% c(paste0("rp0",1:4,"2"),"ggam2","logn2")) %>%
dplyr::filter(dplyr::case_when(model=="logn2" & trans==4~T,
model=="ggam2" & trans %in% 1:3~T,
model=="rp022" & trans==4~T,
model=="rp042" & trans==1~T,
model=="rp032" & trans==2~T,
model=="rp012" & trans==3~T,
T~F)) %>%
dplyr::mutate(get_nd_a=dplyr::case_when(!grepl("ggam|logn",model)~"newdat_a",T~"newdat_a_sc")) %>%
dplyr::mutate(get_nd_b=dplyr::case_when(!grepl("ggam|logn",model)~"newdat_b",T~"newdat_b_sc"))
Time for this code chunk to run: 0 minutes
# m2_1_gom m2_2_gom m2_3_logn m2_4_ggam m2_5_logn m2_6_ggam m2_7_ggam m2_8_ggam
#m2_1_rp9 m2_2_rp10 m2_3_rp10 m2_4_rp7 m2_5_rp3 m2_6_rp4 m2_7_rp4 m2_8_rp2
invisible("Every model is scaled in the arrival")
fitted_flexsurvreg3<-data.frame()
fit_flexsurvreg3<-data.frame()
Time for this code chunk to run: 0 minutes
# Semi-parametric models
#Since there are tied event times, we need to specify ties="breslow" in order to obtain the Aalen-Johansen estimator of
#the transition probability
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
formula3_mstate<-
as.formula(paste0("Surv(time, status) ~", paste0(fitform2," + arrival + strata(trans)")[[3]]))
cox_fits <- survival::coxph(formula3_mstate,
data = ms_d_match_surv_exp, method = "breslow")
cox_fits_9s <- survival::coxph(formula3_mstate,
data = ms_d_match_surv_oct_2022_exp, method = "breslow")
paste0("Test the Proportional Hazards Assumption of a Cox Regression:")
## [1] "Test the Proportional Hazards Assumption of a Cox Regression:"
cox.zph(cox_fits)
## chisq df p
## factor(tipo_de_plan_res_1) 30.2 1 3.9e-08
## arrival 28.3 1 1.0e-07
## GLOBAL 56.9 2 4.4e-13
paste0(c("Not-proportional hazards"))
## [1] "Not-proportional hazards"
invisible(c("dists_w_covs_5s_w_arrival ver para ver la distribución"))
#1° TRANS, un modelo con splines cúblicos restringidos a 4 nudos (RP05) y la distribución F generalizado (después G-gamma en STATA) obtuvieron un mejor ajuste. En R, el único que Gen-F es peor que RP
#2° TRANS, un modelo con splines cúblicos restringidos a 3 nudos (RP04) y la distribución F generalizado (después G-gamma en STATA) obtuvieron un mejor ajuste.
#3° TRANS, un modelo con splines cúblicos restringidos a 2 nudos (RP03) y la distribución F generalizado (Lognormal en STATA) obtuvieron un mejor ajuste.
#4° TRANS, un modelo con splines cúblicos restringidos a 2 nudos (RP03) y la distribución F generalizado (Lognormal en STATA) obtuvieron un mejor ajuste.
#EN STATA, todos los RPs son mejores que los paramétricos. En R, sólo la transición 3 y 4 tienen menor error en Gen-F en el max time
invisible("At October 2022")
##m2_1_ggam m2_2_ggam m2_3_ggam m2_4_logn
#m2_1_rp5 m2_2_rp4 m2_3_rp2 m2_4_rp3
sel_param_fits_a <- vector(length = n_trans, mode = "list")
sel_param_fits_a[[1]]<- fits_c_ggam2[[1]] #fits_c_genf2[[1]]
sel_param_fits_a[[2]]<- fits_c_ggam2[[2]]
sel_param_fits_a[[3]]<- fits_c_ggam2[[3]]
sel_param_fits_a[[4]]<- fits_c_logn2[[4]]
sel_param_fits_b <- vector(length = n_trans, mode = "list")
sel_param_fits_b[[1]]<- fits_c_rp042[[1]]
sel_param_fits_b[[2]]<- fits_c_rp032[[2]]
sel_param_fits_b[[3]]<- fits_c_rp012[[3]]
sel_param_fits_b[[4]]<- fits_c_rp022[[4]]
# m2_1_gom m2_2_gom m2_3_logn m2_4_ggam m2_5_logn m2_6_ggam m2_7_ggam m2_8_ggam
#m2_1_rp9 m2_2_rp10 m2_3_rp10 m2_4_rp7 m2_5_rp3 m2_6_rp4 m2_7_rp4 m2_8_rp2
sel_param_fits_c <- vector(length = n_trans2_9s, mode = "list")
sel_param_fits_c[[1]]<- fits_c_gomp3[[1]] #fits_c_genf2[[1]]
sel_param_fits_c[[2]]<- fits_c_gomp3[[2]]
sel_param_fits_c[[3]]<- fits_c_logn3[[3]]
sel_param_fits_c[[4]]<- fits_c_ggam3[[4]]
sel_param_fits_c[[5]]<- fits_c_logn3[[5]]
sel_param_fits_c[[6]]<- fits_c_ggam3[[6]]
sel_param_fits_c[[7]]<- fits_c_ggam3[[7]]
sel_param_fits_c[[8]]<- fits_c_ggam3[[8]]
sel_param_fits_d <- vector(length = n_trans2_9s, mode = "list")
sel_param_fits_d[[1]]<- fits_c_rp083[[1]]
sel_param_fits_d[[2]]<- fits_c_rp093[[2]]
sel_param_fits_d[[3]]<- fits_c_rp093[[3]]
sel_param_fits_d[[4]]<- fits_c_rp063[[4]]
sel_param_fits_d[[5]]<- fits_c_rp023[[5]]
sel_param_fits_d[[6]]<- fits_c_rp033[[6]]
sel_param_fits_d[[7]]<- fits_c_rp033[[7]]
sel_param_fits_d[[8]]<- fits_c_rp013[[8]]
Time for this code chunk to run: 0 minutes
#https://stats.stackexchange.com/questions/533495/can-one-compare-hazard-ratio-and-average-hazard-ratio?noredirect=1&lq=1
#2_1_gom m2_2_gom m2_3_logn m2_4_ggam m2_5_logn m2_6_ggam m2_7_ggam m2_8_ggam
calcAHRgeo <- function(x, h0, h1, ft, wt){
integrand <- function(x){ log(h1(x)/h0(x)) * wt(x) * ft(x) }
logahr <- integrate(integrand, lower=0, upper=x)$value
ahr <- exp(logahr)
return(ahr)
}
#https://wilmarigl.de/wp-content/uploads/2018/01/tutorial_hr_parsurvmodels.pdf
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Log-normal")#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
logn_aft_to_ahr<-
function(x, trans){
fit.lnm<-get(x)[[trans]]
# Probability Density Functions
f0 <- function(x,
meanlog = coef(fit.lnm)["meanlog"],
sdlog = exp(coef(fit.lnm)["sdlog"])){
dlnorm(x=x, meanlog=meanlog, sdlog=sdlog)
}
f1 <- function(x,
meanlog = coef(fit.lnm)["meanlog"]+coef(fit.lnm)["factor(tipo_de_plan_res_1)1"],
sdlog = exp(coef(fit.lnm)["sdlog"])){
dlnorm(x=x, meanlog=meanlog, sdlog=sdlog)
}
ft <- function(x){ (f0(x) + f1(x))}
# Survival functions
S0 <- function(x,
meanlog = coef(fit.lnm)["meanlog"],
sdlog = exp(coef(fit.lnm)["sdlog"])){
plnorm(q=x, meanlog=meanlog, sdlog=sdlog, lower=FALSE)
}
S1 <- function(x,
meanlog = coef(fit.lnm)["meanlog"]+coef(fit.lnm)["factor(tipo_de_plan_res_1)1"],
sdlog = exp(coef(fit.lnm)["sdlog"])){
plnorm(q=x, meanlog=meanlog, sdlog=sdlog, lower=FALSE)
}
St <- function(x){ ( S0(x) * f0(x) + S1(x) * f1(x) ) / ( f0(x) + f1(x) ) }
## St <- function(x){ (S0(x) + S1(x))/2} ## assuming same number of events
# Hazard functions
h0 <- function(x, f=f0, S=S0){f(x)/S(x)}
h1 <- function(x, f=f1, S=S1){f(x)/S(x)}
newList <- list("90 days" = calcAHRgeo(x=90, h0=h0, h1=h1, ft=ft, wt=St),
"1 year" = calcAHRgeo(x=365.25, h0=h0, h1=h1, ft=ft, wt=St),
"3 years" = calcAHRgeo(x=1096, h0=h0, h1=h1, ft=ft, wt=St),
"5 years" = calcAHRgeo(x=1826, h0=h0, h1=h1, ft=ft, wt=St)
)
return(newList)
}
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
invisible("Generalized gamma")#_#_#_#_#_#_#_#_#_#_#_#_#_
#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_#_
# Probability Density Functions
ggam_aft_to_ahr<-
function(x, trans){
fit.ggm<-get(x)[[trans]]
print(fit.ggm)
f0 <- function(x,
mu = coef(fit.ggm)["mu"],
sigma =exp(coef(fit.ggm)["sigma"]),
Q = coef(fit.ggm)["Q"]){
dgengamma(x=x, mu=mu, sigma=sigma, Q=Q)
}
f1 <- function(x,
mu = coef(fit.ggm)["mu"]+coef(fit.ggm)["factor(tipo_de_plan_res_1)1"],
sigma =exp(coef(fit.ggm)["sigma"]),
Q = coef(fit.ggm)["Q"]){
dgengamma(x=x, mu=mu, sigma=sigma, Q=Q)
}
ft <- function(x){ (f0(x) + f1(x))}
# Cumulative Density Functions
S0 <- function(x,
mu = coef(fit.ggm)["mu"],
sigma =exp(coef(fit.ggm)["sigma"]),
Q = coef(fit.ggm)["Q"]){
pgengamma(q=x, mu=mu, sigma=sigma, Q=Q, lower=FALSE)
}
S1 <- function(x,
mu = coef(fit.ggm)["mu"]+coef(fit.ggm)["factor(tipo_de_plan_res_1)1"],
sigma =exp(coef(fit.ggm)["sigma"]),
Q = coef(fit.ggm)["Q"]){
pgengamma(q=x, mu=mu, sigma=sigma, Q=Q, lower=FALSE)
}
St <- function(x){ ( S0(x) * f0(x) + S1(x) * f1(x) ) / ( f0(x) + f1(x) ) }
## St <- function(x){ (S0(x) + S1(x))/2} ## assuming same number of events
## Hazard functions
h0 <- function(x,
mu = coef(fit.ggm)["mu"],
sigma =exp(coef(fit.ggm)["sigma"]),
Q = coef(fit.ggm)["Q"]){
hgengamma(x=x, mu=mu, sigma=sigma, Q=Q)
}
h1 <- function(x,
mu = coef(fit.ggm)["mu"]+coef(fit.ggm)["factor(tipo_de_plan_res_1)1"],
sigma =exp(coef(fit.ggm)["sigma"]),
Q = coef(fit.ggm)["Q"]){
hgengamma(x=x, mu=mu, sigma=sigma, Q=Q)
}
newList <- list("90 days" = calcAHRgeo(x=90, h0=h0, h1=h1, ft=ft, wt=St),
"1 year" = calcAHRgeo(x=365.25, h0=h0, h1=h1, ft=ft, wt=St),
"3 years" = calcAHRgeo(x=1096, h0=h0, h1=h1, ft=ft, wt=St),
"5 years" = calcAHRgeo(x=1826, h0=h0, h1=h1, ft=ft, wt=St)
)
return(newList)
}
print("Average hazard ratio")
## [1] "Average hazard ratio"
cat("Model of 5 states, first transition")
## Model of 5 states, first transition
ggam_aft_to_ahr("fits_c_ggam2",1)
## Call:
## flexsurvreg(formula = as.formula(form(i)), data = subset(dplyr::mutate(ms_d_match_surv_exp,
## arrival = scale(arrival, scale = F)), trans == i), dist = "gengamma")
##
## Estimates:
## data mean est L95% U95% se
## mu NA 8.1644 8.0647 8.2641 0.0509
## sigma NA 2.4307 2.3796 2.4828 0.0263
## Q NA -1.0995 -1.2133 -0.9857 0.0581
## factor(tipo_de_plan_res_1)1 0.5000 -0.5727 -0.6405 -0.5050 0.0346
## exp(est) L95% U95%
## mu NA NA NA
## sigma NA NA NA
## Q NA NA NA
## factor(tipo_de_plan_res_1)1 0.5640 0.5270 0.6035
##
## N = 22452, Events: 6370, Censored: 16082
## Total time at risk: 34109835
## Log-likelihood = -60116.56, df = 4
## AIC = 120241.1
## $`90 days`
## [1] 1.034761
##
## $`1 year`
## [1] 1.121543
##
## $`3 years`
## [1] 1.190868
##
## $`5 years`
## [1] 1.214286
cat("Model of 9 states, transitions 3 4 5 6 7 8")
## Model of 9 states, transitions 3 4 5 6 7 8
logn_aft_to_ahr("fits_c_logn3",3)
## $`90 days`
## [1] 1.107305
##
## $`1 year`
## [1] 1.197835
##
## $`3 years`
## [1] 1.285328
##
## $`5 years`
## [1] 1.327338
logn_aft_to_ahr("fits_c_logn3",5)
## $`90 days`
## [1] 1.010998
##
## $`1 year`
## [1] 1.03859
##
## $`3 years`
## [1] 1.07001
##
## $`5 years`
## [1] 1.083333
ggam_aft_to_ahr( "fits_c_ggam3", 4)
## Call:
## flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,
## arrival = scale(arrival, scale = F)), trans == i), dist = "gengamma",
## control = list(reltol = 1e-16, fnscale = 1600, trace = 100))
##
## Estimates:
## data mean est L95% U95%
## mu NA 9.425990 9.271101 9.580879
## sigma NA 3.423292 3.242992 3.613615
## Q NA -0.174012 -0.326673 -0.021351
## factor(tipo_de_plan_res_1)1 0.448764 -1.191746 -1.337199 -1.046293
## arrival 4.843927 -0.001043 -0.001544 -0.000543
## se exp(est) L95% U95%
## mu 0.079026 NA NA NA
## sigma 0.094502 NA NA NA
## Q 0.077889 NA NA NA
## factor(tipo_de_plan_res_1)1 0.074212 0.303691 0.262580 0.351237
## arrival 0.000255 0.998957 0.998458 0.999457
##
## N = 13067, Events: 4046, Censored: 9021
## Total time at risk: 18299896
## Log-likelihood = -36434.4, df = 5
## AIC = 72878.8
## $`90 days`
## [1] 1.131721
##
## $`1 year`
## [1] 1.220509
##
## $`3 years`
## [1] 1.295448
##
## $`5 years`
## [1] 1.328334
ggam_aft_to_ahr( "fits_c_ggam3", 6)
## Call:
## flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,
## arrival = scale(arrival, scale = F)), trans == i), dist = "gengamma",
## control = list(reltol = 1e-16, fnscale = 1600, trace = 100))
##
## Estimates:
## data mean est L95% U95%
## mu NA 7.50e+00 7.32e+00 7.69e+00
## sigma NA 2.18e+00 2.06e+00 2.30e+00
## Q NA -7.23e-01 -9.69e-01 -4.77e-01
## factor(tipo_de_plan_res_1)1 5.43e-01 1.45e-02 -1.33e-01 1.62e-01
## arrival 5.55e+02 2.48e-04 1.47e-04 3.49e-04
## se exp(est) L95% U95%
## mu 9.65e-02 NA NA NA
## sigma 6.19e-02 NA NA NA
## Q 1.25e-01 NA NA NA
## factor(tipo_de_plan_res_1)1 7.55e-02 1.01e+00 8.75e-01 1.18e+00
## arrival 5.14e-05 1.00e+00 1.00e+00 1.00e+00
##
## N = 4046, Events: 1305, Censored: 2741
## Total time at risk: 4698233
## Log-likelihood = -11852.98, df = 5
## AIC = 23715.95
## $`90 days`
## [1] 0.9987035
##
## $`1 year`
## [1] 0.9962212
##
## $`3 years`
## [1] 0.9944871
##
## $`5 years`
## [1] 0.9939478
try(ggam_aft_to_ahr( "fits_c_ggam3", 7)) #error
## Call:
## flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,
## arrival = scale(arrival, scale = F)), trans == i), dist = "gengamma",
## control = list(reltol = 1e-16, fnscale = 1600, trace = 100))
##
## Estimates:
## data mean est L95% U95%
## mu NA 6.44e+00 5.72e+00 7.16e+00
## sigma NA 1.02e+00 6.71e-01 1.56e+00
## Q NA 1.89e-10 -8.40e-05 8.40e-05
## factor(tipo_de_plan_res_1)1 7.67e-01 2.82e-06 -6.10e-01 6.10e-01
## arrival 1.32e+03 2.05e-03 1.60e-03 2.50e-03
## se exp(est) L95% U95%
## mu 3.66e-01 NA NA NA
## sigma 2.20e-01 NA NA NA
## Q 4.28e-05 NA NA NA
## factor(tipo_de_plan_res_1)1 3.11e-01 1.00e+00 5.44e-01 1.84e+00
## arrival 2.31e-04 1.00e+00 1.00e+00 1.00e+00
##
## N = 447, Events: 127, Censored: 320
## Total time at risk: 424351
## Log-likelihood = 33292232, df = 5
## AIC = -66584454
##
## Error in integrate(integrand, lower = 0, upper = x) :
## maximum number of subdivisions reached
ggam_aft_to_ahr( "fits_c_ggam3", 8)
## Call:
## flexsurvreg(formula = as.formula(form_9s(i)), data = subset(dplyr::mutate(ms_d_match_surv_oct_2022_exp,
## arrival = scale(arrival, scale = F)), trans == i), dist = "gengamma",
## control = list(reltol = 1e-16, fnscale = 1600, trace = 100))
##
## Estimates:
## data mean est L95% U95%
## mu NA 7.30e+00 7.05e+00 7.56e+00
## sigma NA 1.80e+00 1.61e+00 2.02e+00
## Q NA -4.23e-01 -9.26e-01 8.01e-02
## factor(tipo_de_plan_res_1)1 5.61e-01 -2.60e-01 -4.99e-01 -2.16e-02
## arrival 1.06e+03 3.19e-04 6.95e-05 5.69e-04
## se exp(est) L95% U95%
## mu 1.30e-01 NA NA NA
## sigma 1.06e-01 NA NA NA
## Q 2.57e-01 NA NA NA
## factor(tipo_de_plan_res_1)1 1.22e-01 7.71e-01 6.07e-01 9.79e-01
## arrival 1.27e-04 1.00e+00 1.00e+00 1.00e+00
##
## N = 1305, Events: 447, Censored: 858
## Total time at risk: 1259238
## Log-likelihood = -3962.874, df = 5
## AIC = 7935.748
## $`90 days`
## [1] 1.029869
##
## $`1 year`
## [1] 1.094424
##
## $`3 years`
## [1] 1.141215
##
## $`5 years`
## [1] 1.154815
#aHR
# cat("The average HR (residential:outpatient) for patients with a follow-up period of",
# "3 months",
# "\nthe average hazard ratio is ",
# round(ahr.maxt3m, 2), ".")
Time for this code chunk to run: 0 minutes
#https://stats.stackexchange.com/questions/533495/can-one-compare-hazard-ratio-and-average-hazard-ratio?noredirect=1&lq=1
#The OC is the probability P(T1 < T0) that a randomly chosen survival time T1 from group G1 is smaller than a randomly
#chosen survival time T0 from group G0.
# The concordance probability represents the pairwise probability of lower patient risk given longer survival time. The c-index and the concordance probability estimate have been used to estimate the concordance probability when patient-specific risk scores are continuous.
# average HRs which them selves approximate the odds of concordance, defined for two treatment groups A and B as OC = P(TA < TB)/P(TB < TA), where TA and TB denote survival times from two subjects randomly selected from these groups. Odds of concordance can be conveniently transformed into concordance probabilities c = P(TA < TB) = OC/(OC + 1), which are intuitive effect size measures
# probabilidad de que grupo B[ambulatorio] tenga >T que A[residencial]
# /probabilidad de que grupo A[residencial] tenga >T que B[ambulatorio]
# AHR (average hazard ratio) setting, the weight for all cases at risk at an event time t is set to the product of the estimated survival probability and the inverse of the estimated probability of censoring at that time.
# AHR: La ponderación por cada tiempo evento t es= p(supervivencia)* 1/p(censura|t)
Time for this code chunk to run: 0 minutes
Sys.getenv("R_LIBS_USER")
## [1] "C:/Users/CISS Fondecyt/OneDrive/Documentos/R/win-library/4.0"
rstudioapi::getSourceEditorContext()
## Document Context:
## - id: 'B97877EB'
## - path: 'C:/Users/CISS Fondecyt/Mi unidad/Alvacast/SISTRAT 2019 (github)/SUD_CL/Matching_Process5_SEP_22.Rmd'
## - contents: <1575 rows>
## Document Selection:
## - [77, 31] -- [77, 31]: ''
if (grepl("CISS Fondecyt",rstudioapi::getSourceEditorContext()$path)==T){
save.image("C:/Users/CISS Fondecyt/Mi unidad/Alvacast/SISTRAT 2019 (github)/mult_state_3_apr22.RData")
} else if (grepl("andre",rstudioapi::getSourceEditorContext()$path)==T){
save.image("C:/Users/andre/Desktop/SUD_CL/mult_state_3_apr22.RData")
} else if (grepl("E:",rstudioapi::getSourceEditorContext()$path)==T){
save.image("E:/Mi unidad/Alvacast/SISTRAT 2019 (github)/mult_state_3_apr22.RData")
} else if (grepl("G:",rstudioapi::getSourceEditorContext()$path)==T){
save.image("G:/Mi unidad/Alvacast/SISTRAT 2019 (github)/mult_state_3_apr22.RData")
} else {
save.image("~/mult_state_3_apr22.RData")
path.expand("~/mult_state_3_apr22.RData")
}
sessionInfo()
## R version 4.0.2 (2020-06-22)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19042)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Spanish_Chile.1252 LC_CTYPE=Spanish_Chile.1252
## [3] LC_MONETARY=Spanish_Chile.1252 LC_NUMERIC=C
## [5] LC_TIME=Spanish_Chile.1252
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## other attached packages:
## [1] Metrics_0.1.4 muhaz_1.2.6.4 flexsurv_2.2
## [4] mstate_0.3.1 DiagrammeR_1.0.6.1.9000 Amelia_1.8.0
## [7] Rcpp_1.0.7 igraph_1.2.6 eha_2.9.0
## [10] cobalt_4.3.1 MatchIt_4.2.0 tableone_0.13.0
## [13] stargazer_5.2.2 reshape2_1.4.4 gridExtra_2.3
## [16] foreign_0.8-81 survMisc_0.5.5 ggfortify_0.4.12
## [19] survminer_0.4.9 ggpubr_0.4.0 epiR_2.0.33
## [22] forcats_0.5.1 purrr_0.3.4 readr_2.0.1
## [25] tibble_3.0.3 tidyverse_1.3.1 dplyr_1.0.7
## [28] treemapify_2.5.5 sf_1.0-2 ggiraph_0.7.10
## [31] finalfit_1.0.3 lsmeans_2.30-0 emmeans_1.6.3
## [34] RColorBrewer_1.1-2 panelr_0.7.5 lme4_1.1-27.1
## [37] Matrix_1.2-18 data.table_1.14.2 codebook_0.9.2
## [40] devtools_2.4.2 usethis_2.0.1 sqldf_0.4-11
## [43] RSQLite_2.2.8 gsubfn_0.7 proto_1.0.0
## [46] broom_0.7.9 zoo_1.8-9 rbokeh_0.5.2
## [49] janitor_2.1.0 plotly_4.9.4.1 kableExtra_1.3.4
## [52] Hmisc_4.5-0 Formula_1.2-4 survival_3.1-12
## [55] lattice_0.20-41 ggplot2_3.3.5 stringr_1.4.0
## [58] stringi_1.4.6 tidyr_1.1.3 knitr_1.33
## [61] matrixStats_0.60.0 boot_1.3-28
##
## loaded via a namespace (and not attached):
## [1] utf8_1.1.4 tidyselect_1.1.1 htmlwidgets_1.5.3.9000
## [4] grid_4.0.2 jtools_2.1.3 munsell_0.5.0
## [7] codetools_0.2-16 units_0.7-2 statmod_1.4.37
## [10] chron_2.3-56 withr_2.5.0 colorspace_1.4-1
## [13] uuid_0.1-4 rstudioapi_0.13 ggsignif_0.6.3
## [16] KMsurv_0.1-5 bit64_4.0.5 rprojroot_2.0.2
## [19] coda_0.19-4 vctrs_0.3.8 generics_0.1.3
## [22] TH.data_1.0-10 xfun_0.25 R6_2.5.1
## [25] cachem_1.0.6 assertthat_0.2.1 scales_1.1.1
## [28] multcomp_1.4-17 nnet_7.3-16 gtable_0.3.1
## [31] processx_3.5.2 sandwich_3.0-1 rlang_0.4.11
## [34] systemfonts_1.0.2 splines_4.0.2 rstatix_0.7.0
## [37] lazyeval_0.2.2 hexbin_1.28.2 checkmate_2.0.0
## [40] yaml_2.2.1 abind_1.4-5 modelr_0.1.8
## [43] backports_1.1.7 tools_4.0.2 tcltk_4.0.2
## [46] ellipsis_0.3.2 jquerylib_0.1.4 proxy_0.4-26
## [49] sessioninfo_1.1.1 plyr_1.8.6 visNetwork_2.0.9
## [52] base64enc_0.1-3 BiasedUrn_1.07 classInt_0.4-3
## [55] ps_1.6.0 prettyunits_1.1.1 rpart_4.1-15
## [58] cowplot_1.1.1 deSolve_1.28 haven_2.4.3
## [61] cluster_2.1.2 survey_4.1-1 fs_1.5.0
## [64] crul_1.1.0 magrittr_2.0.1 openxlsx_4.2.4
## [67] reprex_2.0.1 mvtnorm_1.1-2 pkgload_1.2.1
## [70] hms_1.1.0 evaluate_0.14 xtable_1.8-4
## [73] rio_0.5.27 jpeg_0.1-9 readxl_1.3.1
## [76] testthat_3.0.4 compiler_4.0.2 mice_3.13.0
## [79] maps_3.3.0 KernSmooth_2.23-17 crayon_1.4.1
## [82] minqa_1.2.4 htmltools_0.5.1.1 tzdb_0.1.2
## [85] lubridate_1.7.10 DBI_1.1.1 dbplyr_2.1.1
## [88] MASS_7.3-51.6 car_3.0-11 mitools_2.4
## [91] cli_3.0.1 pryr_0.1.5 quadprog_1.5-8
## [94] pkgconfig_2.0.3 km.ci_0.5-2 numDeriv_2016.8-1.1
## [97] xml2_1.3.2 svglite_2.0.0 bslib_0.2.5.1
## [100] ggcorrplot_0.1.3 webshot_0.5.2 estimability_1.3
## [103] rvest_1.0.1 snakecase_0.11.0 callr_3.7.0
## [106] digest_0.6.25 httpcode_0.3.0 rmarkdown_2.11
## [109] cellranger_1.1.0 htmlTable_2.2.1 curl_4.3
## [112] nloptr_1.2.2.2 lifecycle_1.0.1 nlme_3.1-148
## [115] jsonlite_1.7.2 carData_3.0-4 desc_1.3.0
## [118] viridisLite_0.4.1 fansi_0.4.1 labelled_2.8.0
## [121] pillar_1.7.0 fastmap_1.1.0 httr_1.4.2
## [124] pkgbuild_1.2.0 glue_1.4.1 remotes_2.4.0
## [127] zip_2.2.0 png_0.1-7 pander_0.6.3
## [130] bit_4.0.4 class_7.3-19 sass_0.4.0
## [133] gistr_0.9.0 blob_1.2.2 ggfittext_0.9.1
## [136] latticeExtra_0.6-29 memoise_2.0.0 e1071_1.7-8
sesion_info <- devtools::session_info()
dplyr::select(
tibble::as_tibble(sesion_info$packages),
c(package, loadedversion, source)
) %>%
DT::datatable(filter = 'top', colnames = c('Row number' =1,'Variable' = 2, 'Percentage'= 3),
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: left;',
'', htmltools::em('Packages')),
options=list(
initComplete = htmlwidgets::JS(
"function(settings, json) {",
"$(this.api().tables().body()).css({'font-size': '80%'});",
"}")))
Time for this code chunk to run: 0 minutes