@sjcrh/proteinpaint-server 2.105.0 → 2.107.0

package/utils/burden-ci95.R

@@ -0,0 +1,134 @@
+rm(list=ls())
+
+suppressPackageStartupMessages({
+  library(dplyr)  ### Qi changed to load plyr first, due to R message: If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
+  library(survival)
+  library(jsonlite)
+  library(parallel)
+  library(doParallel)
+})
+
+options(warn=-1)
+
+# stream in json input data
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+input <- fromJSON(json)
+# handle input arguments
+args <- commandArgs(trailingOnly = T)
+if (length(args) != 0) stop("Usage: echo <in_json> | Rscript burden.R > <out_json>")
+
+# register the parallel backend (used by foreach() for parallelization)
+availCores <- detectCores()
+if (is.na(availCores)) stop("cannot detect number of available cores")
+registerDoParallel(cores = availCores - 1) # use all available cores except one
+
+chc_nums <- c(1:32)[-c(2,5,14,20,23,26)] # CHCs. 6 out of 32 CHCs not used.
+
+#####################
+# Functions for our method
+# Ref: https://stats.stackexchange.com/questions/46532/cox-baseline-hazard
+#####################
+# setwd("R:/Biostatistics/Biostatistics2/Qi/QiCommon/St Jude/Nature Review/CHCs/App/Rdata")
+
+
+#################################
+# Bootstrapping burden estimate #
+#################################
+
+# import get_burden() function
+source(file.path(input$binpath, "utils/getBurden.R"))
+
+# compute burden estimate for each bootstrap
+# parallelize across bootstraps (not across chcs)
+bootnums <- 20 # number of bootstraps
+f <- input$datafiles
+sampleData <- file.path(f$dir, f$files$sample) # dataframe with all the X's needed, and X's are updated by input values
+outall <- foreach(i = 1:bootnums, .combine = rbind) %dopar% {
+  fitsData <- file.path(f$dir, f$boosubdir, paste0("boot",i), f$files$fit)
+  survData <- file.path(f$dir, f$boosubdir, paste0("boot",i), f$files$surv)
+  person_burden <- get_burden(fitsData, survData, sampleData, FALSE)
+  person_burden$boot <- i
+  person_burden
+}
+
+
+###########################
+# 95% confidence interval #
+###########################
+
+# pr=5
+# outall=NULL
+# for(bootnum in 1:20){
+# #bootnum=1 ##### loop this from 1 to 20.
+# print(bootnum)
+# setwd(paste("/Users/gmatt/data/tp/files/hg38/sjlife/burden/boot/boot",bootnum,sep=""))
+# out1=read.csv(file=paste("./bootprimary",pr,".csv",sep=""))
+# out1$boot=bootnum
+# outall=rbind(outall,out1)
+# }
+
+
+### For each cell (each chc and age combination), there are 20 values. get the SD from the 20 bootstrapped burdens.
+SDall=NULL
+for(chc_num in chc_nums){ 
+  #	chc_num=1
+  data=outall[outall$chc==chc_num,]  ## data for this chc_num from the 20 bootstraps on each age point
+  data=data[,!colnames(data) %in% c("chc","boot")]
+  # for each column (each age point), get the SD
+  sd1=apply(data,2,sd) 
+  sd1$chc=chc_num
+  SDall=rbind(SDall,sd1)
+}
+
+# #### burden for total of the 26 CHCs is the sum of the 26 burdens. So for each boot, take all the 26 and then sum up, to result in a column with 20 rows.
+
+btotal=NULL
+for(bootnum in 1:bootnums){
+  #	bootnum=1
+  data=outall[outall$boot==bootnum,]
+  data=data[,!colnames(data) %in% c("chc","boot")]
+  total=apply(data,2,sum) 
+  btotal=rbind(btotal,total)
+}
+### get SD for the total burdern from the 20 rows
+sdtotal=apply(btotal,2,sd)
+sdtotal=data.frame(t(sdtotal), check.names=F)
+sdtotal$chc=0 ### indicating the total CHCs
+
+sd=rbind(SDall,sdtotal)
+sd=apply(sd,c(1,2),as.numeric)
+
+##### read the burden from the original data. Use that and SD to get lower and upper bound.
+# oburden=read.csv(paste("R:/Biostatistics/Biostatistics2/Qi/QiCommon/St Jude/Nature Review/CHCs/App/Rdata/primary",pr,".csv",sep=""))
+oburden=input$burden
+# oburden$boot=0
+### total burden for the original data
+total=apply(oburden[,!colnames(oburden) %in% c("chc","boot")],2,sum) 
+burdentotal=data.frame(t(total), check.names=F)
+burdentotal$chc=0 ### indicating the total CHCs
+oburden=rbind(oburden,burdentotal)  #### burden for each chc with age in the columns. The last row is for the total burden.
+oburden=data.frame(oburden, check.names=F)
+
+
+#### lower bound, the lowest is 0 burden.
+low=oburden[,!colnames(oburden) %in% "chc"]-1.96*sd[,!colnames(oburden) %in% "chc"]
+low[low<0]=0
+low$chc=oburden$chc
+#### The upper bound
+up=oburden[,!colnames(oburden) %in% "chc"]+1.96*sd[,!colnames(oburden) %in% "chc"]
+up$chc=oburden$chc
+
+### Take primary=5 CNS as an example (with hight TXs in step 3). At age 50, the burden is 9.04 with 95% CI (7.92 to 10.16)
+# oburden$X.50.51[oburden$chc==0]
+# low$X.50.51[low$chc==0]
+# up$X.50.51[up$chc==0]
+
+# plot(c(20,95),c(0,15),type="n",xlab="Age",ylab="Burden",font=2)
+# lines(seq(20,94,1),oburden[oburden$chc==0,!colnames(oburden) %in% "chc"],lty=1)
+# lines(seq(20,94,1),low[low$chc==0,!colnames(low) %in% "chc"],lty=2)
+# lines(seq(20,94,1),up[up$chc==0,!colnames(up) %in% "chc"],lty=2)
+
+ci <- list(low = low, up = up, overall=burdentotal)
+toJSON(ci, digits = NA, na = "string")

package/utils/burden-main.R

@@ -0,0 +1,46 @@
+rm(list=ls())
+
+suppressPackageStartupMessages({
+  library(dplyr)  ### Qi changed to load plyr first, due to R message: If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
+  library(survival)
+  library(jsonlite)
+  library(parallel)
+  library(doParallel)
+})
+
+options(warn=-1)
+
+# stream in json input data
+con <- file("stdin", "r")
+json <- readLines(con)
+close(con)
+input <- fromJSON(json)
+# handle input arguments
+args <- commandArgs(trailingOnly = T)
+if (length(args) != 0) stop("Usage: echo <in_json> | Rscript burden.R > <out_json>")
+
+# register the parallel backend (used by foreach() for parallelization)
+availCores <- detectCores()
+if (is.na(availCores)) stop("cannot detect number of available cores")
+registerDoParallel(cores = availCores - 1) # use all available cores except one
+
+chc_nums <- c(1:32)[-c(2,5,14,20,23,26)] # CHCs. 6 out of 32 CHCs not used.
+
+#####################
+# Functions for our method
+# Ref: https://stats.stackexchange.com/questions/46532/cox-baseline-hazard
+#####################
+# setwd("R:/Biostatistics/Biostatistics2/Qi/QiCommon/St Jude/Nature Review/CHCs/App/Rdata")
+
+# import get_burden() function
+source(file.path(input$binpath, "utils/getBurden.R"))
+
+# compute main burden estimate
+# parallelize across CHCs
+f <- input$datafiles
+fitsData <- file.path(f$dir, f$files$fit)
+survData <- file.path(f$dir, f$files$surv)
+sampleData <- file.path(f$dir, f$files$sample) # dataframe with all the X's needed, and X's are updated by input values
+person_burden <- get_burden(fitsData, survData, sampleData, TRUE)
+
+toJSON(person_burden, digits = NA, na = "string")

package/utils/edge.R

@@ -144,7 +144,7 @@ if (length(input$conf1) == 0) { # No adjustment of confounding factors
 } else { # Adjusting for confounding factors
     y$samples <- data.frame(conditions = conditions, conf1 = input$conf1)
     model_gen_time <- system.time({
-        design <- model.matrix(~ conf1 + conditions, data = y$samples)
+        design <- model.matrix(~ conditions + conf1, data = y$samples)
     })
     #cat("Time for making design matrix: ", model_gen_time[3], " seconds\n")
 

package/utils/getBurden.R

@@ -0,0 +1,371 @@
+# TODOs: see TODOs in the code
+
+# function to compute burden estimate
+# fitsData: file path to fit data
+# survData: file path to surv data
+# sampleData: file path to sample data
+# parallelizeChcs: boolean for whether to parallelize across chcs
+get_burden <- function(fitsData, survData, sampleData, parallelizeChcs) {
+  load(fitsData)
+  load(survData)
+  # Qi made many newdata_chc_sampled so we have 1000 times more donors -- but in different files.
+  load(sampleData)
+  # survs[[1]]
+
+  ############################ These are the input values in APP that users can change. Edgar, these should be the same as the APP before, variable names and units. #############
+  ### Input the primary DX. 
+  # pr=5
+  # agecut=40   ##### Edgar, This is not an user input paramter, but we input this. This depends on the DX. For example, here for CNS we use 40. For HL DX, it is 55. I will give this value for each DX.
+  
+  # # # Input person's values, 18 input X's , plus the input primary DX
+  # 	sexval=1  #sex, take value 1 for male and 0 for female
+  # 	whiteval=1	# Race white or not, 1 for white, 0 for non-white
+  # 	agedxval=6  # age at primary cancer DX
+  
+  # #### Chemotherapy 	
+  # 	steroidval=0  #Steroids 1 for yes 0 for no
+  # 	bleoval=0; ##Bleomycin
+  # 	vcrval=12; 	#Vincristine 
+  # 	etopval=2500; #Etoposide 
+  # 	itmtval=0; 		#Intrathecal Methotrexate 
+  # 	cedval=1.6		# Cyclophosphamide, 0.7692 mean 7692. 
+  # 	cispval=300		#Cisplatin
+  # 	doxval=0		#Anthracycline, 3 mean 300 ml/m2
+  # 	carboval=0  ## Carboplatin
+  # 	hdmtxval=0	## High-Dose Methotrexate
+  	
+  # # Radiation
+  # 	brainval=5.4 #Brain, 5.4 means 54Gy, 5400 cGy. #####Same for all RT doses.#####
+  # 	chestval=2.4 # chest/neck RT, 2.4 for 24 Gy
+  # 	heartval=0	# Heart RT
+  # 	pelvisval=0	#pelvis RT
+  # 	abdval=2.4  # Abdominal RT
+  
+  ####################################################################################
+  
+  ##### if no TX, use these.
+  #	steroidval=0; bleoval=0; 	vcrval=0; 	etopval=0;	itmtval=0; 	cedval=0; cispval=0; brainval=0; 
+  #	doxval=0; chestval=0; abdval=0;
+  
+  # survs[[1]]
+  
+  ############### no TX
+  #	steroidval=0;  bleoval=0; vcrval=0; etopval=0; itmtval=0; cedval=0; cispval=0; brainval=0;  doxval=0; chestval=0; abdval=0; heartval=0; pelvisval=0; carboval=0; hdmtxval=0
+  
+  newdata_chc_sampled=do.call("rbind", replicate(6,newdata_chc_sampled, simplify = FALSE))
+  newdata_chc_sampled$t.startage=seq(5,70,1)
+  newdata_chc_sampled$t.endage=seq(6,71,1)
+  ### originally data fit to 60 only. using cphfits can get est up to 60 only. ==> later I further cut at 50 or so to fit lines, becuase original data had 95th percentile around age 50 or so.
+  newdata_chc_sampled=newdata_chc_sampled[newdata_chc_sampled$t.endage<=60,]
+  
+  # paste(names(input), input, sep = ":", collapse = ",")
+  pr=input$diaggrp
+  # agecut was previously hardcoded to 40 above
+  agecut=c('1'=50, '2'=45, '3'=55, '4'=50, '5'=40, '6'=60, '7'=50, '8'=45, '9'=45, '10'=45, '11'=50 )[pr]
+  sexval=input$sex
+  newdata_chc_sampled$sex=input$sex # sexval
+  newdata_chc_sampled$white=input$white # whiteval
+  newdata_chc_sampled$agedx2=input$agedx # agedxval
+  newdata_chc_sampled$steroid=input$steroid # steroidval
+  newdata_chc_sampled$bleodose=input$bleo # bleoval
+  newdata_chc_sampled$vcrdose=input$vcr # vcrval
+  newdata_chc_sampled$etopdose=input$etop # etopval
+  newdata_chc_sampled$itmtxdose=input$itmt # itmtval
+  newdata_chc_sampled$ced_sum2=input$ced # cedval
+  newdata_chc_sampled$cisplatdose=input$cisp # cispval
+  newdata_chc_sampled$brainrad2=input$brain # brainval
+  newdata_chc_sampled$doxed_sum2=input$dox # doxval
+  newdata_chc_sampled$chestrad2=input$chest # chestval
+  newdata_chc_sampled$abdrad2=input$abd # abdval
+  newdata_chc_sampled$heartradboth2=input$heart # heartval
+  newdata_chc_sampled$pelvisrad2=input$pelvis # pelvisval
+  newdata_chc_sampled$carboplatdose=input$carbo # carboval
+  newdata_chc_sampled$hdmtxdose=input$hdmtx # hdmtxval
+  
+  # newdata_chc_sampled$sex=sexval
+  # newdata_chc_sampled$white=whiteval
+  # newdata_chc_sampled$agedx2=agedxval
+  # newdata_chc_sampled$steroid=steroidval
+  # newdata_chc_sampled$bleodose=bleoval
+  # newdata_chc_sampled$vcrdose=vcrval
+  # newdata_chc_sampled$etopdose=etopval
+  # newdata_chc_sampled$itmtxdose=itmtval
+  # newdata_chc_sampled$ced_sum2=cedval
+  # newdata_chc_sampled$cisplatdose=cispval
+  # newdata_chc_sampled$brainrad2=brainval
+  # newdata_chc_sampled$doxed_sum2=doxval
+  # newdata_chc_sampled$chestrad2=chestval
+  # newdata_chc_sampled$abdrad2=abdval
+  # newdata_chc_sampled$heartradboth2=heartval
+  # newdata_chc_sampled$pelvisrad2=pelvisval
+  # newdata_chc_sampled$carboplatdose=carboval
+  # newdata_chc_sampled$hdmtxdose=hdmtxval
+  
+  #	1="Acute lymphoblastic leukemia"
+  #	2="AML"
+  #	3="Hodgkin lymphoma"
+  #	4="Non-Hodgkin lymphoma"
+  #	5="Central nervous system"
+  #	6="Bone tumor"
+  #	7="STS"
+  #	8="Wilms tumor"
+  #	9="Neuroblastoma"
+  #	10="Retinoblastoma"
+  #	11="Germ cell tumor";
+  
+  #results <- mclapply(X = chc_nums, FUN = function(chc_num) predict(cphfits2[[chc_num]], newdata = data.frame(newdata_chc_sampled,primary=pr),type='expected'), mc.cores = cores)
+  predictChc <- function(chc_num) {
+    predict(cphfits2[[chc_num]], newdata = data.frame(newdata_chc_sampled,primary=pr),type='expected')
+  }
+  chcCols <- NULL
+  if (parallelizeChcs) {
+    # parallelize over chc_nums
+    chcCols <- foreach(chc_num = chc_nums, .combine = cbind) %dopar% {
+      predictChc(chc_num)
+    }
+  } else {
+    # do not parallelize over chc_nums
+    # parallelizing over bootstraps instead
+    chcCols <- foreach(chc_num = chc_nums, .combine = cbind) %do% {
+      predictChc(chc_num)
+    }
+  }
+  
+  newdata_chc_sampled = data.frame(newdata_chc_sampled, chcCols)
+  names(newdata_chc_sampled)[25:50]=paste0("est_chc",chc_nums)
+  newdata_chc_sampled = newdata_chc_sampled %>%
+  	mutate(sumN_tmp = rowSums(dplyr::select(.,starts_with("est_chc"))))%>%
+  	group_by(mrn) %>%
+  	mutate(sumN_obs = cumsum(sumN_tmp)) %>%
+  	as.data.frame()
+  
+  ##Qi: the sumN here depends on all the 26 grouped conditions. So the input X's all matter. That is, if sex is not in a CHC of interest, it would make a difference here on sumN (becuase sex was on some CHCs), and hence make a difference on burden of that CHC even that it is not in the cphfits of that CHC.
+  newdata_chc_sampled = newdata_chc_sampled %>%
+  	group_by(mrn) %>%
+  	mutate(chc20 = sumN_obs[t.endage == 20]) %>%
+  	ungroup() %>%
+  	as.data.frame()
+  newdata_chc_sampled$death =1
+  newdata_chc_sampled$obsCHCat20 = newdata_chc_sampled$current.chc
+  
+  
+  # survival probability
+  # https://stats.stackexchange.com/questions/288393/calculating-survival-probability-per-person-at-time-t-from-cox-ph
+  
+  
+  newdata_chc_sampled$survprob = exp(-predict(survs[[1]],newdata=data.frame(newdata_chc_sampled,primary=pr),type='expected'))
+  
+  #----------------------------------------------------------------------------------------------------------------#
+  ##### Qi added the below "cumprod" for survival by time t. But need to figure out: What is the "survprob" in BCCT formulat? Should it be survival of the segment, or survival by time t? == need to figure out with YY. Discussed, YY confirmed my way: survival prob in the formula is cumulative, not for that segment.
+  #----------------------------------------------------------------------------------------------------------------#
+  
+  #----------------------------------------------------------------------------------------------------------------#
+  ## If assume "survprob" is over time (not for each segment):
+  #### why does the survprob does not decrease over time? I think this is not the real survival probability over time. Do I have to do multiplication over time thinking survprob is the survival over that segment? Try the multiplication over time.===== I think this make sense. In the "predict" above, survial=exp(-expected) was for each row (thinking each row is a separate person). While in newdata_chc_sampled, the rows are for the same person, and the survival depends on the previoys line, so need to multiply the survival from the previous line.
+  newdata_chc_sampled$survprob4=cumprod(newdata_chc_sampled$survprob)
+  newdata_chc_sampled$survprob=newdata_chc_sampled$survprob4
+  
+  #	plot(c(0,90),c(0,1),type="n")
+  survspline=smooth.spline(newdata_chc_sampled$t.endage[newdata_chc_sampled$t.endage<=agecut],newdata_chc_sampled$survprob[newdata_chc_sampled$t.endage<=agecut],spar=0.5)
+  predsurv=predict(survspline,seq(0,95,1))
+  
+  #	lines(predsurv$x,predsurv$y,col=3,lty=2)
+  
+  ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### ##### 
+  
+  ###### get rid of the est_chcXX and "sumN"columns which were used to calculate the survival probability only.
+  # invisible(dim(newdata_chc_sampled))
+  newdata_chc_sampled=newdata_chc_sampled[,-grep("est_chc", colnames(newdata_chc_sampled))]
+  newdata_chc_sampled=newdata_chc_sampled[,-grep("sumN", colnames(newdata_chc_sampled))]
+  # invisible(dim(newdata_chc_sampled))
+  
+  ### Add rows  t.startage from 60 to 94, and t.endage from 65 to 95; so we can get burden 60-90.
+  add=newdata_chc_sampled[newdata_chc_sampled$t.startage<=39,]
+  # table(add$t.startage)
+  # table(add$t.endage)
+  add$t.startage=add$t.startage+55
+  add$t.endage=add$t.endage+55
+  # table(add$t.startage)
+  # table(add$t.endage)
+  newdata_chc_sampled=rbind(newdata_chc_sampled,add)
+  newdata_chc_sampled=newdata_chc_sampled[order(newdata_chc_sampled$mrn,newdata_chc_sampled$t.startage),]
+  ### replace the survival prob with the calculated/extrapolated survival probability
+  smooth_surv=data.frame(age=predsurv$x,surv=predsurv$y)
+  smooth_surv$surv[smooth_surv$age<=20]=1
+  #### survival probability cannot be <0. Hanle the years with survival prob<0
+  #https://www150.statcan.gc.ca/t1/tbl1/en/tv.action?pid=1310013501 This page had the conditional survival based on age
+  ## take the last year with a positive survival prob, and its survival prob
+  positive=smooth_surv[smooth_surv$surv>0,]
+  alast=tail(positive,1)[1,1]
+  slast=tail(positive,1)[1,2]
+  #smooth_surv$alast=alast
+  #smooth_surv$alast=slast
+  smooth_surv$interval=smooth_surv$age-alast
+  ### use the last positive survival prob*0.5^(years from the last age with positive survival probability), assuming the conditions survival prob after that age 50% each year.
+  cave <- function(x) slast*0.5^(max(x["interval"],0))
+  smooth_surv$surv1=apply(smooth_surv,1,cave)
+  smooth_surv$surv[smooth_surv$surv<0]=smooth_surv$surv1[smooth_surv$surv<0]
+  
+  newdata_chc_sampled=merge(newdata_chc_sampled,smooth_surv,by.x="t.endage",by.y="age")
+  newdata_chc_sampled$survprob=newdata_chc_sampled$surv
+  
+  # when there is an interaction in the model, it gave warning. So I would make a new data with all 0's to make it work.
+  newdata0=matrix(0,nrow=1,ncol=18)
+  newdata0=as.data.frame(newdata0)
+  colnames(newdata0)=c("sex","white","agedx2","steroids","bleodose","vcrdose","etopdose","itmtxdose","ced_sum2",
+  "cisplatdose","brainrad2","doxed_sum2","chestrad2","abdrad2","heartradboth2","pelvisrad2","carboplatdose","hdmtxdose")
+  
+  
+  newdata_chc_sampled1=newdata_chc_sampled ## do this so each run on chc_num loops below starts with the original newdata_chc_sampled1
+  
+  
+  ##########################################################################
+  person_burden=NULL
+  
+  get_estimate <- function(chc_num) {  #### Edgar, you may make this in separate runs to save time.
+    # print(chc_num)
+    newdata_chc_sampled=newdata_chc_sampled1
+    
+    # linear predictor
+    newdata_chc_sampled$exp_lp = predict(cphfits2[[chc_num]], newdata = data.frame(newdata_chc_sampled,primary=pr),type='risk',reference="zero")
+    
+    # Baseline nelson-aalan est
+    # https://stats.stackexchange.com/questions/46532/cox-baseline-hazard
+    j=chc_num
+    base = basehaz(cphfits2[[chc_num]],centered = F) # this is a cumulative hazard, so need to convert it into non-cumulative version
+    #centered,	if TRUE return data from a predicted survival curve at the mean values of the covariates fit$mean, if FALSE return a prediction for all covariates equal to zero.
+    #request the hazard for that covariate combination from the survfit() function that is called by basehaz(). https://stats.stackexchange.com/questions/565210/about-getting-baseline-survival-probability-for-a-piecewise-cox-model-with-inter
+    
+    
+    ### Max time in the data is 70.42. We need to estimate up to 90. 
+    #Yutaka: I think we should smooth the cumulative hazard and then take the derivative to get the hazard.
+    #One thread I found on Web is: "As an approximation you can smooth the fitted baseline cumulative hazard (e.g. by package pspline) and ask for its derivative."  Can you try using smooth.spline and smooth the cumulative hazard and then get the derivative?  https://cran.r-project.org/web/packages/pspline/pspline.pdf
+    
+    
+    #### Qi added: base is for different DX. Now we run within each pr, so neeed cumulaive hazrd for that pr only
+    base=base[base$strata==paste("primary=",pr,sep=""),] #cumulative hazard
+    base=base[base$time<=agecut,]  ### shouldn't we use the same age cutoff as the survival function splines? Yes, do so.
+    
+    ##### study the smooth parameter. I think spar=1 is the best one to use (most smoothest)
+    cumHspline=smooth.spline(base$time,base$hazard,spar=1)
+    predcumhz=predict(cumHspline,seq(0,95,1))  ### predicted cumulative hazard
+    
+    
+    ##### In order to use the above way to get dN0, do Daisuke's original way using cumhz difference. But the  difference is that: we fit cumhz with smooth.spline and can extend it to 90 years old.
+    base=data.frame(time=predcumhz$x,hazard=predcumhz$y)  ##Daisuke used the cumHz, here we smoothed it and then use it.
+    #### fitted values had <0 values in age 0-8 or so. change to 0 cumulative hazard.
+    base$hazard[base$hazard<0]=0
+    base2 = base %>% 
+      mutate(hazard2 = hazard - c(0,hazard[-length(hazard)])) %>%
+      ungroup() %>% as.data.frame()
+    
+    base2 = base2 %>%
+      mutate(time_cat = cut(time,breaks=seq(0,95,1),right = FALSE, include.lowest = TRUE)) %>% 
+      ungroup()
+    
+    base3 = base2 %>%
+      group_by(time_cat) %>%
+      dplyr::summarize(dN0 = sum(hazard2)) %>%
+      filter(!is.na(time_cat))	
+    
+    ###############
+    # BCCT
+    ###############
+    newdata_chc_sampled$time_cat = cut(newdata_chc_sampled$t.startage,breaks=seq(0,95,1),right = FALSE, include.lowest = TRUE)
+    
+    #newdata_chc_sampled$time_cat = cut(newdata_chc_sampled$t.startage,breaks=seq(0,90,5),right = FALSE, include.lowest = TRUE) this won't work, because the input donors file had "t.startage" up to 55 only
+    
+    newdata_chc_sampled = newdata_chc_sampled %>% 
+      left_join(base3,by="time_cat")
+    newdata_chc_sampled$dN0 = ifelse(is.na(newdata_chc_sampled$dN0),0,newdata_chc_sampled$dN0)
+    
+    BCCT = newdata_chc_sampled %>% 
+      group_by(mrn) %>%
+      mutate(BCCT_tmp = exp_lp*survprob*dN0) %>%
+      mutate(BCCT = cumsum(BCCT_tmp)) %>%
+      filter(t.startage>=20) %>%
+      ungroup() %>%
+      as.data.frame()
+    
+    for_web_BCCT = as.data.frame(tidyr::pivot_wider(BCCT,id_cols = mrn, names_from=time_cat,values_from=BCCT))
+    for_web_BCCT =for_web_BCCT[,-1]
+    
+    #### for non-recurrent ones, maximum burden is 1 if the grouped conditions had only 1 condition. (11, 19,29) had only 1 conditons non-recurrent. (15,17,25) had 2 conditons. Take 25 as an example, it had obesity/underweight where underweight was so rare. So max 1 is still good. 
+    #### non-recurrent CHCs are 11, 15, 17, 19, 25, 29. ==I think making it maximum 1 is not good always, becuase these are grouped conditions. For example, chc=10 contains 3 non-recurrent events, so one person could have each of these once, making it maximum 3 in this person for chc=10. 
+    ncoltmp=75  ## from 20 to 94
+    if(chc_num %in% c(11, 15, 17, 19, 25, 29)){
+      for_web_BCCT2=apply(for_web_BCCT,c(1,2),function(x) min(x,1))
+      for_web_BCCT=as.data.frame(for_web_BCCT2)
+      colnames(for_web_BCCT)=colnames(person_burden[1:ncoltmp])
+    }
+    #For example, chc=10 contains 3 non-recurrent events, so one person could have each of these once, making it maximum 3 in this person for chc=10. 
+    if(chc_num %in% c(10)){
+      for_web_BCCT2=apply(for_web_BCCT,c(1,2),function(x) min(x,3))
+      for_web_BCCT=as.data.frame(for_web_BCCT2)
+      colnames(for_web_BCCT)=colnames(person_burden[1:ncoltmp])
+    }
+    ##### if female condition 6, then it is 0 for males.
+    if(chc_num %in% c(6) & sexval==1){
+      for_web_BCCT2=matrix(0,nrow=1,ncol=ncoltmp)
+      for_web_BCCT=as.data.frame(for_web_BCCT2)
+      colnames(for_web_BCCT)=colnames(person_burden[1:75])
+    }
+    ##### if male condition 7, then it is 0 for females.d
+    if(chc_num %in% c(7) & sexval==0){
+      for_web_BCCT2=matrix(0,nrow=1,ncol=ncoltmp)
+      for_web_BCCT=as.data.frame(for_web_BCCT2)
+      colnames(for_web_BCCT)=colnames(person_burden[1:ncoltmp])
+    }
+    
+    for_web_BCCT$chc=chc_num
+    
+    return(for_web_BCCT)
+  }
+  
+  results <- NULL
+  if (parallelizeChcs) {
+    # parallelize over chc_nums
+    results <- foreach(chc_num = chc_nums) %dopar% {
+      get_estimate(chc_num)
+    }
+  } else {
+    # do not parallelize over chc_nums
+    # parallelizing over bootstraps instead
+    results <- foreach(chc_num = chc_nums) %do% {
+      get_estimate(chc_num)
+    }
+  }
+  
+  # this serial loop works
+  # for(chc_num in chc_nums) {
+  # 	person_burden=rbind(person_burden, get_estimate(chc_num))
+  # }
+  
+  # get estimates
+  # parallelize across chc_nums
+  #results <- mclapply(X = chc_nums, FUN = get_estimate, mc.cores = cores)
+  #results <- lapply(X = chc_nums, FUN = get_estimate)
+  
+  # combine rows into person_burden data frame
+  # TODO: need to verify this
+  for (n in 1:length(results)) {
+    row <- results[[n]]
+    if (!identical(names(row), names(results[[1]]))) {
+      # some rows may have empty column names because they
+      # used the columns names from the person_burden table, which
+      # is NULL when get_estimate() is run in parallel (see the
+      # if() statements in get_estimate())
+      # in this situation, use the column names from the first row
+      names(row) <- names(results[[1]])
+    }
+    person_burden <- rbind(person_burden, row)
+  }
+  
+  # person_burden[,30:31]
+  # sum(person_burden[,31])  ## total burden at 50 years old. 8.971574 for this example.
+  
+  #### The predicated burden for 26 grouped CHCs from age 20 to 95.
+  # write.csv(person_burden,file=paste("primary",pr,".csv"),row.names=F)
+  #toJSON(person_burden, digits = NA, na = "string")
+  return(person_burden)
+}