Added information value table calculation and export. Improved "get_a…

…ll_metrics" function. Validation code became a little bit more automated.

funs_valid.R

@@ -1,13 +1,22 @@
 #### validation and visualisation automating functions
 
-get_all_metrics <- function(pred_dfs, spec = 1L) {
-  f <- function(df) metrics(df, Exited, .pred_class, .pred_No)
-  model1_metrics <- f(pred_dfs[[1]][[spec]])
+get_all_iv <- function(..., y_name = "Exited", pos = "No") {
+  ivs_list <- list(...) %>% map(~ iv(.x, y = y_name, positive = pos) %>% as_tibble)
 
-  all_metrics <- do.call(
-    function(...) bind_cols(model1_metrics, ...), 
-    pred_dfs %>% select(-1) %>% map(~ f(.x[[spec]])$.estimate)) %>%
-    rename(model_1 = .estimate) %>% 
+  ivs_list %>% 
+    reduce(~ full_join(.x, .y, by = ("variable"))) %>% 
+    `colnames<-`(c("Klasyfikator", str_c("Model ", 1:length(ivs)))) %>% 
+    return
+}
+
+get_all_metrics <- function(pred_dfs, spec = 1L, y_name = "Exited") {
+  metrics_list <- pred_dfs %>% 
+    map(~ .x[[1]]) %>%
+    map(~ metrics(.x, y_name, .pred_class, .pred_No) %>% select(-2))
+
+  metrics_list %>% 
+    reduce(~ full_join(.x, .y, by = (".metric"))) %>% 
+    `colnames<-`(c("Metryka", str_c("Model ", 1:length(metrics_list)))) %>% 
     return
 }
 

validation_rf.R

@@ -1,4 +1,4 @@
-#### walidation
+#### validation
 
 library(tidyverse)
 library(stringr)
@@ -7,43 +7,66 @@ library(ranger)
 library(vip)
 library(knitr)
 library(kableExtra)
+library(scorecard)
 
 rm(list = ls())
 
+source("funs_valid.R")
+
 fitted_models <- read_rds("data/fitted_models.RDS")
 pred_dfs <- read_rds("data/predictions.RDS")
+df_1 <- read_rds("data/split.RDS")$data
+df_2 <- read_rds("data/split_raw.RDS")$data
 
-source("funs_valid.R")
+##########
+
+all_iv <- get_all_iv(df_1, df_2)
+all_iv %>% kable("markdown")
+
+# all_iv %>% kable("html") %>% save_kable("figures/ivs.png")
 
 all_metrics <- get_all_metrics(pred_dfs)
-all_metrics %>%
-  dplyr::select(-2) %>% 
-  kable(format = "html") %>% 
-  save_kable("figures/metrics.png")
-
-pred_dfs[[1]][[1]] %>% 
-  exportable_conf_matrix %>% 
-  kable(format = "html") %>% 
-  save_kable("figures/conf_matrix1.png")
-
-pred_dfs[[2]][[1]] %>% 
-  exportable_conf_matrix %>% 
-  kable(format = "html") %>% 
-  save_kable("figures/conf_matrix2.png")
-
-roc_1 <- pred_dfs[[1]][[1]] %>% 
+all_metrics %>% kable("markdown")
+
+# all_metrics %>% kable("html") %>% save_kable("figures/metrics.png")
+
+##########
+
+## tu filtrujemy wybraną specyfikację
+
+preds <- pred_dfs %>% map(~ .x[[1]])
+
+##########
+
+conf_matrix_1 <- preds[[1]] %>% exportable_conf_matrix 
+conf_matrix_1 %>% kable("markdown")
+
+# conf_matrix_1 %>% kable("html") %>% save_kable("figures/conf_matrix1.png")
+
+conf_matrix_2 <- preds[[2]] %>% exportable_conf_matrix 
+conf_matrix_2 %>% kable("markdown")
+
+# conf_matrix_2 %>% kable("html") %>% save_kable("figures/conf_matrix2.png")
+
+roc_1 <- preds[[1]] %>% 
   roc_curve(Exited, .pred_No) %>% 
   autoplot()
 
-roc_2 <- pred_dfs[[2]][[1]] %>% 
+roc_2 <- preds[[1]] %>% 
   roc_curve(Exited, .pred_No) %>% 
   autoplot()
 
-ggsave("figures/roc_1.png", roc_1)
-ggsave("figures/roc_2.png", roc_2)
+roc_1
+roc_2
+
+# ggsave("figures/roc_1.png", roc_1)
+# ggsave("figures/roc_2.png", roc_2)
 
 vip_1 <- vip(fitted_models[[1]][[1]])
 vip_2 <- vip(fitted_models[[2]][[1]])
 
-ggsave("figures/vip_1.png", vip_1)
-ggsave("figures/vip_2.png", vip_2)
+vip_1
+vip_2
+
+# ggsave("figures/vip_1.png", vip_1)
+# ggsave("figures/vip_2.png", vip_2)