Bug fixes (closes #28)

NEWS.md

@@ -1,6 +1,11 @@
 # metaUI 0.1.2 (under development)
 * Added the ability to create an app without any filters/moderators
 
+## Bug fixes
+* Corrected random intercept specification in rma.mv (and added sparse = TRUE to speed up model fitting)
+* Fixed bug in describing moderators where "Other"-category already existed
+* Fixed creation of code to install required packages and added check to ensure that filters are factors or numeric (#28)
+
 # metaUI 0.1.1
 
 * Fixed issue where k was not displayed for moderators with spaces in names

R/create_app.R

@@ -173,7 +173,8 @@ generate_shiny <- function(dataset, dataset_name, eff_size_type_label = NA,
 generate_global.R <- function(metaUI_eff_size_type_label) {
   req_packages <- utils::packageDescription("metaUI") %>%
     purrr::pluck("Imports") %>%
-    stringr::str_split(",\n") %>%
+    stringr::str_split(",", simplify = TRUE) %>%
+    purrr::map_chr(stringr::str_trim) %>%
     unlist()
   metaUI_eff_size_type_label <- metaUI_eff_size_type_label  %>% stringr::str_replace("'", stringr::fixed("\\\\'"))
 

R/helpers.R

@@ -61,22 +61,43 @@ summarise_numeric <- function(x, name) {
     tidyr::pivot_longer(dplyr::everything(), names_to = "Statistic", values_to = "Value")
 }
 
+# Count categories in x, return top 10 and return everything else as Other (merging with existing Other if it exists)
 summarise_categorical <- function(x, name) {
   if (length(x) == 0) {
     return(NULL)
   }
-  counts <- tibble::tibble(x = x)  %>% dplyr::count(x, sort = TRUE, name = "Count", .drop = FALSE)
 
-  out <- dplyr::bind_rows(
-    counts  %>% dplyr::slice(1:10),
-    tibble::tibble(x = "Other", Count = sum(counts$Count) - sum(counts$Count[1:10])) %>% tidyr::drop_na())  %>%
-    dplyr::mutate(Percentage = paste0(round(.data$Count / sum(.data$Count) * 100, 1), "%"))
+  counts <- tibble::tibble(!!rlang::sym(name) := x) %>%
+    dplyr::count(!!rlang::sym(name), sort = TRUE, .drop = FALSE) %>%
+    dplyr::rename(Count = n)
 
-  names(out)[1] <- name
+  if (nrow(counts) > 10) {
 
-  out
+  top_categories <- counts %>%
+    dplyr::filter(!!rlang::sym(name) != "Other") %>%
+    dplyr::slice_max(order_by = Count, n = 9, with_ties = FALSE)
+
+  other_count <- sum(counts$Count) - sum(top_categories$Count)
+
+  if ("Other" %in% counts[[name]]) {
+    other_count <- other_count + counts %>% dplyr::filter(!!rlang::sym(name) == "Other") %>% dplyr::pull(Count)
+  }
+
+  final_counts <- if (other_count > 0) {
+    dplyr::bind_rows(top_categories, tibble::tibble(!!rlang::sym(name) := "Other", Count = other_count))
+  } else {
+    top_categories
+  }
+
+  } else {
+    final_counts <- counts
+  }
+
+  final_counts %>%
+    dplyr::mutate(Percentage = paste0(round(Count / sum(Count) * 100, 1), "%"))
 }
 
+
 #' Format confidence interval based on the bounds
 #'
 #' Constructs a confidence intervals from upper and lower bounds,

R/models.R

@@ -40,10 +40,11 @@ get_model_tibble <- function() {
             "Random-Effects Multilevel Model", ('metafor::rma.mv(
                                 yi = metaUI__effect_size,
                                 V = metaUI__variance,
-                                random = ~ 1 | metaUI__study_id,
+                                random = ~ 1 | metaUI__study_id/metaUI__effect_size,
                                 tdist = TRUE, # knapp-hartung adjustment
                                 data = df,
-                                method = "REML"
+                                method = "REML",
+                                sparse = TRUE
                             )'),
             "Robust Variance Estimation", ('robumeta::robu(
                         metaUI__effect_size ~ 1, data = df,

R/prepare_data.R

@@ -36,6 +36,12 @@ prepare_data <- function(data, study_label, es_field, se, pvalue, sample_size, v
                                 "Other effect size types may work, but internal conversions (e.g., r-to-z) are not yet supported. ",
                                 "If you need such an extension, please open an issue: https://github.com/LukasWallrich/metaUI/issues")
 
+  for (i in seq_along(filters)) {
+    if(!is.factor(data[[filters[i]]]) && !is.numeric(data[[filters[i]]])) {
+      stop("All filters/moderators must be factors or numeric. This check failed first for ", filters[i])
+    }
+  }
+
   if (!is.null(names(filters))) {
     filter_names <- names(filters) %>%
       dplyr::na_if("") %>%
@@ -54,6 +60,8 @@ prepare_data <- function(data, study_label, es_field, se, pvalue, sample_size, v
     }
   }
 
+
+
   # Rename the fields
   data <- data %>%
     dplyr::rename(

R/template_app.R

@@ -89,7 +89,7 @@ generate_ui_filters <- function(data, filter_popups, any_filters) {
       )
                  ')
 
-    } else {
+    } else if (is.factor(data[[filter_col]])) {
       out <- glue::glue('checkboxGroupInput("{filter_col %>% stringr::str_replace_all(" ", "_")}",
       p("{stringr::str_remove(filter_col, rm_prefix)}",
       {if(add_popup)  {{
@@ -102,6 +102,8 @@ generate_ui_filters <- function(data, filter_popups, any_filters) {
           choices = c("{glue::glue_collapse(levels(data[[filter_col]]) %>% na.omit(), sep = \'", "\')}"),
         selected = c("{glue::glue_collapse(levels(data[[filter_col]]) %>% na.omit(), sep = \'", "\')}")
         )')
+    } else {
+      stop("Filter/moderator variables must be numeric or factors. This check failed first for ", filter_col)
     }
 
     if (is.numeric(data[[filter_col]])) {
@@ -651,11 +653,12 @@ glue_string <- ('
       model <- metafor::rma.mv(
         yi = metaUI__effect_size,
         V = metaUI__variance,
-        random = ~ 1 | metaUI__study_id,
+        random = ~ 1 | metaUI__study_id/metaUI__effect_size,
         tdist = TRUE,
         data = df,
         mods = as.formula(glue::glue("~`{input$moderator}`")),
-        method = "ML"
+        method = "ML",
+        sparse = TRUE
       )
      moderation_text <-     HTML(glue::glue(
       \'<br><br>The {ifelse(is.numeric(df[[input$moderator]]), "linear ", "")}relationship between  <b> {input$moderator  %>% stringr::str_remove("metaUI__filter_")} </b>\',
@@ -668,20 +671,22 @@ glue_string <- ('
      model_sig <- metafor::rma.mv(
         yi = metaUI__effect_size,
         V = metaUI__variance,
-        random = ~ 1 | metaUI__study_id,
+        random = ~ 1 | metaUI__study_id/metaUI__effect_size,
         tdist = TRUE,
         data = df,
         mods = as.formula(glue::glue("~`{input$moderator}`")),
-        method = "ML"
+        method = "ML",
+        sparse = TRUE
       )
      model <- metafor::rma.mv(
         yi = metaUI__effect_size,
         V = metaUI__variance,
-        random = ~ 1 | metaUI__study_id,
+        random = ~ 1 | metaUI__study_id/metaUI__effect_size,
         tdist = TRUE,
         data = df,
         mods = as.formula(glue::glue("~`{input$moderator}` - 1")),
-        method = "ML"
+        method = "ML",
+        sparse = TRUE
       )
 
      moderation_text <-     HTML(glue::glue(
@@ -745,10 +750,11 @@ glue_string <- ('
     metapp_total <- metafor::rma.mv(
       yi = metaUI__effect_size,
       V = metaUI__variance,
-      random = ~ 1 | metaUI__study_id ,
+      random = ~ 1 | metaUI__study_id/metaUI__effect_size,
       tdist = TRUE, # knapp-hartung adjustment
       data = df,
-      method = "ML" # REML failed to converge in tests
+      method = "ML" # REML failed to converge in tests,
+      sparse = TRUE
     )
 
     het <- data.frame(