Create 2-modeling-class.R

ML/2-modeling-class.R

@@ -0,0 +1,174 @@
+# The following script is for training and testing Classification models
+rm(list = ls(all.names = TRUE)) # Clear the memory of variables from previous run.
+cat("\014") # Clear the console
+
+
+# load packages -----------------------------------------------------------
+
+box::use(
+  magrittr[`%>%`]
+  ,here[here]
+  ,readr
+  ,gp2 = ggplot2[ggplot, aes]
+  ,rsample
+  ,r = recipes
+  ,wf = workflows
+  ,p = parsnip[tune]
+  ,ys = yardstick
+  ,d = dials
+  ,rsamp = rsample
+  ,tune
+)
+
+
+
+# globals -----------------------------------------------------------------
+
+set.seed(070823) #set seed for reproducible research
+
+
+# load-data ---------------------------------------------------------------
+
+model_data <- readr$read_rds(here("ML","data-unshared","model_data.RDS")) %>%
+  dplyr::select(-subject_id, -charttime)
+
+
+# split data --------------------------------------------------------------
+
+model_data_split <- rsample$initial_split(
+  model_data
+  ,prop   = 0.80
+  ,strata = ft4_dia
+)
+
+ds_train <- rsample$training(model_data_split)
+ds_test  <- rsample$testing(model_data_split)
+
+# verify distribution of data
+table(ds_train$ft4_dia) %>% prop.table()
+table(ds_test$ft4_dia) %>% prop.table()
+
+
+ds_train <- ds_train %>% dplyr::select(-FT4)
+ds_test  <- ds_test %>% dplyr::select(-FT4)
+
+data_folds <- rsamp$vfold_cv(ds_train, repeats = 5)
+
+
+
+# recipes ------------------------------------------------------------------
+
+
+# Neural Net, KNN
+normalized_rec <- recipes::recipe(ft4_dia ~ ., data = ds_train) %>%
+  recipes::step_impute_bag(recipes::all_predictors()) %>%
+  # recipes::step_corr(recipes::all_numeric_predictors()) %>%
+  recipes::step_normalize(recipes::all_numeric_predictors() , -anchor_age) %>%
+  recipes::step_dummy(gender)
+
+
+# Random Forest and Boasted Tree
+rf_rec <- recipes::recipe(ft4_dia ~ . , data = ds_train) %>%
+  recipes::step_impute_bag(recipes::all_predictors())
+
+boost_rec <- recipes::recipe(ft4_dia ~ . , data = ds_train) %>%
+  recipes::step_impute_bag(recipes::all_predictors()) %>%
+  recipes::step_dummy(gender)
+
+
+# models ------------------------------------------------------------------
+
+
+nnet_spec <-
+  p$mlp(hidden_units = tune(), penalty = tune(), epochs = tune()) %>%
+  p$set_engine("nnet", MaxNWts = 2600) %>%
+  p$set_mode("classification")
+
+
+knn_spec <-
+  p$nearest_neighbor(neighbors = tune(), dist_power = tune(), weight_func = tune()) %>%
+  p$set_engine("kknn") %>%
+  p$set_mode("classification")
+
+
+rf_spec <-
+  p$rand_forest(mtry = tune(), min_n = tune(), trees = tune()) %>%
+  p$set_engine("ranger") %>%
+  p$set_mode("classification")
+
+
+xgb_spec <-
+  p$boost_tree(tree_depth = tune(), learn_rate = tune(), loss_reduction = tune(),
+               min_n = tune(), sample_size = tune(), trees = tune()) %>%
+  p$set_engine("xgboost") %>%
+  p$set_mode("classification")
+
+
+svm_r_spec <-
+  p$svm_rbf(cost = tune(), rbf_sigma = tune()) %>%
+  p$set_engine("kernlab") %>%
+  p$set_mode("classification")
+
+svm_p_spec <-
+  p$svm_poly(cost = tune(), degree = tune()) %>%
+  p$set_engine("kernlab") %>%
+  p$set_mode("classification")
+
+
+
+nnet_param <-
+  nnet_spec %>%
+  tune$extract_parameter_set_dials() %>%
+  update(hidden_units = d$hidden_units(c(1, 27)))
+
+
+rf_param <-
+  rf_spec %>%
+  tune$extract_parameter_set_dials() %>%
+  d$finalize(ds_train)
+
+
+
+
+# workflows ---------------------------------------------------------------
+
+normalized <-
+  workflowsets::workflow_set(
+    preproc = list(normalized = normalized_rec),
+    models = list(
+      SVM_radial = svm_r_spec,
+      # SVM_poly = svm_p_spec,
+      KNN = knn_spec,
+      neural_network = nnet_spec)
+  ) %>%
+  workflowsets::option_add(param_info = nnet_param, id = "normalized_neural_network")
+
+forest <-
+  workflowsets::workflow_set(
+    preproc = list(forests = rf_rec),
+    models = list(RF = rf_spec)
+  ) %>%
+  workflowsets::option_add(param_info = rf_param, id = "forests_RF")
+
+boost <-
+  workflowsets::workflow_set(
+    preproc = list(boost = boost_rec),
+    models = list(boosting = xgb_spec)
+  )
+
+all_workflows <-
+  dplyr::bind_rows(normalized, forest, boost) %>%
+  dplyr::mutate(wflow_id = gsub("(forest_)|(normalized_)|(boost_)", "", wflow_id))
+
+
+
+# workflow screening ------------------------------------------------------
+num_cores <- parallel::detectCores() - 2
+doParallel::registerDoParallel(cores = num_cores)
+
+screen_workflows <- all_workflows %>%
+  workflowsets::workflow_map(
+    resamples = data_folds,
+    verbose = TRUE
+  )
+