eval-performance.Rmd

---
title: "Evaluation of performances"
output: 
  workflowr::wflow_html:
    includes:
      in_header: header.html
editor_options:
  chunk_output_type: console
author: "Patrick Schratz"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(
  fig.retina = 3,
  fig.align = "center",
  fig.width = 6.93,
  fig.height = 6.13,
  out.width = "100%",
  echo = FALSE
)

R.utils::sourceDirectory("R")
library("drake")

# load drake objects
loadd(
  bm_aggregated_new_buffer2
)
library("xtable")
library("flextable")
library("ggbeeswarm")
library("ggsci")
library("ggrepel")
library("ggpubr")
library("here")
library("mlr")
library("dplyr")
library("forcats")
```

Last update: 

```{r}
date()
```

```{r}
df_perf <- getBMRPerformances(bm_aggregated_new_buffer2, as.df = T) %>%
  mutate(task.id = recode_factor(task.id,
    `hr_buffer2` = "HR",
    `vi_buffer2` = "VI",
    `nri_buffer2` = "NRI",
    `nri_vi_buffer2` = "NRI_VI",
    `hr_nri_buffer2` = "HR-NRI",
    `hr_vi_buffer2` = "HR-VI",
    `hr_nri_vi_buffer2` = "HR-NRI-VI",
  )) %>%
  tidyr::separate(learner.id, c("learner_group", "filter"),
    remove = FALSE,
    sep = " MBO "
  )
```

Aggregate performances and add standard error column.

```{r aggr-perf}
df_perf %<>%
  group_by(task.id, learner.id, filter) %>%
  mutate(rmse_aggr = round(mean(rmse), 3)) %>%
  mutate(se = round(sd(rmse), 3)) %>%
  select(-rmse, iter) %>%
  ungroup()
```

## (Table) T1 All leaner/filter/task combinations ordered by performance.

Overall leaderboard across all settings, sorted descending by performance.

```{r eval-performance-1, warning=FALSE}
table1 <- df_perf %>%
  group_by(learner.id, task.id, filter) %>%
  slice(which.min(rmse_aggr)) %>%
  dplyr::rename(
    "Model" = learner_group,
    "Learner ID" = learner.id,
    "Task" = task.id,
    "Filter" = filter,
    "RMSE" = rmse_aggr,
    "SE" = se,
  ) %>%
  ungroup() %>%
  mutate(Filter = replace(Filter, is.na(Filter), "No Filter")) %>%
  select(-iter, -`Learner ID`) %>%
  arrange(RMSE)

# save as latex table
table1 %>%
  ungroup() %>%
  arrange(RMSE) %>%
  slice(1:15) %>%
  xtable(
    type = "latex",
    caption = "Top 15 results for any task/learner/filter combination, sorted by performance.",
    label = "tab:perf-top-15"
  ) %>%
  print(
    file = here("docs/00-manuscripts/ieee/performance-top-20.tex"),
    include.rownames = TRUE,
    latex.environments = c("center"),
    table.placement = "ht!",
    caption.placement = "top",
    timestamp = NULL
  )

saveRDS(table1, here("docs/00-manuscripts/presentation/table-perf.rda"))

table1 %>%
  flextable() %>%
  autofit()
```

## (Table) T2 Best learner/filter/task combination

Learners: On which task and using which filter did every learner score their best result on?

*CV: L2 penalized regression using the internal 10-fold CV tuning of the `glmnet` package

*MBO: L2 penalized regression using using MBO for hyperparameter optimization.

```{r eval-performance-2, warning=FALSE}
table2 <- df_perf %>%
  group_by(learner_group) %>%
  slice(which.min(rmse_aggr)) %>%
  mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
  arrange(rmse_aggr) %>%
  dplyr::rename(
    "Model" = learner_group,
    "Learner ID" = learner.id,
    "Task" = task.id,
    "Filter" = filter,
    "RMSE" = rmse_aggr,
    "SE" = se,
  ) %>%
  select(-iter) %>%
  select(-`Learner ID`)

# save as latex table
table2 %>%
  xtable(
    type = "latex",
    caption = "Best performance of each learner across any task and filter method.",
    label = "tab:best-learner-perf"
  ) %>%
  print(
    file = here("docs/00-manuscripts/ieee/performance-best-per-learner.tex"),
    include.rownames = TRUE,
    latex.environments = c("center"),
    table.placement = "ht!",
    scalebox = 0.90,
    caption.placement = "top",
    timestamp = NULL
  )

saveRDS(table2, here("docs/00-manuscripts/presentation/table-best-learner-per-task.rda"))

table2 %>%
  flextable() %>%
  autofit()
```

## (Plot) P1 Best learner/filter combs for all tasks

```{r performance-results, warning=FALSE, dev = c("png", "pdf")}
results_aggr <- df_perf %>%
  mutate(filter = replace(filter, is.na(filter), "NF")) %>%
  mutate(learner_group = recode_factor(learner_group, `XG` = "XGBOOST")) %>%
  group_by(learner_group, filter, task.id) %>%
  ### get the best performance per learner and task
  # this group_by() & slice() approach is better than summarise() because we can
  # keep additional columns
  # in constrast to summarise which only keeps the grouping columns and the
  # summarised one
  slice(which.min(rmse_aggr)) %>% # this groups the CV iters
  ungroup() %>%
  group_by(task.id, learner_group) %>%
  slice(which.min(rmse_aggr))

results_aggr %>%
  ggplot(aes(x = rmse_aggr, y = task.id)) +
  # geom_jitter(aes(color = learner_group), size = 2, width = 0, height = 0.3) +
  # geom_dotplot(aes(fill = learner_group), binaxis="y",
  #                        stackdir="up") +
  geom_beeswarm(groupOnX = FALSE, aes(color = learner_group), size = 3) +
  scale_color_nejm(breaks = sort(levels(results_aggr$learner_group))) +
  labs(x = "RMSE", y = "Task", color = "Learner") +
  guides(size = FALSE) +
  scale_x_continuous(limits = c(27, 47)) +
  geom_label_repel(
    # subset data to remove out of bounds values
    data = results_aggr[results_aggr$rmse_aggr < 100, ],
    # from ggbeeswarm, avoid overlapping of points by labels
    position = position_quasirandom(),
    aes(label = paste0(filter, ",", round(rmse_aggr, 2))),
    size = 2.8,
    min.segment.length = 0.1,
    seed = 123,
    point.padding = 0.5
  ) +
  theme_pubr() +
  theme(
    panel.grid.major.y = element_line(size = 0.1, linetype = "dashed"),
    axis.title.y = element_blank(),
    legend.text = element_text(size = 12),
    legend.title = element_text(size = 12),
    axis.text.y = element_text(angle = 45),
    plot.margin = unit(c(6, 6, 6, 0), "pt")
  )
```

## (Plot) P2 Best filter combination of each learner vs. no filter per task vs. Borda

**DEPRECATED**: Please see the scatterplots below for a better visulization

Showing the final effect of applying feature selection to a learner for each task.
The more left a certain filter appears for a given task compared to the purple dot (No Filter), the higher the effectivity of applying feature selection for that given learner on the given task.

```{r filter-effect-best-vs-no-filter, warning=FALSE, dev = c("png", "pdf")}
# we rbind two filtered data.frames
# doing the filtering in one step is (at least) complicated here

best_filter <- df_perf %>%
  mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
  dplyr::filter(filter != "No Filter") %>%
  group_by(learner_group, task.id) %>%
  dplyr::filter(learner_group == "SVM" | learner_group == "RF" | learner_group == "XGBoost") %>%
  slice(which.min(rmse_aggr))

best_no_filter <- df_perf %>%
  mutate(task.id = recode_factor(task.id,
    `hr` = "HR",
    `vi` = "VI",
    `nri` = "NRI",
    `nri_vi` = "NRI_VI",
    `hr_nri` = "HR-NRI",
    `hr_vi` = "HR-VI",
    `hr_nri_vi` = "HR-NRI-VI",
  )) %>%
  tidyr::separate(learner.id, c("learner_group", "filter"),
    remove = FALSE,
    sep = " MBO "
  ) %>%
  mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
  dplyr::filter(filter == "No Filter") %>%
  group_by(learner_group, task.id) %>%
  dplyr::filter(learner_group == "SVM" | learner_group == "RF" | learner_group == "XGBoost") %>%
  slice(which.min(rmse_aggr))

comb <- bind_rows(best_filter, best_no_filter)

comb %>%
  ggplot(aes(x = rmse_aggr, y = learner_group)) +
  geom_beeswarm(groupOnX = FALSE, aes(color = filter), size = 3) +
  facet_wrap(~task.id) +
  # scale_color_nejm() +
  labs(x = "RMSE", y = "Task", color = "Filter") +
  guides(size = FALSE) +
  scale_x_continuous(limits = c(27, 47)) +
  theme_pubr() +
  theme(
    panel.grid.major.y = element_line(size = 0.1, linetype = "dashed"),
    axis.title.y = element_blank(),
    axis.text.y = element_text(angle = 45),
    legend.text = element_text(size = 12),
    legend.title = element_text(size = 12),
    plot.margin = unit(c(6, 6, 6, 0), "pt")
  )
```

## (Plot) P3 Best filter combination of each learner vs. Borda filter

Showing the final effect of the ensemble Borda filter vs the best scoring simple filter.

```{r filter-effect-ensemble, warning=FALSE}
# we rbind two filtered data.frames
# doing the filtering in one step is (at least) complicated here

best_filter <- df_perf %>%
  mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
  dplyr::filter(filter != "No Filter") %>%
  group_by(learner_group, task.id) %>%
  dplyr::filter(learner_group == "SVM" | learner_group == "RF" | learner_group == "XGBoost") %>%
  slice(which.min(rmse_aggr))

borda <- df_perf %>%
  mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
  dplyr::filter(filter == "Borda") %>%
  group_by(learner_group, task.id) %>%
  dplyr::filter(learner_group == "SVM" | learner_group == "RF" | learner_group == "XGBoost") %>%
  slice(which.min(rmse_aggr))

comb_borda <- bind_rows(best_filter, borda)

comb_borda %>%
  ggplot(aes(x = rmse_aggr, y = learner_group)) +
  geom_beeswarm(groupOnX = FALSE, aes(color = filter), size = 3) +
  facet_wrap(~task.id) +
  scale_color_nejm() +
  labs(x = "RMSE", y = "Task", color = "Filter") +
  guides(size = FALSE) +
  scale_x_continuous(limits = c(27, 47)) +
  theme_pubr() +
  theme(
    panel.grid.major.y = element_line(size = 0.1, linetype = "dashed"),
    axis.title.y = element_blank(),
    axis.text.y = element_text(angle = 45),
    legend.text = element_text(size = 12),
    legend.title = element_text(size = 12),
    plot.margin = unit(c(6, 6, 6, 0), "pt")
  )
```

## (Plot) P4 Performances of all filter methods

```{r filter-perf-all, warning=FALSE, dev = c("png", "pdf")}
# perf_all_filters <- df_perf %>%
#   mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
#   dplyr::filter(filter != "No Filter") %>%
#   group_by(learner_group, task.id) %>%
#   dplyr::filter(learner_group == "SVM" | learner_group == "RF" | learner_group == "XGBoost") %>%
#   slice(which.min(rmse_aggr))
#   summarise(perf = mean(rmse_aggr), filter = as.character(filter))
#
# perf_all_filters %>%
#   ggplot(aes(x = rmse_aggr, y = learner_group)) +
#   geom_beeswarm(groupOnX = FALSE, aes(color = filter), size = 2) +
#   facet_wrap(~task.id) +
#   scale_color_nejm() +
#   labs(x = "RMSE", y = "Task", color = "Filter") +
#   guides(size = FALSE) +
#   scale_x_continuous(limits = c(30, 45)) +
#   theme_pubr() +
#   theme(
#     panel.grid.major.y = element_line(size = 0.1, linetype = "dashed"),
#     axis.title.y = element_blank(),
#     axis.text.y = element_text(angle = 45),
#     legend.text = element_text(size = 12),
#     legend.title = element_text(size = 12),
#     plot.margin = unit(c(6, 6, 6, 0), "pt")
#   )
```

## (Plot) P5 Scatterplots of filter methods vs. no filter for each learner and task

Showing the final effect of applying feature selection to a learner for each task.
All filters are colored in the same way whereas using "no filter" appears in a different color.

```{r filter-effect-all-vs-no-filter, warning=FALSE, dev = c("png", "pdf")}
results_aggr1 <- df_perf %>%
  filter(learner_group != "Ridge-CV") %>%
  filter(learner_group != "Lasso-CV") %>%
  # mutate(filter = replace(filter, "No Filter", "NF")) %>%
  mutate(learner_group = as.factor(learner_group)) %>%
  mutate(learner_group = recode(learner_group, `XGBoost` = "XG")) %>%
  mutate(filter = recode(filter, `No Filter` = "NF")) %>%
  mutate(learner_group = fct_rev(learner_group)) %>%
  group_by(learner_group, task.id, filter) %>%
  # we actually took the mean already in chunk 'aggr-perf'. This is only to get
  # summarise() working
  summarise(perf = mean(rmse_aggr))

results_aggr1 %>%
  ggplot(aes(x = perf, y = learner_group)) +
  geom_beeswarm(
    data = results_aggr1[results_aggr1$filter != "NF", ], size = 1.1, shape = 3,
    groupOnX = FALSE, aes(color = "Filter")
  ) +
  geom_point(
    data = results_aggr1[results_aggr1$filter == "NF", ],
    size = 2, shape = 19, aes(color = "No Filter")
  ) +
  facet_wrap(~task.id) +
  scale_color_nejm(guide = guide_legend(override.aes = list(shape = c(3, 19)))) +
  labs(x = "RMSE", y = "Task", colour = NULL) +
  guides(size = FALSE) +
  scale_x_continuous(limits = c(27, 51)) +
  theme_pubr() +
  theme(
    panel.grid.major.y = element_line(size = 0.1, linetype = "dashed"),
    axis.title.y = element_blank(),
    legend.text = element_text(size = 12),
    legend.title = element_text(size = 12),
  )
```

## (Plot) P6 Scatterplots of filter methods vs. Borda for each learner and task

Showing the final effect of applying feature selection to a learner for each task.
All filters are summarized into a a single color whereas the "Borda" filter appears in its own color.

```{r filter-effect-all-vs-borda-filter, warning=FALSE, dev = c("png", "pdf")}
results_aggr2 <- df_perf %>%
  na.omit() %>%
  filter(learner_group != "Ridge-CV") %>%
  filter(learner_group != "Lasso-CV") %>%
  mutate(learner_group = recode_factor(learner_group, `XGBoost` = "XG")) %>%
  group_by(learner_group, task.id, filter) %>%
  # we actually took the mean already in chunk 'aggr-perf'. This is only to get
  # summarise() working
  summarise(perf = mean(rmse_aggr)) %>%
  ungroup()

results_aggr2 %>%
  ggplot(aes(x = perf, y = fct_reorder(learner_group, -perf))) +
  geom_beeswarm(
    data = results_aggr2[results_aggr2$filter != "Borda", ],
    shape = 3, size = 1.1, aes(color = "Filter"),
    groupOnX = FALSE
  ) +
  geom_point(
    data = results_aggr2[results_aggr2$filter == "Borda", ],
    shape = 19, size = 2, aes(color = "Borda Filter")
  ) +
  facet_wrap(~task.id) +
  scale_color_manual(
    guide = guide_legend(override.aes = list(shape = c(19, 3))),
    values = c(
      "Filter" = "#BC3C29FF",
      "Borda Filter" = "#0072B5FF"
    )
  ) +
  labs(x = "RMSE", y = "Task", colour = NULL) +
  guides(size = FALSE) +
  scale_x_continuous(limits = c(27, 51)) +
  theme_pubr() +
  theme(
    panel.grid.major.y = element_line(size = 0.1, linetype = "dashed"),
    axis.title.y = element_blank(),
    legend.text = element_text(size = 12),
    legend.title = element_text(size = 12),
  )
```