The code below splits the dataframe by subgroup and prints the results to a csv file after exponentiation. I would like to add the subgroup name as a final column but am not sure how to do that. Any help would be appreciated. Code for made up sample data is below.
library(survival)
library(purrr)
mydata <- read.table(header=T,
text="age Sex survival out_stroke out_cancer
out_respiratory id tstart tstop region
51 1 1.419178082 2 1 1 1 0 50 1
60 2 5 1 2 2 2 0 50 1
49 1 1.082191781 2 2 2 3 0 50 2
83 2 0.038356164 1 1 2 4 0 50 2
68 1 0.77260274 2 1 2 5 0 50 1
30 2 -0 2 1 2 6 50 0 2
44 1 2.336986301 1 2 1 7 0 100 1
76 2 1.271232877 1 2 2 8 0 100 2")
mydata$Sex<-ifelse(mydata$Sex==1, "Male", "Female")
mydata$Sex <- factor(mydata$Sex, levels = c("Female","Male"))
mydata$Sex = relevel(mydata$Sex, ref = "Female")
outcomes <- names(mydata[4:6])
cov <- c("region: ", "age: ")
cov_name<-c("region age")
writeLines(c("OUTCOME COVARIATE HR LCI UCI SE NEVENT SUBGROUP"), "HR_new.csv")
lapply(split(mydata, mydata$Sex), function(y)
purrr::map(outcomes, function(x) {
f <- as.formula(paste("Surv(survival, event=", x, ") ~ ",cov_name))
model <- coxph(f, y)
model$call$formula <- f
s <- summary(model)
cat(paste0(substring(x,5,40),' ',cov, apply(s$coefficients, 1,
function(x) {
paste0(" ", round(exp(x[1]), 2),
' ', round(exp(x[1] - 1.96 * x[3]), 2),
' ', round(exp(x[1] 1.96 * x[3]), 2),
" ", round((x[3]), 4)," ",
" ", summary(model)$nevent)}),
collapse = '\n'), '\n', sep = '', file = paste0('HR_new.csv'),
append = TRUE)
invisible(model)
})
)
But I would like the following which shows the subgroup in the last column
CodePudding user response:
writeLines(c("OUTCOME COVARIATE HR LCI UCI SE NEVENT SUBGROUP"), "HR_new.csv")
lapply(split(mydata, mydata$Sex), function(y)
purrr::map(outcomes, function(x) {
f <- as.formula(paste("Surv(survival, event=", x, ") ~ ",cov_name))
model <- coxph(f, y)
model$call$formula <- f
s <- summary(model)
cat(paste0(substring(x,5,40),' ',cov, apply(s$coefficients, 1,
function(x) {
paste0(" ", round(exp(x[1]), 2),
' ', round(exp(x[1] - 1.96 * x[3]), 2),
' ', round(exp(x[1] 1.96 * x[3]), 2),
" ", round((x[3]), 4)," ",
" ", summary(model)$nevent,
" ", y$Sex[1])}),
collapse = '\n'), '\n', sep = '', file = paste0('HR_new.csv'),
append = TRUE)
invisible(model)
})
)
# OUTCOME COVARIATE HR LCI UCI SE NEVENT SUBGROUP
# stroke region: 5094.96 0 Inf 101330.9473 1 Female
# stroke age: 0.62 0 Inf 1331.5643 1 Female
# cancer region: 65019409.08 0 Inf 40192.9701 2 Female
# cancer age: 1.22 0 Inf 2512.0603 2 Female
# respiratory region: 2778652312.63 0 Inf 24930.3879 4 Female
# respiratory age: 0.94 0.82 1.08 0.0704 4 Female
# stroke region: 236112975987.23 0 Inf 30239.6491 3 Male
# stroke age: 16.05 0 Inf 2329.6551 3 Male
# cancer region: 4170531618.22 0 Inf 45664.714 2 Male
# cancer age: 1 0 Inf 11992.1384 2 Male
# respiratory region: 53874452658.47 0 Inf 17348.6865 2 Male
# respiratory age: 10.85 0 Inf 1545.2618 2 Male