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

# load drake objects
drake::loadd(
  bm_aggregated
)
library("mlr")
library("magrittr")
library("dplyr")
library("ggplot2")
library("ggrepel")
library("ggsci")
library("ggpubr")
library("ggbeeswarm")
library("flextable")
library("xtable")
```

```{r}
df_simple = getBMRAggrPerformances(bm_aggregated, as.df = TRUE) %>%
  mutate(task.id = recode_factor(task.id,
    `defoliation-all-plots-HR` = "HR",
    `defoliation-all-plots-VI` = "VI",
    `defoliation-all-plots-NRI` = "NRI",
    `defoliation-all-plots-HR-NRI` = "HR-NRI",
    `defoliation-all-plots-HR-VI` = "HR-VI",
    `defoliation-all-plots-HR-NRI-VI` = "HR-NRI-VI",
  )) %>%
    tidyr::separate(learner.id, c("learner_group", "filter"),
    remove = FALSE,
    sep = " "
  )
```


## (Table) 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_simple %>%
  group_by(learner_group, task.id, filter) %>%
  summarise(best = min(rmse.test.rmse)) %>%
  dplyr::rename(
    "Learner Group" = learner_group,
    "Task" = task.id,
    "Filter" = filter,
    "RMSE" = best
  ) %>%
  mutate(Filter = replace(Filter, is.na(Filter), "No Filter")) %>%
  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 = "code/98-paper/ieee/performance-top-20.tex",
    include.rownames = TRUE,
    latex.environments = c("center"),
    table.placement = "ht!",
    caption.placement = "top",
    timestamp = NULL
  )

table1 %>%
  flextable()
```

## (Table) 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 <- getBMRAggrPerformances(bm_aggregated, as.df = TRUE) %>%
  tidyr::separate(learner.id, c("learner_group", "filter"),
    remove = FALSE,
    sep = " "
  ) %>%
  group_by(learner_group) %>%
  slice(which.min(rmse.test.rmse)) %>%
  mutate(filter = replace(filter, is.na(filter), "No Filter")) %>%
  arrange(rmse.test.rmse) %>%
  dplyr::rename(
    "Learner Group" = learner_group,
    "Learner ID" = learner.id,
    "Task" = task.id,
    "Filter" = filter,
    "RMSE" = rmse.test.rmse
  ) %>%
  select(-6) %>%
  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 = "code/98-paper/ieee/performance-best-per-learner.tex",
    include.rownames = TRUE,
    latex.environments = c("center"),
    table.placement = "ht!",
    scalebox = 0.90,
    caption.placement = "top",
    timestamp = NULL
  )

table2 %>%
  flextable()
```

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

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

results_aggr %>%
  ggplot(aes(x = rmse.test.rmse, 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(30, 70)) +
  geom_label_repel(
    # subset data to remove out of bounds values
    data = results_aggr[results_aggr$rmse.test.rmse < 100, ],
    # from ggbeeswarm, avoid overlapping of points by labels
    position = position_quasirandom(),
    aes(label = paste(filter, ",", round(rmse.test.rmse, 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) Best filter combination of each learner vs. no filter per task vs. Borda

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, 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_simple %>%
  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.test.rmse))

best_no_filter <- getBMRAggrPerformances(bm_aggregated, as.df = TRUE) %>%
  mutate(task.id = recode_factor(task.id,
    `defoliation-all-plots-HR` = "HR",
    `defoliation-all-plots-VI` = "VI",
    `defoliation-all-plots-NRI` = "NRI",
    `defoliation-all-plots-HR-NRI` = "HR-NRI",
    `defoliation-all-plots-HR-VI` = "HR-VI",
    `defoliation-all-plots-HR-NRI-VI` = "HR-NRI-VI",
  )) %>%
  tidyr::separate(learner.id, c("learner_group", "filter"),
    remove = FALSE,
    sep = " "
  ) %>%
  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.test.rmse))

comb <- bind_rows(best_filter, best_no_filter)

comb %>%
  ggplot(aes(x = rmse.test.rmse, 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(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) 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_simple %>%
  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.test.rmse))

borda <- df_simple %>%
  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.test.rmse))

comb_borda <- bind_rows(best_filter, borda)

comb_borda %>%
  ggplot(aes(x = rmse.test.rmse, 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(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) Performances of all filter methods

```{r filter-perf-all, warning=FALSE, dev = c("png", "pdf")}

perf_all_filters <- df_simple %>%
  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")

perf_all_filters %>%
  ggplot(aes(x = rmse.test.rmse, 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")
  )
```