Ajout analyse inference

code/analysis/analyze_inference_bernoulli.qmd

@@ -1,9 +1,10 @@
 ---
-title: "Analysis inference for Bernoulli distribution"
-output:
-  bookdown::html_document2:
-    toc: true
-    fig_caption: true
+title: "Analysis inference for Bernoulli distribution 3run"
+output: html
+execute: 
+    cache: true
+    echo: false
+    warning: false
 ---
 
 ```{r knitropts, echo = FALSE}
@@ -15,6 +16,8 @@ suppressPackageStartupMessages(library(ggplot2))
 suppressPackageStartupMessages(library(tidyverse))
 suppressPackageStartupMessages(library(latex2exp))
 suppressPackageStartupMessages(library(here))
+library(latex2exp)
+library(flextable)
 loadNamespace(package = "patchwork")
 loadNamespace("knitr")
 loadNamespace("kableExtra")
@@ -24,7 +27,9 @@ loadNamespace("kableExtra")
 #  Loading data
 data_folder <- file.path(here(), "code", "results", "simulations", "inference", "bernoulli")
 # files_list <- list.files(data_folder, pattern = "^NA_robustness_19-04-2024")
-data <- readRDS(file.path(data_folder, "bernoulli_inference_18-04-2024_09-41-45_1-972.Rds"))
+data <- readRDS(file.path(data_folder, "bernoulli_inference_06-05-2024_17-21-48_1-972.Rds"))
+# data <- do.call("rbind", lapply(list.files(file.path(data_folder, "tmp02-05-2024_11-15-20"), pattern = "^conditions*", full.names = TRUE), function(filepath) readRDS(filepath)))
+
 ```
 
 ```{r data-transfo, echo = FALSE}
@@ -52,7 +57,7 @@ av_data <- data %>%
     select(-((contains(c("over", "under", "equal")) & contains("sd")) | contains(c("BICL_mean", "_Q2_mean", "Q1_mean", "BICL_sd", "_Q2_sd", "Q1_sd"))))
 ```
 
-```{r data_print, echo = FALSE}
+```{r data_print}
 print_data <- av_data %>%
     group_by(epsilon_alpha) %>%
     round(2) %>%
@@ -75,45 +80,72 @@ print_data <- av_data %>%
         #  Grouping accuracy
         pirho_mean_row_ARI = paste(pirho_mean_row_ARI_mean,
             pirho_mean_row_ARI_sd,
-            sep = "+/-"
+            sep = "\\pm"
         ),
         pirho_mean_col_ARI = paste(pirho_mean_col_ARI_mean,
             pirho_mean_col_ARI_sd,
-            sep = "+/-"
+            sep = "\\pm"
         ),
         pirho_double_row_ARI = paste(pirho_double_row_ARI_mean,
             pirho_double_row_ARI_sd,
-            sep = "+/-"
+            sep = "\\pm"
         ),
         pirho_double_col_ARI = paste(pirho_double_col_ARI_mean,
             pirho_double_col_ARI_sd,
-            sep = "+/-"
+            sep = "\\pm"
         ),
         .keep = "none"
     )
 ```
 
 ```{r table, echo = FALSE}
-knitr::kable(print_data, col.names = c(
-    "$\\epsilon_\\alpha$",
-    "$\\pi\\rho$ pref. to $sep$", "$\\pi\\rho$ pref. to $iid$",
-    "$\\pi\\rho$ pref. to $\\pi$",
-    "$\\pi\\rho$ pref. to $\\rho$",
-    "$1_{\\widehat{Q_1} < 4}$",
-    "$1_{\\widehat{Q_1} = 4}$",
-    "$1_{\\widehat{Q_1} > 4}$",
-    "$1_{\\widehat{Q_2} < 4}$",
-    "$1_{\\widehat{Q_2} = 4}$",
-    "$1_{\\widehat{Q_2} > 4}$",
-    "$\\overline{ARI}^{d=1}$",
-    "$\\overline{ARI}^{d=1}$",
-    "$ARI^{d=1}_{1,2}$",
-    "$ARI^{d=1}_{1,2}$"
-), escape = TRUE)
+# knitr::kable(print_data, col.names = col_keys_latex, escape = TRUE)
 #  %>%
 #     kableExtra::add_header_above(c(
 #         " " = 1,
 #         "Model comparison" = 4,
 #         "Estimation of Q" = 6, "Grouping accuracy" = 4
 #     ),escape = TRUE)
+```
+
+```{r}
+col_keys <- c(
+    "\\epsilon_\\alpha",
+    "\\pi\\rho\\text{ pref. to }sep",
+    "\\pi\\rho\\text{ pref. to }iid",
+    "\\pi\\rho\\text{ pref. to }\\pi",
+    "\\pi\\rho\\text{ pref. to }\\rho",
+    "1_{\\widehat{Q_1} < 4}",
+    "1_{\\widehat{Q_1} = 4}",
+    "1_{\\widehat{Q_1} > 4}",
+    "1_{\\widehat{Q_2} < 4}",
+    "1_{\\widehat{Q_2} = 4}",
+    "1_{\\widehat{Q_2} > 4}",
+    "\\overline{ARI}^{d=1}",
+    "\\overline{ARI}^{d=2}",
+    "ARI^{d=1}_{1,2}",
+    "ARI^{d=2}_{1,2}"
+)
+
+ft_1 <- flextable(print_data) |>
+    set_table_properties(
+        opts_html = list(
+            scroll = list(freeze_first_column = TRUE)
+        )
+    ) |> 
+    compose(j = "pirho_mean_row_ARI", value = as_paragraph(as_equation(pirho_mean_row_ARI)))
+ft_1 <- compose(ft_1, j = "pirho_mean_col_ARI", value = as_paragraph(as_equation(pirho_mean_col_ARI)))
+ft_1 <- compose(ft_1, j = "pirho_double_row_ARI", value = as_paragraph(as_equation(pirho_double_row_ARI)))
+ft_1 <- compose(ft_1, j = "pirho_double_col_ARI", value = as_paragraph(as_equation(pirho_double_col_ARI)))
+ft_1 <- ft_1 |> mk_par(
+    i = 1, part = "header",
+    value = as_paragraph(
+        as_equation(col_keys, width = .1, height = .2)
+    )
+)
+theme_zebra(ft_1) |> 
+    hline(i = 1, border = fp_border_default(), part = "header") |>
+    vline(j = 1, border = fp_border_default(), part = "all") |>
+    bg(j = 1, bg = "#DDDDDD", part = "all") |>
+    bg(i = 1, bg = "#DDDDDD", part = "header")
 ```