From 92ebb1dd705ac489dfa055594e4c0e38a03e3da1 Mon Sep 17 00:00:00 2001
From: Lambda Moses <dlu2@caltech.edu>
Date: Tue, 17 Oct 2023 22:54:59 -0700
Subject: [PATCH] Allow y as S4 DataFrame in *_join()

---
 R/dplyr_methods.R                   | 17 +++++++---
 man/left_join.Rd                    |  7 ++++
 tests/testthat/test-dplyr_methods.R | 51 +++++++++++++++++++++++++++++
 3 files changed, 70 insertions(+), 5 deletions(-)

diff --git a/R/dplyr_methods.R b/R/dplyr_methods.R
index db079f9..6cdc9ab 100755
--- a/R/dplyr_methods.R
+++ b/R/dplyr_methods.R
@@ -336,7 +336,14 @@ rowwise.SingleCellExperiment <- function(data, ...) {
 #' tt |> left_join(tt |>  
 #'   distinct(groups) |> 
 #'   mutate(new_column=1:2))
-#'
+#' 
+#' library(S4Vectors)
+#' # y can be S4 DataFrame for _*join, though not tested on list columns
+#' DF <- tt |>  
+#'   distinct(groups) |> 
+#'   mutate(new_column=1:2) |> DataFrame()
+#' tt |> left_join(DF)
+#' 
 #' @importFrom SummarizedExperiment colData
 #' @importFrom dplyr left_join
 #' @importFrom dplyr count
@@ -349,7 +356,7 @@ left_join.SingleCellExperiment <- function(x, 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() |>
         dplyr::left_join(y, by=by, copy=copy, suffix=suffix, ...)
@@ -389,7 +396,7 @@ inner_join.SingleCellExperiment <- function(x, 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() |>
         dplyr::inner_join(y, by=by, copy=copy, suffix=suffix, ...)
@@ -430,7 +437,7 @@ right_join.SingleCellExperiment <- function(x, 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() |>
         dplyr::right_join(y, by=by, copy=copy, suffix=suffix, ...)
@@ -467,7 +474,7 @@ full_join.SingleCellExperiment <- function(x, 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() |>
         dplyr::full_join(y, by=by, copy=copy, suffix=suffix, ...) 
diff --git a/man/left_join.Rd b/man/left_join.Rd
index 0c10d0e..39031ad 100644
--- a/man/left_join.Rd
+++ b/man/left_join.Rd
@@ -164,6 +164,13 @@ tt |> left_join(tt |>
   distinct(groups) |> 
   mutate(new_column=1:2))
 
+library(S4Vectors)
+# y can be S4 DataFrame for _*join, though not tested on list columns
+DF <- tt |>  
+  distinct(groups) |> 
+  mutate(new_column=1:2) |> DataFrame()
+tt |> left_join(DF)
+
 }
 \seealso{
 Other joins: 
diff --git a/tests/testthat/test-dplyr_methods.R b/tests/testthat/test-dplyr_methods.R
index 9e01f96..8fee11b 100755
--- a/tests/testthat/test-dplyr_methods.R
+++ b/tests/testthat/test-dplyr_methods.R
@@ -1,3 +1,4 @@
+library(S4Vectors)
 data(pbmc_small)
 df <- pbmc_small
 df$number <- sample(seq(ncol(df)))
@@ -130,6 +131,17 @@ test_that("left_join()", {
     expect_identical(colData(fd)[-n], colData(df))
 })
 
+test_that("left_join(), with DataFrame y", {
+    y <- df |> 
+        distinct(factor) |> 
+        mutate(string=letters[seq(nlevels(df$factor))]) |> 
+        DataFrame()
+    fd <- left_join(df, y, by="factor")
+    expect_s4_class(fd, "SingleCellExperiment")
+    expect_equal(n <- ncol(colData(fd)), ncol(colData(df))+1)
+    expect_identical(colData(fd)[-n], colData(df))
+})
+
 test_that("inner_join()", {
     y <- df |> 
         distinct(factor) |> 
@@ -141,6 +153,17 @@ test_that("inner_join()", {
     expect_equal(ncol(fd), sum(df$factor == fd$factor[1]))
 })
 
+test_that("inner_join(), with DataFrame y", {
+    y <- df |> 
+        distinct(factor) |> 
+        mutate(string=letters[seq(nlevels(df$factor))]) |> 
+        slice(1) |> DataFrame()
+    fd <- inner_join(df, y, by="factor")
+    expect_s4_class(fd, "SingleCellExperiment")
+    expect_equal(n <- ncol(colData(fd)), ncol(colData(df))+1)
+    expect_equal(ncol(fd), sum(df$factor == fd$factor[1]))
+})
+
 test_that("right_join()", {
     y <- df |>
         distinct(factor) |>
@@ -152,6 +175,17 @@ test_that("right_join()", {
     expect_equal(ncol(fd), sum(df$factor == fd$factor[1]))
 })
 
+test_that("right_join(), with DataFrame y", {
+    y <- df |>
+        distinct(factor) |>
+        mutate(string=letters[seq(nlevels(df$factor))]) |>
+        slice(1) |> DataFrame()
+    fd <- right_join(df, y, by="factor")
+    expect_s4_class(fd, "SingleCellExperiment")
+    expect_equal(n <- ncol(colData(fd)), ncol(colData(df))+1)
+    expect_equal(ncol(fd), sum(df$factor == fd$factor[1]))
+})
+
 test_that("full_join()", {
     # w/ duplicated cell names
     y <- tibble(factor="g2", other=1:3)
@@ -169,6 +203,23 @@ test_that("full_join()", {
         mutate(df, factor=paste(factor)))
 })
 
+test_that("full_join(), with DataFrame y", {
+    # w/ duplicated cell names
+    y <- tibble(factor="g2", other=1:3) |> DataFrame()
+    fd <- expect_message(full_join(df, y, by="factor", relationship="many-to-many"))
+    expect_s3_class(fd, "tbl_df")
+    expect_true(all(is.na(fd$other[fd$factor != "g2"])))
+    expect_true(all(!is.na(fd$other[fd$factor == "g2"])))
+    expect_equal(nrow(fd), ncol(df)+2*sum(df$factor == "g2"))
+    # w/o duplicates
+    y <- tibble(factor="g2", other=1) |> DataFrame()
+    fd <- expect_silent(full_join(df, y, by="factor"))
+    expect_s4_class(fd, "SingleCellExperiment")
+    expect_identical(
+        select(fd, -other), 
+        mutate(df, factor=paste(factor)))
+})
+
 test_that("slice()", {
     expect_identical(slice(df), df[, 0])
     expect_identical(slice(df, ncol(df)+1), df[, 0])