diff --git a/ML/2-modeling-reg.R b/ML/2-modeling-reg.R index be59e32..3147af9 100644 --- a/ML/2-modeling-reg.R +++ b/ML/2-modeling-reg.R @@ -178,26 +178,3 @@ saveRDS( screen_workflows, here::here("ML", "outputs", "workflowscreen.rds") ,compress = TRUE) -# grid search ------------------------------------------------------------- - - - - -grid_ctrl <- - tune$control_grid( - save_pred = TRUE, - parallel_over = "everything", - save_workflow = TRUE - ) - - - -grid_results <- - all_workflows %>% - workflowsets::workflow_map( - seed = 070823 - ,resamples = data_folds - ,grid = 25 - ,control = grid_ctrl - ,verbose = TRUE - ) diff --git a/ML/2-modeling.R b/ML/2-modeling.R index 7838cad..f8540ed 100644 --- a/ML/2-modeling.R +++ b/ML/2-modeling.R @@ -1,3 +1,4 @@ +# Random Forests are the best models for both types finalize grid searchs rm(list = ls(all.names = TRUE)) # Clear the memory of variables from previous run. cat("\014") # Clear the console @@ -27,7 +28,8 @@ set.seed(070823) #set seed for reproducible research # load-data --------------------------------------------------------------- -model_data <- readr$read_rds(here("ML","data-unshared","model_data.RDS")) +model_data <- readr$read_rds(here("ML","data-unshared","model_data.RDS")) %>% + dplyr::select(-subject_id, -charttime) # split data -------------------------------------------------------------- @@ -45,52 +47,30 @@ ds_test <- rsample$testing(model_data_split) table(ds_train$ft4_dia) %>% prop.table() table(ds_test$ft4_dia) %>% prop.table() - -class_train <- ds_train %>% dplyr::select(-FT4) # training data for classification models -reg_train <- ds_train %>% dplyr::select(-ft4_dia) # training data for reg models predicting result - # random forest classification ----------------------------------------------------------- # base model - No Hyper Tuning -rf__base_model <- p$rand_forest() %>% - p$set_engine("ranger") %>% p$set_mode("classification") - -rf_recipe <- r$recipe(ft4_dia ~ . , data = class_train) %>% - r$update_role(subject_id, new_role = "id") %>% - r$update_role(charttime, new_role = "time") %>% +rf_recipe <- r$recipe(ft4_dia ~ . , data = ds_train) %>% + r$step_rm(FT4) %>% r$step_impute_bag(r$all_predictors()) - -rf_workflow <- wf$workflow() %>% - wf$add_model(rf__base_model) %>% - wf$add_recipe(rf_recipe) - -rf_base_fit <- p$fit(rf_workflow, class_train) - -rf_predict <- class_train %>% - dplyr::select(ft4_dia) %>% - dplyr::bind_cols( - predict(rf_base_fit, class_train) - ,predict(rf_base_fit, class_train, type = "prob") - ) - -conf_mat_rf <- ys$conf_mat(rf_predict, ft4_dia, .pred_class) - - - -rf_pred <- dplyr::select(class_train, -ft4_dia, -subject_id, -charttime) - rf_tuning_model <- p$rand_forest(trees = tune(), mtry = tune(), min_n = tune()) %>% p$set_engine("ranger") %>% p$set_mode("classification") + +rf_workflow <- wf$workflow() %>% + wf$add_model(rf_tuning_model) %>% + wf$add_recipe(rf_recipe) + + rf_param <- p$extract_parameter_set_dials(rf_tuning_model) -rf_param <- rf_param %>% update(mtry = d$finalize(d$mtry(), rf_pred)) +rf_param <- rf_param %>% update(mtry = d$finalize(d$mtry(), ds_train)) + +data_fold <- rsamp$vfold_cv(ds_train, v = 5) -data_fold <- rsamp$vfold_cv(class_train, v = 5) -rf_workflow <- wf$update_model(rf_workflow, rf_tuning_model) # takes around 1 hr to run grid search. saving best params manaually # rf_tune <- rf_workflow %>% @@ -105,82 +85,100 @@ rf_best_params <- tibble::tibble( ,min_n = 2 ) -final_rf_workflow <- rf_workflow %>% - tune::finalize_workflow(rf_best_params) - -final_rf_fit <- p$fit(final_rf_workflow, class_train) - -final_rf_predict <- class_train %>% - dplyr::select(ft4_dia) %>% - dplyr::bind_cols( - predict(final_rf_fit, class_train) - ,predict(final_rf_fit, class_train, type = "prob") +rf_best_params_screen <- + tibble::tibble( + mtry = 7 + ,trees = 763 + ,min_n = 15 ) +final_rf_workflow <- rf_workflow %>% + tune::finalize_workflow(rf_best_params_screen) + +# Final Fit training data + +final_rf_fit <- p$fit(final_rf_workflow, ds_train) + +final_rf_predict <- ds_train %>% + dplyr::select(ft4_dia) %>% + dplyr::bind_cols( + predict(final_rf_fit, ds_train) + ,predict(final_rf_fit, ds_train, type = "prob") + ) + +ys$accuracy(final_rf_predict,truth = ft4_dia, estimate = .pred_class ) + final_conf_rf <- ys$conf_mat(final_rf_predict, ft4_dia, .pred_class) +# fitting test data + +class_test_results <- + final_rf_fit %>% + tune::last_fit(split = model_data_split) + +class_test_result_conf_matrix <- ys$conf_mat( + class_test_results %>% tune::collect_predictions() + ,truth = ft4_dia + ,estimate = .pred_class + ) + + # random forest regression ------------------------------------------------ # -# reg_metrics <- ys$metric_set(ys$rmse, ys$rsq, ys$mae) -# -# rf_base_reg_model <- p$rand_forest() %>% -# p$set_engine("ranger") %>% p$set_mode("regression") -# -# rf_reg_recipe <- r$recipe(FT4 ~ . , data = reg_train) %>% -# r$update_role(subject_id, new_role = "id") %>% -# r$update_role(charttime, new_role = "time") %>% -# r$step_impute_bag(r$all_predictors()) -# -# -# rf_reg_workflow <- wf$workflow() %>% -# wf$add_model(rf_base_reg_model) %>% -# wf$add_recipe(rf_reg_recipe) -# -# rf_base_reg_fit <- p$fit(rf_reg_workflow, reg_train) -# -# rf_reg_predict <- reg_train %>% -# dplyr::select(FT4) %>% -# dplyr::bind_cols( -# predict(rf_base_reg_fit, reg_train) +reg_metrics <- ys$metric_set(ys$rmse, ys$rsq, ys$mae) + +rf_reg_tune_model <- p$rand_forest(trees = tune(), mtry = tune(), min_n = tune()) %>% + p$set_engine("ranger") %>% p$set_mode("regression") + +rf_reg_recipe <- r$recipe(FT4 ~ . , data = reg_train) %>% + r$step_rm(ft4_dia) %>% + r$step_impute_bag(r$all_predictors()) + + +rf_reg_workflow <- wf$workflow() %>% + wf$add_model(rf_reg_tune_model) %>% + wf$add_recipe(rf_reg_recipe) + + +rf_reg_param <- p$extract_parameter_set_dials(rf_reg_tune_model) %>% + update(mtry = d$finalize(d$mtry(), reg_train)) + +data_fold_reg <- rsamp$vfold_cv(reg_train, v = 5) + +# takes around 1 hr to run grid search. saving best params manaually +# rf_reg_tune <- rf_reg_workflow %>% +# tune::tune_grid( +# data_fold_reg +# ,grid = rf_reg_param %>% d$grid_regular() # ) + +rf_reg_best_params <- tibble::tibble( + mtry = 8 + ,trees = 1000 + ,min_n = 2 +) + +final_rf_reg_workflow <- rf_reg_workflow %>% + tune::finalize_workflow(rf_reg_best_params) + +final_rf_reg_fit <- p$fit(final_rf_reg_workflow, reg_train) + + # -# reg_metrics(rf_reg_predict, truth = FT4, estimate = .pred) -# -# rf_reg_tune_model <- p$rand_forest(trees = tune(), mtry = tune(), min_n = tune()) %>% -# p$set_engine("ranger") %>% p$set_mode("regression") -# -# rf_reg_pred <- dplyr::select(reg_train, -FT4, -subject_id, -charttime) -# -# rf_reg_param <- p$extract_parameter_set_dials(rf_reg_tune_model) %>% -# update(mtry = d$finalize(d$mtry(), rf_reg_pred)) -# -# data_fold_reg <- rsamp$vfold_cv(reg_train, v = 5) -# -# rf_reg_workflow <- wf$update_model(rf_reg_workflow, rf_reg_tune_model) -# -# # takes around 1 hr to run grid search. saving best params manaually -# # rf_reg_tune <- rf_reg_workflow %>% -# # tune::tune_grid( -# # data_fold_reg -# # ,grid = rf_reg_param %>% d$grid_regular() -# # ) -# -# rf_reg_best_params <- tibble::tibble( -# mtry = 8 -# ,trees = 1000 -# ,min_n = 2 -# ) -# -# final_rf_reg_workflow <- rf_reg_workflow %>% -# tune::finalize_workflow(rf_reg_best_params) -# -# final_rf_reg_fit <- p$fit(final_rf_reg_workflow, reg_train) -# -# final_rf_reg_predict <- reg_train %>% -# dplyr::select(FT4) %>% -# dplyr::bind_cols( -# predict(final_rf_reg_fit, reg_train) -# ) -# -# reg_metrics(final_rf_reg_predict, truth = FT4, estimate = .pred) +final_rf_reg_predict <- reg_train %>% + dplyr::select(FT4) %>% + dplyr::bind_cols( + predict(final_rf_reg_fit, reg_train) + ) + +reg_metrics(final_rf_reg_predict, truth = FT4, estimate = .pred) + + +reg_test_results <- + final_rf_reg_workflow %>% + tune::last_fit() + + + + diff --git a/ML/3_model_outputs.R b/ML/3_model_outputs.R index 678fe1c..08f9c78 100644 --- a/ML/3_model_outputs.R +++ b/ML/3_model_outputs.R @@ -30,6 +30,7 @@ set.seed(070823) #set seed for reproducible research # load-data --------------------------------------------------------------- screen_workflows_reg <- readr::read_rds(here("ML","outputs","workflowscreen_reg.rds")) +screen_workflows_class <- readr::read_rds(here("ML","outputs","workflowscreen_class.rds")) @@ -56,6 +57,32 @@ ggplot2::autoplot( ggplot2::scale_color_manual(values = rep("black", times = 5)) + ggplot2::theme(legend.position = "none") +class_results <- screen_workflows_class %>% + workflowsets::rank_results() + + +ggplot2::autoplot( + screen_workflows_class + ,rank_metric = "roc_auc" + ,metric = "roc_auc" + ,select_best = TRUE +) + + ggplot2::geom_text(ggplot2::aes(y = mean, label = wflow_id) + # ,angle = 90 + ,hjust = -0.2 + ) + + ggplot2::theme_bw() + + ggplot2::scale_color_manual(values = rep("black", times = 5)) + + ggplot2::theme(legend.position = "none") + + + +# best results ------------------------------------------------------------ + +best_class_result <- + screen_workflows_class %>% + workflowsets::extract_workflow_set_result("forests_RF") %>% + tune::select_best(metric = "accuracy")