Add mcrps results html table

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,
+    column_spec(1 + j,
-      background = table_col2[, cols]
+      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(
+        "&nbsp;&nbsp;&nbsp;&nbsp;",
+        performance_loss_tibble[i, 2 + j], 
+        "\\(^{***}\\)"
+      )
+    } else if (loss_and_dm[i, j, "p.val"] < 0.01) {
+      performance_loss_tibble[i, 2 + j] <- paste0(
+        "&nbsp;&nbsp;&nbsp;&nbsp;",
+        performance_loss_tibble[i, 2 + j], "\\(^{**}\\)"
+      )
+    } else if (loss_and_dm[i, j, "p.val"] < 0.05) {
+      performance_loss_tibble[i, 2 + j] <- paste0(
+        "&nbsp;&nbsp;&nbsp;&nbsp;",
+        performance_loss_tibble[i, 2 + j], "\\(^{*}\\)"
+      )
+    } else if (loss_and_dm[i, j, "p.val"] < 0.1) {
+      performance_loss_tibble[i, 2 + j] <- paste0(
+        "&nbsp;&nbsp;&nbsp;&nbsp;",
+        performance_loss_tibble[i, 2 + j], "\\({.}\\)"
+      )
+    } else {
+      performance_loss_tibble[i, 2 + j] <- paste0(
+        "&nbsp;&nbsp;&nbsp;&nbsp;",
+        performance_loss_tibble[i, 2 + j], "&emsp;"
+      )
+    }
+  }
+}
+
+table_performance <- performance_loss_tibble %>%
+  kbl(
+    col.names = c(
+          'Description',
+          'Parameter Tuning', 	
+          '&emsp;&emsp;&emsp;BOA', 	
+          '&emsp;&emsp;&nbsp;ML-Poly', 	
+          '&emsp;&emsp;&emsp;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 <- '<span style="background-color: #66BA6A; padding: 2px 6px;">&lt;&nbsp;-5</span> <span style="background-color: #7CC168; padding: 2px 6px;">-4</span> <span style="background-color: #91C866; padding: 2px 6px;">-3</span> <span style="background-color: #B0D363; padding: 2px 6px;">-2</span> <span style="background-color: #D8E05E; padding: 2px 6px;">-1</span> <span style="background-color: #FFED58; padding: 2px 6px;">0</span> <span style="background-color: #FFD145; padding: 2px 6px;">1</span> <span style="background-color: #FFB531; padding: 2px 6px;">2</span> <span style="background-color: #FC9733; padding: 2px 6px;">3</span> <span style="background-color: #F67744; padding: 2px 6px;">4</span> <span style="background-color: #EE5250; padding: 2px 6px;">&gt;&nbsp;5</span>'
+
+signif <- "<span>.</span> p &lt; 0.1; <span>*</span> p &lt; 0.05; <span>**</span> p &lt; 0.01; <span>***</span> p &lt; 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}