From 751337eb5c3d57b1a86089ba41ce534760e52f26 Mon Sep 17 00:00:00 2001 From: Jonathan Berrisch Date: Mon, 19 May 2025 22:38:26 +0200 Subject: [PATCH] Add mcrps results html table --- 25_07_phd_defense/index.qmd | 143 ++++++++++++++++++++++++++++++++++-- 1 file changed, 137 insertions(+), 6 deletions(-) diff --git a/25_07_phd_defense/index.qmd b/25_07_phd_defense/index.qmd index 590b12c..80199c6 100644 --- a/25_07_phd_defense/index.qmd +++ b/25_07_phd_defense/index.qmd @@ -1236,9 +1236,9 @@ for (i.p in 1:MO) { table_out <- kbl(table, align = rep("c", ncol(table))) -for (cols in 1:ncol(table)) { +for (j in 1:ncol(table)) { table_out <- table_out %>% - column_spec(cols, background = table_col[, cols]) + column_spec(j, background = table_col[, j]) } table_out %>% kable_material() @@ -1274,10 +1274,10 @@ for (i.p in 1:MO) { table_out2 <- kableExtra::kbl(table2, align = rep("c", ncol(table2))) -for (cols in 1:ncol(table2)) { +for (j in 1:ncol(table2)) { table_out2 <- table_out2 %>% - column_spec(1 + cols, - background = table_col2[, cols] + column_spec(1 + j, + background = table_col2[, j] ) } @@ -1838,12 +1838,143 @@ knitr::include_graphics("assets/mcrps_learning/smooth_best.svg") :::: -## Results +## Results Orig ```{r, fig.align="center", echo=FALSE, out.width = "400"} knitr::include_graphics("assets/mcrps_learning/tab_performance_sa.svg") ``` +## Results HTML + +```{r, fig.align="center", echo=FALSE} +load("assets/mcrps_learning/naive_table_df.rds") + +table_naive <- naive_table_df %>% + as_tibble() %>% + head(1) %>% + mutate_all(round, 4) %>% + mutate_all(sprintf, fmt = "%#.3f") %>% + kbl( + bootstrap_options = "condensed", + escape = FALSE, + format = "html", + booktabs = TRUE, + align = c("c", rep("c", ncol(naive_table_df) - 1)) + ) %>% + kable_paper(full_width = TRUE) %>% + kable_styling(font_size = 16) + + +for (i in 1:ncol(naive_table_df)) { + table_naive <- table_naive %>% + column_spec(i, + background = ifelse( + is.na(naive_table_df["stat", i, drop = TRUE][-ncol(naive_table_df)]), + cols[5, "grey"], + col_scale2( + naive_table_df["stat", i, drop = TRUE][-ncol(naive_table_df)], + rng_t + ) + ), + bold = i == which.min(naive_table_df["loss", ]) + ) +} + +table_naive + +load("assets/mcrps_learning/performance_data.rds") +i <- 1 +j <- 1 +for (j in 1:3) { + for (i in seq_len(nrow(performance_loss_tibble))) { + if (loss_and_dm[i, j, "p.val"] < 0.001) { + performance_loss_tibble[i, 2 + j] <- paste0( + "    ", + performance_loss_tibble[i, 2 + j], + "\\(^{***}\\)" + ) + } else if (loss_and_dm[i, j, "p.val"] < 0.01) { + performance_loss_tibble[i, 2 + j] <- paste0( + "    ", + performance_loss_tibble[i, 2 + j], "\\(^{**}\\)" + ) + } else if (loss_and_dm[i, j, "p.val"] < 0.05) { + performance_loss_tibble[i, 2 + j] <- paste0( + "    ", + performance_loss_tibble[i, 2 + j], "\\(^{*}\\)" + ) + } else if (loss_and_dm[i, j, "p.val"] < 0.1) { + performance_loss_tibble[i, 2 + j] <- paste0( + "    ", + performance_loss_tibble[i, 2 + j], "\\({.}\\)" + ) + } else { + performance_loss_tibble[i, 2 + j] <- paste0( + "    ", + performance_loss_tibble[i, 2 + j], " " + ) + } + } +} + +table_performance <- performance_loss_tibble %>% + kbl( + col.names = c( + 'Description', + 'Parameter Tuning', + '   BOA', + '   ML-Poly', + '   EWA' + ), + bootstrap_options = "condensed", + # Dont replace any string, dataframe has to be valid latex code ... + escape = FALSE, + format = "html", + align = c(rep("l", ncol(performance_loss_tibble))) + ) %>% + kable_paper(full_width = TRUE) %>% + row_spec(1:nrow(performance_loss_tibble), monospace = TRUE) + +# %% + +for (i in 3:ncol(performance_loss_tibble)) { + bold_cells <- rep(FALSE, times = nrow(performance_loss_tibble)) + + loss <- loss_and_dm[, i - 2, "loss"] + + table_performance <- table_performance %>% + column_spec(i, + background = c( + col_scale2( + loss_and_dm[, i - 2, "stat"], + rng_t + ) + ), + bold = loss == min(loss), + ) +} + +col_note_html <- '< -5 -4 -3 -2 -1 0 1 2 3 4 > 5' + +signif <- ". p < 0.1; * p < 0.05; ** p < 0.01; *** p < 0.001;" + +table_performance %>% + footnote( + general = c( + "Coloring w.r.t. test statistic: ", + col_note_html, + signif + ), + general_title = "", + fixed_small_size = TRUE, + escape = FALSE + ) %>% + kable_styling(font_size = 16) |> + row_spec(0, extra_css = "text-align: center") +``` + + + ## Results ```{r, warning=FALSE, fig.align="center", echo=FALSE, fig.width=12, fig.height=6}