library(data.table)
library(survival)
library(survminer)
library(tableone)
library(ggplot2)
library(GGally)
library(patchwork)
library(gtools)
library(plyr)
library(Hmisc)
library(mltools)
library(RColorBrewer)
library(ResourceSelection)
library(pROC)
library(corrplot)

absolute_risk <- function(coxmodel,data){
    cumhaz <- basehaz(coxmodel,centered = TRUE) #Note that this is centered at mean covariates
    basesurv <- exp(-1*cumhaz$hazard[which.min(abs(cumhaz$time - 3652))])
    print(paste0("S_o(10) = ",round(basesurv,3)))

    tenyrpredict <- 1 - basesurv^(predict(coxmodel,data,type="risk"))
    return(tenyrpredict)
}

calibration_plot <- function(data,predictioncol,eventcol,manualpvalue=NULL){
    if(any(is.na(cbind(data[[predictioncol]],data[[eventcol]])))){
        warning('at least 1 NA entry in predictioncol or eventcol')
    }

    pred_quantiles <- quantcut(data[[predictioncol]],q=10)
    pred_mean <- tapply(data[[predictioncol]],pred_quantiles,mean)
    event_mean <- tapply(data[[eventcol]],pred_quantiles,mean)
    data.lm <- lm(event_mean ~ pred_mean)
#     print(data.lm)

    num <- round_any(max(max(pred_mean),max(event_mean))*1.4,0.05)
#     print(max(pred_mean))
#     print(max(event_mean))
#     print(num)

#     print(pred_mean)
#     print(event_mean)
#     print(cbind(pred_mean,event_mean))

    #Greenwood-Nam-D'Agostino
#     gnd_result <- GND.calib(pred=data[[predictioncol]],tvar=pmin(data[[timetoeventcol]],censortime),
#                            out=data[[eventcol]],cens.t=data[[censorcol]],groups=pred_quantiles,
#                            adm.cens=censortime)
#     print(paste0('GND: ',gnd_result))

    hoslem_result <- hoslem.test(x=data[[predictioncol]],y=as.numeric(data[[eventcol]]),g=10)
#     print(paste0('HL: ',hoslem_result))
    HLpval <- round(hoslem_result$p.value,3)
    HLpvalprint <- paste0("p-value = ",HLpval)

    if(!is.null(manualpvalue)) HLpvalprint <- manualpvalue

    g1 <- ggplot(data=as.data.frame(cbind(pred_mean,event_mean)),aes(x=pred_mean,y=event_mean)) +
    geom_point() +
    geom_abline(intercept=0,slope=1,linetype="dashed") +
    geom_abline(intercept=data.lm$coefficients[['(Intercept)']],slope=data.lm$coefficients[['pred_mean']],color="red") +
    scale_x_continuous(limits=c(0,num),breaks=seq(0,num,by=0.05)) +
    scale_y_continuous(limits=c(0,num),breaks=seq(0,num,by=0.05)) +
    xlab("Predicted 10-year Cumulative Incidence") +
    ylab("Observed 10-year Cumulative Incidence") +
    theme_classic() +
    theme(text = element_text(size=16)) +
    annotate("text",x=0.8*num,y=0.2*num,size=6,label=paste0("m = ",round(data.lm$coefficients[['pred_mean']],2))) +
    annotate("text",x=0.8*num,y=0.15*num,size=6,label=paste0("b = ",round(data.lm$coefficients[['(Intercept)']],3))) +
    annotate("text",x=0.8*num,y=0.10*num,size=6,label=HLpvalprint)
    return(g1)
}

reclass <- function(data,cOutcome,predrisk1,predrisk2,cutoff){

c1 <- cut(predrisk1,breaks = cutoff ,include.lowest=TRUE,right= FALSE)
c2 <- cut(predrisk2,breaks = cutoff ,include.lowest=TRUE,right= FALSE)
tabReclas <- table("Initial Model"=c1, "Updated Model"=c2)
cat(" _________________________________________\n")
cat(" \n     Reclassification table    \n")
cat(" _________________________________________\n")

 ta<- table(c1, c2, data[[cOutcome]])
    print(ta)

  cat ("\n Outcome: absent \n  \n" )
  TabAbs <- ta[,,1]
  tab1 <- cbind(TabAbs, " % reclassified"= round((rowSums(TabAbs)-diag(TabAbs))/rowSums(TabAbs),2)*100)
  names(dimnames(tab1)) <- c("Initial Model", "Updated Model")
  print(tab1)

  cat ("\n \n Outcome: present \n  \n" )
  TabPre <- ta[,,2]
  tab2 <- cbind(TabPre, " % reclassified"= round((rowSums(TabPre)-diag(TabPre))/rowSums(TabPre),2)*100)
  names(dimnames(tab2)) <- c("Initial Model", "Updated Model")
  print(tab2)

  cat ("\n \n Combined Data \n  \n" )
  Tab <- tabReclas
  tab <- cbind(Tab, " % reclassified"= round((rowSums(Tab)-diag(Tab))/rowSums(Tab),2)*100)
  names(dimnames(tab)) <- c("Initial Model", "Updated Model")
  print(tab)
cat(" _________________________________________\n")

c11 <-factor(c1, levels = levels(c1), labels = c(1:length(levels(c1))))
c22 <-factor(c2, levels = levels(c2), labels = c(1:length(levels(c2))))

  x<-improveProb(x1=as.numeric(c11)*(1/(length(levels(c11)))),
  x2=as.numeric(c22)*(1/(length(levels(c22)))), y=data[[cOutcome]])

y<-improveProb(x1=predrisk1, x2=predrisk2, y=data[[cOutcome]])

cat("\n NRI(Categorical) [95% CI]:", round(x$nri,4),"[",round(x$nri-1.96*x$se.nri,4),"-",
 round(x$nri+1.96*x$se.nri,4), "]", "; p-value:", round(2*pnorm(-abs(x$z.nri)),5), "\n" )

 cat(" NRI(Continuous) [95% CI]:", round(y$nri,4),"[",round(y$nri-1.96*y$se.nri,4),"-",
 round(y$nri+1.96*y$se.nri,4), "]", "; p-value:", round(2*pnorm(-abs(y$z.nri)),5), "\n" )

cat(" NRIevent(Continuous) [95% CI]:", round(y$nri.ev,4),"[",round(y$nri.ev-1.96*y$se.nri.ev,4),"-",
 round(y$nri.ev+1.96*y$se.nri.ev,4), "]", "; p-value:", round(2*pnorm(-abs(y$z.nri.ev)),5), "\n" )

cat(" NRInonevent(Continuous) [95% CI]:", round(y$nri.ne,4),"[",round(y$nri.ne-1.96*y$se.nri.ne,4),"-",
 round(y$nri.ne+1.96*y$se.nri.ne,4), "]", "; p-value:", round(2*pnorm(-abs(y$z.nri.ne)),5), "\n" )

cat(" IDI [95% CI]:", round(y$idi,4),"[",round(y$idi-1.96*y$se.idi,4),"-",
 round(y$idi+1.96*y$se.idi,4), "]","; p-value:", round(2*pnorm(-abs(y$z.idi)),5), "\n")

#     return(y)
}

#Master data.table with UKB ids and many descriptive variables relevant to PCE
masterdfukb <- fread("/medpop/esp2/sagrawal/prs_crs_integration/prs_crs_masterdf_ascvd_sbpavg.csv")

#Hard CAD
CAD_SA <- fread("CAD_SA.csv")

#CVD outcome
CVD_Elliot <- fread('/medpop/esp2/sagrawal/prs_crs_integration/Elliot_CVD_analysisready.csv')

#QRISK3 for UKBB
qrisk <- fread("/medpop/esp2/aniruddh/SouthAsians/Qriskscoresnonmissingnew.txt")
qrisk$qrisk3 <- qrisk$QRISK3_2017/100

#Processing Hard CAD outcome file to include 10 year outcome
CAD_SA <- CAD_SA[,c("eid","incident_disease","fu_days","fu_yrs")]
names(CAD_SA) <- c("eid","CAD_incident_disease","CAD_fu_days","CAD_fu_yrs")
CAD_SA$CAD_tenyearoutcome <- 0
CAD_SA[CAD_incident_disease == 1 &
       CAD_fu_days <= 3652.5]$CAD_tenyearoutcome <- 1
CAD_SA$CAD_tenyearcensor <- ifelse(CAD_SA$CAD_fu_days > 3652.5,1,0)

CVD_Elliot <- CVD_Elliot[,c("eid","incident_disease","fu_days","fu_yrs")]
names(CVD_Elliot) <- c("eid","CVD_incident_disease","CVD_fu_days","CVD_fu_yrs")
CVD_Elliot$CVD_tenyearoutcome <- 0
CVD_Elliot[CVD_incident_disease == 1 &
       CVD_fu_days <= 3652.5]$CVD_tenyearoutcome <- 1
CVD_Elliot$CVD_tenyearcensor <- ifelse(CVD_Elliot$CVD_fu_days > 3652.5,1,0)

masterdf1 <- merge(masterdfukb,CAD_SA,by="eid")
masterdf1 <- merge(masterdf1,CVD_Elliot,by="eid")
masterdf <- merge(masterdf1,qrisk[,c('ID','qrisk3')],by.x='eid',by.y='ID',all=TRUE)

#Groups made of self-reported race/ethnicity
whiteonlyvec <- c("Any_other_white_background","British","Irish","White")
southasianvec <- c("Bangladeshi","Indian","Pakistani")
asianminusSA <- c("Any_other_Asian_background","Asian_or_Asian_British","Chinese","White_and_Asian")
blackvec <- c("African","Any_other_Black_background","Black_or_Black_British","Caribbean","White_and_Black_African","White_and_Black_Caribbean")
othervec <- c("Any_other_mixed_background","Mixed","Other_ethnic_group","Do_not_know","Prefer_not_to_answer") #is.na in this too in terms of PC similarity

masterdf$sex_strat <- ifelse(masterdf$sex == "Male",1,0)

masterdf$ethnicity_white <- ifelse(masterdf$ethnicity %in% whiteonlyvec,1,0)

masterdf$ethnicity_black <- ifelse(masterdf$ethnicity %in% blackvec,1,0)

masterdf$ethnicity_asian <- ifelse(masterdf$ethnicity %in% asianminusSA,1,0)

masterdf$ethnicity_southasian <- ifelse(masterdf$ethnicity %in% southasianvec,1,0)

masterdf$ethnicity_other <- ifelse((masterdf$ethnicity %in% othervec) | is.na(masterdf$ethnicity),1,0)

masterdf$ethnicity_group <- "placeholder"
masterdf[ethnicity_white==1]$ethnicity_group <- "White"
masterdf[ethnicity_black==1]$ethnicity_group <- "Black"
masterdf[ethnicity_asian==1]$ethnicity_group <- "East Asian"
masterdf[ethnicity_southasian==1]$ethnicity_group <- "South Asian"
masterdf[ethnicity_other==1]$ethnicity_group <- "Other"

masterdf$ethnicity_group <- factor(masterdf$ethnicity_group,levels=c('Black','South Asian','East Asian','White','Other'))

# Defined this for the purpose of recalibration

masterdf$age_group <- "G1" #(age < 45, basically meaning 40-45)
masterdf[age >= 45 & age < 50]$age_group <- "G2"
masterdf[age >= 50 & age < 55]$age_group <- "G3"
masterdf[age >= 55 & age < 60]$age_group <- "G4"
masterdf[age >= 60 & age < 65]$age_group <- "G5"
masterdf[age >= 65 & age < 70]$age_group <- "G6"
masterdf[age >= 70 & age < 75]$age_group <- "G7"

masterdf$ageG2 <- ifelse(masterdf$age_group=='G2',1,0)
masterdf$ageG3 <- ifelse(masterdf$age_group=='G3',1,0)
masterdf$ageG4 <- ifelse(masterdf$age_group=='G4',1,0)
masterdf$ageG5 <- ifelse(masterdf$age_group=='G5',1,0)
masterdf$ageG6 <- ifelse(masterdf$age_group=='G6',1,0)
masterdf$ageG7 <- ifelse(masterdf$age_group=='G7',1,0)

#Define a secondary follow-up time variable that cuts off at 10 years
masterdf[CAD_fu_days >= 3652,CAD_fu_days10yr:=3652]
masterdf[CAD_fu_days < 3652,CAD_fu_days10yr:=CAD_fu_days]

#Adjusting PRS for ancestry

pcmod1 <- lm(prs ~ PC1+PC2+PC3+PC4, data=masterdf)
masterdf$prs_resid <- masterdf$prs - predict(pcmod1,masterdf)

##Importing additional descriptive variables I want

ldl <- fread("/medpop/esp2/sagrawal/prs_crs_integration/labs_ldl_ukbb.csv")
names(ldl)[5] <- 'LDL_C'
masterdf <- merge(masterdf,ldl[,c("sample_id","LDL_C")],by.x='eid',by.y='sample_id',all=TRUE)

#Contain the patient ids that went into the development and holdout sets
#Only contains 51 columns, corresponding to 51 nonzero features in Coxnet model
#at selected alpha

fullfeat_dev <- fread("coxnet__feature_matrix__development_0_0011765691116882482__30Nov_2020.txt")
fullfeat_ho <- fread("coxnet__feature_matrix__holdout_0_0011765691116882482__30Nov_2020.txt")

fullfeat_devUnscaled <- fread('coxnet__feature_matrix_nonzero_model_0_0011765691116882482__development_unscaled__30Nov_2020.txt')
fullfeat_hoUnscaled <- fread('coxnet__feature_matrix_nonzero_model_0_0011765691116882482__holdout_unscaled__30Nov_2020.txt')

masterdf$subgroup_indicator <- 0
masterdf[eid %in% fullfeat_dev$index]$subgroup_indicator <- 1
masterdf[eid %in% fullfeat_ho$index]$subgroup_indicator <- 2

masterdf_dev <- masterdf[subgroup_indicator == 1]

masterdf_tab1 <- masterdf

masterdf_tab1$framrisk <- masterdf_tab1$framrisk * 100
masterdf_tab1$tenyearASCVD <- masterdf_tab1$tenyearASCVD * 100
masterdf_tab1$qrisk3 <- masterdf_tab1$qrisk3 * 100
masterdf_tab1$Cholesterol <- masterdf_tab1$Cholesterol * 38.6
masterdf_tab1$HDL_C <- masterdf_tab1$HDL_C * 38.6
masterdf_tab1$LDL_C <- masterdf_tab1$LDL_C * 38.6
masterdf_tab1$prs_resid_scaled <- scale(masterdf_tab1$prs_resid)

masterdf_tab1$included <- ifelse(masterdf_tab1$subgroup_indicator==0,0,1)

tab1vars <- c('age','sex','ethnicity_group','currentsmoker','DM','Cholesterol',
              'HDL_C','LDL_C','systolicbp','antihtnrx','prs_resid_scaled','framrisk',
              'tenyearASCVD','qrisk3','CAD_incident_disease','CAD_tenyearoutcome')
tab1facvars <- c('sex','ethnicity_group','currentsmoker','DM','antihtnrx',
             'CAD_incident_disease','CAD_tenyearoutcome')

tabone=CreateTableOne(tab1vars,data=masterdf_tab1,strata=c('subgroup_indicator'),factorVars=tab1facvars)
print(tabone,quote = F,digits=1)

tabone=CreateTableOne(tab1vars,data=masterdf_tab1[subgroup_indicator != 0],strata=c('subgroup_indicator'),factorVars=tab1facvars)
print(tabone,quote = F,digits=1)

tabone=CreateTableOne(tab1vars,data=masterdf_tab1,strata=c('included'),factorVars=tab1facvars)
print(tabone,quote = F,digits=1)

xgcoxAbsRiskDev <- fread('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/2021.01.12_xgboost2/model2_xgboost_cox_best_model_predictions_all_data__absolute_risk_with_ids__development__model2__30Nov_2020.txt')
xgcoxAbsRiskHo <- fread('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/2021.01.12_xgboost2/model2_xgboost_cox_best_model_predictions_all_data__absolute_risk_with_ids__holdout__model2__30Nov_2020.txt')

xgcoxBaseSurv <- fread('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/2021.01.12_xgboost2/model2_xgboost_cox_best_model_predictions_all_data__baseline_survival__model2__30Nov_2020.txt')
xgcoxLeave1OutLabel <- fread('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/xgcoxFeatLabel.csv')

xgcoxFeatList <- fread('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/2021.01.12_xgboost2/model2_xgboost_cox_best_model_predictions_all_data__feature_importance__total_gain__overall__model2__30Nov_2020.txt')

xgcoxLeave1OutLabel$category <- factor(xgcoxLeave1OutLabel$category,
                                             levels=c("Demographics",
                                                     "Lifestyle",
                                                     "Medical history",
                                                     "Surgical history",
                                                     "Family history",
                                                     "Physical exam",
                                                     "Genetics",
                                                     "Labs"),
                                     ordered=TRUE)

xgcoxLeave1OutLabelOrder <- xgcoxLeave1OutLabel[order(category)]

coxnet_feature_list_annot_clean <- fread('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/coxnet51_annotate.csv')

coxnet_feature_list_annot_clean$category <- factor(coxnet_feature_list_annot_clean$category,
                                             levels=c("Demographics",
                                                     "Lifestyle",
                                                     "Medical history",
                                                     "Surgical history",
                                                     "Family history",
                                                     "Physical exam",
                                                     "Genetics",
                                                     "Labs"),
                                     ordered=TRUE)

simplecox_feat <- fread("/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/coxph__feature_list_0_0011765691116882482__30Nov_2020.txt")
simplecox_feat <- simplecox_feat[-1]
names(simplecox_feat) <- c('field','simplecoxcoef')
coxnetvscox <- merge(coxnet_feature_list_annot_clean,simplecox_feat,by='field')
coxnetvscox$coxnetHR <- exp(coxnetvscox$coef)
coxnetvscox$simplecoxHR <- exp(coxnetvscox$simplecoxcoef)
# coxnetvscox[order(category)]

coxnetvscox$simplecoxdiff <- abs(coxnetvscox$coxnetHR-coxnetvscox$simplecoxHR)

coxnet_perm_imp <- fread("/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/2021.01.12_misc/coxnet_final_model_permutation_importance__model_0_0002480304066510752.txt")

coxnet_perm_imp <- coxnet_perm_imp[,V1 := NULL]

a <- apply(coxnet_perm_imp,2,mean)
b <- apply(coxnet_perm_imp,2,function(x) quantile(x,c(0.025,0.975)))

coxnet_perm_imp_clean <- as.data.table(rbind(a,b))

coxnet_perm_imp_clean <- transpose(coxnet_perm_imp_clean)

coxnet_perm_imp_clean$field <- names(a)

coxnet_perm_merged <- merge(coxnet_perm_imp_clean,coxnet_feature_list_annot_clean,by='field')
coxnet_perm_merged <- coxnet_perm_merged[order(-V1)]

coxnet_perm_merged$category <- factor(coxnet_perm_merged$category,
                                             levels=c("Demographics",
                                                     "Lifestyle",
                                                     "Medical history",
                                                     "Surgical history",
                                                     "Family history",
                                                     "Physical exam",
                                                     "Genetics",
                                                     "Labs"),
                                     ordered=TRUE)

options(repr.plot.width=12,repr.plot.height=8)

featplot <- ggplot(coxnet_perm_merged[1:20],aes(x=reorder(human,-V1),y=V1,fill=category)) +
geom_bar(stat="identity",color="black") +
geom_errorbar(aes(ymin=V2,ymax=V3),width=0.2) +
xlab("") +
ylab("Predictor importance\n(Leave-one-out C-statistic decrease)") +
labs(fill='Category') +
theme_classic() +
theme(axis.text.x = element_text(angle=90,hjust=0.95,vjust=0.5,color='black'),text = element_text(size=16,color='black'),
     legend.position=c(0.9,0.5)) +
# scale_fill_discrete(drop=FALSE) +
scale_fill_brewer(palette = 'Set2',drop=FALSE) +
scale_y_continuous(expand=expansion(mult = c(0,0.1))) +
scale_x_discrete(breaks=coxnet_perm_merged[1:20]$human,
                labels=c('Age',expression(GPS[CAD]),'Sex','HDL-c','SBP','HbA1C',
                         'LDL-c','Testosterone','Hip circ.','ApoB','Waist circ.',
                         'Cystatin C','Father heart dz','Lp(a)','Hypertension',
                         'Fair health rating','Neutrophils','Sibling heart dz',
                         'PC3','Lipid-lowering'))
#the drop=FALSE allows all categories to remain even though I subsetting the datatable

featplot

# ggsave('coxnet51_leave1out.pdf',g2,width=10,height=8)

###Feat plot for xgcox

options(repr.plot.width=12,repr.plot.height=6)

xgCoxFeatPlot <- ggplot(xgcoxLeave1OutLabel[1:20],aes(x=reorder(abbrev,-mean),y=mean,fill=factor(overlap,levels=c(1,0),ordered=TRUE,labels=c('Yes','No')))) +
geom_bar(stat="identity",color="black") +
geom_errorbar(aes(ymin=lower,ymax=upper),width=0.2) +
xlab("") +
ylab("Predictor importance\n(Leave-one-out C-statistic decrease)") +
labs(fill=expression(Overlap~with~ML4H[EN-COX])) +
theme_classic() +
theme(axis.text.x = element_text(angle=90,hjust=0.95,vjust=0.5),text = element_text(size=16),
     legend.position=c(0.8,0.6)) +
# scale_fill_discrete(drop=FALSE) +
scale_fill_brewer(palette = 'Set2',drop=FALSE) +
scale_y_continuous(expand=expansion(mult = c(0,0.2))) +
scale_x_discrete(breaks=xgcoxLeave1OutLabel[1:20]$abbrev,
                labels=c('Age',expression(GPS[CAD]),'Sex','SBP','ApoB','Testosterone',
                         'HbA1C','Cystatin C','HDL-c','Father heart dz','Current smoker',
                         'Sibling heart dz','ApoA','Lp(a)','CRP','Fair health rating',
                         'Hypertension','Poor health rating','Height','LDL-c'))
#the drop=FALSE allows all categories to remain even though I subsetting the datatable

xgCoxFeatPlot

# ggsave('coxnet51_leave1out.pdf',g2,width=10,height=8)

coxnet_perm_imp_clean_corrplot <- coxnet_perm_imp_clean[field %in% coxnet_feature_list_annot_clean$field]

corrplot_dt <- merge(coxnet_feature_list_annot_clean,
                     coxnet_perm_imp_clean_corrplot[,c('field','V1')],
                    by='field',all=TRUE)

corrplot_dt[is.na(V1),V1:=0]

corrplot_dt <- corrplot_dt[order(-V1)]
corrplot_dt <- corrplot_dt[order(category)]

fullfeat_dev_corrplot <- setcolorder(fullfeat_devUnscaled,c('index',corrplot_dt$field))

names(fullfeat_dev_corrplot)[-1] <- corrplot_dt$abbrev

M <- cor(fullfeat_dev_corrplot[,-c('index')])

options(repr.plot.width=14,repr.plot.height=14)
corrplot(M,type='upper',order='original',col=brewer.pal(n=8,name='RdYlBu'),
         tl.col='black')

# pdf(height=16,width=16,file='/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/efigure6.pdf')

# corrplot(M,type='upper',order='original',col=brewer.pal(n=8,name='RdYlBu'),
#          tl.col='black')

# dev.off()

fullfeat_dev <- fread("coxnet__feature_matrix__development_0_0011765691116882482__30Nov_2020.txt")
fullfeat_ho <- fread("coxnet__feature_matrix__holdout_0_0011765691116882482__30Nov_2020.txt")

dev_merged <- merge(fullfeat_dev,masterdf[,c('eid','CAD_incident_disease','CAD_fu_days')],
                   by.x='index',by.y='eid')

simplecox_cph <- coxph(Surv(CAD_fu_days,CAD_incident_disease) ~ ., data=dev_merged[,-c('index')])
summary(simplecox_cph)

simplecox_cph_20 <- coxph(Surv(CAD_fu_days,CAD_incident_disease) ~ d_age +
                          d_prsadjscore + c_sex + d_biochemistry_30760 +
                          d_systolic_bp + d_biochemistry_30750 +
                          d_biochemistry_30780 + d_biochemistry_30850 +
                          d_hip + d_biochemistry_30640 +
                          d_waist + father_1 + d_biochemistry_30720 +
                          d_lipoprotein_a + c_selfreport_icd10_20002_1065 +
                          c_overall_health_3 + d_biochemistry_30140 +
                          sibling_1 + d_PC3 + c_lipidlowering, data=dev_merged)
summary(simplecox_cph_20)

fullfeat_dev <- fread("coxnet__feature_matrix__development_0_0011765691116882482__30Nov_2020.txt")
fullfeat_ho <- fread("coxnet__feature_matrix__holdout_0_0011765691116882482__30Nov_2020.txt")

masterdf_dev1_pred <- masterdf[subgroup_indicator == 1]
masterdf_ho1_pred <- masterdf[subgroup_indicator == 2]
masterdf_devho1_pred <- masterdf[subgroup_indicator != 0]

tfunc <- function(vec){
        vec2 <- log(-1*log(1-vec))
        return(vec2)
    }

undo_func <- function(vec){
    vec2 <- 1 - (exp(-1*exp(vec)))
    return(vec2)
}

EHJ2019Cox <- coxph(Surv(CAD_fu_days,CAD_incident_disease) ~ ageG2 + ageG3 + ageG4 + ageG5 + ageG6 + ageG7,
                    data=masterdf_dev1_pred[sex == 'Male'])

EHJ2019Cox_10yr <- coxph(Surv(CAD_fu_days10yr,CAD_tenyearoutcome) ~ ageG2 + ageG3 + ageG4 + ageG5 + ageG6 + ageG7,
                    data=masterdf_dev1_pred[sex == 'Male'])

EHJ2019CoxF <- coxph(Surv(CAD_fu_days,CAD_incident_disease) ~ ageG2 + ageG3 + ageG4 + ageG5 + ageG6 + ageG7,
                    data=masterdf_dev1_pred[sex == 'Female'])

EHJ2019Cox_10yrF <- coxph(Surv(CAD_fu_days10yr,CAD_tenyearoutcome) ~ ageG2 + ageG3 + ageG4 + ageG5 + ageG6 + ageG7,
                    data=masterdf_dev1_pred[sex == 'Female'])

dummyDT <- data.table(ageG1 = c(1,rep(0,6)),
                     ageG2 = c(0,1,rep(0,5)),
                      ageG3 = c(0,0,1,rep(0,4)),
                      ageG4 = c(0,0,0,1,0,0,0),
                      ageG5 = c(rep(0,4),1,0,0),
                      ageG6 = c(rep(0,5),1,0),
                      ageG7 = c(rep(0,6),1))

MalePred <- absolute_risk(EHJ2019Cox,dummyDT)

FemalePred <- absolute_risk(EHJ2019CoxF,dummyDT)

ext_cal_mod <- function(dt_in,predcol,sortcol,extpred){
    intpred <-
    tapply(dt_in[[predcol]],dt_in[[sortcol]],mean)

    dt <- as.data.table(cbind(intpred,extpred))
    names(dt) <- c("intpred","extpred")

    lm1 <- lm(tfunc(extpred) ~ tfunc(intpred),data = dt)
    return(lm1)
}

##Note that the requirement to make sure tenyearASCVD or qrisk3 are not missing
##omits 9 entries for former and 6-7% entries for latter.

PCE_recal_male <- ext_cal_mod(masterdf_dev1_pred[sex=='Male' & !is.na(tenyearASCVD)],"tenyearASCVD","age_group",MalePred)
PCE_recal_female <- ext_cal_mod(masterdf_dev1_pred[sex=='Female' & !is.na(tenyearASCVD)],"tenyearASCVD","age_group",FemalePred)

QRISK3_recal_male <- ext_cal_mod(masterdf_dev1_pred[sex=='Male' & !is.na(qrisk3)],"qrisk3","age_group",MalePred)
QRISK3_recal_female <- ext_cal_mod(masterdf_dev1_pred[sex=='Female' & !is.na(qrisk3)],"qrisk3","age_group",FemalePred)

fram_recal_male <- ext_cal_mod(masterdf_dev1_pred[sex=='Male' & !is.na(framrisk)],"framrisk","age_group",MalePred)
fram_recal_female <- ext_cal_mod(masterdf_dev1_pred[sex=='Female' & !is.na(framrisk)],"framrisk","age_group",FemalePred)

masterdf_ho1_pred[sex=='Male',tenyearASCVD_recal:=undo_func((tfunc(tenyearASCVD) * PCE_recal_male$coefficients[["tfunc(intpred)"]]) +
    PCE_recal_male$coefficients[["(Intercept)"]])]

masterdf_ho1_pred[sex=='Female',tenyearASCVD_recal:=undo_func((tfunc(tenyearASCVD) * PCE_recal_female$coefficients[["tfunc(intpred)"]]) +
    PCE_recal_female$coefficients[["(Intercept)"]])]

masterdf_dev1_pred[sex=='Male',tenyearASCVD_recal:=undo_func((tfunc(tenyearASCVD) * PCE_recal_male$coefficients[["tfunc(intpred)"]]) +
    PCE_recal_male$coefficients[["(Intercept)"]])]

masterdf_dev1_pred[sex=='Female',tenyearASCVD_recal:=undo_func((tfunc(tenyearASCVD) * PCE_recal_female$coefficients[["tfunc(intpred)"]]) +
    PCE_recal_female$coefficients[["(Intercept)"]])]

masterdf_devho1_pred[sex=='Male',tenyearASCVD_recal:=undo_func((tfunc(tenyearASCVD) * PCE_recal_male$coefficients[["tfunc(intpred)"]]) +
    PCE_recal_male$coefficients[["(Intercept)"]])]

masterdf_devho1_pred[sex=='Female',tenyearASCVD_recal:=undo_func((tfunc(tenyearASCVD) * PCE_recal_female$coefficients[["tfunc(intpred)"]]) +
    PCE_recal_female$coefficients[["(Intercept)"]])]

masterdf_ho1_pred[sex=='Male',qrisk3_recal:=undo_func((tfunc(qrisk3) * QRISK3_recal_male$coefficients[["tfunc(intpred)"]]) +
    QRISK3_recal_male$coefficients[["(Intercept)"]])]

masterdf_ho1_pred[sex=='Female',qrisk3_recal:=undo_func((tfunc(qrisk3) * QRISK3_recal_female$coefficients[["tfunc(intpred)"]]) +
    QRISK3_recal_female$coefficients[["(Intercept)"]])]

masterdf_dev1_pred[sex=='Male',qrisk3_recal:=undo_func((tfunc(qrisk3) * QRISK3_recal_male$coefficients[["tfunc(intpred)"]]) +
    QRISK3_recal_male$coefficients[["(Intercept)"]])]

masterdf_dev1_pred[sex=='Female',qrisk3_recal:=undo_func((tfunc(qrisk3) * QRISK3_recal_female$coefficients[["tfunc(intpred)"]]) +
    QRISK3_recal_female$coefficients[["(Intercept)"]])]

masterdf_devho1_pred[sex=='Male',qrisk3_recal:=undo_func((tfunc(qrisk3) * QRISK3_recal_male$coefficients[["tfunc(intpred)"]]) +
    QRISK3_recal_male$coefficients[["(Intercept)"]])]

masterdf_devho1_pred[sex=='Female',qrisk3_recal:=undo_func((tfunc(qrisk3) * QRISK3_recal_female$coefficients[["tfunc(intpred)"]]) +
    QRISK3_recal_female$coefficients[["(Intercept)"]])]

masterdf_ho1_pred[sex=='Male',framrisk_recal:=undo_func((tfunc(framrisk) * fram_recal_male$coefficients[["tfunc(intpred)"]]) +
    fram_recal_male$coefficients[["(Intercept)"]])]

masterdf_ho1_pred[sex=='Female',framrisk_recal:=undo_func((tfunc(framrisk) * fram_recal_female$coefficients[["tfunc(intpred)"]]) +
    fram_recal_female$coefficients[["(Intercept)"]])]

masterdf_dev1_pred[sex=='Male',framrisk_recal:=undo_func((tfunc(framrisk) * fram_recal_male$coefficients[["tfunc(intpred)"]]) +
    fram_recal_male$coefficients[["(Intercept)"]])]

masterdf_dev1_pred[sex=='Female',framrisk_recal:=undo_func((tfunc(framrisk) * fram_recal_female$coefficients[["tfunc(intpred)"]]) +
    fram_recal_female$coefficients[["(Intercept)"]])]

masterdf_devho1_pred[sex=='Male',framrisk_recal:=undo_func((tfunc(framrisk) * fram_recal_male$coefficients[["tfunc(intpred)"]]) +
    fram_recal_male$coefficients[["(Intercept)"]])]

masterdf_devho1_pred[sex=='Female',framrisk_recal:=undo_func((tfunc(framrisk) * fram_recal_female$coefficients[["tfunc(intpred)"]]) +
    fram_recal_female$coefficients[["(Intercept)"]])]

coxnet_abs_id <- fread("coxnet__absolute_risk_with_ids__development_model_0_0011765691116882482__30Nov_2020.txt")
coxnet_abs_ho_id <- fread("coxnet__absolute_risk_with_ids__holdout_model_0_0011765691116882482__30Nov_2020.txt")

coxnet_abs_ho_id$coxnet51risk <- coxnet_abs_ho_id$abs_risk_t10
coxnet_abs_id$coxnet51risk <- coxnet_abs_id$abs_risk_t10

masterdf_ho1_pred1 <- merge(masterdf_ho1_pred,coxnet_abs_ho_id[,c('ukbid','coxnet51risk')],
                           by.x='eid',by.y='ukbid')

masterdf_dev1_pred1 <- merge(masterdf_dev1_pred,coxnet_abs_id[,c('ukbid','coxnet51risk')],
                           by.x='eid',by.y='ukbid')

simplecox_feat1 <- fread("coxph__feature_list_0_0011765691116882482__30Nov_2020.txt")
simplecox_feat1 <- simplecox_feat1[-1]

all.equal(simplecox_feat1$V1,names(fullfeat_dev[,-c('index')]))

featurenames_simplecox <- names(fullfeat_dev[,-c('index')])

simplecox_newlp_dev <- fullfeat_dev[,Calc := as.matrix(fullfeat_dev[,..featurenames_simplecox])%*%simplecox_feat1$V2]
simplecox_newlp_ho <- fullfeat_ho[,Calc := as.matrix(fullfeat_ho[,..featurenames_simplecox])%*%simplecox_feat1$V2]

coxnet_abs_id$simplecox_newlp <- simplecox_newlp_dev$Calc
coxnet_abs_ho_id$simplecox_newlp <- simplecox_newlp_ho$Calc

cph_simplecox_dev <- coxph(Surv(time,O) ~ simplecox_newlp,data=coxnet_abs_id)
cumhaz5 <- basehaz(cph_simplecox_dev,centered = TRUE)
basesurv10_5 <- exp(-1*cumhaz5$hazard[which.min(abs(cumhaz5$time - 3652))])
coxnet_abs_ho_id$simpcox51risk <- 1 - basesurv10_5^exp((coxnet_abs_ho_id$simplecox_newlp - mean(coxnet_abs_id$simplecox_newlp)))
coxnet_abs_id$simpcox51risk <- 1 - basesurv10_5^exp((coxnet_abs_id$simplecox_newlp - mean(coxnet_abs_id$simplecox_newlp)))

coxnet_abs_ho_id$simpcox20risk <- absolute_risk(simplecox_cph_20,data=fullfeat_ho)
coxnet_abs_id$simpcox20risk <- absolute_risk(simplecox_cph_20,data=fullfeat_dev)

masterdf_ho1_pred2 <- merge(masterdf_ho1_pred1,coxnet_abs_ho_id[,c('ukbid','simpcox51risk','simpcox20risk')],
                           by.x='eid',by.y='ukbid')

masterdf_dev1_pred2 <- merge(masterdf_dev1_pred1,coxnet_abs_id[,c('ukbid','simpcox51risk','simpcox20risk')],
                           by.x='eid',by.y='ukbid')

xgcoxAbsRiskHo_clean <- xgcoxAbsRiskHo[,c('ukbid','abs_risk_t10')]
names(xgcoxAbsRiskHo_clean)[2] <- 'xgcoxrisk'

masterdf_ho1_pred2 <- merge(masterdf_ho1_pred2,xgcoxAbsRiskHo_clean,by.x='eid',by.y='ukbid')

dtforcorrEFig9 <- masterdf_ho1_pred2[,c('coxnet51risk','simpcox51risk','xgcoxrisk',
                                   'framrisk_recal','tenyearASCVD_recal','qrisk3_recal')]

names(dtforcorrEFig9) <- c('ML4HEN-COX','SimpleCox51','XGBoost','FRS','PCE','QRISK3')

M4 <- cor(dtforcorrEFig9,use = 'complete.obs')
M4

# pdf(height=8,width=8,file='/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/efigure9.pdf')
options(repr.plot.width=8,repr.plot.height=8)
corrplot(M4,type='upper',order='original',col=brewer.pal(n=10,name='Paired'),
         tl.col='black',cl.lim=c(0.7,1),is.corr=FALSE)

# dev.off()

options(repr.plot.width=14,repr.plot.height=7)

coxnet51_cal_dev <- calibration_plot(data=masterdf_dev1_pred2,
                predictioncol='coxnet51risk',
                eventcol='CAD_tenyearoutcome')

coxnet51_cal_ho <- calibration_plot(data=masterdf_ho1_pred2,
                predictioncol='coxnet51risk',
                eventcol='CAD_tenyearoutcome')

coxnet_cal <- coxnet51_cal_dev + coxnet51_cal_ho + plot_layout(nrow=1)
coxnet_cal

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/efigure4_alt.pdf',
#        coxnet_cal,width=14,height=7)

options(repr.plot.width=14,repr.plot.height=14)

xgboost_cal_ho <- calibration_plot(data=masterdf_ho1_pred2,
                predictioncol='xgcoxrisk',
                eventcol='CAD_tenyearoutcome')

simpcox51_cal_ho <- calibration_plot(data=masterdf_ho1_pred2,
                predictioncol='simpcox51risk',
                eventcol='CAD_tenyearoutcome')

simpcox20_cal_ho <- calibration_plot(data=masterdf_ho1_pred2,
                predictioncol='simpcox20risk',
                eventcol='CAD_tenyearoutcome')

SnAnalysis_cal <- xgboost_cal_ho + simpcox51_cal_ho + simpcox20_cal_ho + plot_layout(nrow=2,ncol=2)
SnAnalysis_cal

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/efigure5_alt.pdf',
#        SnAnalysis_cal,width=14,height=14)

options(repr.plot.width=14,repr.plot.height=7)

pce_cal_dev <- calibration_plot(data=masterdf_dev1_pred[!is.na(tenyearASCVD)],
                predictioncol='tenyearASCVD',
                eventcol='CAD_tenyearoutcome',
                manualpvalue='p-value < 0.001')

pce_recal_cal_dev <- calibration_plot(data=masterdf_dev1_pred[!is.na(tenyearASCVD)],
                predictioncol='tenyearASCVD_recal',
                eventcol='CAD_tenyearoutcome')

pce_plots_dev <- pce_cal_dev + pce_recal_cal_dev
pce_plots_dev

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/pce_calplots_dev.pdf',
#        pce_plots_dev,width=14,height=7)

options(repr.plot.width=14,repr.plot.height=7)

pce_cal_ho <- calibration_plot(data=masterdf_ho1_pred[!is.na(tenyearASCVD)],
                predictioncol='tenyearASCVD',
                eventcol='CAD_tenyearoutcome',
                manualpvalue='p-value < 0.001')

pce_recal_cal_ho <- calibration_plot(data=masterdf_ho1_pred[!is.na(tenyearASCVD)],
                predictioncol='tenyearASCVD_recal',
                eventcol='CAD_tenyearoutcome')

pce_plots_ho <- pce_cal_ho + pce_recal_cal_ho
pce_plots_ho

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/pce_calplots.pdf',
#        pce_plots,width=14,height=7)

options(repr.plot.width=14,repr.plot.height=7)

qrisk3_cal_dev <- calibration_plot(data=masterdf_dev1_pred[!is.na(qrisk3)],
                predictioncol='qrisk3',
                eventcol='CAD_tenyearoutcome',
                manualpvalue='p-value < 0.001')

qrisk3_recal_cal_dev <- calibration_plot(data=masterdf_dev1_pred[!is.na(qrisk3_recal)],
                predictioncol='qrisk3_recal',
                eventcol='CAD_tenyearoutcome')

qrisk3_plots_dev <- qrisk3_cal_dev + qrisk3_recal_cal_dev
qrisk3_plots_dev

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/qrisk3_calplots_dev.pdf',
#        qrisk3_plots_dev,width=14,height=7)

options(repr.plot.width=14,repr.plot.height=7)

qrisk3_cal_ho <- calibration_plot(data=masterdf_ho1_pred[!is.na(qrisk3)],
                predictioncol='qrisk3',
                eventcol='CAD_tenyearoutcome',
                manualpvalue='p-value < 0.001')

qrisk3_recal_cal_ho <- calibration_plot(data=masterdf_ho1_pred[!is.na(qrisk3_recal)],
                predictioncol='qrisk3_recal',
                eventcol='CAD_tenyearoutcome')

qrisk3_plots_ho <- qrisk3_cal_ho + qrisk3_recal_cal_ho
qrisk3_plots_ho

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/qrisk3_calplots.pdf',
#        qrisk3_plots,width=14,height=7)

options(repr.plot.width=14,repr.plot.height=7)

framrisk_cal_dev <- calibration_plot(data=masterdf_dev1_pred[!is.na(framrisk)],
                predictioncol='framrisk',
                eventcol='CAD_tenyearoutcome',
                manualpvalue='p-value < 0.001')

framrisk_recal_cal_dev <- calibration_plot(data=masterdf_dev1_pred[!is.na(framrisk_recal)],
                predictioncol='framrisk_recal',
                eventcol='CAD_tenyearoutcome')

fram_plots_dev <- framrisk_cal_dev + framrisk_recal_cal_dev
fram_plots_dev

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/framrisk_calplots_dev.pdf',
#        fram_plots_dev,width=14,height=7)

options(repr.plot.width=14,repr.plot.height=7)

framrisk_cal_ho <- calibration_plot(data=masterdf_ho1_pred[!is.na(framrisk)],
                predictioncol='framrisk',
                eventcol='CAD_tenyearoutcome',
                manualpvalue='p-value < 0.001')

framrisk_recal_cal_ho <- calibration_plot(data=masterdf_ho1_pred[!is.na(framrisk_recal)],
                predictioncol='framrisk_recal',
                eventcol='CAD_tenyearoutcome')

fram_plots_ho <- framrisk_cal_ho + framrisk_recal_cal_ho
fram_plots_ho

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/framrisk_calplots.pdf',
#        fram_plots,width=14,height=7)

#Purpose of this is simply to correctly calculate DeLong p-value between ML4HEN-COX and QRISK3
masterdf_ho1_pred3 <- masterdf_ho1_pred2[!is.na(qrisk3_recal)]

rocobj_coxnet51 <- roc(masterdf_ho1_pred2$CAD_tenyearoutcome,masterdf_ho1_pred2$coxnet51risk)
rocobj_coxnet51_2 <- roc(masterdf_ho1_pred3$CAD_tenyearoutcome,masterdf_ho1_pred3$coxnet51risk)
rocobj_simpcox51risk <- roc(masterdf_ho1_pred2$CAD_tenyearoutcome,masterdf_ho1_pred2$simpcox51risk)
rocobj_simpcox20risk <- roc(masterdf_ho1_pred2$CAD_tenyearoutcome,masterdf_ho1_pred2$simpcox20risk)
rocobj_framrisk <- roc(masterdf_ho1_pred2[!is.na(framrisk_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[!is.na(framrisk_recal)]$framrisk_recal)
rocobj_tenyearASCVD <- roc(masterdf_ho1_pred2[!is.na(tenyearASCVD_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[!is.na(tenyearASCVD_recal)]$tenyearASCVD_recal)
rocobj_qrisk3 <- roc(masterdf_ho1_pred3$CAD_tenyearoutcome,masterdf_ho1_pred3$qrisk3_recal)
rocobj_xgcoxrisk <- roc(masterdf_ho1_pred2$CAD_tenyearoutcome,masterdf_ho1_pred2$xgcoxrisk)

roc.test(rocobj_coxnet51,rocobj_framrisk,method='delong')
roc.test(rocobj_coxnet51,rocobj_tenyearASCVD,method='delong')
roc.test(rocobj_coxnet51_2,rocobj_qrisk3,method='delong')
roc.test(rocobj_coxnet51,rocobj_xgcoxrisk,method='delong')
roc.test(rocobj_coxnet51,rocobj_simpcox51risk,method='delong')
roc.test(rocobj_coxnet51,rocobj_simpcox20risk,method='delong')

ci(rocobj_qrisk3,method='bootstrap',boot.n=1000,progress='text')

rocobj_coxnet51_male <- roc(masterdf_ho1_pred2[sex=='Male']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Male']$coxnet51risk)
rocobj_coxnet51_male_2 <- roc(masterdf_ho1_pred3[sex=='Male']$CAD_tenyearoutcome,masterdf_ho1_pred3[sex=='Male']$coxnet51risk)
rocobj_simpcox51risk_male <- roc(masterdf_ho1_pred2[sex=='Male']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Male']$simpcox51risk)
rocobj_simpcox20risk_male <- roc(masterdf_ho1_pred2[sex=='Male']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Male']$simpcox20risk)
rocobj_framrisk_male <- roc(masterdf_ho1_pred2[sex=='Male' & !is.na(framrisk_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Male' & !is.na(framrisk_recal)]$framrisk_recal)
rocobj_tenyearASCVD_male <- roc(masterdf_ho1_pred2[sex=='Male' & !is.na(tenyearASCVD_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Male' & !is.na(tenyearASCVD_recal)]$tenyearASCVD_recal)
rocobj_qrisk3_male <- roc(masterdf_ho1_pred3[sex=='Male']$CAD_tenyearoutcome,masterdf_ho1_pred3[sex=='Male']$qrisk3_recal)
rocobj_xgcoxrisk_male <- roc(masterdf_ho1_pred2[sex=='Male']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Male']$xgcoxrisk)

roc.test(rocobj_coxnet51_male,rocobj_framrisk_male,method='delong')
roc.test(rocobj_coxnet51_male,rocobj_tenyearASCVD_male,method='delong')
roc.test(rocobj_coxnet51_male_2,rocobj_qrisk3_male,method='delong')
roc.test(rocobj_coxnet51_male,rocobj_xgcoxrisk_male,method='delong')
roc.test(rocobj_coxnet51_male,rocobj_simpcox51risk_male,method='delong')
roc.test(rocobj_coxnet51_male,rocobj_simpcox20risk_male,method='delong')

rocobj_coxnet51_female <- roc(masterdf_ho1_pred2[sex=='Female']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Female']$coxnet51risk)
rocobj_coxnet51_female_2 <- roc(masterdf_ho1_pred3[sex=='Female']$CAD_tenyearoutcome,masterdf_ho1_pred3[sex=='Female']$coxnet51risk)
rocobj_simpcox51risk_female <- roc(masterdf_ho1_pred2[sex=='Female']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Female']$simpcox51risk)
rocobj_simpcox20risk_female <- roc(masterdf_ho1_pred2[sex=='Female']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Female']$simpcox20risk)
rocobj_framrisk_female <- roc(masterdf_ho1_pred2[sex=='Female' & !is.na(framrisk_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Female' & !is.na(framrisk_recal)]$framrisk_recal)
rocobj_tenyearASCVD_female <- roc(masterdf_ho1_pred2[sex=='Female' & !is.na(tenyearASCVD_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Female' & !is.na(tenyearASCVD_recal)]$tenyearASCVD_recal)
rocobj_qrisk3_female <- roc(masterdf_ho1_pred3[sex=='Female']$CAD_tenyearoutcome,masterdf_ho1_pred3[sex=='Female']$qrisk3_recal)
rocobj_xgcoxrisk_female <- roc(masterdf_ho1_pred2[sex=='Female']$CAD_tenyearoutcome,masterdf_ho1_pred2[sex=='Female']$xgcoxrisk)

roc.test(rocobj_coxnet51_female,rocobj_framrisk_female,method='delong')
roc.test(rocobj_coxnet51_female,rocobj_tenyearASCVD_female,method='delong')
roc.test(rocobj_coxnet51_female_2,rocobj_qrisk3_female,method='delong')

roc.test(rocobj_coxnet51_female,rocobj_xgcoxrisk_female,method='delong')
roc.test(rocobj_coxnet51_female,rocobj_simpcox51risk_female,method='delong')
roc.test(rocobj_coxnet51_female,rocobj_simpcox20risk_female,method='delong')

rocobj_coxnet51_under55 <- roc(masterdf_ho1_pred2[age<55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age<55]$coxnet51risk)
rocobj_coxnet51_under55_2 <- roc(masterdf_ho1_pred3[age<55]$CAD_tenyearoutcome,masterdf_ho1_pred3[age<55]$coxnet51risk)
rocobj_simpcox51risk_under55 <- roc(masterdf_ho1_pred2[age<55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age<55]$simpcox51risk)
rocobj_simpcox20risk_under55 <- roc(masterdf_ho1_pred2[age<55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age<55]$simpcox20risk)
rocobj_framrisk_under55 <- roc(masterdf_ho1_pred2[age<55 & !is.na(framrisk_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[age<55 & !is.na(framrisk_recal)]$framrisk_recal)
rocobj_tenyearASCVD_under55 <- roc(masterdf_ho1_pred2[age<55 & !is.na(tenyearASCVD_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[age<55 & !is.na(tenyearASCVD_recal)]$tenyearASCVD_recal)
rocobj_qrisk3_under55 <- roc(masterdf_ho1_pred3[age<55]$CAD_tenyearoutcome,masterdf_ho1_pred3[age<55]$qrisk3_recal)
rocobj_xgcoxrisk_under55 <- roc(masterdf_ho1_pred2[age<55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age<55]$xgcoxrisk)

roc.test(rocobj_coxnet51_under55,rocobj_framrisk_under55,method='delong')
roc.test(rocobj_coxnet51_under55,rocobj_tenyearASCVD_under55,method='delong')
roc.test(rocobj_coxnet51_under55_2,rocobj_qrisk3_under55,method='delong')

roc.test(rocobj_coxnet51_under55,rocobj_xgcoxrisk_under55,method='delong')
roc.test(rocobj_coxnet51_under55,rocobj_simpcox51risk_under55,method='delong')
roc.test(rocobj_coxnet51_under55,rocobj_simpcox20risk_under55,method='delong')

rocobj_coxnet51_over55 <- roc(masterdf_ho1_pred2[age>=55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age>=55]$coxnet51risk)
rocobj_coxnet51_over55_2 <- roc(masterdf_ho1_pred3[age>=55]$CAD_tenyearoutcome,masterdf_ho1_pred3[age>=55]$coxnet51risk)

rocobj_simpcox51risk_over55 <- roc(masterdf_ho1_pred2[age>=55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age>=55]$simpcox51risk)
rocobj_simpcox20risk_over55 <- roc(masterdf_ho1_pred2[age>=55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age>=55]$simpcox20risk)
rocobj_framrisk_over55 <- roc(masterdf_ho1_pred2[age>=55 & !is.na(framrisk_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[age>=55 & !is.na(framrisk_recal)]$framrisk_recal)
rocobj_tenyearASCVD_over55 <- roc(masterdf_ho1_pred2[age>=55 & !is.na(tenyearASCVD_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[age>=55 & !is.na(tenyearASCVD_recal)]$tenyearASCVD_recal)
rocobj_qrisk3_over55 <- roc(masterdf_ho1_pred3[age>=55]$CAD_tenyearoutcome,masterdf_ho1_pred3[age>=55]$qrisk3_recal)
rocobj_xgcoxrisk_over55 <- roc(masterdf_ho1_pred2[age>=55]$CAD_tenyearoutcome,masterdf_ho1_pred2[age>=55]$xgcoxrisk)

roc.test(rocobj_coxnet51_over55,rocobj_framrisk_over55,method='delong')
roc.test(rocobj_coxnet51_over55,rocobj_tenyearASCVD_over55,method='delong')
roc.test(rocobj_coxnet51_over55_2,rocobj_qrisk3_over55,method='delong')

roc.test(rocobj_coxnet51_over55,rocobj_xgcoxrisk_over55,method='delong')
roc.test(rocobj_coxnet51_over55,rocobj_simpcox51risk_over55,method='delong')
roc.test(rocobj_coxnet51_over55,rocobj_simpcox20risk_over55,method='delong')

rocobj_tenyearASCVD_1 <- roc(masterdf_ho1_pred2[!is.na(tenyearASCVD_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[!is.na(tenyearASCVD_recal)]$tenyearASCVD_recal)
rocobj_qrisk3_1 <- roc(masterdf_ho1_pred2[!is.na(qrisk3_recal)]$CAD_tenyearoutcome,masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal)

rocobj_tenyearASCVD_1
rocobj_qrisk3_1

rocobj_tenyearASCVD_1 <- roc(masterdf_ho1_pred2[!is.na(tenyearASCVD)]$CAD_tenyearoutcome,masterdf_ho1_pred2[!is.na(tenyearASCVD)]$tenyearASCVD_recal)
rocobj_qrisk3_1 <- roc(masterdf_ho1_pred2[!is.na(qrisk3)]$CAD_tenyearoutcome,masterdf_ho1_pred2[!is.na(qrisk3)]$qrisk3_recal)

rocobj_tenyearASCVD_1
rocobj_qrisk3_1

rocobj_tenyearASCVD_1 <- roc(masterdf_ho1_pred2[!is.na(tenyearASCVD)]$CVD_tenyearoutcome,masterdf_ho1_pred2[!is.na(tenyearASCVD)]$tenyearASCVD_recal)
rocobj_qrisk3_1 <- roc(masterdf_ho1_pred2[!is.na(qrisk3)]$CVD_tenyearoutcome,masterdf_ho1_pred2[!is.na(qrisk3)]$qrisk3_recal)
rocobj_coxnet51_1 <- roc(masterdf_ho1_pred2$CVD_tenyearoutcome,masterdf_ho1_pred2$coxnet51risk)

rocobj_tenyearASCVD_1
rocobj_qrisk3_1
rocobj_coxnet51_1

ci(rocobj_tenyearASCVD_1,method='bootstrap',boot.n=1000,progress='text')
ci(rocobj_qrisk3_1,method='bootstrap',boot.n=1000,progress='text')
ci(rocobj_coxnet51_1,method='bootstrap',boot.n=1000,progress='text')

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$coxnet51risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$coxnet51risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$coxnet51risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$coxnet51risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$coxnet51risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$coxnet51risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$simpcox51risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$simpcox51risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$simpcox51risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$simpcox51risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$simpcox51risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$simpcox51risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$simpcox20risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$simpcox20risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$simpcox20risk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$simpcox20risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$simpcox20risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$simpcox20risk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$xgcoxrisk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$xgcoxrisk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$xgcoxrisk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$xgcoxrisk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$xgcoxrisk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$xgcoxrisk,
                cutoff=c(0,0.05,1))

dtfordensityplots <- masterdf_ho1_pred2[,c('eid','coxnet51risk','simpcox51risk','xgcoxrisk',
                                   'framrisk','tenyearASCVD','qrisk3','framrisk_recal',
                                   'tenyearASCVD_recal','qrisk3_recal')]

names(dtfordensityplots) <- c('eid','ML4HEN-Cox','SimpleCox51','XgCox','FRS','PCE','QRISK3',
                      'FRS(recal)','PCE(recal)','QRISK(recal)')

densityplotdt1 <- melt(dtfordensityplots,id.vars=c('eid'),measure.vars=c('ML4HEN-Cox'))

densityplotdt2 <- melt(dtfordensityplots,id.vars=c('eid'),measure.vars=c('ML4HEN-Cox',
                                                       'FRS(recal)','PCE(recal)',
                                                       'QRISK(recal)'))

densityplotdt3 <- melt(dtfordensityplots,id.vars=c('eid'),measure.vars=c('ML4HEN-Cox','SimpleCox51',
                                                       'XgCox'))

options(repr.plot.width=12,repr.plot.height=10)

g1 <- ggplot(data=densityplotdt1,aes(x=value,colour=variable)) +
geom_density() +
scale_x_continuous(limits=c(0,0.15)) +
scale_y_continuous(expand=c(0,0),limits=c(0,45)) +
theme_bw() +
xlab('Predicted Risk') +
labs(colour = 'Model') +
scale_color_manual(values=c('#66C2A5'),labels=c(expression(ML4H[EN-COX]))) +
theme(legend.text.align = 0)

g2 <- ggplot(data=densityplotdt2,aes(x=value,colour=variable)) +
geom_density() +
theme_bw() +
scale_x_continuous(limits=c(0,0.15)) +
scale_y_continuous(expand=c(0,0),limits=c(0,45)) +
xlab('Predicted Risk') +
labs(colour = 'Model') +
scale_color_manual(values=c('#66C2A5','#FC8D62','#8DA0CB','#E78AC3'),
                   labels=c(expression(ML4H[EN-COX]),'FRS','PCE','QRISK3')) +
theme(legend.text.align = 0)

g3 <- ggplot(data=densityplotdt3,aes(x=value,colour=variable)) +
geom_density() +
theme_bw() +
scale_x_continuous(limits=c(0,0.15)) +
scale_y_continuous(expand=c(0,0),limits=c(0,45)) +
xlab('Predicted Risk') +
labs(colour = 'Model') +
scale_color_manual(values=c('#66C2A5','#A6D854','#FFD92F'),
                   labels=c(expression(ML4H[EN-COX]),'SimpleCox51','XGBoost')) +
theme(legend.text.align = 0)

absriskplots <- g1 + g2 + g3 + plot_layout(ncol = 1)
absriskplots

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/efigure8.pdf',
#        absriskplots,width=12,height=10)

options(repr.plot.width=10,repr.plot.height=10)
densityplotdt4 <- melt(dtfordensityplots,id.vars=c('eid'),measure.vars=c('ML4HEN-Cox','XgCox'))

g4 <- ggplot(data=densityplotdt4,aes(x=value,colour=variable)) +
geom_density() +
scale_x_continuous(limits=c(0,0.25)) +
theme_classic() +
xlab('Predicted Risk') +
labs(colour = 'Model') +
scale_color_brewer(palette='Set1',labels=c(expression(ML4H[EN-COX]),'XGBoost')) +
theme(text = element_text(size=16),
      legend.position=c(0.8,0.4),
     legend.title=element_blank(),
     legend.text.align=0)

options(repr.plot.width=12,repr.plot.height=12)
efigure11 <- xgCoxFeatPlot / (aucfig2 | g4) + plot_layout(nrow=2,heights = c(2,2))

efigure11

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/efigure11.pdf',
#        efigure11,width=10,height=10)

fullfeat_dev <- fread("coxnet__feature_matrix__development_0_0011765691116882482__30Nov_2020.txt")
fullfeat_ho <- fread("coxnet__feature_matrix__holdout_0_0011765691116882482__30Nov_2020.txt")

fullfeat_devUnscaled <- fread('coxnet__feature_matrix_nonzero_model_0_0011765691116882482__development_unscaled__30Nov_2020.txt')
fullfeat_hoUnscaled <- fread('coxnet__feature_matrix_nonzero_model_0_0011765691116882482__holdout_unscaled__30Nov_2020.txt')

prsvec <- quantile(fullfeat_devUnscaled[['d_prsadjscore']],seq(0,1,0.01),na.rm = TRUE)
prsperc <- seq(0,100,1)

prsmean <- mean(fullfeat_devUnscaled[['d_prsadjscore']],na.rm=TRUE)
prssd <- sd(fullfeat_devUnscaled[['d_prsadjscore']],na.rm=TRUE)

prsvec1 <- (prsvec - prsmean)/prssd

agevec <- c(45,55,65)
agevarmean <- mean(fullfeat_devUnscaled[['d_age']],na.rm=TRUE)
agevarsd <- sd(fullfeat_devUnscaled[['d_age']],na.rm=TRUE)

prsvec2 <- rep(prsvec1,length(agevec))
agevecrep <- rep(agevec,each=length(prsvec1))
agevecrep_scaled <- (agevecrep - agevarmean)/agevarsd

plotdt <- data.table(prsvec2,
                        agevecrep_scaled,
                        rep(prsperc,length(agevec)),
                        agevecrep)
names(plotdt) <- c('d_prsadjscore','d_age','unscaledvar','age_unscaled')
mutnamvec <- names(plotdt)[1:2]

modscaleddt <- fullfeat_dev[,-c('index')]
modscaleddtmean <- modscaleddt[,lapply(.SD,mean)]
modscaleddtmeanrep <- modscaleddtmean[rep(seq_len(nrow(modscaleddtmean)),nrow(plotdt))]

modscaleddtmeanrep[, (mutnamvec) := plotdt[, .SD, .SDcols=mutnamvec],
                            .SDcols = mutnamvec]

if(!all.equal(coxnet_feature_list_annot_clean$field,names(modscaleddtmeanrep))){
    stop('fields in coefdt and column names in scaleddt not in same order')
}

modscaleddtmeanrep[, lp := as.matrix(modscaleddtmeanrep)%*%coxnet_feature_list_annot_clean$coef]
modscaleddtmeanrep[, absrisk := (1 - 0.9876555687885301^exp(lp))]
finaldt <- cbind(modscaleddtmeanrep,
                            plotdt[,.SD,.SDcols=which(names(plotdt) %in% c('unscaledvar','age_unscaled'))])

prsplot <- ggplot(finaldt,aes(x=unscaledvar,y=absrisk*100,
                              color=factor(age_unscaled,levels=c(65,55,45)))) +
    geom_point() +
    scale_y_continuous(limits=c(0,6)) +
    theme_classic() +
    xlab(expression(Adjusted~GPS[CAD]~Percentile)) +
    ylab('Predicted 10-year risk of CAD, %') +
    labs(color = 'Age') +
    scale_color_brewer(palette = 'Set1') +
    theme(text = element_text(size=16),legend.position='none')

hipquant <- quantile(fullfeat_devUnscaled[['d_hip']],c(0.01,0.99),na.rm = TRUE)
hipvec <- seq(hipquant[[1]],hipquant[[2]],length.out=100)

hipmean <- mean(fullfeat_devUnscaled[['d_hip']],na.rm=TRUE)
hipsd <- sd(fullfeat_devUnscaled[['d_hip']],na.rm=TRUE)

hipvec1 <- (hipvec - hipmean)/hipsd

agevec <- c(45,55,65)
agevarmean <- mean(fullfeat_devUnscaled[['d_age']],na.rm=TRUE)
agevarsd <- sd(fullfeat_devUnscaled[['d_age']],na.rm=TRUE)

hipvec2 <- rep(hipvec1,length(agevec))
agevecrep <- rep(agevec,each=length(hipvec1))
agevecrep_scaled <- (agevecrep - agevarmean)/agevarsd

plotdt <- data.table(hipvec2,
                        agevecrep_scaled,
                        rep(hipvec,length(agevec)),
                        agevecrep)
names(plotdt) <- c('d_hip','d_age','unscaledvar','age_unscaled')
mutnamvec <- names(plotdt)[1:2]

modscaleddt <- fullfeat_dev[,-c('index')]
modscaleddtmean <- modscaleddt[,lapply(.SD,mean)]
modscaleddtmeanrep <- modscaleddtmean[rep(seq_len(nrow(modscaleddtmean)),nrow(plotdt))]

modscaleddtmeanrep[, (mutnamvec) := plotdt[, .SD, .SDcols=mutnamvec],
                            .SDcols = mutnamvec]

if(!all.equal(coxnet_feature_list_annot_clean$field,names(modscaleddtmeanrep))){
    stop('fields in coefdt and column names in scaleddt not in same order')
}

modscaleddtmeanrep[, lp := as.matrix(modscaleddtmeanrep)%*%coxnet_feature_list_annot_clean$coef]
modscaleddtmeanrep[, absrisk := (1 - 0.9876555687885301^exp(lp))]
finaldt <- cbind(modscaleddtmeanrep,
                            plotdt[,.SD,.SDcols=which(names(plotdt) %in% c('unscaledvar','age_unscaled'))])

hipplot <- ggplot(finaldt,aes(x=unscaledvar,y=absrisk*100,
                              color=factor(age_unscaled,levels=c(65,55,45)))) +
    geom_point() +
    scale_y_continuous(limits=c(0,6)) +
    theme_classic() +
    xlab('Hip circumference (cm)') +
    ylab('') +
    labs(color = 'Age') +
    scale_color_brewer(palette = 'Set1') +
    theme(text = element_text(size=16),legend.position='none')

waistquant <- quantile(fullfeat_devUnscaled[['d_waist']],c(0.01,0.99),na.rm = TRUE)
waistvec <- seq(waistquant[[1]],waistquant[[2]],length.out=100)

waistmean <- mean(fullfeat_devUnscaled[['d_waist']],na.rm=TRUE)
waistsd <- sd(fullfeat_devUnscaled[['d_waist']],na.rm=TRUE)

waistvec1 <- (waistvec - waistmean)/waistsd

agevec <- c(45,55,65)
agevarmean <- mean(fullfeat_devUnscaled[['d_age']],na.rm=TRUE)
agevarsd <- sd(fullfeat_devUnscaled[['d_age']],na.rm=TRUE)

waistvec2 <- rep(waistvec1,length(agevec))
agevecrep <- rep(agevec,each=length(waistvec1))
agevecrep_scaled <- (agevecrep - agevarmean)/agevarsd

plotdt <- data.table(waistvec2,
                        agevecrep_scaled,
                        rep(waistvec,length(agevec)),
                        agevecrep)
names(plotdt) <- c('d_waist','d_age','unscaledvar','age_unscaled')
mutnamvec <- names(plotdt)[1:2]

modscaleddt <- fullfeat_dev[,-c('index')]
modscaleddtmean <- modscaleddt[,lapply(.SD,mean)]
modscaleddtmeanrep <- modscaleddtmean[rep(seq_len(nrow(modscaleddtmean)),nrow(plotdt))]

modscaleddtmeanrep[, (mutnamvec) := plotdt[, .SD, .SDcols=mutnamvec],
                            .SDcols = mutnamvec]

if(!all.equal(coxnet_feature_list_annot_clean$field,names(modscaleddtmeanrep))){
    stop('fields in coefdt and column names in scaleddt not in same order')
}

modscaleddtmeanrep[, lp := as.matrix(modscaleddtmeanrep)%*%coxnet_feature_list_annot_clean$coef]
modscaleddtmeanrep[, absrisk := (1 - 0.9876555687885301^exp(lp))]
finaldt <- cbind(modscaleddtmeanrep,
                            plotdt[,.SD,.SDcols=which(names(plotdt) %in% c('unscaledvar','age_unscaled'))])

waistplot <- ggplot(finaldt,aes(x=unscaledvar,y=absrisk*100,
                              color=factor(age_unscaled,levels=c(65,55,45)))) +
    geom_point() +
    scale_y_continuous(limits=c(0,6)) +
    theme_classic() +
    xlab('Waist circumference (cm)') +
    ylab('') +
    labs(color = 'Age') +
    scale_color_brewer(palette = 'Set1') +
    theme(text = element_text(size=16),legend.position=c(0.7,0.8))

options(repr.plot.width=12,repr.plot.height=12)
figure3 <- featplot / (prsplot | hipplot | waistplot) + plot_layout(nrow=2)
figure3

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/figure3.pdf',
#         figure3,width=12,height=12)

# names(plotdt) <- c('d_waist','d_age','unscaledvar','age_unscaled')
# mutnamvec <- names(plotdt)[1:2]

modscaleddt <- copy(fullfeat_ho)
modscaleddt[,d_prsadjscore:=0]

modscaleddt[, lp := as.matrix(modscaleddt[,-c('index')])%*%coxnet_feature_list_annot_clean$coef]
modscaleddt[, coxnetNoPrsRisk := (1 - 0.9876555687885301^exp(lp))]

masterdf_ho1_pred2 <- merge(masterdf_ho1_pred2,modscaleddt[,c('index','coxnetNoPrsRisk')],by.x='eid',by.y='index')

dim(masterdf_ho1_pred2)
head(masterdf_ho1_pred2)

rocobj_coxnetNoPrs <- roc(masterdf_ho1_pred2$CAD_tenyearoutcome,masterdf_ho1_pred2$coxnetNoPrsRisk)
rocobj_coxnetNoPrs

ci(rocobj_coxnetNoPrs,method='bootstrap',boot.n=1000,progress='text')

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$coxnetNoPrsRisk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$coxnetNoPrsRisk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$coxnetNoPrsRisk,
                cutoff=c(0,0.025,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$framrisk_recal,
                predrisk2=masterdf_ho1_pred2$coxnetNoPrsRisk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2,
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2$tenyearASCVD_recal,
                predrisk2=masterdf_ho1_pred2$coxnetNoPrsRisk,
                cutoff=c(0,0.05,1))

reclass(data=masterdf_ho1_pred2[!is.na(qrisk3_recal)],
                 cOutcome="CAD_tenyearoutcome",
                predrisk1=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$qrisk3_recal,
                predrisk2=masterdf_ho1_pred2[!is.na(qrisk3_recal)]$coxnetNoPrsRisk,
                cutoff=c(0,0.05,1))

names(masterdf_ho1_pred2)

masterdf_ho1_pred2[,coxnet51riskQuintiles := quantcut(coxnet51risk,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,coxnet51riskDeciles := quantcut(coxnet51risk,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,simpcox51riskQuintiles := quantcut(simpcox51risk,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,simpcox51riskDeciles := quantcut(simpcox51risk,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,framrisk_recalQuintiles := quantcut(framrisk_recal,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,framrisk_recalDeciles := quantcut(framrisk_recal,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,tenyearASCVD_recalQuintiles := quantcut(tenyearASCVD_recal,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,tenyearASCVD_recalDeciles := quantcut(tenyearASCVD_recal,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,qrisk3_recalQuintiles := quantcut(qrisk3_recal,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,qrisk3_recalDeciles := quantcut(qrisk3_recal,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,framriskQuintiles := quantcut(framrisk,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,framriskDeciles := quantcut(framrisk,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,tenyearASCVDQuintiles := quantcut(tenyearASCVD,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,tenyearASCVDDeciles := quantcut(tenyearASCVD,4,labels=paste0('Q',1:4),ordered=TRUE)]

masterdf_ho1_pred2[,qrisk3Quintiles := quantcut(qrisk3,5,labels=paste0('Q',1:5),ordered=TRUE)]
masterdf_ho1_pred2[,qrisk3Deciles := quantcut(qrisk3,4,labels=paste0('Q',1:4),ordered=TRUE)]

coxnet51riskQuintilesCalc <-
masterdf_ho1_pred2[order(coxnet51riskQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='coxnet51riskQuintiles']
names(coxnet51riskQuintilesCalc) <- c('quant','coxnet51Q20')

coxnet51riskDecilesCalc <-
masterdf_ho1_pred2[order(coxnet51riskDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='coxnet51riskDeciles']
names(coxnet51riskDecilesCalc) <- c('quant','coxnet51Q10')

simpcox51riskQuintilesCalc <-
masterdf_ho1_pred2[order(simpcox51riskQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='simpcox51riskQuintiles']
names(simpcox51riskQuintilesCalc) <- c('quant','simpcox51Q20')

simpcox51riskDecilesCalc <-
masterdf_ho1_pred2[order(simpcox51riskDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='simpcox51riskDeciles']
names(simpcox51riskDecilesCalc) <- c('quant','simpcox51Q10')

framrisk_recalQuintilesCalc <-
masterdf_ho1_pred2[order(framrisk_recalQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='framrisk_recalQuintiles']
names(framrisk_recalQuintilesCalc) <- c('quant','framriskQ20')

framrisk_recalDecilesCalc <-
masterdf_ho1_pred2[order(framrisk_recalDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='framrisk_recalDeciles']
names(framrisk_recalDecilesCalc) <- c('quant','framriskQ10')

tenyearASCVD_recalQuintilesCalc <-
masterdf_ho1_pred2[order(tenyearASCVD_recalQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='tenyearASCVD_recalQuintiles']
names(tenyearASCVD_recalQuintilesCalc) <- c('quant','PCEQ20')

tenyearASCVD_recalDecilesCalc <-
masterdf_ho1_pred2[order(tenyearASCVD_recalDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='tenyearASCVD_recalDeciles']
names(tenyearASCVD_recalDecilesCalc) <- c('quant','PCEQ10')

qrisk3_recalQuintilesCalc <-
masterdf_ho1_pred2[order(qrisk3_recalQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='qrisk3_recalQuintiles']
names(qrisk3_recalQuintilesCalc) <- c('quant','qrisk3Q20')
qrisk3_recalQuintilesCalc <- qrisk3_recalQuintilesCalc[!is.na(quant)]

qrisk3_recalDecilesCalc <-
masterdf_ho1_pred2[order(qrisk3_recalDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='qrisk3_recalDeciles']
names(qrisk3_recalDecilesCalc) <- c('quant','qrisk3Q10')
qrisk3_recalDecilesCalc <- qrisk3_recalDecilesCalc[!is.na(quant)]

framriskQuintilesCalc <-
masterdf_ho1_pred2[order(framriskQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='framriskQuintiles']
names(framriskQuintilesCalc) <- c('quant','framriskRawQ20')

framriskDecilesCalc <-
masterdf_ho1_pred2[order(framriskDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='framriskDeciles']
names(framriskDecilesCalc) <- c('quant','framriskRawQ10')

tenyearASCVDQuintilesCalc <-
masterdf_ho1_pred2[order(tenyearASCVDQuintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='tenyearASCVDQuintiles']
names(tenyearASCVDQuintilesCalc) <- c('quant','PCERawQ20')

tenyearASCVDDecilesCalc <-
masterdf_ho1_pred2[order(tenyearASCVDDeciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='tenyearASCVDDeciles']
names(tenyearASCVDDecilesCalc) <- c('quant','PCERawQ10')

qrisk3QuintilesCalc <-
masterdf_ho1_pred2[order(qrisk3Quintiles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='qrisk3Quintiles']
names(qrisk3QuintilesCalc) <- c('quant','qrisk3RawQ20')
qrisk3QuintilesCalc <- qrisk3QuintilesCalc[!is.na(quant)]

qrisk3DecilesCalc <-
masterdf_ho1_pred2[order(qrisk3Deciles),
                   lapply(.SD,mean),.SDcols='CAD_tenyearoutcome',
                   by='qrisk3Deciles']
names(qrisk3DecilesCalc) <- c('quant','qrisk3RawQ10')
qrisk3DecilesCalc <- qrisk3DecilesCalc[!is.na(quant)]

Quintilesdt <- merge(coxnet51riskQuintilesCalc,simpcox51riskQuintilesCalc,by='quant')
Quintilesdt <- merge(Quintilesdt,framrisk_recalQuintilesCalc,by='quant')
Quintilesdt <- merge(Quintilesdt,tenyearASCVD_recalQuintilesCalc,by='quant')
Quintilesdt <- merge(Quintilesdt,qrisk3_recalQuintilesCalc,by='quant')
Quintilesdt <- merge(Quintilesdt,framriskQuintilesCalc,by='quant')
Quintilesdt <- merge(Quintilesdt,tenyearASCVDQuintilesCalc,by='quant')
Quintilesdt <- merge(Quintilesdt,qrisk3QuintilesCalc,by='quant')

Quintilesdtmelted <- melt(Quintilesdt,id.vars=c('quant'),
                        measure.vars=c('coxnet51Q20','simpcox51Q20',
                                      'framriskQ20','PCEQ20','qrisk3Q20',
                                      'framriskRawQ20','PCERawQ20','qrisk3RawQ20'))

Quintilesdtmelted$variable <- factor(Quintilesdtmelted$variable,
                                  levels=c('coxnet51Q20','simpcox51Q20',
                                      'framriskQ20','PCEQ20','qrisk3Q20',
                                          'framriskRawQ20','PCERawQ20','qrisk3RawQ20'),
                                  ordered=TRUE,labels=c('ML4HEN-Cox','SimpleCox51',
                                                       'FRS(recal)','PCE(recal)',
                                                       'QRISK(recal)','FRS(raw)',
                                                       'PCE(raw)','QRISK(raw)'))

QuintilesdtmeltedFig4 <- melt(Quintilesdt,id.vars=c('quant'),
                        measure.vars=c('coxnet51Q20',
                                      'framriskQ20','PCEQ20','qrisk3Q20'))

QuintilesdtmeltedFig4$variable <- factor(QuintilesdtmeltedFig4$variable,
                                  levels=c('coxnet51Q20',
                                      'framriskQ20','PCEQ20','qrisk3Q20'),
                                  ordered=TRUE,labels=c('ML4HEN-Cox',
                                                       'FRS','PCE',
                                                       'QRISK3'))

options(repr.plot.width=8,repr.plot.height=8)
QuintilesgradFig4 <- ggplot(QuintilesdtmeltedFig4,aes(x=quant,y=value*100,
                              fill=variable)) +
    geom_bar(stat='identity',width=0.8,position='dodge') +
    scale_y_continuous(limits=c(0,10.5),expand=c(0,0)) +
    theme_classic() +
    xlab('Quintiles of Predicted Risk') +
    ylab('Observed 10-year risk of CAD, %') +
    labs(fill = 'Model') +
    scale_fill_brewer(palette = 'Set2',labels=c(expression(ML4H[EN-COX]),'FRS','PCE','QRISK3')) +
    theme(axis.title.y = element_text(size=18),
          axis.text.y = element_text(size=16,color='black'),
          axis.ticks.y = element_blank(),
          axis.title.x = element_text(size=18),
          axis.text.x = element_text(size=16,color='black'),
          axis.ticks.x = element_blank(),
          legend.position=c(0.2,0.8),
          legend.text.align=0,
         legend.key.size=unit(1,'cm'),
         legend.title = element_text(size=16),
         legend.text = element_text(size=16))

QuintilesgradFig4

# ggsave('/medpop/esp2/sagrawal/mi_mlprediction/2020.11.30_marcus/mlpaperplots/figure4_gradient.pdf',
#         QuintilesgradFig4,width=8,height=8)


code 'cf_mcf_rate'
name '月现金流、加权利率'
dimensions {
	accbook null
	monthEnd name:'cfDate'
	target {
		headModels {
			model ([id:'principal',name:'发生额'])
			model ([id:'balance',name:'余额'])
			model ([id:'rate',name:'加权利率'])
		}
	}
}
layout {
	rows 'accbook'
	columns (['cfDate','target'])
}
dataRequest {
	table 'mcf',{
		allDimensions (['organ','accbook','currency','cfDate','target'])
		dataFieldsMap ([rate:'rate',balance:'endingBalance',principal:'principal'])
	}
	fields 'accbook,cfDate,endingBalance,rate,principal'
	contextParams (['date','organ','currency','staticModel'])
}
dataGrids {
	apply selectRows({children!=null}),{
		formula {sumChildren()}
	}
	apply selectColumns({head.value=='rate'}),{
		dataType 'percent'
	}
	apply selectColumns({head.value=='rate'},{children!=null}),{
		formula{
			def balanceSum=left.result
			if(balanceSum && balanceSum > 1.0){
				def wrate=children?.sum(0.0){it.left*it}
				wrate/balanceSum
			}else{
				0.0
			}
		}
	}
}


library(tidyquant)
library(tidyverse)
# library(quantmod)
library(data.table)
library(scales)
library(quantreg)

setwd("~/Public_Policy/Projects/Finance/output")

large_text_theme = theme(
  plot.title = element_text(size = 24),
  plot.subtitle = element_text(size = 18, face = 'italic'),
  plot.caption = element_text(size = 13, face = 'italic', hjust = 0),
  axis.text = element_text(size = 16),
  axis.title = element_text(size = 18)
)

get_monthly_annual_index_fred = function(symbol) {

  the_dat = getSymbols(symbol, from = 1940, to = 2020, src = 'FRED', auto.assign = F)

  interest_rate_spread_df = tibble(
    date = index(the_dat),
    period_index = as.numeric(the_dat[,symbol])
  ) %>%
    mutate(
      year = year(date),
      month = month(date)
    ) %>%
    arrange(date) %>%
    group_by(year, month) %>%
    summarize(
      last_val = tail(period_index, 1)
    ) %>%
    ungroup()

}

ten_year_interest_rates = get_monthly_annual_index_fred('DGS10') %>% rename(ten_year_yield = last_val)
interest_rate_spread = get_monthly_annual_index_fred('T10Y2Y') %>% rename(ten_two_spread = last_val)

gdp = getSymbols('GDPC1', from = 1940, to = 2020, src = 'FRED', auto.assign = F)
index(gdp) = index(gdp) - 1 # change the reporting dates to end of period
gdp_changes = allReturns(gdp) %>% as.data.frame()
gdp_df = tibble(
  date = index(gdp),
  quarterly_index = as.numeric(gdp$GDPC1)
) %>%
  bind_cols(
    gdp_changes
  ) %>%
  rename(
    annual_gdp = yearly,
    quarterly_gdp = quarterly
  ) %>%
  mutate(
    year = year(date),
    month = month(date)
  )

inflation = getSymbols('CPIAUCSL', from = 1940, to = 2020, src = 'FRED', auto.assign = F)

inflation_changes = allReturns(inflation) %>% as.data.frame()
inflation_df = tibble(
  date = index(inflation),
  monthly_index = as.numeric(inflation$CPIAUCSL)
) %>%
  bind_cols(
    inflation_changes
  ) %>%
  rename(
    annual_inflation = yearly,
    monthly_inflation = monthly
  ) %>%
  mutate(
    year = year(date),
    month = month(date)
  )

# annual_inflation = filter(inflation_df, !is.na(yearly)) %>% mutate(year = year(date))
#
# ggplot(annual_inflation, aes(year, yearly)) +
#   geom_bar(stat = 'identity')

get_monthly_symbol_returns = function(symbol, src) {

  the_dat = getSymbols(symbol, auto.assign = F, from = 2000)

  returns = allReturns(the_dat) %>% as.data.frame()
  adjusted_col = names(the_dat)[str_detect(names(the_dat), 'Adjusted')]

  gold_df = tibble(
    date = index(the_dat),
    adjusted_close = as.numeric(the_dat[,adjusted_col])
  ) %>%
    bind_cols(
      returns
    ) %>%
    mutate(
      year = year(date),
      month = month(date)
    ) %>%
    arrange(year, month) %>%
    group_by(
      year, month
    ) %>%
    summarize(
      last_monthly_value = tail(monthly, 1),
      last_yearly_value = tail(yearly, 1),
      last_close_val = tail(adjusted_close, 1)
    )

}

sp500_df = get_monthly_symbol_returns('^GSPC')
gold_df = get_monthly_symbol_returns('IAU')

# get month end returns

joined_inflation_gold_growth = left_join(
  inflation_df %>% select(year, month, annual_inflation, monthly_inflation),
  gold_df %>% select(year, month, annual_gold = last_yearly_value, monthly_gold = last_monthly_value, gold_adjusted_close = last_close_val)
) %>%
  left_join(
    sp500_df %>% select(year, month, annual_sp500 = last_yearly_value, monthly_sp500 = last_monthly_value, sp500_adjusted_close = last_close_val)
  ) %>%
  left_join(gdp_df %>% select(year, month, annual_gdp, quarterly_gdp)) %>%
  left_join(interest_rate_spread) %>%
  left_join(ten_year_interest_rates) %>%
  filter(
    !is.na(monthly_inflation)
  ) %>%
  mutate(
    month_date = as.Date(paste(year, month, '01', sep = '-')),
    ten_two_spread = ten_two_spread  / 100,
    ten_year_yield = ten_year_yield  / 100
  )

annual_comparison = filter(joined_inflation_gold_growth, !is.na(annual_inflation), month == 12) %>%
  mutate(
    scaled_growth = scale(annual_gdp) %>% as.numeric(),
    scaled_sp500 = scale(annual_sp500) %>% as.numeric()
  )

monthly_comparison = filter(joined_inflation_gold_growth, !is.na(monthly_gold)) %>%
  mutate(
    scaled_gold = scale(monthly_gold) %>% as.numeric(),
    scaled_gold_close = scale(gold_adjusted_close) %>% as.numeric(),
    scaled_ten_two_spread = scale(ten_two_spread) %>% as.numeric(),
    scaled_inflation = scale(monthly_inflation) %>% as.numeric()
  )

ggplot(monthly_comparison, aes(month_date, scaled_gold_close)) +
  theme_bw() +
  geom_line(colour = 'gold', size = 1) +
  geom_line(aes(y = scaled_ten_two_spread), colour = 'steelblue', size = 1)

ggplot(annual_comparison, aes(annual_inflation, annual_sp500)) +
  geom_point()

ggplot(annual_comparison, aes(annual_gdp, annual_sp500)) +
  geom_point() +
  stat_smooth(method = 'lm') +
  # geom_quantile(quantiles = 0.5) +
  theme_bw() +
  scale_x_continuous(labels = percent, limits = c(-0.04, 0.065)) +
  scale_y_continuous(labels = percent, breaks = seq(-0.4, 0.3, by = 0.1)) +
  large_text_theme +
  labs(
    x = '\nReal Annual GDP Growth', y = 'Annual SP500 Market Return\n'
  )

ggsave('economic_growth_vs_stock_market.png', height = 10, width = 10, units = 'in', dpi = 400)

ggplot(monthly_comparison, aes(scaled_ten_two_spread, scaled_gold)) +
  geom_point()

ggplot(annual_comparison, aes(ten_year_yield, annual_gold)) +
  geom_point()

ggplot(annual_comparison, aes(annual_inflation, annual_gold)) +
  geom_point()

ggplot(annual_comparison, aes(annual_inflation, ten_year_yield)) +
  geom_point() +
  # stat_smooth() +
  stat_smooth(method = 'lm') +
  scale_y_continuous(labels = percent, breaks = seq(0, 0.15, by = 0.025)) +
  scale_x_continuous(labels = percent, breaks = seq(0, 0.13, by = 0.025)) +
  labs(
    x = '\nAnnual Inflation\nConsumer Price Index for All Urban Consumers',
    y = '10 Year Treasury Bond Yield\n',
    caption = 'Chart: Taylor G. White\nData: St. Louis Federal Reserve'
  ) +
  theme_bw() +
  large_text_theme +
  coord_cartesian(xlim = c(0, 0.13), ylim = c(0, 0.15))

ggsave('inflation_vs_10yr_yield.png', height = 10, width = 10, units = 'in', dpi = 450)

ggplot(monthly_comparison, aes(monthly_inflation, ten_year_yield )) +
  geom_point()

ggplot(annual_comparison, aes(annual_gdp, annual_inflation)) +
  geom_point()

ggplot(annual_comparison, aes(annual_gdp, annual_inflation)) +
  geom_point()

ggplot(annual_comparison, aes(year, annual_inflation)) +
  geom_bar(stat = 'identity', aes(fill = annual_gdp)) +
  scale_fill_viridis_c(option = 'A')

ggplot(annual_comparison, aes(year, annual_inflation)) +
  geom_point(stat = 'identity', aes(colour = annual_gdp, size = annual_gdp)) +
  scale_colour_viridis_c(option = 'A')

tail(joined_inflation_gold_growth, 12)

ggplot(monthly_comparison, aes(scaled_gold , scaled_inflation)) +
  geom_point() +
  stat_smooth(method = 'lm')

ggplot(monthly_comparison, aes(annual_inflation  , annual_gold )) +
  geom_point() +
  stat_smooth(method = 'lm')

summary(monthly_comparison$monthly_gold)
summary(monthly_comparison$monthly_inflation)
hist(monthly_comparison$monthly_gold)
hist(monthly_comparison$monthly_inflation)
scale(monthly_comparison$monthly_gold)


library("rstudioapi")
setwd(dirname(getActiveDocumentContext()$path))

library(raster)

dir.create('data', showWarnings = FALSE)
if (!file.exists('data/rs/samples.rds')) {
        download.file('https://biogeo.ucdavis.edu/data/rspatial/rsdata.zip', dest = 'data/rsdata.zip')
        unzip('data/rsdata.zip', exdir='data')
}

# Blue
b2 <- raster('data/rs/LC08_044034_20170614_B2.tif')
# Green
b3 <- raster('data/rs/LC08_044034_20170614_B3.tif')
# Red
b4 <- raster('data/rs/LC08_044034_20170614_B4.tif')
# Near Infrared (NIR)
b5 <- raster('data/rs/LC08_044034_20170614_B5.tif')

b2

# coordinate reference system (CRS)
crs(b2)

ncell(b2)
dim(b2)
res(b2)
nlayers(b2)
compareRaster(b2,b3)
s <- stack(b5, b4, b3)
s

#first create a list of raster layers to use
filenames <- paste0('data/rs/LC08_044034_20170614_B', 1:11, ".tif")
filenames

landsat <- stack(filenames)
landsat

par(mfrow = c(2,2))
plot(b2, main = "Blue", col = gray(0:100 / 100))
plot(b3, main = "Green", col = gray(0:100 / 100))
plot(b4, main = "Red", col = gray(0:100 / 100))
plot(b5, main = "NIR", col = gray(0:100 / 100))

landsatRGB <- stack(b4, b3, b2)
plotRGB(landsatRGB, axes = TRUE, stretch = "lin", main = "Landsat True Color Composite")

par(mfrow = c(1,2))
plotRGB(landsatRGB, axes=TRUE, stretch="lin", main="Landsat True Color Composite")
landsatFCC <- stack(b5, b4, b3)
plotRGB(landsatFCC, axes=TRUE, stretch="lin", main="Landsat False Color Composite")

set.seed(1)
sr <- sampleRandom(landsat, 10000)
plot(sr[,c(4,5)], main = "NIR-Red plot")

pca <- prcomp(sr, scale = TRUE)
pca

screeplot(pca)
pci <- predict(landsat, pca, index = 1:2)
plot(pci[[1]])
pc2 <- reclassify(pci[[2]], c(-Inf,0,1,0,Inf,NA))
par(mfrow = c(1,2))
plotRGB(landsatFCC, r = 1, g = 2, b = 3, axes = TRUE, stretch = "lin", main ="Landsat False Color Composite")
plotRGB(landsatFCC, r = 1, g = 2, b = 3, axes = TRUE, stretch = "lin", main ="Landsat False Color Composite")
plot(pc2, legend = FALSE, add = TRUE)


# Day 2: Dive!

get_day2_input_path <- function() {
    paste(getwd(), "/2021/Day 2/Day2_input.txt", sep = "")
}

part1 <- function() {
    commands <- readLines(get_day2_input_path())
    position <- 0
    depth <- 0

    for (i in seq_len(length(commands))) {
        command <- strsplit(commands[i], " ")[[1]]

        if (command[1] == "forward") {
            position <- position + strtoi(command[2])
        } else if (command[1] == "down") {
            depth <- depth + strtoi(command[2])
        } else if (command[1] == "up") {
            depth <- depth - strtoi(command[2])
        }
    }

    cat("  Position = ", position, "; Depth = ", depth, ";")
    print(position * depth)
}

part2 <- function() {
    commands <- readLines(get_day2_input_path())
    aim <- 0
    position <- 0
    depth <- 0

    for (i in seq_len(length(commands))) {
        command <- strsplit(commands[i], " ")[[1]]

        if (command[1] == "forward") {
            position <- position + strtoi(command[2])
            depth <- depth + (aim * strtoi(command[2]))
        } else if (command[1] == "down") {
            aim <- aim + strtoi(command[2])
        } else if (command[1] == "up") {
            aim <- aim - strtoi(command[2])
        }
    }

    cat("  Position = ", position, "; Depth = ", depth, ";")
    print(position * depth)
}

part1()
part2()


x <- 1:100
ifelse(x %% 15 == 0, 'FizzBuzz',
       ifelse(x %% 5 == 0, 'Buzz',
              ifelse(x %% 3 == 0, 'Fizz', x)))


# Compare LOOAIC between different TE

# Resources:
# https://cran.r-project.org/web/packages/loo/vignettes/loo2-example.html
# https://link.springer.com/article/10.1007/s11222-016-9696-4

source('2020-08-31-jsa-type-v2-ch2/03-evaluate/init.r')

chosen_models <- c(
    "BGY-E0-C4-I8000-A0.8-T12-F25-V0",
    "BGY-E1-C4-I20000-A0.9-T12-F25-V0",
    "BGY-E2-C4-I8000-A0.8-T12-F25-V0"
)

chosen_models <- c(
    "FAM-E0-C4-I8000-A0.8-T12-F25-V0",
    "FAM-E1-C4-I100000-A0.9-T12-F25-V0",
    "FAM-E2-C4-I8000-A0.8-T12-F25-V0"
)

# using LOO --------------------------------------------------------------------

model1 <- chosen_models[1]
model1_loo <- get_loo(model1)
print(model1_loo)

model2 <- chosen_models[2]
model2_loo <- get_loo(model2)
print(model2_loo)

model3 <- chosen_models[3]
model3_loo <- get_loo(model3)
print(model3_loo)

compare <- loo_compare(model1_loo, model2_loo, model3_loo)
print(compare)

# using WAIC -------------------------------------------------------------------

model_params <- parse_model_identifier(model1)
model_dirs <- initialize_model_params(model_params)
model_dir <- model_dirs[1]

# load zero inflated fits
load(paste0(model_dir, "fit.data"))       # as "fit"
log_lik1  <- extract_log_lik(fit)
(waic1 <- waic(log_lik1))

# TODO: modularize the forecasting code below

model <- model1
model_params <- parse_model_identifier(model)
model_dirs <- initialize_model_params(model_params)
model_dir <- model_dirs[1]

# read original data
data_raw <- read.csv(paste0(model_dir, "data.csv"), na.strings = c(""))

# read modelled data
data <- read_rdump(paste0(model_dir, "count_info.data.R"))

# load zero inflated fits
load(paste0(model_dir, "fit.data"))       # as "fit"

# load posterior simulation
load(paste0(model_dir, "post.data"))      # as "allsim"

# create data.frame of observed
cumm <- lapply(seq(data$P), function(ii) { # each group
    data.frame(
        index = 1:data$end[ii],                    # index/offset/year
        value = data$counts[ii, ],                 # count
        cml_value = cumsum(data$counts[ii, ]),     # cumulative
        off = data$off[ii, ],                      # tax. effort
        group = ii                                 # group "family"
    )}) %>% rbind.fill

cumm$sim <- 0 # set sim to 0 to indicate that it is observed data

# create data.frame of simulated (interpolated)
cummsim <- lapply(seq(length(allsim)), function(jj) { # each sim
    lapply(seq(data$P), function(ii) { # each group
        data.frame(
            index = 1:data$end[ii],
            value = allsim[[jj]][[ii]],
            cml_value = cumsum(allsim[[jj]][[ii]]),
            off = data$off[ii, ],
            group = ii,
            sim = jj
        )}) %>% rbind.fill
    }) %>% rbind.fill

# combine the observed and simmed series
Z <- rbind(cumm, cummsim)

# add original year back
Z$year <- Z$index + min(data_raw$year) - 1

# merge observed values
Z <- data.table(Z)
obs_Z <- Z[sim == 0, c("group", "year", "cml_value")]

Z2 <- merge(
    Z, obs_Z,
    by = c("group", "year"),
    all.x = T, all.y = T,
    suffixes = c("_sim", "_obs")
)

Z2 <- Z2[sim!=0]

# Resources

# TODO: http://mc-stan.org/loo/articles/loo2-with-rstan.html
# Simple example of LOOAIC
# TODO: https://datascienceplus.com/k-fold-cross-validation-in-stan/
# Alternative to LOOAIC
# TODO: https://discourse.mc-stan.org/t/calculating-log-like-for-waic-loo-with-user-defined-functions/2696/3
# How to calculate LOOAIC for custom functions
# TODO: https://fabiandablander.com/r/Law-of-Practice.html
# What's the purpose of LOOAIC
# TODO: https://groups.google.com/g/stan-users/c/ESxlrXmaQkM?pli=1
# How to fit an AR1 poisson hierachical model

###############
# OLD SCRIPT
###############

# This script compares models that have already been run through model.r.

library(forecast)
library(ggplot2)

source('2020-08-31-jsa-type-v2-ch2/02-model/init.r')

chosen_models <- c("BGY-E2-C4-I8000-A0.8-T12-F10",
                   "BGY-E2-C4-I8000-A0.8-T12-F25")

model_param_list <- lapply(
    chosen_models,
    function(x) parse_model_identifier(x)
)

model_dir_list <- lapply(
    model_param_list[1],
    function(x) initialize_model_params(x)
)

results <- list()
theme <- theme_minimal()
plots <- list()

for (i in 1:length(chosen_models)) {

    dir_model_folder <- model_dir_list[i]

    # initial model data
    data_raw <- read.csv(
        paste0(dir_model_folder, "data.csv"),
        na.strings = c("")
    ) # original data

    data <- read_rdump(paste0(dir_model_folder, "count_info.data.R"))

    # load zero inflated fits
    load(paste0(dir_model_folder, "fit.data"))       # as "fit"
    zips <- fit; rm(fit)

    # load posterior simulation
    load(paste0(dir_model_folder, "post.data"))      # as "allsim"

    # create data.frame of observed
    cumm <- lapply(seq(data$P), function(ii) { # each group
        data.frame(index=1:data$end[ii],                    # index/offset/year
                   value=data$counts[ii, ],                 # count
                   cml_value=cumsum(data$counts[ii, ]),     # cumulative
                   off=data$off[ii, ],                      # tax. effort
                   group=ii)}) %>% rbind.fill               # group "family"
    cumm$sim <- 0 # set sim to 0 to indicate that it is observed data

    # create data.frame of simulated (interpolated)
    cummsim <- lapply(seq(length(allsim)), function(jj) { # each sim
        lapply(seq(data$P), function(ii) { # each group
            data.frame(index=1:data$end[ii],
                    value=allsim[[jj]][[ii]],
                    cml_value=cumsum(allsim[[jj]][[ii]]),
                    off=data$off[ii, ],
                    group=ii,
                    sim=jj)}) %>% rbind.fill
        }) %>% rbind.fill

    # combine the observed and simmed series
    Z <- rbind(cumm, cummsim)

    # add original year back
    Z$year <- Z$index + min(data_raw$year) - 1

    # merge observed values
    Z <- data.table(Z)
    obs_Z <- Z[sim == 0, c("group", "year", "cml_value")]

    Z2 <- merge(
        Z, obs_Z,
        by = c("group", "year"),
        all.x = T, all.y = T,
        suffixes = c("_sim", "_obs")
    )

    Z2 <- Z2[sim!=0]

    # get accuracy
    result <- lapply(unique(Z2$group), function(grp) {
        lapply(unique(Z2$sim), function(s) {
            to_calc <- Z2[group==grp & sim==s]
            data.frame(
                accuracy(to_calc$cml_value_sim, to_calc$cml_value_obs),
                group = grp,
                sim = s
            )
        })
    })

    results[[i]] <- result
}

# list of models of groups of simulations
formatted <- list()
for (i in 1:length(results)) {
    formatted[[i]] <- lapply(results[[i]], function(grp) {
        rbindlist(lapply(grp, as.data.frame))
    })
}

formatted2 <- list()

mapping <- unique(data.frame(
    groupname = as.character(data_raw$group),
    group = as.numeric(data_raw$group)
))

for (i in 1:length(results)) {
    formatted2[[i]] <- merge(
        rbindlist(formatted[[i]]), mapping,
        by = "group", all.x = T, all.y = F
    )
}

do.call(cbind, lapply(formatted2, function(model) {
    model[, list(MAPE_mean = mean(MAPE)), by=c('groupname')]
}))

do.call(cbind, lapply(formatted2, function(model) {
    model[, list(MAPE_mean = mean(MAPE))]
}))

# https://otexts.com/fpp2/accuracy.html
# https://pkg.robjhyndman.com/forecast/reference/accuracy.html


# We test our H0 that the version has no influence on the OSTRICH query evaluation efficiency.
# Lineair model with as reponse the lookup time and as factors the version and the number of results,
# we expect version not to have an influence

# confidence level 99%
# H0: impact of version is 0
# If p is low, reject H0 with 1-alpha confidence

beara_dm <- read.csv('../beara/query/ostrich/_average_dm.csv')
beara_dm <- beara_dm[which(beara_dm$offset==0 & beara_dm$patch_start==0),]
#summary(lm(lookup.mus.inf ~ patch_end + resultsinf, data=beara_dm))
# v-p: 0.301 => == 0
# r-p: 0.320 => == 0
# ACCEPT H0
#cor.test(beara_dm$patch, beara_dm$lookup.mus.inf)
# cor: 0.1380577
# p:   0.7232
# H0: ACCEPT

beara_vm <- read.csv('../beara/query/ostrich/_average_vm.csv')
beara_vm <- beara_vm[which(beara_vm$offset==0),]
#summary(lm(lookup.mus.inf ~ patch + resultsinf, data=beara_vm))
# v-p: 0.960 => == 0
# r-p: 0.570 => == 0
# ACCEPT H0
#cor.test(beara_vm$patch, beara_vm$lookup.mus.inf)
# cor: -0.2770768
# p:   0.4383
# H0: ACCEPT

bearbd_dm <- read.csv('../bearb-daily/query/ostrich/_average_dm.csv')
bearbd_dm <- bearbd_dm[which(bearbd_dm$patch_start==0 & bearbd_dm$offset==0),]
#summary(lm(lookup.mus ~ patch_end + results, data=bearbd_dm))
# v-p: 0.0391 => == 0
# r-p: 2.13e-09 => != 0
# ACCEPT H0
#cor.test(bearbd_dm$patch_end, bearbd_dm$lookup.mus)
# cor: 0.4509677
# p:   1.037e-05
# H0: REJECT

bearbd_vm <- read.csv('../bearb-daily/query/ostrich/_average_vm.csv')
bearbd_vm <- bearbd_vm[which(bearbd_vm$offset==0),]
#summary(lm(lookup.mus ~ patch + results, data=bearbd_vm))
# v-p: 0.694 => == 0
# r-p: 0.697 => == 0
# ACCEPT H0
#cor.test(bearbd_vm$patch, bearbd_vm$lookup.mus)
# cor: 0.007640334
# p:   0.9433
# H0: ACCEPT

bearbh_dm <- read.csv('../bearb-hourly/query/ostrich/_average_dm.csv')
bearbh_dm <- bearbh_dm[which(bearbh_dm$patch_start==0 & bearbh_dm$offset==0),]
#summary(lm(lookup.mus.inf ~ patch_end + resultsinf, data=bearbh_dm))
# v-p: 0.259 => == 0
# r-p: 2e-16 => != 0
# ACCEPT H0
#cor.test(bearbh_dm$patch_end, bearbh_dm$lookup.mus.inf)
# cor: 0.1499068
# p:   1.658e-14
# H0: REJECT

bearbh_vm <- read.csv('../bearb-hourly/query/ostrich/_average_vm.csv')
bearbh_vm <- bearbh_vm[which(bearbh_vm$offset==0),]
#summary(lm(lookup.mus.inf ~ patch + resultsinf, data=bearbh_vm))
# v-p: 0.568319 => == 0
# r-p: 0.000574 => != 0
# ACCEPT H0
#cor.test(bearbh_vm$patch, bearbh_vm$lookup.mus.inf)
# cor: 0.2063941
# p:   5.924e-14
# H0: REJECT


#!/usr/bin/r
##
## varSimulation.r: Simulation of first-order vector autoregression data
##
## Copyright (C)  2011 - 2015  Lance Bachmeier and Dirk Eddelbuettel
##
## This file is part of RcppArmadillo.
##
## RcppArmadillo is free software: you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 2 of the License, or
## (at your option) any later version.
##
## RcppArmadillo is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.

## load Rcpp to be able to use cppFunction() below
suppressMessages(library(Rcpp))

## parameter and error terms used throughout
a <- matrix(c(0.5,0.1,0.1,0.5),nrow=2)
e <- matrix(rnorm(10000),ncol=2)

## Let's start with the R version
rSim <- function(coeff, errors) {
    simdata <- matrix(0, nrow(errors), ncol(errors))
    for (row in 2:nrow(errors)) {
        simdata[row,] = coeff %*% simdata[(row-1),] + errors[row,]
    }
    return(simdata)
}

rData <- rSim(a, e)                     # generated by R

## Now let's load the R compiler (requires R 2.13 or later)
suppressMessages(require(compiler))
compRsim <- cmpfun(rSim)

compRData <- compRsim(a,e)              # generated by R 'compiled'

stopifnot(all.equal(rData, compRData))  # checking results

## C++ variant: code passed as a text variable ...
code <- '
arma::mat rcppSim(const arma::mat& coeff, const arma::mat& errors) {
    int m = errors.n_rows;
    int n = errors.n_cols;
    arma::mat simdata(m,n);
    simdata.row(0) = arma::zeros<arma::mat>(1,n);
    for (int row=1; row<m; row++) {
        simdata.row(row) = simdata.row(row-1) * coeff + errors.row(row);
    }
    return simdata;
}
'
## ... which is compiled/linked/loaded here to create the compiled function
cppFunction(code=code, depends="RcppArmadillo")

rcppData <- rcppSim(a,e)                # generated by C++ code

stopifnot(all.equal(rData, rcppData))   # checking results

## now load the rbenchmark package and compare all three
suppressMessages(library(rbenchmark))
res <- benchmark(rcppSim(a,e),
                 rSim(a,e),
                 compRsim(a,e),
                 columns=c("test", "replications", "elapsed",
                           "relative", "user.self", "sys.self"),
                 order="relative")
print(res)


#healthcare analysis

healthcare<-read.csv(file.choose(),header=T)

View(healthcare)
str(healthcare)
summary(healthcare)
names(healthcare)

table(healthcare$AGE)
table(healthcare$FEMALE)
table(healthcare$RACE)

#Which age category Has maximum Expenditure

summary(as.factor(healthcare$AGE))
max(table(healthcare$AGE))
max(summary(as.factor(healthcare$AGE)))
which.max(table(healthcare$AGE))
age <- aggregate(TOTCHG ~ AGE , data = healthcare, sum)
age
which.max(age$TOTCHG)
age[which.max(age$TOTCHG),]

# Diagnosis related group which has maximum hospitalized and expenditure
t <- table(healthcare$APRDRG)
d <- as.data.frame(t)
names(d)[1] = 'Diagnosis Group'
d
which.max(table(healthcare$APRDRG))
which.max(t)
which.max(d)
res <- aggregate(TOTCHG ~ APRDRG, data = healthcare, sum)
res
which.max(res$TOTCHG)
res[which.max(res$TOTCHG),]

#Race of patient related to Hospital cost or not

healthcare$RACE <- as.factor(healthcare$RACE)

R_A<- aov(TOTCHG ~ RACE, data=healthcare)
summary(R_A)

R_L<-lm(TOTCHG ~RACE,data= healthcare)
summary(R_L)

healthcare <- na.omit(healthcare)

#Hospital cost can be predicted by Age or Gender

T_A<- aov(TOTCHG ~ AGE+FEMALE, data=healthcare)
summary(T_A)

T_L<-lm(TOTCHG ~AGE+FEMALE,data= healthcare)
summary(T_L)

#length of stay can be predicted by AGE,Female or Race

L<- aov(LOS ~ AGE+FEMALE+RACE, data=healthcare)
summary(L)

fit<-lm(LOS ~AGE+FEMALE+RACE,data= healthcare)
summary(fit)

# Agency want to know which entity effects the hospital cost most

A<- aov(TOTCHG ~., data=healthcare)
summary(A)

B<- lm(TOTCHG ~.,data=healthcare)
summary(B)