analysis : model_selection table and time

This commit is contained in:
Louis Lacoste 2024-06-26 17:16:06 +02:00
parent 54c351d084
commit ae8560aebc
2 changed files with 133 additions and 0 deletions

View file

@ -0,0 +1,101 @@
---
title: Model selection analysis
author: Louis Lacoste
filters:
- parse-latex.lua
header-includes:
- \usepackage{booktabs}
- \usepackage{longtable}
execute:
warning: false
echo: false
---
```{r setup}
options(xtable.comment=FALSE)
```
```{r libraries}
library(here)
library(dplyr)
library(tidyr)
library(ggplot2)
```
```{r import data}
data_folder <- here("code", "results", "simulations", "model_selection")
file_list <- file.info(file.path(data_folder, list.files(data_folder)))
# Tri par date de création
file_list <- file_list %>% arrange(ctime)
file_list[["filepath"]] <- rownames(file_list)
data_file <- file_list[["filepath"]][1]
data <- readRDS(data_file)
data[["preferred_model"]] <- factor(data[["preferred_model"]], levels = c("sep", "iid", "pi", "rho", "pirho"))
latex_ready_data <- data %>% select(epsilon_pi, epsilon_rho, preferred_model)
names(latex_ready_data) <- c("$\\epsilon_{\\pi}$", "$\\epsilon_{\\rho}$", "preferred model")
```
```{r temps_calcul}
time_data <- data %>%
group_by(epsilon_pi, epsilon_rho) %>%
select(-(pi2.1:preferred_model)) %>%
mutate(elapsed_secs = as.numeric(elapsed_secs))
ggplot(time_data) +
aes(
x = as.factor(epsilon_rho),
y = elapsed_secs, color = as.factor(epsilon_pi)
) +
geom_boxplot()
ggplot(time_data) +
aes(
x = as.factor(epsilon_pi),
y = elapsed_secs, color = as.factor(epsilon_rho)
) +
geom_boxplot()
```
Ainsi les temps de calculs ne semblent pas augmenter de beaucoup avec des
modèles aux proportions plus éloignées.
```{r}
bloc_recov_data <- data %>%
group_by(epsilon_pi, epsilon_rho) %>%
select(
-(pi2.1:rho2.3), -repetition, -elapsed_secs,
-contains("BICL"), -preferred_model
) %>%
mutate_at(vars(contains("Q")), function(Q) as.numeric(Q == 3)) %>%
summarise_at(vars(contains("Q")), mean)
preferred_model_data <- data %>%
group_by(epsilon_pi, epsilon_rho) %>%
select(
-(pi2.1:rho2.3), -repetition, -elapsed_secs,
-contains("BICL"), -contains("Q")
) %>%
mutate(
sep_pref = preferred_model == "sep",
iid_pref = preferred_model == "iid",
pi_pref = preferred_model == "pi",
rho_pref = preferred_model == "rho",
pirho_pref = preferred_model == "pirho"
) %>%
select(-preferred_model) %>%
summarise_at(vars(contains("pref")), list("prop" = mean))
preferred_model_data_longer <- preferred_model_data %>% pivot_longer(cols = contains("pref"), names_to = "model", names_pattern = "(sep|iid|pirho|pi|rho)", values_to = "proportion")
model_comparison_table <- ftable(prop.table(xtabs(~ `$\\epsilon_{\\pi}$` + `$\\epsilon_{\\rho}$` + `preferred model`, data = latex_ready_data), margin = c("$\\epsilon_{\\pi}$", "$\\epsilon_{\\rho}$")), digits = 2)
```
```{r}
#| output: asis
print(
xtable::xtableFtable(round(model_comparison_table, digits = 2),
method = "row.compact"
))
```

View file

@ -0,0 +1,32 @@
--- parse-latex.lua parse and replace raw LaTeX snippets
---
--- Copyright: © 20212022 Albert Krewinkel
--- License: MIT see LICENSE for details
-- Makes sure users know if their pandoc version is too old for this
-- filter.
PANDOC_VERSION:must_be_at_least '2.9'
-- Return an empty filter if the target format is LaTeX: the snippets will be
-- passed through unchanged.
if FORMAT:match 'latex' then
return {}
end
-- Parse and replace raw TeX blocks, leave all other raw blocks
-- alone.
function RawBlock(raw)
if raw.format:match 'tex' then
return pandoc.read(raw.text, 'latex').blocks
end
end
-- Parse and replace raw TeX inlines, leave other raw inline
-- elements alone.
function RawInline(raw)
if raw.format:match 'tex' then
return pandoc.utils.blocks_to_inlines(
pandoc.read(raw.text, 'latex').blocks
)
end
end