Merge pull request #31 from Merck/19-handle-situation-with-0-rows

19 handle situation with 0 rows
Merck · Oct 2, 2023 · 2956e40 · 2956e40
2 parents 6a67fec + 4f4e9b7
commit 2956e40
Showing 1 changed file with 24 additions and 14 deletions.
diff --git a/R/prepare_boxly.R b/R/prepare_boxly.R
@@ -132,31 +132,41 @@ prepare_boxly <- function(meta,
   tbl <- merge(obs, n_tbl, all.x = TRUE)
 
   # Calculate summary statistics and add these variables into tbl
-  plotds <- lapply(
-    split(tbl, list(tbl[[obs_var]], tbl[[obs_group]], tbl[[x]])),
-    function(s) {
+  plotds <- mapply(
+    function(s, u) {
       t <- as.vector(summary(s[[y]]))
 
       if (nrow(s) > 5) {
         iqr.range <- t[5] - t[2]
         upper_outliers <- t[5] + iqr.range * 1.5
         lower_outliers <- t[2] - iqr.range * 1.5
         s$outlier <- ifelse((s[[y]] > upper_outliers | s[[y]] < lower_outliers), s[[y]], NA)
-      } else {
+      } else if (nrow(s) > 0) {
         s$outlier <- NA
+      } else {
+        warning(paste0(
+          "There is no record for the combination of `var` and `group` in `meta$observation`, and `x` in `meta$analysis`: ",
+          u
+        ))
       }
       # mutate ans for output
-      ans <- s
-      ans$min <- t[1]
-      ans$q1 <- t[2]
-      ans$median <- t[3]
-      ans$mean <- t[4]
-      ans$q3 <- t[5]
-      ans$max <- t[6]
-
-      ans
-    }
+      if (nrow(s) > 0) {
+        ans <- s
+        ans$min <- t[1]
+        ans$q1 <- t[2]
+        ans$median <- t[3]
+        ans$mean <- t[4]
+        ans$q3 <- t[5]
+        ans$max <- t[6]
+
+        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 = ", ")),
+    SIMPLIFY = FALSE
   )
+
   plotds <- do.call(rbind, plotds)
   rownames(plotds) <- NULL