Merge pull request #113 from stemangiola/add-anti_join

Add anti join

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidySingleCellExperiment
 Title: Brings SingleCellExperiment to the Tidyverse 
-Version: 1.15.5
+Version: 1.15.6
 Authors@R: c(person("Stefano", "Mangiola", 
     comment=c(ORCID="0000-0001-7474-836X"),
     email="[email protected]",

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(add_count,SingleCellExperiment)
+S3method(anti_join,SingleCellExperiment)
 S3method(arrange,SingleCellExperiment)
 S3method(as_tibble,SingleCellExperiment)
 S3method(bind_cols,SingleCellExperiment)
@@ -64,6 +65,7 @@ importFrom(SummarizedExperiment,assays)
 importFrom(SummarizedExperiment,colData)
 importFrom(SummarizedExperiment,rowData)
 importFrom(dplyr,add_count)
+importFrom(dplyr,anti_join)
 importFrom(dplyr,any_of)
 importFrom(dplyr,arrange)
 importFrom(dplyr,contains)

R/dplyr_methods.R

@@ -329,16 +329,17 @@ rowwise.SingleCellExperiment <- function(data, ...) {
 .join_factory <- function(fun, change_x) {
     function(x, y, 
              by=NULL, copy=FALSE, suffix=c(".x", ".y"), ...) {
-        
+
         # Deprecation of special column names
         .cols <- if (!is.null(by)) by else colnames(y)
         if (is_sample_feature_deprecated_used(x, .cols)) {
             x <- ping_old_special_column_into_metadata(x)
         }
         if (is(y, "DataFrame")) y <- as.data.frame(y)
-        z <- x |>
-            as_tibble() |>
-            fun(y, by=by, copy=copy, suffix=suffix, ...)
+
+          z <- x |>
+              as_tibble() |>
+              fun(y, by=by, copy=copy, suffix=suffix, ...)
 
         # If duplicated cells returns tibble
         if (any(duplicated(z[[c_(x)$name]]))) {
@@ -355,6 +356,36 @@ rowwise.SingleCellExperiment <- function(data, ...) {
     }
 }
 
+.join_factory_anti_join <- function(fun, change_x) {
+  function(x, y, 
+           by=NULL, copy=FALSE, ...) {
+
+    # Deprecation of special column names
+    .cols <- if (!is.null(by)) by else colnames(y)
+    if (is_sample_feature_deprecated_used(x, .cols)) {
+      x <- ping_old_special_column_into_metadata(x)
+    }
+    if (is(y, "DataFrame")) y <- as.data.frame(y)
+
+    z <- x |>
+        as_tibble() |>
+        fun(y, by=by, copy=copy, ...)
+
+    # If duplicated cells returns tibble
+    if (any(duplicated(z[[c_(x)$name]]))) {
+      message(duplicated_cell_names)
+      return(z)
+    }
+
+    # Otherwise return updated tidySingleCellExperiment
+    if (change_x)
+      new_obj <- x[, pull(z, c_(x)$name)]
+    else new_obj <- x
+    colData(new_obj) <- z |> as_meta_data(new_obj)
+    return(new_obj)
+  }
+}
+
 #' @name left_join
 #' @rdname left_join
 #' @inherit dplyr::left_join
@@ -397,6 +428,24 @@ left_join.SingleCellExperiment <- .join_factory(dplyr::left_join, FALSE)
 #' @export
 inner_join.SingleCellExperiment <- .join_factory(dplyr::inner_join, TRUE)
 
+#' @name anti_join
+#' @rdname anti_join
+#' @inherit dplyr::anti_join
+#'
+#' @examples
+#' data(pbmc_small)
+#' tt <- pbmc_small
+#' tt |> anti_join(tt |> 
+#'   distinct(groups) |>  
+#'   mutate(new_column=1:2) |> 
+#'   slice(1))
+#'
+#' @importFrom SummarizedExperiment colData
+#' @importFrom dplyr anti_join
+#' @importFrom dplyr pull
+#' @export
+anti_join.SingleCellExperiment <- .join_factory_anti_join(dplyr::anti_join, TRUE)
+
 #' @name right_join
 #' @rdname right_join
 #' @inherit dplyr::right_join

R/utilities.R

@@ -521,6 +521,8 @@ splitColData <- function(x, f) {
 
 }
 
+
+
 cell__ <- get_special_column_name_symbol(".cell")
 feature__ <- get_special_column_name_symbol(".feature")
 sample__ <- get_special_column_name_symbol(".sample")

tests/testthat/test-dplyr_methods.R

@@ -224,6 +224,17 @@ test_that("full_join(), with DataFrame y", {
     #     mutate(df, factor=paste(factor)))
 })
 
+test_that("anti_join()", {
+  y <- df |> 
+    distinct(factor) |> 
+    mutate(string=letters[seq(nlevels(df$factor))]) |> 
+    filter(factor !="g1")
+  fd <- anti_join(df, y, by="factor")
+  expect_s4_class(fd, "SingleCellExperiment")
+  expect_equal(n <- ncol(colData(fd)), ncol(colData(df)))
+  expect_lt(ncol(fd), ncol(df))
+})
+
 test_that("slice()", {
   # I DON'T KNOW WHY THESE TESTS GIVES WARNING 
   # Please use `all_of()` or `any_of()` instead.