fix(clonalutils): set count to 0 if a group doesn't exist during comparison

Author: pwwang

R/clonalutils.R

@@ -314,7 +314,7 @@ screp_subset <- function(screp, subset) {
         data2 <- data
     }
     data2 <- data2 %>%
-        group_by(!!!syms(unique(c(id, groups)))) %>%
+        group_by(!!!syms(unique(c(id, groups))), .drop = FALSE) %>%
         summarise(.n = n(), .groups = "drop")
 
     if (!is.null(groups)) {
@@ -571,6 +571,10 @@ uniq <- function(group1, group2, ..., groups = NULL, data = NULL, id = NULL, in_
         expr <- paste0(expr, " & ", .bquote(g), " == 0")
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2, other_groups), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2, other_groups))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -603,6 +607,10 @@ shared <- function(group1, group2, ..., groups = NULL, data = NULL, id = NULL, i
         expr <- paste0(expr, " & ", .bquote(g), " > 0")
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2, other_groups), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2, other_groups))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -634,6 +642,10 @@ gt <- function(group1, group2, include_zeros = TRUE, groups = NULL, data = NULL,
         expr <- paste0(.bquote(group2), " > 0 & ", expr)
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -665,6 +677,10 @@ ge <- function(group1, group2, include_zeros = TRUE, groups = NULL, data = NULL,
         expr <- paste0(.bquote(group2), " > 0 & ", expr)
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -696,6 +712,10 @@ lt <- function(group1, group2, include_zeros = TRUE, groups = NULL, data = NULL,
         expr <- paste0(.bquote(group1), " > 0 & ", expr)
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -727,6 +747,10 @@ le <- function(group1, group2, include_zeros = TRUE, groups = NULL, data = NULL,
         expr <- paste0(.bquote(group1), " > 0 & ", expr)
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -755,6 +779,10 @@ eq <- function(group1, group2, groups = NULL, data = NULL, id = NULL, in_form =
     id <- id %||% ifelse(envtype == "tidy", "CTaa", "CloneID")
     expr <- paste0(.bquote(group1), " == ", .bquote(group2))
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }
 
@@ -786,6 +814,10 @@ ne <- function(group1, group2, include_zeros = TRUE, groups = NULL, data = NULL,
         expr <- paste0(.bquote(group1), " > 0 & ", .bquote(group2), " > 0 & ", expr)
     }
     stopifnot("`groups` must be provided when `in_form` is 'long'." = !is.null(groups) || in_form == "wide")
+    if (in_form == "long") {
+        data <- data[data[[groups]] %in% c(group1, group2), , drop = FALSE]
+        data[[groups]] <- factor(data[[groups]], levels = c(group1, group2))
+    }
     sel(expr, groups, data, id = id, in_form = in_form, within = within, return_ids = return_ids)
 }