BerriJ/PHD-Presentation
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add mcrps results html table

Browse Source
This commit is contained in:
Jonathan Berrisch
2025-05-19 22:38:26 +02:00
parent 00ce3d9dd9
commit 751337eb5c
1 changed files with 137 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

143
25_07_phd_defense/index.qmd
View File

@@ -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(
"&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}