Skip to content
Snippets Groups Projects
Commit e3e7ef2e authored by VANRENTERGHEM Théodore's avatar VANRENTERGHEM Théodore
Browse files

add the table and a width controler

parent bcd75c4a
No related branches found
No related tags found
No related merge requests found
Pipeline #106966 passed with stage
in 6 minutes and 58 seconds
......@@ -15,10 +15,10 @@ mod_tab_report_ui <- function(id) {
status = "info", collapsible = T,
radioButtons(ns("language"), "Select your language:",
choices = list(
"Francais" = "_fr.Rmd",
"English" = "_en.Rmd"
"English" = "_en.Rmd",
"Francais" = "_fr.Rmd"
),
selected = "_fr.Rmd",
selected = "_en.Rmd",
inline = T
),
textInput(ns("fileName"),
......
......@@ -235,7 +235,7 @@ mod_tab_sbm_server <- function(id, r, parent_session) {
"All stored models are in Table 3, the",
HTML("<font color=red>red line</font>"),
"is the best model based on ICL criteria. The",
HTML('<mark color=\"#FFA500\">orange line</mark>'),
HTML('<mark color=orange>orange line</mark>'),
"is the selected model.",
tags$br(),
tags$br()
......
......@@ -39,10 +39,10 @@ if (R$sbm$ICL != max(R$sbm$storedModels$ICL)) {
"The most likely model has an ILC of ",
round(max(R$sbm$storedModels$ICL), 2),
" for ",
nb_group_best, " groups ", bip_best, "."
nb_group_best, " groups ", bip_best
)
} else {
entrop_cur <- paste0("On all estimated SBM, the selected one is the most likely.")
entrop_cur <- paste0("On all estimated SBM, the selected one is the most likely")
}
```
......@@ -50,11 +50,16 @@ if (R$sbm$ICL != max(R$sbm$storedModels$ICL)) {
Following application of the sbm model (`r modelName`), `r nb_models` models were estimated, each with a different number of groups ranging from `r R$sbm$storedModels$nbBlocks[1]` `r bip_min` to `r R$sbm$storedModels$nbBlocks[nb_models]` `r bip_max` groups.
The selected model in this document has `r sum(R$sbm$nbBlocks)` groups`r bip_cur`. The ICL of this model is `r R$sbm$ICL`. `r entrop_cur`.
On this table the `r colorize("red line",'red')` is the best model according to the ICL criteria and the `r colorize("orange line",'orange')` is the selected one.
```{r all-sbm, echo=FALSE,results='asis',warning=FALSE}
get_flextable(R$sbm,R$upload$labels,type = 'storedModels', caption = "All Stored Models") %>%
fit_width_to_output()
```
### Selected model
```{r block-proportion, echo=FALSE,results='asis'}
```{r block-proportion, echo=FALSE,results='asis',warning=FALSE}
col_group_names <- paste0(
R$upload$labels$col, "_",
1:R$sbm$nbBlocks[[1 + is_bipartite]]
......@@ -70,13 +75,15 @@ if (is_bipartite) {
example_group <- round_proportion(R$sbm$blockProp)[[R$sbm$nbBlocks[[1]]]] * 100
}
get_flextable(R$sbm,R$upload$labels,type = 'blockProp')
get_flextable(R$sbm,R$upload$labels,type = 'blockProp', caption = "Block proportion") %>%
fit_width_to_output()
```
<br>
Here, for example, `r example_group`\% of the `r R$upload$labels$row` are in the `r row_group_names[[R$sbm$nbBlocks[[1]]]]` group.
```{r block-connectivity, echo=FALSE,results='asis',fig.align = 'center', fig.width=12}
get_flextable(R$sbm,R$upload$labels,type = "connectParam")
```{r block-connectivity, echo=FALSE,results='asis',warning=FALSE}
get_flextable(R$sbm,R$upload$labels,type = "connectParam", caption = "Connectivity between blocks") %>%
fit_width_to_output()
```
<br>
The values in this table are the connectivity parameters of the sbm model (`r modelName`).
......
......@@ -42,22 +42,27 @@ if (R$sbm$ICL != max(R$sbm$storedModels$ICL)) {
entrop_cur <- paste0(
"Contre ", round(max(R$sbm$storedModels$ICL), 2),
" pour le mod", "\ue8", "le le plus vraisemblant ", "\ue0 ",
nb_group_best, " groupes ", bip_best, "."
nb_group_best, " groupes ", bip_best
)
} else {
entrop_cur <- paste0("Sur tout les SBM observ", "\ue9", "s ce mod", "\ue8", "le ", "\ue0", " l'ICL la plus ", "\ue9", "l", "\ue9", "v", "\ue9", "e, c'est le plus vraisemblable.")
entrop_cur <- paste0("Sur tout les SBM observ", "\ue9", "s ce mod", "\ue8", "le ", "\ue0", " l'ICL la plus ", "\ue9", "l", "\ue9", "v", "\ue9", "e, c'est le plus vraisemblable")
}
```
Suite à l'application du modèle sbm (`r modelName`), `r nb_models` modèles ont été trouvés avec pour chacun un nombre de groupes différent allant de `r R$sbm$storedModels$nbBlocks[1]` `r bip_min` à `r R$sbm$storedModels$nbBlocks[nb_models]` groupes`r bip_max`.
Le modèle sélectionné dans ce document est à `r sum(R$sbm$nbBlocks)` groupes`r bip_cur`. L'ICL (Critère de vraisemblance intégrée sur données-complète) de ce modèle vaut `r R$sbm$ICL`. `r entrop_cur`
Le modèle sélectionné dans ce document est à `r sum(R$sbm$nbBlocks)` groupes`r bip_cur`. L'ICL (Critère de vraisemblance intégrée sur données-complète) de ce modèle vaut `r R$sbm$ICL`. `r entrop_cur`.
Dans cette table `r colorize("la ligne en rouge",'red')` est le meilleur modèle selon le critère d'ICL et `r colorize("la ligne en orange",'orange')` est le modèle séléctionné.
```{r all-sbm, echo=FALSE,results='asis',warning=FALSE}
get_flextable(R$sbm,R$upload$labels,type = 'storedModels', caption = "All Stored Models") %>%
fit_width_to_output()
```
### Modèle sélectionné
```{r block-proportion, echo=FALSE, results='asis'}
```{r block-proportion, echo=FALSE, results='asis',warning=FALSE}
col_group_names <- paste0(
R$upload$labels$col, "_",
1:R$sbm$nbBlocks[[1 + is_bipartite]]
......@@ -73,13 +78,15 @@ if (is_bipartite) {
example_group <- round_proportion(R$sbm$blockProp)[[R$sbm$nbBlocks[[1]]]] * 100
}
get_flextable(R$sbm,R$upload$labels,type = 'blockProp')
get_flextable(R$sbm,R$upload$labels,type = 'blockProp', caption = "Proportion des blocs") %>%
fit_width_to_output()
```
<br>
Ici par exemple `r example_group`\% des `r R$upload$labels$row` sont dans le groupe `r row_group_names[[R$sbm$nbBlocks[[1]]]]`.
```{r block-connectivity, echo=FALSE,results='asis'}
get_flextable(R$sbm,R$upload$labels,type = "connectParam")
```{r block-connectivity, echo=FALSE,results='asis',warning=FALSE}
get_flextable(R$sbm,R$upload$labels,type = "connectParam", caption = paste0("Connectivit",'\ue9'," des blocs")) %>%
fit_width_to_output()
```
<br>
Les valeurs dans ce tableau sont les paramètres de connectivité du model sbm (`r modelName`).
......
......@@ -23,4 +23,22 @@ if (show_mat) {
} else {
is_bipartite <- F
}
colorize <- function(x, color) {
if (knitr::is_latex_output()) {
sprintf("\\textcolor{%s}{%s}", color, x)
} else if (knitr::is_html_output()) {
sprintf("<span style='color: %s;'>%s</span>", color,
x)
} else x
}
fit_width_to_output <- function(x,max_pdf_with = 7.1, max_html_with = 12){
if (knitr::is_latex_output()) {
flextable::fit_to_width(x,max_width = max_pdf_with)
} else if (knitr::is_html_output()) {
flextable::fit_to_width(x,max_width = max_html_with)
} else x
}
```
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment