51 bug of prepare boxly when there are 2 variables selected in define observationvar

R/prepare_boxly.R

@@ -119,15 +119,10 @@ prepare_boxly <- function(meta,
     ))
   }
 
-  obs[, obs_var] <- lapply(obs_var, function(var) {
-    x <- obs[[var]]
-    if (!is.factor(x)) {
-      message("In observation level data, the facet variable '", var, "' is automatically transformed into a factor.")
-      factor(x, levels = sort(unique(x)))
-    } else {
-      x
-    }
-  })
+  if (!is.factor(obs[[filter_var]])) {
+    message("In observation level data, the filter variable '", filter_var, "' is automatically transformed into a factor.")
+    obs[[filter_var]] <- factor(obs[[filter_var]], levels = sort(unique(obs[[filter_var]])))
+  }
 
   if (!"factor" %in% class(obs[[x]])) {
     message("In observation level data, the group variable '", x, "' is automatically transformed into a factor.")
@@ -140,27 +135,35 @@ prepare_boxly <- function(meta,
   }
 
   # a table calculates the number of subjects per parameter per visit per arm
-  n_tbl <- table(obs[, c(x, obs_group, obs_var)]) |>
+  n_tbl <- table(obs[, c(x, obs_group, filter_var)]) |>
     as.data.frame()
 
   n_tbl$n <- n_tbl$Freq
 
   tbl <- merge(obs, n_tbl, all.x = TRUE)
 
   # Calculate summary statistics and add these variables into tbl
+  split_vars <- c(filter_var, obs_group, x)
+
   plotds <- mapply(
     function(s, u) {
-      vals <- stats::quantile(s[[y]],
+      vals <- stats::quantile(
+        s[[y]],
         probs = c(0, 0.25, 0.5, 0.75, 1),
-        type = 2, na.rm = TRUE, names = FALSE
+        type = 2,
+        na.rm = TRUE,
+        names = FALSE
       )
 
       if (nrow(s) > 5) {
         iqr.range <- vals[4] - vals[2] # Q3 - Q1 (type=2)
         upper_outliers <- vals[4] + iqr.range * 1.5 # Q3 + 1.5*IQR
         lower_outliers <- vals[2] - iqr.range * 1.5 # Q1 - 1.5*IQR
-        s$outlier <- ifelse((s[[y]] > upper_outliers | s[[y]] < lower_outliers),
-          s[[y]], NA
+
+        s$outlier <- ifelse(
+          s[[y]] > upper_outliers | s[[y]] < lower_outliers,
+          s[[y]],
+          NA
         )
       } else if (nrow(s) > 0) {
         s$outlier <- NA
@@ -186,8 +189,8 @@ prepare_boxly <- function(meta,
         ans
       }
     },
-    split(tbl, list(tbl[[obs_var]], tbl[[obs_group]], tbl[[x]])),
-    names(split(tbl, list(tbl[[obs_var]], tbl[[obs_group]], tbl[[x]]), sep = ", ")),
+    split(tbl, tbl[split_vars], sep = ", "),
+    names(split(tbl, tbl[split_vars], sep = ", ")),
     SIMPLIFY = FALSE
   )
 

inst/js/filter_default.js

@@ -19,6 +19,15 @@
  *
  */
 
+function waitForSelectize(select, callback) {
+  const timer = setInterval(function() {
+    if (select.selectize) {
+      clearInterval(timer);
+      callback(select.selectize);
+    }
+  }, 100);
+}
+
 function filter_default() {
   const uniqueIds = [];
   const elements = document.querySelectorAll('[id*="filter_param_"]');
@@ -29,18 +38,18 @@ function filter_default() {
       uniqueIds.push(id);
     }
   }
+
   console.log(uniqueIds);
   for (const id of uniqueIds) {
     const default_value = id.split("|").pop(); // extract value after the last "|" character
     console.log(default_value);
-    document
-      .getElementById(id)
-      .getElementsByClassName("selectized")[0]
-      .selectize.setValue(default_value, false);
-    document
-      .getElementById(id)
-      .getElementsByClassName("selectized")[0]
-      .selectize.removeOption("");
+
+    const parent = document.getElementById(id);
+    const select = parent.querySelector("select");
+    waitForSelectize(select, function(s) {
+        s.setValue(default_value, false);
+        s.removeOption("");
+    });
   }
 }