Skip to content

Commit

Permalink
bug!: #42 update model summary metrics table for all yi deviations
Browse files Browse the repository at this point in the history 
and improve scientific formatting #65
  • Loading branch information
@egouldo
egouldo committed Sep 4, 2024
1 parent a78da90 commit 0a0031c
Showing 1 changed file with 68 additions and 59 deletions.
127 changes: 68 additions & 59 deletions supp_mat/SM3_ExplainingDeviation.qmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1644,38 +1644,35 @@ yi_multivar_singularity_convergence %>%
#| message: false
#| include: false
all_yi_deviation_models <- ManyEcoEvo_yi_viz %>%
filter(exclusion_set == "complete",
dataset == "blue tit",
model_name %nin% c("MA_mod", "box_cox_rating_cat_no_int")) %>%
bind_rows({euc_yi_results %>%
filter(model_name %nin% c("MA_mod", "box_cox_rating_cat_no_int"))}) %>%
filter(model_name %nin% c("MA_mod", "box_cox_rating_cat_no_int", "MA_mod_mv")) %>%
mutate( dataset = case_when(str_detect(dataset, "eucalyptus") ~ "Eucalyptus",
TRUE ~ dataset)) %>%
semi_join(
{yi_singularity_convergence_sorensen_mixed_mod %>%
filter(singularity == FALSE)},
{yi_convergence_singularity %>% filter(convergence, !singularity, SE_calc, CI_calc) %>% select(-convergence, -singularity, -ends_with("_calc"))},
by = join_by("dataset", "estimate_type")
)
tbl_data_yi_deviation_model_params <- all_yi_deviation_models %>%
mutate(perf = map(model, performance::performance),
mod_sum_stats = map(model, broom.mixed::glance)
) %>%
select(dataset, estimate_type, model_name, perf, mod_sum_stats) %>%
hoist(mod_sum_stats, "nobs") %>%
unnest(cols = perf) %>%
select(-mod_sum_stats) %>%
rowwise() %>%
filter(!is_logical(model))
tbl_data_yi_deviation_model_params <-
all_yi_deviation_models %>%
group_by(dataset, estimate_type, model_name) %>%
select(mod_glance, mod_fit_stats) %>%
hoist(mod_fit_stats, "RMSE", "Sigma", "R2_conditional", "R2_marginal", "ICC", "R2") %>%
hoist(mod_glance, "nobs") %>% select(-mod_fit_stats, -mod_glance) %>%
mutate(model_name = forcats::as_factor(model_name),
model_name = forcats::fct_relevel(model_name,
c("box_cox_rating_cat",
"box_cox_rating_cont",
"sorensen_glm",
"uni_mixed_effects")),
model_name = forcats::fct_recode(model_name,
`Deviation explained by categorical ratings` = "box_cox_rating_cat",
`Deviation explained by continuous ratings` = "box_cox_rating_cont",
`Deviation explained by Sorensen's index` = "sorensen_glm",
`Deviation explained by inclusion of random effects` = "uni_mixed_effects")) %>%
model_name =
forcats::fct_recode(
model_name,
`Deviation explained by categorical ratings` = "box_cox_rating_cat",
`Deviation explained by continuous ratings` = "box_cox_rating_cont",
`Deviation explained by Sorensen's index` = "sorensen_glm",
`Deviation explained by inclusion of random effects` = "uni_mixed_effects")) %>%
group_by(model_name) %>%
relocate("R2", .before = starts_with("R2_"))
```
Expand All @@ -1687,44 +1684,56 @@ tbl_data_yi_deviation_model_params <- all_yi_deviation_models %>%
#| tbl-cap: "Model summary metrics for models of Box-Cox transformed deviation from the mean $y_i$ estimate as a function of categorical peer-review rating, continuous peer-review rating, and Sorensen's index for blue tit and *Eucalyptus* analyses, and also for the inclusion of random effects for *Eucalyptus* analyses. Coefficient of determination, $R^2$, is reported for models of deviation as a function of Sorensen diversity scores and presence of random effects, while $R^{2}_\\text{Conditional}$, $R^{2}_\\text{Marginal}$ and the intra-class correlation (ICC) are reported for models of deviation as explained by peer-review ratings. For all models the residual standard deviation $\\sigma$, root mean squared error (RMSE) were calculated. The number of observations ($N_{Obs.}$) is displayed for reference."
#| column: page-inset-right
tbl_data_yi_deviation_model_params %>%
select(!c(contains("AIC"), BIC)) %>%
dplyr::filter(dataset != "blue tit" | str_detect(model_name, "random", negate = TRUE)) %>%
gt::gt(rowname_col = "dataset") %>%
gt::opt_stylize(style = 6, color = "gray") %>%
gt::sub_missing(missing_text = "") %>%
gt::cols_label(dataset = "Dataset",
R2 = gt::md("$$R^2$$"),
R2_conditional = "$$R^{2}_\\text{Conditional}$$",
R2_marginal = "$$R^{2}_\\text{Marginal}$$",
Sigma = "$$\\sigma$$",
nobs = "$$N_{Obs.}$$",
estimate_type = "Prediction Scenario") %>%
gt::tab_style(locations = cells_body(rows = str_detect(dataset, "Eucalyptus"),
columns = dataset),
style = cell_text(style = "italic")) %>%
gt::text_transform(
locations = cells_stub(
rows = estimate_type != "y25"
),
fn = function(x){
paste0("")
}
) %>%
gt::tab_style(locations = gt::cells_stub(rows = str_detect(dataset, "Eucalyptus")),
style = cell_text(style = "italic")) %>%
gt::fmt_scientific(columns = c("R2", "RMSE", "Sigma"),
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_number(columns = gt::contains(c("ICC")),
drop_trailing_zeros = T,
decimals = 3) %>%
gt::fmt_number(columns = gt::contains(c("R2_")),
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_scientific(columns = c(gt::contains(("R2_marginal"))),
rows = str_detect(model_name, "continuous"),
drop_trailing_zeros = T,
decimals = 2) %>% gt_fmt_yi("estimate_type")
gt::gt(rowname_col = "dataset") %>%
gt::opt_stylize(style = 6, color = "gray") %>%
gt::sub_missing(missing_text = "") %>%
gt::cols_label(dataset = "Dataset",
R2 = gt::md("$$R^2$$"),
R2_conditional = "$$R^{2}_\\text{Conditional}$$",
R2_marginal = "$$R^{2}_\\text{Marginal}$$",
Sigma = "$$\\sigma$$",
nobs = "$$N_{Obs.}$$",
estimate_type = "Prediction Scenario") %>%
gt::tab_style(locations = cells_body(rows = str_detect(dataset, "Eucalyptus"),
columns = dataset),
style = cell_text(style = "italic")) %>%
gt::text_transform(
locations = cells_stub(
rows = estimate_type != "y25"
),
fn = function(x){
paste0("")
}
) %>%
gt::tab_style(locations = gt::cells_stub(rows = str_detect(dataset, "Eucalyptus")),
style = cell_text(style = "italic")) %>%
gt::fmt_number(columns = gt::contains(c("ICC", "RMSE")),
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_scientific(columns = c("RMSE"),
rows = RMSE < 0.01 | RMSE > 1000,
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_scientific(columns = c(gt::contains(("R2_marginal"))),
rows = str_detect(model_name, "continuous|categorical"),
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_number(columns = gt::contains(c("R2_conditional")),
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_number(columns = gt::contains(c("Sigma")),
decimals = 2) %>%
gt::fmt_scientific(columns = c("Sigma"),
rows = Sigma < 0.01 | Sigma > 1000,
drop_trailing_zeros = T,
decimals = 2) %>%
gt::fmt_number(columns = "R2",
decimals = 2) %>%
gt::fmt_scientific(columns = c("R2"),
rows = R2 < 0.01 | R2 > 1000,
drop_trailing_zeros = T,
decimals = 2) %>%
gt_fmt_yi("estimate_type")
```

## Post-hoc analysis: checking the use of model weights in all models explaining deviation from the meta-analytic mean {#sec-post-hoc-weights-analysis}
Expand Down

0 comments on commit 0a0031c

Please sign in to comment.