library(haven)
library(tidyverse)
library(janitor)
library(tidymodels)
library(vip)
library(themis)
library(DALEXtra)
library(GGally)
library(gtsummary)
library(correlation)
library(ggraph)
library(gridExtra)
library(pROC)
library(naniar)
library(finalfit)

covid <- read_spss(file = 'COVID_preditor_Dez_2020_2.sav')
covid <- covid %>% clean_names()
covid %>% str()


##preditor apenas sintomas
covid_predictor <- covid %>% 
  select(centro , regiao ,  diagn_pcr , diagn_antigeno , diagn_sorologia , diag_outro, tx_dv , sexo_masc , idade ,  negro , imc , dr_cpor_dm , nosocomial , 
         tempo_txanos ,  tf_gbasal ,  tempo_sintomas , sem_comorb , has , dm , dca_autoimune , cardio_cerebrovasc , pneumopatia , 
         hepatopatia , neoplasia , dcaneurologica , tabagismo , iecabra , cni , mpaaza , m_to_ri , iss_esteroide , 
         pulso_sm_drecente , timorecente , 
         febre , febreeou_calafrios , calafrios , tosse , expectoracao , dispneia , 
         dor_toracica , coriza , cefaleia , congestao_nasal , fadiga_adinamia_inapetencia_astenia , 
         mialgia , artralgia , nauseas_vomitos , diarreia , conjuntivite , rash , anosmia , 
         ageusia , dor_garganta , hipoxemia , hospitalizacao , 
         vm ,  hd , uti ,  obito28dias, mesdoenca
         )


names(covid_predictor) <- c('center', 'region', 'PCR_diag', 'antigen_diag', 'sorology_diag','other_diag', 'living_donor', 'male_sex', 'age', 'black_race', 'BMI', 'diabetes_ESRD', 'nosocomial',
  'time_tx_ys', 'egf_baseline', 'time_symptoms', 'without_comorbidities', 'hypertension', 'diabetes', 'autoimmune_disease', 'cardiovascular_disease', 'pulmonar_disease',
  'liver_disease', 'cancer', 'neurology_disease', 'smoking', 'IECA_or_BRA_use', 'CNI_iss', 'MPA_or_AZA_iss', 'MTOR_iss','Steroids_iss', 
   'Steroids_pulse_recently', 'TIMO_recently', 
  'fever', 'fever_or_chills', 'chills',  'cough', 'expectoration', 'dyspnoea', 
  'chest_pain', 'coryza', 'headache', 'nasal_congestion', 'fatigue_adynamia_asthenia',
  'myalgia', 'arthralgia', 'nauseas_vomitos', 'diarrhea','conjunctivitis', 'rash', 'anosmia', 
  'ageusia', 'sore_throat', 'hypoxemia', 'hospitalization',
  'mv', 'hd', 'uti', 'death', 'month')



##Selecionar apenas PCR positivo
covid_predictor <- covid_predictor %>% 
  filter(PCR_diag == 1) %>% 
  filter(month < 11) %>% 
  select(-month)

covid_predictor <- covid_predictor %>% 
  mutate_at(vars('death', 'mv','hd'), ~ factor(. , labels = c('no','yes')))

dim(covid_predictor)

covid_predictor %>% map(~ (sum(is.na(.)) / length(.))*100 )

##missing
covid_predictor %>% 
  missing_glimpse()


##EDA Death
theme_set(theme_bw())

covid_predictor %>% 
  group_by(death) %>% 
  count() %>% 
  ggplot(aes(death, n, fill = death))+
  geom_col()+
  geom_label(aes(label = n))+
  scale_fill_manual(values = c('blue', 'red'))+
  labs(x = 'Death')+
  theme(legend.position = 'none')


##distribution of events
events <- covid_predictor %>% 
  select(mv, hd, uti, death) %>% 
  rename(mecanical_ventilation = mv, hemodialysis = hd, intensive_care_unit = uti)


events %>% 
  mutate_at(vars(c('mecanical_ventilation','hemodialysis','intensive_care_unit','death')),  ~ factor(. , labels = c('no','yes'))) %>% 
  tbl_summary() %>% 
  as_tibble()

## Number of centers
centers <- covid_predictor %>% 
  group_by(center) %>% 
  count()

##Mortality over centers
covid_predictor %>% 
  group_by(center) %>% 
  count(death) %>% 
  mutate(prop = n/sum(n) ) %>% 
  filter(death == 'yes') %>% 
  ggplot(aes(reorder(center, prop), prop, fill = n))+
  geom_col()+
  coord_flip()


##Plot
p1 <- covid_predictor %>% 
  mutate(age_cat = 
           case_when(
            age < 40 ~ 'lower than 40',
            age >= 40 & age <= 60 ~ 'between 40 and 60',
            age > 60 & age <= 70~ 'between 60 and 70',
            age > 70 ~ 'more than 70'
           )) %>%
  mutate(age_cat = factor(age_cat, levels = c('lower than 40', 'between 40 and 60', 'between 60 and 70', 'more than 70'))) %>% 
  ggplot(aes(age_cat, fill = death))+
  geom_bar(position = 'fill', alpha = 0.75)+
  scale_fill_manual(values = c('gray','red'))+
  coord_flip()+
  labs(x = '', fill = 'Death', title = 'A', y = '%')+
  theme(plot.title = element_text(size = 20))
  

p2 <-  covid_predictor %>% 
  filter(!is.na(BMI)) %>% 
  mutate(BMI_cat =
           case_when(
            BMI <= 25 ~ 'normal',
            BMI >25 & BMI < 30 ~ 'overweight',
            BMI >=30 & BMI < 35 ~ 'obese class I',
            BMI >=35 & BMI < 40 ~ 'obese class II',
            BMI >= 40 ~ 'obese class III'
           )) %>% 
  mutate(BMI_cat = factor(BMI_cat, levels = c('normal', 'overweight', 'obese class I', 'obese class II', 'obese class III'))) %>% 
  ggplot(aes(BMI_cat, fill = death))+
  geom_bar(position = 'fill', alpha = 0.75)+
  scale_fill_manual(values = c('gray','red'))+
  coord_flip()+
  labs(x = '', fill = 'Death', title = 'B', y = '%')+
  theme(plot.title = element_text(size = 20))

p3 <- ggplot(covid_predictor, aes(egf_baseline, fill = death))+
  geom_density(alpha = 0.75)+
  scale_fill_manual(values = c('gray','red'))+
  labs(x = 'eGFR Baseline', title = 'C')+
  theme(plot.title = element_text(size = 20))


p4 <- ggplot(covid_predictor, aes(time_symptoms, fill = death))+
  geom_density(alpha = 0.75)+
  scale_fill_manual(values = c('gray','red'))+
  labs(x = 'Time to symptoms', title = 'D')+
  theme(plot.title = element_text(size = 20))


p_1 <- grid.arrange(p1, p2, p3, p4)
ggsave(p_1, filename = 'figure01.tiff', dpi = 300, compression = 'lzw')

##symptons
p5 <- covid_predictor %>% 
  select(fever, fever_or_chills, chills, cough, coryza, chest_pain, dyspnoea, nausea_vomiting, diarrhea, anosmia, headache, myalgia,
         arthralgia, ageusia,nasal_congestion, 
         death) %>% 
  pivot_longer(
    cols = -death
  ) %>% 
  group_by(name, value, death) %>%
  count() %>% 
  filter(!is.na(value)) %>% 
  rename(symptos = name, occurance = value) %>% 
  mutate(occurance = factor(occurance)) %>% 
  mutate(occurance = fct_recode(occurance, 
                                'no' = '0',
                                'yes' = '1'
                                )) %>% 
  mutate(death = fct_recode(death, 
                                    'Favor Outcome' = 'no',
                                    'Unfavor Outcome' = 'yes'
  )) %>% 
  ggplot(aes(reorder(symptos,n), n, fill = occurance))+
  geom_col(alpha = 0.75)+
  coord_flip()+
  scale_fill_manual(values = c('gray','red'))+
  facet_wrap(~ death, scales = 'free', ncol = 1)+
  labs(x = '')


##Correlatad symptoms
p6 <- covid_predictor %>% 
  select(fever , feber_or_chills , chills , cough , expectoration , dyspnoea , nausea_vomiting , diarrhea , chest_pain , coryza , headache , nasal_congestion , fatigue_adynamia_asthenia , myalgia , arthralgia , conjunctivitis , rash , anosmia , ageusia , sore_throat) %>% 
  correlation() %>% 
  plot()+
  labs(title = 'B')+
  theme(plot.title = element_text(size = 20))


p_2 <- grid.arrange(p5, p6)
ggsave(p_2, filename = 'Figure02.tiff', dpi = 300, compression = 'lzw')

##ggparis
cont_vars <- covid_predictor %>% 
  select(age, BMI, egf_baseline, time_tx_ys, composite_out)


##Pairs
ggpairs(cont_vars, aes(fill = composite_out))


##table01

covid_predictor %>% 
  select(-region, -center, -PCR_diag, -antigen_diag, -sorology_diag, -other_diag) %>% 
  tbl_summary(by = death) %>% 
  add_p() %>% 
  bold_labels()

##split the data
set.seed(123)
split <- initial_split(covid_predictor, strata = 'death')
covid_train <- training(split)
covid_test <- testing(split)


##Table comparing train and test set
covid_train$split <- 'train'
covid_test$split <- 'test'

covid_full <- covid_train %>% 
  bind_rows(covid_test)


covid_full %>% 
  select(-region, -center, -PCR_diag, -antigen_diag, -sorology_diag, -other_diag) %>% 
  tbl_summary(by = split) %>% 
  add_p() %>% 
  bold_labels() 

## Missmap
covid_miss <- covid_predictor %>% 
  select(-c(center, region, PCR_diag , antigen_diag , sorology_diag , other_diag, hospitalization , 
            mv ,  hd , uti , nosocomial, Steroids_pulse_recently, TIMO_recently))

vis_miss(covid_miss)

## Model to compare center effect
rec_simple <- recipe(death ~ . , data = covid_train) %>% 
  step_rm(region, PCR_diag , antigen_diag , sorology_diag , other_diag, hospitalization , 
          mv ,  hd , uti , nosocomial, diabetes) %>% 
  step_medianimpute(all_predictors()) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors())


## preprocess 
covid_center <- rec_simple %>% prep() %>% bake(new_data = covid_predictor)


## simple glm
library(lme4)
library(lmerTest)
library(gtsummary)

options()

model1 <- glm(death ~ . , data = covid_center %>% select(-center), family = 'binomial')
summary(model1)

model2 <- glmer(death ~ . + (1 | center), data = covid_center, family = 'binomial')
summary(model2)

##recipe
rec <- recipe(death ~ . , data = covid_train) %>% 
  step_rm(center, region, PCR_diag , antigen_diag , sorology_diag , other_diag, hospitalization , 
          mv ,  hd , uti , nosocomial, diabetes) %>% 
  step_medianimpute(all_predictors()) %>% 
  step_nzv(all_predictors()) %>% 
  step_smote(death)

rec_smote <- recipe(death ~ . , data = covid_train) %>% 
  step_rm(center, region, PCR_diag , antigen_diag , sorology_diag , other_diag, hospitalization , 
           mv ,  hd , uti ,  nosocomial, diabetes) %>%
  step_medianimpute(all_predictors()) %>% 
  step_ns(age, egf_baseline, deg_free = 4) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors()) %>% 
  step_smote(death)

rec_smote_glm <- recipe(death ~ . , data = covid_train) %>% 
  step_rm(center, region, PCR_diag , antigen_diag , sorology_diag , other_diag, hospitalization , 
          mv ,  hd , uti ,  nosocomial, diabetes) %>%
  step_medianimpute(all_predictors()) %>% 
  step_ns(age, egf_baseline, deg_free = 4) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors()) 

rec_simple_model <- recipe(death ~ dyspnoea + egf_baseline + age + MPA_or_AZA_iss +
                             hypertension + diabetes_ESRD + cardiovascular_disease + smoking + Steroids_iss + BMI +
                             MTOR_iss + diarrhea + time_symptoms + anosmia + headache,
                           data = covid_train) %>% 
  step_medianimpute(all_predictors()) %>% 
  step_ns(age, egf_baseline,deg_free = 4) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors()) %>% 
  step_smote(death)

rec_simple <- recipe(death ~ dyspnoea + egf_baseline + age + MPA_or_AZA_iss +
                       hypertension + diabetes_ESRD + cardiovascular_disease + smoking + Steroids_iss + BMI +
                       MTOR_iss + diarrhea + time_symptoms + anosmia + headache,
                     data = covid_train) %>% 
  step_medianimpute(all_predictors()) %>% 
  step_ns(age, egf_baseline,deg_free = 4) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors()) 


rec_xgb_reduced <- recipe(death ~ dyspnoea + egf_baseline + age + MPA_or_AZA_iss +
                             hypertension + diabetes_ESRD + cardiovascular_disease + smoking + Steroids_iss + BMI +
                             MTOR_iss + diarrhea + time_symptoms + anosmia + headache,
                           data = covid_train) %>% 
  step_medianimpute(all_predictors()) %>% 
  step_nzv(all_predictors()) %>% 
  step_smote(death)

##model

model_lasso <- logistic_reg(penalty = tune(), mixture = tune()) %>% 
  set_engine('glmnet')

model_xgb <- boost_tree(mode = 'classification', mtry = tune() ,tree_depth = tune(), learn_rate = tune(), loss_reduction = tune()) %>% 
  set_engine('xgboost')

model_svm <- svm_rbf(mode = 'classification', cost = tune(), rbf_sigma = tune(), margin = tune()) %>% 
  set_engine('kernlab')

model_rf <- rand_forest(mode = 'classification', mtry = tune(), min_n = tune()) %>% 
  set_engine('ranger', importance = 'impurity')

model_glm <- logistic_reg() %>% 
  set_engine('glm')

##workflow
work_lasso_smote <- workflow() %>% 
  add_recipe(rec_smote) %>% 
  add_model(model_lasso)


work_lasso_reduced <- workflow() %>% 
  add_recipe(rec_simple_model) %>% 
  add_model(model_lasso)


work_lasso_app <- workflow() %>% 
  add_recipe(rec_to_app) %>% 
  add_model(model_lasso)

work_xgb <- workflow() %>% 
  add_recipe(rec) %>% 
  add_model(model_xgb)

work_xgb_reduced <- workflow() %>% 
  add_recipe(rec_xgb_reduced) %>% 
  add_model(model_xgb)

work_svm <- workflow() %>% 
  add_recipe(rec_smote) %>% 
  add_model(model_svm)


work_svm_reduced <- workflow() %>% 
  add_recipe(rec_simple_model) %>% 
  add_model(model_svm)

work_rf <- workflow() %>% 
  add_recipe(rec) %>% 
  add_model(model_rf)


work_rf_reduced <- workflow() %>% 
  add_recipe(rec_xgb_reduced) %>% 
  add_model(model_rf)


work_glm <- workflow() %>% 
  add_recipe(rec_simple) %>% 
  add_model(model_glm)

work_glm_full <- workflow() %>% 
  add_recipe(rec_smote_glm) %>% 
  add_model(model_glm)

## folds
set.seed(123)
folds <- vfold_cv(covid_train, strata = 'death')


##tune

tune_lasso <- tune_grid(
  work_lasso_smote,
  resamples = folds,
  grid = 20,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)

tune_lasso_reduced <- tune_grid(
  work_lasso_reduced,
  resamples = folds,
  grid = 30,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)


tune_svm <- tune_grid(
  work_svm,
  resamples = folds,
  grid = 20,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)

tune_svm_reduced <- tune_grid(
  work_svm_reduced,
  resamples = folds,
  grid = 20,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)



tune_xgb <- tune_grid(
  work_xgb,
  resamples = folds,
  grid = 30,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)

tune_xgb_reduced <- tune_grid(
  work_xgb_reduced,
  resamples = folds,
  grid = 40,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)

tune_rf <- tune_grid(
  work_rf,
  resamples = folds,
  grid = 30,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)

tune_rf_reduced <- tune_grid(
  work_rf_reduced,
  resamples = folds,
  grid = 30,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)


tune_glm <- fit_resamples(
  work_glm,
  resamples = folds,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)

tune_glm_full <- fit_resamples(
  work_glm_full,
  resamples = folds,
  metrics = metric_set(mn_log_loss, roc_auc, accuracy),
  control = control_grid(verbose = TRUE, parallel_over = 'resamples')
)



##save resamples
saveRDS(tune_lasso, file = 'tunes_lasso_smote.RDS')
saveRDS(tune_lasso_reduced, file = 'tunes_lasso_reduced.RDS')
saveRDS(tune_xgb, file = 'tune_xgb.RDS')
saveRDS(tune_xgb_reduced, file = 'tune_xgb_reduced.RDS')
saveRDS(tune_svm, file = 'tunes_svm.RDS')
saveRDS(tune_svm, file = 'tunes_svm_reduced.RDS')
saveRDS(tune_rf, file = 'tunes_rf.RDS')
saveRDS(tune_rf_reduced, file = 'tunes_rf_reduced.RDS')

##Load
tune_lasso_smote <- readRDS(file = 'tunes_lasso_smote.RDS')  
tune_lasso_reduced <- readRDS(file = 'tunes_lasso_reduced.RDS')
tune_xgb <- readRDS( file = 'tune_xgb.RDS')
tune_xgb_reduced <- readRDS(file = 'tune_xgb_reduced.RDS')
tune_svm <- readRDS(file = 'tunes_svm_reduced.RDS')
tune_svm_reduced <- readRDS(file = 'tunes_svm_reduced.RDS')
tune_rf <- readRDS(file = 'tunes_rf.RDS')
tune_rf_reduced <- readRDS(file = 'tunes_rf_reduced.RDS')


##autlplot
autoplot(tune_lasso_reduced)

## show best
show_best(tune_lasso_smote, metric = 'roc_auc')
best_lasso <- select_best(tune_lasso_smote, metric = 'mn_log_loss')

show_best(tune_lasso_reduced, metric = 'roc_auc')
best_lasso_reduced <- select_best(tune_lasso_reduced, metric = 'mn_log_loss')

show_best(tune_xgb, metric = 'roc_auc')
best_xgb <- select_best(tune_xgb, metric = 'mn_log_loss')

show_best(tune_xgb_reduced, metric = 'roc_auc')
best_xgb_reduce <- select_best(tune_xgb_reduced, metric = 'mn_log_loss')

show_best(tune_svm, metric = 'roc_auc')
best_svm <- select_best(tune_svm, metric = 'roc_auc')

show_best(tune_svm_reduced, metric = 'roc_auc')
best_svm_reduced <- select_best(tune_svm_reduced, metric = 'roc_auc')

show_best(tune_rf, metric = 'roc_auc')
best_rf <- select_best(tune_rf, metric = 'roc_auc')

show_best(tune_rf_reduced, metric = 'roc_auc')
best_rf_reduced <- select_best(tune_rf_reduced, metric = 'roc_auc')

show_best(tune_glm, metric = 'roc_auc')
best_glm <- select_best(tune_glm, metric = 'roc_auc')

show_best(tune_glm_full, metric = 'roc_auc')
best_glm_full <- select_best(tune_glm, metric = 'roc_auc')

## test
test_lasso <- work_lasso_smote %>% 
  finalize_workflow(best_lasso) %>% 
  last_fit(split)


test_lasso %>% collect_metrics()

test_lasso %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

conf_lasso_full <- test_lasso %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

roc_lasso <- test_lasso %>% collect_predictions() %>% 
  roc(death, .pred_yes)

ci.auc(roc_lasso)

summary(conf_lasso_full)

##Reduced lasso
test_lasso_reduced <- work_lasso_reduced %>% 
  finalize_workflow(best_lasso_reduced) %>% 
  last_fit(split)

test_lasso_reduced %>% collect_metrics()

test_lasso_reduced %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

conf_lasso_reduced <- test_lasso_reduced %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

roc_lasso_red <- test_lasso_reduced %>% collect_predictions() %>% 
  roc(death, .pred_yes)

ci.auc(roc_lasso_red)


##Plot ROC
## Plot ROC in Lasso
lasso_values <- test_lasso_reduced %>% collect_predictions()
plot.roc(lasso_values$death, lasso_values$.pred_no, ci = TRUE, percent = TRUE,  print.auc = TRUE)


##Multiple ROC analysis
lasso_values <- test_lasso_reduced %>% collect_predictions() ##Reduced
lasso_value1 <- test_lasso %>% collect_predictions() ##Full
xgb_full <- test_xgb %>% collect_predictions() ## Full
xgb_red <- test_xgb_red %>% collect_predictions() ## Reduced

##Gerate a table
roc_plot <- lasso_values %>% 
  select('.pred_yes', death) %>% 
  rename(pred_yes_lasso_reduced = '.pred_yes') %>%
  bind_cols(lasso_value1 %>% select(.pred_yes)) %>% 
  rename(pred_yes_lasso_full = .pred_yes) %>% 
  bind_cols(xgb_red %>% select(.pred_yes)) %>% 
  rename(pred_yes_xgb_reduced = .pred_yes) %>% 
  bind_cols(xgb_full %>% select(.pred_yes)) %>% 
  rename(pred_yes_xgb_full = .pred_yes) %>% 
  relocate(death, .after = last_col())

write.csv(roc_plot, file = 'plot_roc.csv', row.names = FALSE, quote = FALSE)


plot.roc(lasso_values$death, lasso_values$.pred_no, col="darkblue", percent = TRUE)
lines.roc(lasso_value1$death, lasso_value1$.pred_no, 
          percent=TRUE, 
          col="blue2")
lines.roc(xgb_full$death, xgb_full$.pred_no, 
          percent=TRUE, 
          col="darkred")
lines.roc(xgb_red$death, xgb_red$.pred_no, 
          percent=TRUE, 
          col="brown4")

## Best threshold
roc_lasso_red <- test_lasso_reduced %>% collect_predictions() 

plot.roc(roc_lasso_red$death, roc_lasso_red$.pred_yes, ci = TRUE,
         percent = TRUE, of = 'thresholds', thresholds="best",
         print.thres="best", print.auc = TRUE)


##XGB test
test_xgb <- work_xgb %>% 
  finalize_workflow(best_xgb) %>% 
  last_fit(split)

test_xgb %>% collect_metrics()

test_xgb %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

roc_xgb <- test_xgb %>% collect_predictions() %>%
  roc(death, .pred_yes)

ci.auc(roc_xgb)

##XGB test reduced
test_xgb_red <- work_xgb_reduced %>% 
  finalize_workflow(best_xgb_reduce) %>% 
  last_fit(split)

test_xgb %>% collect_metrics()

test_xgb %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

test_xgb_reduced <- test_xgb %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

roc_xgb_red <- test_xgb %>% collect_predictions() %>% 
  roc(death, .pred_yes)

ci.auc(roc_xgb_red)

summary(test_xgb_reduced)

## SVM
test_svm <- work_svm %>% 
  finalize_workflow(best_svm) %>% 
  last_fit(split)

test_svm %>% collect_metrics()

roc_svm <- test_svm %>% collect_predictions() %>% 
  roc(death, .pred_yes)

ci.auc(roc_svm)

#SVM Reduced
test_xgb_reduced <- work_svm_reduced %>% 
  finalize_workflow(best_svm_reduced) %>% 
  last_fit(split)

test_xgb_reduced %>% collect_metrics()

##RF Full
test_rf <- work_rf %>% 
  finalize_workflow(best_rf) %>% 
  last_fit(split)

test_rf %>% collect_metrics()

test_rf %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

##RF Full
test_rf_reduced <- work_rf_reduced %>% 
  finalize_workflow(best_rf_reduced) %>% 
  last_fit(split)

test_rf_reduced %>% collect_metrics()

##glm test
test_glm <- work_glm %>% 
  finalize_workflow(best_glm) %>% 
  last_fit(split)

test_glm %>% collect_metrics()


test_glm %>% collect_predictions() %>% 
  conf_mat(truth = death, estimate = .pred_class)

## final model
final_lasso <- work_lasso_smote %>% 
  finalize_workflow(best_lasso) %>% 
  fit(covid_train)

final_lasso %>% pull_workflow_fit() %>% vi %>% 
  ggplot(aes(reorder(Variable, Importance), Importance, fill = Sign))+
  geom_col()+
  coord_flip()+
  labs(x = '', title = 'Elastic Net Full Model - Variable Importance')+
  theme(legend.position = 'none')



##final reduced lasso


ggsave(filename = 'Figure05.tiff', dpi = 300, compression = 'lzw')

coef_elastic_reduced <- final_lasso_reduced %>% pull_workflow_fit() %>% tidy()
saveRDS(coef_elastic_reduced, file = 'coef_elastic.RDS')


## replace variable names
theme_set(theme_bw())
plot <- final_lasso_reduced %>% pull_workflow_fit() %>% vi
plot <- as.data.frame(plot)

plot <- plot %>% 
  mutate(varibale = c('Age Second Spline', 'Age Third Spline', 'Age First Spline', 
                      'Dyspnoea', 'Hypertension', 'Age Fourth Spline', 'MPA or AZA use',
                      'Cardiovascular Disease', 'BMI (kg/m2)', 'Smoking', 'Diabetes ESRD',
                      'eGFR at baseline Fourth Spline', 'Steroids use', 'eGFR at baseline First Spline',
                      'mTOR use', 'Headache', 'Anosmia', 'Diarrhea','eGFR at baseline Third Spline',
                      'Time COVID symptoms','eGFR at baseline Second Spline'))

ggplot(plot, aes(reorder(varibale, Importance), Importance, fill = Sign))+
  geom_col(alpha = 0.75)+
  coord_flip()+
  scale_fill_manual(values = c('blue','red'))+
  labs(x = '', title = '')+
  theme(legend.position = 'none')



##Save final lasso reduced
saveRDS(final_lasso_reduced, file = 'final_lasso_reduced.RDS')
final_lasso_reduced <- readRDS('final_lasso_reduced.RDS')

## model to app
final_lasso_app <- work_lasso_app %>% 
  finalize_workflow(best_lasso_app) %>% 
  fit(covid_train)

saveRDS(final_lasso_app, file = 'final_lasso_app.RDS')

## final model glm
final_glm <- work_glm %>% 
  finalize_workflow(best_glm) %>% 
  fit(covid_train)


## final model glm
final_glm_full <- work_glm_full %>% 
  finalize_workflow(best_glm_full) %>% 
  fit(covid_train)


##Example predict with reduced model
table_new <- data.frame(
  dyspnoea = c(1,1,1,1),
  egf_baseline = c(60,20,50,40),
  age = c(40,40,60,60),
  BMI = c(25,35,25,30),
  Steroids_iss = c(1,1,1,1),
  MPA_or_AZA_iss = c(0,1,1,1),
  MTOR_iss = c(1,0,0,0),
  diabetes_ESRD = c(0,0,0,1),
  hypertension = c(1,1,1,1),
  smoking = c(0,0,0,0),
  cardiovascular_disease = c(0,0,0,1),
  time_symptoms = c(5,2,5,6),
  anosmia = c(1,0,0,0),
  headache = c(0,0,0,0),
  diarrhea = c(0,0,0,0)
)

predict(final_lasso_reduced, table_new[4, ], type = 'prob')
predict(final_lasso_app, table_new[4, ], type = 'prob')

predito <- predict(final_lasso_reduced, table_new[4, ], type = 'prob')

table <- data.frame(
  group = c('Prob Alive','Prob Deah'),
  value = c(predito$.pred_no, predito$.pred_yes)
)

ggplot(table, aes(group, value, fill = group))+
  geom_col(alpha = 0.75)+
  geom_label(aes(label = round(value,2)*100))+
  scale_fill_manual(values = c('blue','red'))+
  theme_bw()+
  theme(legend.position = 'none')

##final XGB
final_xgb <- work_xgb_reduced %>% 
  finalize_workflow(best_xgb_reduce) %>% 
  fit(covid_train)

final_xgb %>% pull_workflow_fit() %>% vip(num_features = 40)



final_xgb_reduced <- work_xgb_reduced %>% 
  finalize_workflow(best_xgb_reduce) %>% 
  fit(covid_train)

saveRDS(final_xgb_reduced, file = 'final_xgb_reduced.RDS')


final_rf_reduced <- work_rf_reduced %>% 
  finalize_workflow(best_rf_reduced) %>% 
  fit(covid_train)

final_rf <- work_rf %>% 
  finalize_workflow(best_rf) %>% 
  fit(covid_train)

## Calibration Plot

#reduced lasso


##usign Caret
dataPlotLasso <- data.frame(
  obs = covid_test$death,
  lassoReduced = predict(final_lasso_reduced, covid_test, type = 'prob')$.pred_no,
  lassoFull = predict(final_lasso, covid_test, type = 'prob')$.pred_no,
  xgBoostReduced = predict(final_xgb_reduced, covid_test, type = 'prob')$.pred_no,
  xgBoostFull = predict(final_xgb, covid_test, type = 'prob')$.pred_no
)

cal_obj <- plot(calibration(obs ~ lassoFull + lassoReduced + xgBoostFull + xgBoostReduced, data = dataPlotLasso,
                            cuts = 10))

plot(cal_obj, type = "l", auto.key = list(columns = 3,
                                          lines = TRUE,
                                          points = FALSE))


##Brier Score
dataPlotLasso <- data.frame(
  obs = ifelse(covid_test$death == 'no',0,1 ),
  lassoReduced = predict(final_lasso_reduced, covid_test, type = 'prob')$.pred_no,
  lassoFull = predict(final_lasso, covid_test, type = 'prob')$.pred_no,
  xgBoostReduced = predict(final_xgb_reduced, covid_test, type = 'prob')$.pred_no,
  xgBoostFull = predict(final_xgb, covid_test, type = 'prob')$.pred_no
)


mean((dataPlotLasso$obs - dataPlotLasso$lassoReduced )^2)
mean((dataPlotLasso$obs - dataPlotLasso$lassoFull )^2)
mean((dataPlotLasso$obs - dataPlotLasso$xgBoostFull )^2)
mean((dataPlotLasso$obs - dataPlotLasso$xgBoostReduced )^2)

## using RMS
library(rms)

##glm full
predito <- predict(final_glm_full, covid_test, type = 'raw')
phat <- 1/(1+exp(-predito))
val.prob(phat, dataPlotLasso$obs, m=20, cex=.5)

##glm reduced
predito <- predict(final_glm, covid_test, type = 'raw')
phat <- 1/(1+exp(-predito))
val.prob(phat, dataPlotLasso$obs, m=20, cex=.5)

##xgboost full
predito <- predict(final_xgb, covid_test, type = 'raw')
phat <- 1/(1+exp(-predito))
val.prob(predito, dataPlotLasso$obs, m=20, cex=.5)

##sgboost reduced
predito <- predict(final_xgb_reduced, covid_test, type = 'raw')
phat <- 1/(1+exp(-predito))
val.prob(predito, dataPlotLasso$obs, m=20, cex=.5)

##manual plot
ggplot(dataPlotLasso, aes(lassoReduced, obs))+
  geom_point()

## Sensitivity analysis

# Hospitalized patients
covid_test_hosp <- covid_test %>% 
  filter(nosocomial == 0)


covid_test_hosp <- covid_test_hosp %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_test_hosp)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_test_hosp, type = 'prob'))$.pred_yes
         )

roc_h <- roc(covid_test_hosp$death, covid_test_hosp$pred_prob)
ci.auc(roc_h)


# non-hospitalized patients
## Number of centers
centers <- covid_predictor %>% 
  group_by(center) %>% 
  count()

covid_hig <- covid_test %>% 
  left_join(centers) %>% 
  filter(n >= 100)

covid_test_hig <- covid_hig %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_hig)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_hig, type = 'prob'))$.pred_yes
  )


roc_hig <- roc(covid_test_hig$death, covid_test_hig$pred_prob)
ci.auc(roc_hig)


## Low volume centers
covid_hig <- covid_test %>% 
  left_join(centers) %>% 
  filter(n < 50)


covid_test_hig <- covid_hig %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_hig)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_hig, type = 'prob'))$.pred_yes
  )

roc_hig <- roc(covid_test_hig$death, covid_test_hig$pred_prob)
ci.auc(roc_hig)


##Time transplant
covid_time <- covid_test %>% 
  filter(time_tx_ys <= 1)

covid_test_time <- covid_time %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_time)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_time, type = 'prob'))$.pred_yes
  )


roc_time <- roc(covid_test_time$death, covid_test_time$pred_prob)
ci.auc(roc_time)


## time more than 1 year
covid_time <- covid_test %>% 
  filter(time_tx_ys > 1)

covid_test_time <- covid_time %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_time)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_time, type = 'prob'))$.pred_yes
  )


roc_time <- roc(covid_test_time$death, covid_test_time$pred_prob)
ci.auc(roc_time)


## Living Donor
covid_donor <- covid_test %>% 
  filter(living_donor == 1)


covid_test_donor <- covid_donor %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_donor)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_donor, type = 'prob'))$.pred_yes
  )


roc_donor <- roc(covid_test_donor$death, covid_test_donor$pred_prob)
ci.auc(roc_donor)



## Deceased Donor
covid_donor <- covid_test %>% 
  filter(living_donor == 0)


covid_test_donor <- covid_donor %>% 
  mutate(pred_class = as.vector(predict(final_lasso_reduced, covid_donor)$.pred_class ),
         pred_prob = as.vector(predict(final_lasso_reduced, covid_donor, type = 'prob'))$.pred_yes
  )


roc_donor <- roc(covid_test_donor$death, covid_test_donor$pred_prob)
ci.auc(roc_donor)




##Using DALEX


explain_lasso_full <- explain_tidymodels(final_lasso, data = covid_test %>% select(-death),
                                         y = ifelse(covid_test$death == 'no',0,1), 
                                         label = 'Elastic Full')

covid_data_reduced <- covid_test %>% 
  select(death,dyspnoea, egf_baseline, age, MPA_or_AZA_iss,
           hypertension, diabetes_ESRD, cardiovascular_disease, smoking, Steroids_iss, BMI,
           MTOR_iss, diarrhea, time_symptoms, anosmia, headache)

explain_lasso_reduced <- explain_tidymodels(final_lasso_reduced, data = covid_data_reduced %>% select(-death),
                                         y = ifelse(covid_data_reduced$death == 'no',0,1), 
                                         label = 'Elastic Reduced')

explain_xgb <- explain_tidymodels(final_xgb, data = covid_test %>% select(-death),
                                  y = ifelse(covid_test$death == 'no',0,1), 
                                  label = 'XgBoost Full')

explain_xgb_reduced <- explain_tidymodels(final_xgb_reduced, data = covid_data_reduced %>% select(-death),
                                          y = ifelse(covid_data_reduced$death == 'no',0,1), 
                                          label = 'XgBoost Reduced')

##variavel Importance
feature_lasso_full <- feature_importance(explain_lasso_full)
plot(feature_lasso_full)

feature_lasso_reduced <- feature_importance(explain_lasso_reduced) 
plot(feature_lasso_reduced)

##shap
##Shap
table_new <- data.frame(
  dyspnoea = 1,
  egf_baseline = 60,
  age = 40,
  BMI = 25,
  Steroids_iss = 1,
  MPA_or_AZA_iss = 0,
  MTOR_iss = 1,
  diabetes_ESRD = 0,
  hypertension = 1,
  smoking = 0,
  cardiovascular_disease = 1,
  time_symptoms = 5,
  anosmia = 1,
  headache = 0,
  diarrhea = 0
)
shap_lasso1 <- predict_parts(explain_lasso_reduced, new_observation = table_new[1, ], type = 'shap')
shap_lasso2 <- predict_parts(explain_lasso_reduced, new_observation = table_new[2, ], type = 'shap')
shap_lasso3 <- predict_parts(explain_lasso_reduced, new_observation = table_new[3, ], type = 'shap')
shap_lasso4 <- predict_parts(explain_lasso_reduced, new_observation = table_new[4, ], type = 'shap')
plot(shap_lasso)

plot_01 <- plot(shap_lasso1)+labs(title = 'Patient 01')
plot_02 <- plot(shap_lasso2)+labs(title = 'Patient 02')
plot_03 <- plot(shap_lasso3)+labs(title = 'Patient 03')
plot_04 <- plot(shap_lasso4)+labs(title = 'Patient 04')
figure06 <- grid.arrange(plot_01, plot_02, plot_03, plot_04)
ggsave(figure06, filename = 'Figure06.tiff', dpi = 300, compression = 'lzw')

break_lasso <- predict_parts(explain_lasso_reduced, new_observation = table_new, type = 'break_down')
plot(break_lasso)


##model performance
performance_lasso_full <- model_performance(explain_lasso_full)
performance_lasso_reduced <- model_performance(explain_lasso_reduced)
preformace_xgb <- model_performance(explain_xgb)
performance_xbg_reduced <- model_performance(explain_xgb_reduced)

plot06 <- plot(performance_lasso_full, performance_lasso_reduced, preformace_xgb, performance_xbg_reduced ,
     geom = 'roc')
ggsave(plot06, file = 'figurexx.tiff', dpi = 300, compression = 'lzw')

##Model Profile

prof_age <- model_profile(explain_lasso_reduced, variables = 'age')
plot(prof_age)

prof_egf <- model_profile(explain_lasso_reduced, variables = 'egf_baseline')
plot(prof_egf)

prof_bmi <-  model_profile(explain_lasso_reduced, variables = 'BMI')
plot(prof_bmi)


prof_time_symptoms <- model_profile(explain_lasso_reduced, variables = 'MTOR_iss', variable_type = 'categorical')
plot(prof_time_symptoms)

prof_time_symptoms <- model_profile(explain_lasso_reduced, variables = 'MPA_or_AZA_iss', variable_type = 'categorical')
plot(prof_time_symptoms)

prof_time_symptoms <- model_profile(explain_lasso_reduced, variables = 'anosmia', variable_type = 'categorical')
plot(prof_time_symptoms)

prof_time_symptoms <- model_profile(explain_lasso_reduced, variables = 'dyspnoea', variable_type = 'categorical')
plot(prof_time_symptoms)