Search code examples
rextractpurrrcox-regression

Adding subgroup to csv output file after purrr coxph results --R version 4.1.2 (2021-11-01)

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)
  })
)

enter image description here

But I would like the following which shows the subgroup in the last column

enter image description here

Solution 
  • 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