## Load Packages

library(tidyverse)
library(tidymodels)
library(gtsummary)
library(haven)
library(janitor)
library(naniar)
library(vip)
library(pROC)
library(Boruta)
library(DALEXtra)
library(gridExtra)
library(finalfit)
library(caret)

## Load Data

covid <- read_sav('covid_ira .sav')
covid <- covid %>% clean_names()

names(covid)


## Select Relevant predictors
## Remove id predictors and other outcome predictors (retain only outcome death)

covid_predictor <- covid %>% 
  select(edad , sexo ,  ha , diabetes , cardiopatia , erc , epoc , id , obesidad , otra , ninguna , dias_covid_ingreso_hospital , 
         condicion_ingreso , creatininemi_amgd_l , potasemi_ammol_l ,
         prot_si_no ,  hematuria ,  gb_corregido , linfocitos ,  pqt_corregido , inr , ddimero , ferritina , p_h , hco3mmol_l , ast , alt , ck , 
         lugar_instalacion , dias_covid_ira , 
         hipovolemia_deshidratacion , dmo_covid , dmo_sepsis , aine , ieca_ara , vanco , ag , otras_ntx , ntx_total , rabdo , otra_causa , diuresis , 
         rr, ventilacion_mecanica, peorpafio2, peorpeep, vasopresores, evolucion)

## Modify predictors names --> translate spanish to english

names(covid_predictor) <- c('age', 'sex', 'hypertenion', 'diabetes', 'cardiovascular_disease',
                            'chronic_kidney_disease', 'COPD', ' immunodepression', 'obesity', 'other_comorbidities', 'without_comorbidities',
                            'time_covid_to_hospital','condition_admission','creatinine', 'potassium',
                            'proteinuria','hematuria','WBC','lymphocyte','platelets','INR','d_dimero','ferritine',
                            'pH','bicarbonate','AST','ALT','CK','covid_infection','days_covid_to_AKI',
                            'dehydration','AKI_etiology_COVID','AKI_etiology_sepsis','aine','ARA_BRA','vanco','aminoglycosides','other_ntx_drugs','ntx_total',
                            'AKI_etiology_rabdo','AKI_etiology_ohter','diuresis', 'renal_replacement', 'mechanical_ventilation', 'peorpafio2', 'peorpeep', 'vasopressors',
                            'outcome')


## Imputation categorical to frequently class

covid_predictor$diuresis[is.na(covid_predictor$diuresis)] <- 2
covid_predictor$condition_admission[is.na(covid_predictor$condition_admission)] <- 2
covid_predictor$covid_infection[is.na(covid_predictor$covid_infection)] <- 2
covid_predictor$renal_replacement[is.na(covid_predictor$renal_replacement)] <- 0
covid_predictor$mechanical_ventilation[is.na(covid_predictor$mechanical_ventilation)] <- 1


## Code the factor variables 

covid_predictor <- covid_predictor %>% 
  mutate(sex_male = ifelse(sex == 1, 1,0),
         condition_admission = case_when(
           condition_admission == 1 ~ 'mild',
           condition_admission == 2 ~ 'moderate',
           condition_admission == 3 ~ 'severe'
         ),
         covid_infection = case_when(
           covid_infection == 1 ~ 'community',
           covid_infection == 2 ~ 'hospital'
         ),
         diuresis = factor(diuresis, labels = c('oliguria','normal')),
         outcome = factor(outcome, labels = c('death','alive'))
         ) %>% 
  mutate(
    mechanical_ventilation = ifelse(mechanical_ventilation == 0, 0, 1),
    renal_replacement = ifelse(renal_replacement == 0, 0, 1)
  ) %>% 
  select(-sex)

## Factor relevel

covid_predictor <- covid_predictor %>% 
  mutate(outcome = fct_relevel(outcome, 'alive','death'))


## Missing variables Table

covid_predictor %>% 
  missing_glimpse()
  

# Missmap (Plot of missing Variables)

naniar::vis_miss(covid_predictor)



## Remove  variable with more than 30% missing 

covid_predictor <- covid_predictor %>% 
  select(-proteinuria, -INR, -d_dimero, -ferritine, -CK, -peorpafio2, -peorpeep) ## remove missing more thena 30%


# Dimension of final Data after remove missing more than 30%
# --------------------------------------------------------------

dim(covid_predictor)

## EDA ----------------------------------------------------------
## --------------------------------------------------------------
## Exploratory Data Analysis
## using ggplot2 

theme_set(theme_bw())

## Outcome death

ggplot(covid_predictor, aes(outcome, fill = outcome))+
  geom_bar()

# Number of COVID-19 cases by Country

covid <- covid %>% 
  mutate(
    pais = fct_collapse(pais,
                        Argentina = c('argentina','Argentina'),
                        Bolivia = c('Bolivia'),
                        Brazil = c('Brasil'),
                        Chile = c('Chile'),
                        Colombia = c('Colombia'),
                        Ecuador = c('Ecuador'),
                        Guatemala = c('Guatemala'),
                        Mexico = c('Mexico','México'),
                        Paraguay = c('Paraguay'),
                        Peru = c('Perú'),
                        'Dominican Republic' = c('República Dominicana'),
                        Uruguay = c('Uruguay')
    ))


# Number of cases by Country

covid %>% 
  group_by(pais) %>% 
  count() %>% 
  ggplot(aes(reorder(pais,n), n))+
  geom_col(fill = 'midnightblue', alpha = 0.75)+
  geom_label(aes(label = n))+
  coord_flip()+
  labs(x = '', y = '', title = 'Number of cases by Country')+
  theme_minimal()


## ----- Univariate Analysis -------------------------------------------
## ----- Table 01 of Manuscript ----------------------------------------

covid_predictor %>% as_tibble() %>% 
  mutate_if(is.logical, ~ factor(.)) %>% 
  mutate_if(is.double, ~ factor(.)) %>% 
  tbl_summary(by = outcome) %>% 
  add_p() %>% 
  bold_labels() %>% 
  add_overall()

## ---------------- Model ---------------------------------------------
## --------------------------------------------------------------------

## Feature Selection with Boruta algorith
## Preprocess to Boruta (missing values only to perform Boruta)

rec_boruta <- recipe(outcome ~ . , data = covid_predictor) %>% 
  step_dummy(all_nominal(), -all_outcomes()) %>% 
  step_medianimpute(diuresis_normal, sex_male, hematuria) %>% 
  step_medianimpute(all_predictors())

covid_boruta <- rec_boruta %>% prep() %>% juice()

x <- covid_boruta %>% select(-outcome)
y <- covid_boruta$outcome

boruta_res <- Boruta(x, y, doTrace = 2)

## Save Boruta Results

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

## Load Boruta Results

boruta_res <- readRDS(file = 'boruta_res.RDS')

## Show Boruta Results
table <- attStats(boruta_res) 
table

## Remove Rejected predictors
# remove unimportant predictors selected by Boruta

covid_predictor <- covid_predictor %>% 
  select(-c(diabetes, cardiovascular_disease, chronic_kidney_disease, COPD, obesity,
           other_comorbidities, without_comorbidities,  ' immunodepression', hematuria,
           platelets, pH, bicarbonate, aine, ARA_BRA, vanco, aminoglycosides, other_ntx_drugs,
           AKI_etiology_rabdo)) ##Remove inimportant predictors

## Remove colinear predictors

covid_predictor <- covid_predictor %>% 
  select(-ALT, -potassium)


## ------ Model Fit ---------------------------------------------------
## using Tidymodels package -------------------------------------------
## https://www.tidymodels.org/books/tmwr/
## --------------------------------------------------------------------

## Model Fit
## Using: 
## 1. demographic data
## 2. comorbidities and condition  at admission
## 3. laboratory at admission
## 4. characteristics and causes of AKI

## Model split (Train and Test Set) ------------------------------------
## Train 80% and Test 20%
## ---------------------------------------------------------------------

set.seed(123)
split <- initial_split(covid_predictor, strata = 'outcome', prop = 0.80)
covid_train <- training(split)
covid_test <- testing(split)


## PreProcess ---------------------------------------------------------
## Using recipes (tidymodels)
## --------------------------------------------------------------------

## Steps:
## 1. Create dummy variables
## 2. Median Impute do nominal predictors
## 3. knn impute to other predictors

rec <- recipe(outcome ~ . , data = covid_train) %>% 
  step_dummy(all_nominal(), -all_outcomes()) %>% 
  step_medianimpute(diuresis_normal, sex_male) %>% 
  step_knnimpute(all_predictors())


## Recipe to Lasso
## Steps:
## 1. Create dummy variables
## 2. Median Impute do nominal predictors
## 3. knn impute to other predictors
## 4. BoxCox transformation 
## 5. Normalize predictors
## 6. Remove near zero variance predictors

rec_lasso <- recipe(outcome ~ . , data = covid_train) %>% 
  step_rm(lymphocyte) %>% 
  step_dummy(all_nominal(), -all_outcomes()) %>% 
  step_medianimpute(diuresis_normal, sex_male) %>% 
  step_knnimpute(all_predictors()) %>% 
  step_BoxCox(all_predictors()) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors())

## model specification ----------------------------------------------
## Lasso, rf (random forest), xgBoost
## ------------------------------------------------------------------

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

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

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


## Workflow ---------------------------------------------------------
## Combine recipe with model
## https://www.tidymodels.org/books/tmwr/


work_lasso <- workflow() %>% 
  add_model(model_lasso) %>% 
  add_recipe(rec_lasso)

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

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

## ----------------------- Resample ---------------------------------
## 10-fold cross-validation in Train Set
## ------------------------------------------------------------------

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


## ---------------------------------------------------------------
## Tune (hyperparameters search in train Set using 10-fold cross-validation)
## --------------------------------------------------------------

## Workflow (recipe + model)
## resamples = 10-fold cross-validation
## Grid search is a latin hypercube semi-random grid
## metric = roc-auc and accuracy

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

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

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


## save results of grid search

saveRDS(tune_lasso, file = 'best_lasso.RDS')
saveRDS(tune_rf, file = 'best_rf.RDS')
saveRDS(tune_xgb, file = 'best_xgb.RDS')

## Load results of grid search

tune_lasso <- readRDS(file = 'best_lasso.RDS')
tune_rf <- readRDS(file = 'best_rf.RDS')
tune_xgb <- readRDS(file = 'best_xgb.RDS')


## Show values of hyperparameters selected by best roc-auc

show_best(tune_lasso, metric = 'roc_auc')
best_lasso <- select_best(tune_lasso, metric = 'roc_auc')

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

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


## Test Set --------------------------------------------------------
## Values of roc-auc, accuracy in Test Set -------------------------
## -----------------------------------------------------------------

lasso_test <- work_lasso %>% 
  finalize_workflow(best_lasso) %>% 
  last_fit(split)

lasso_test %>% collect_metrics()

# Confusion Matrix

lasso_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class)

# Consufion Matxrix Plot
conf_lasso <- lasso_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class) %>% 
  autoplot('heatmap')

p1 <- conf_lasso + labs(title = 'A. Elastic Net')

# ROc-Auc 

roc_lasso <- lasso_test %>% collect_predictions() %>% 
  roc(outcome, .pred_death)

ci.auc(roc_lasso)


## Plot ROC in Lasso

lasso_values <- lasso_test %>% collect_predictions()
plot.roc(lasso_values$outcome, lasso_values$.pred_death, ci = TRUE, percent = TRUE,  print.auc = TRUE)

plot.roc(lasso_values$outcome, lasso_values$.pred_death, ci = TRUE, percent = TRUE,  print.auc = TRUE,
         of = "thresholds", thresholds = "best", print.thres="best")


## Test set Random Forest
## Random Forest

rf_test <- work_rf %>% 
  finalize_workflow(best_rf) %>% 
  last_fit(split)

rf_test %>% collect_metrics()

# confusion Matrix
rf_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class)

roc_rf <- rf_test %>% collect_predictions() %>% 
  roc(outcome, .pred_death)

ci.auc(roc_rf)

# confusion Matrix Plot
conf_rf <- rf_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class) %>% 
  autoplot('heatmap')

p2 <- conf_rf + labs(title = 'B. Random Forest')


## Test Set to XgBoost

xgb_test <- work_xgb %>% 
  finalize_workflow(best_xgb) %>% 
  last_fit(split)

xgb_test %>% collect_metrics()

# Confusion Matrix
xgb_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class)

roc_xgb <- xgb_test %>% collect_predictions() %>% 
  roc(outcome, .pred_death)

ci.auc(roc_xgb)

# confusion Matrix Plot
conf_xgb <- xgb_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class) %>% 
  autoplot('heatmap')

p3 <- conf_xgb + labs(title = 'C. xgBoost')

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

## Plot ROC
xgb_values <- xgb_test %>% collect_predictions()
plot.roc(xgb_values$outcome, xgb_values$.pred_death, ci = TRUE, percent = TRUE,  print.auc = TRUE)

## Final -----------------------------------------------------------------
## final model -----------------------------------------------------------
## Fit the model in Train Set to model visualization ---------------------
## using package vip

final_lasso <- work_lasso %>% 
  finalize_workflow(best_lasso) %>% 
  fit(covid_train)

final_lasso %>% pull_workflow_fit() %>% vip(num_features = 20)

final_plot <- final_lasso %>% pull_workflow_fit() %>% vi %>% 
  mutate(variable = c('Mechanical Ventilation', 'Age (ys)', 'Vasopressors', 'WBC', 'Severe Condition at Admission',
                      'COVID Infection at Hospital','AST','Renal Replacement','Moderate Condition at Admission',
                      'AKI Etiology Sepsis','Hypertension','Creatinine','AKI Etiology COVID', 'Sex male',
                      'Time from COVID to AKI (days)', 'Normal Diuresis','Time from COVID to Hospitalization (days)',
                      'AKI Etiology Other','Any Nephrotoxic Drug','Dehydratation')) %>% 
  ggplot(aes(reorder(variable, Importance), Importance, fill = Sign))+
  geom_col(alpha = 0.75)+
  coord_flip()+
  theme_bw()+
  scale_fill_manual(values = c('blue','red'))+
  labs(x = '', fill = '')+
  theme(legend.position = 'none')

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

##save final Model
saveRDS(final_lasso, file = 'final_lasso.RDS')

## --------------------- Sensitivity analysis ----------------------------
## -----------------------------------------------------------------------

## All predictors without feature selection

## Remove missing more than 30%
sens01 <- covid_predictor %>% 
  select(-hematuria, -CK, -ferritine, -INR, -d_dimero, -proteinuria,
         -peorpafio2, -peorpeep)


##model split
set.seed(123)
split <- initial_split(sens01, strata = 'outcome', prop = 0.80)
covid_train <- training(split)
covid_test <- testing(split)

## Recipe to Lasso
rec_lasso <- recipe(outcome ~ . , data = covid_train) %>% 
  step_rm(lymphocyte) %>% 
  step_dummy(all_nominal(), -all_outcomes()) %>% 
  step_medianimpute(diuresis_normal, sex_male) %>% 
  step_knnimpute(all_predictors()) %>% 
  step_corr(all_predictors(), threshold = 0.90) %>% 
  step_BoxCox(all_predictors()) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors())


## model Lasso

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

## workflow

work_lasso <- workflow() %>% 
  add_model(model_lasso) %>% 
  add_recipe(rec_lasso)

## Folds (10-fold cross-validation)

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

## Tune

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


##save
saveRDS(tune_lasso, file = 'best_lasso_sen01.RDS')


##Load
tune_lasso <- readRDS(file = 'best_lasso_sen01.RDS')


## Show values (sensitivity)

show_best(tune_lasso, metric = 'roc_auc')
best_lasso <- select_best(tune_lasso, metric = 'roc_auc')

## Test (sensitivity analysis)


lasso_test <- work_lasso %>% 
  finalize_workflow(best_lasso) %>% 
  last_fit(split)

lasso_test %>% collect_metrics()

lasso_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class)

lasso_01 <- lasso_test %>% collect_predictions()
roc_sen01 <- roc(lasso_01$outcome, lasso_01$.pred_alive)
ci(roc_sen01)

confusionMatrix(lasso_01$outcome, lasso_01$.pred_class)


## Final model
final_lasso <- work_lasso %>% 
  finalize_workflow(best_lasso) %>% 
  fit(sens01)

final_lasso %>% pull_workflow_fit() %>% vi()


## ----------------------------------------------------
## All predictiors including missing data more than 30%

## Remove missing more than 30%
sens02 <- covid_predictor 


##model split
set.seed(123)
split <- initial_split(sens02, strata = 'outcome', prop = 0.80)
covid_train <- training(split)
covid_test <- testing(split)

## Recipe to Lasso
rec_lasso <- recipe(outcome ~ . , data = covid_train) %>% 
  step_rm(lymphocyte) %>% 
  step_dummy(all_nominal(), -all_outcomes()) %>% 
  step_medianimpute(diuresis_normal, sex_male) %>% 
  step_knnimpute(all_predictors()) %>% 
  step_corr(all_predictors(), threshold = 0.90) %>% 
  step_BoxCox(all_predictors()) %>% 
  step_normalize(all_predictors()) %>% 
  step_nzv(all_predictors())


## model Lasso

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

## workflow

work_lasso <- workflow() %>% 
  add_model(model_lasso) %>% 
  add_recipe(rec_lasso)

## Folds (10-fold cross-validation)

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

## Tune

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


##save
saveRDS(tune_lasso, file = 'best_lasso_sen02.RDS')


##Load
tune_lasso <- readRDS(file = 'best_lasso_sen02.RDS')


## Show values

show_best(tune_lasso, metric = 'roc_auc')
best_lasso <- select_best(tune_lasso, metric = 'roc_auc')

## Test


lasso_test <- work_lasso %>% 
  finalize_workflow(best_lasso) %>% 
  last_fit(split)

lasso_test %>% collect_metrics()

lasso_test %>% collect_predictions() %>% 
  conf_mat(truth = outcome, estimate = .pred_class)

lasso_01 <- lasso_test %>% collect_predictions()
roc_sen02 <- roc(lasso_01$outcome, lasso_01$.pred_alive)
ci(roc_sen02)

confusionMatrix(lasso_01$outcome, lasso_01$.pred_class)


## Final model
final_lasso <- work_lasso %>% 
  finalize_workflow(best_lasso) %>% 
  fit(sens02)

final_lasso %>% pull_workflow_fit() %>% vip()

## -------------------------------------------------------------------
## Predictions -------------------------------------------------------


##Prediction LASSO
cov_pred <- data.frame(
  age = c(40,50,60,60),
  hypertenion = c(0,0,0,0),
  time_covid_to_hospital = c(5,10,10,10),
  condition_admission = c('mild','mild','moderate','severe'),
  creatinine = c(2, 2.5, 3, 2.5),
  WBC = c(10000,12000,15000,18000),
  AST = c(40,50,60,60),
  covid_infection = c('community','community','hospital','hospital'),
  lymphocyte = c(800,900,800,800),
  days_covid_to_AKI = c(10,12,12,12),
  dehydration = c(1,0,0,0),
  AKI_etiology_COVID = c(0,1,0,1),
  AKI_etiology_sepsis = c(0,0,1,0),
  ntx_total = c(1,0,0,0),
  AKI_etiology_ohter = c(1,0,0,0), 
  diuresis = c('normal','oliguria','oliguria','oliguria'),
  renal_replacement = c(0,1,1,1),
  mechanical_ventilation = c(0,0,0,1),
  vasopressors = c(0,0,0,1),
  sex_male = c(1,1,1,1)
)

predict(final_lasso, cov_pred, type = 'prob')

## Diference between ROC auc
dataPlot <- data.frame(
  obs = covid_test$outcome,
  lasso = predict(final_lasso, covid_test, type = 'prob')$.pred_alive,
  rf = predict(final_rf, covid_test, type = 'prob')$.pred_alive,
  xgBoost = predict(final_xgb, covid_test, type = 'prob')$.pred_alive
)

roc_lasso <- plot.roc(dataPlot$obs, dataPlot$lasso,
                    main="Statistical comparison",
                    percent=TRUE,
                    col="#1c61b6")

roc_xgb <- plot.roc(dataPlot$obs, dataPlot$xgBoost,
                      main="Statistical comparison",
                      percent=TRUE,
                      col="#008600")


roc_rf <- plot.roc(dataPlot$obs, dataPlot$rf,
                    main="Statistical comparison",
                    percent=TRUE)

roc.test(roc_lasso, roc_rf)


##----------------------------------------------------------------------
## Calibration ---------------------------------------------------------
## Calibartion Plot
## using package caret

library(caret)

dataPlotLasso <- data.frame(
  obs = covid_test$outcome,
  lasso = predict(final_lasso, covid_test, type = 'prob')$.pred_alive,
  rf = predict(final_rf, covid_test, type = 'prob')$.pred_alive,
  xgBoost = predict(final_xgb, covid_test, type = 'prob')$.pred_alive
)

cal_obj <- plot(calibration(obs ~ lasso, data = dataPlotLasso,
                            cuts = 5))


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



## -------------------- Model Explain --------------------------------
## Using Dalex -------------------------------------------------------
## -------------------------------------------------------------------


explain_lasso <- explain_tidymodels(final_lasso, data = covid_train %>% select(-outcome),
                                    y = ifelse(covid_train$outcome == 'alive',0,1), label = 'lasso')


explain_xgboost <- explain_tidymodels(final_xgb, data = covid_train %>% select(-outcome),
                                    y = ifelse(covid_train$outcome == 'alive',0,1), label = 'xgBoost')

## Importance Plotfeature <- feature_importance(explain_lasso)
feature <- feature_importance(explain_lasso)
plot(feature)

feature2 <- feature_importance(explain_xgboost)
plot(feature2)


## ROC_auc

explain_lassoT <- explain_tidymodels(final_lasso, data = covid_test %>% select(-outcome),
                                    y = ifelse(covid_test$outcome == 'alive',0,1), label = 'Elastic Net')


explain_xgboostT <- explain_tidymodels(final_xgb, data = covid_test %>% select(-outcome),
                                      y = ifelse(covid_test$outcome == 'alive',0,1), label = 'xgBoost')



explain_rfT <- explain_tidymodels(final_rf, data = covid_test %>% select(-outcome),
                                       y = ifelse(covid_test$outcome == 'alive',0,1), label = 'Random Forest')


feature_lasso <- model_performance(explain_lassoT)
feature_xgboost <- model_performance(explain_xgboostT)
feature_rfT <- model_performance(explain_rfT)

plot(feature_lasso, feature_xgboost, feature_rfT, geom = 'roc')
plot(feature_lasso, feature_xgboost, feature_rfT, geom = 'boxplot')

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

## Explain Data
table_new <- data.frame(
  age = c(40,50,60,60),
  hypertenion = c(0,0,0,0),
  time_covid_to_hospital = c(5,10,10,10),
  condition_admission = c('mild','mild','moderate','severe'),
  creatinine = c(2, 2.5, 3, 2.5),
  WBC = c(10000,12000,15000,18000),
  AST = c(40,50,60,60),
  covid_infection = c('community','community','hospital','hospital'),
  lymphocyte = c(800,900,800,800),
  days_covid_to_AKI = c(10,12,12,12),
  dehydration = c(1,0,0,0),
  AKI_etiology_COVID = c(0,1,0,1),
  AKI_etiology_sepsis = c(0,0,1,0),
  ntx_total = c(1,0,0,0),
  AKI_etiology_ohter = c(1,0,0,0), 
  diuresis = c('normal','oliguria','oliguria','oliguria'),
  renal_replacement = c(0,1,1,1),
  mechanical_ventilation = c(0,0,0,1),
  vasopressors = c(0,0,0,1),
  sex_male = c(1,1,1,1)
)

shap_lasso1 <- predict_parts(explain_lasso, new_observation = table_new[1, ], type = 'shap')
shap_lasso2 <- predict_parts(explain_lasso, new_observation = table_new[2, ], type = 'shap')
shap_lasso3 <- predict_parts(explain_lasso, new_observation = table_new[3, ], type = 'shap')
shap_lasso4 <- predict_parts(explain_lasso, new_observation = table_new[4, ], type = 'shap')

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