Merge branch 'master' into altExp_methods

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: tidySingleCellExperiment
 Title: Brings SingleCellExperiment to the Tidyverse 
-Version: 1.11.7
+Version: 1.13.2
 Authors@R: c(person("Stefano", "Mangiola", 
     comment=c(ORCID="0000-0001-7474-836X"),
     email="[email protected]",
@@ -22,11 +22,10 @@ Depends:
 Imports:
     dplyr, 
     tidyr, 
-    ttservice (>= 0.3.8),
+    ttservice (>= 0.4.0),
     SummarizedExperiment,
     tibble,
     ggplot2,
-    plotly,
     magrittr,
     rlang,
     purrr,
@@ -58,7 +57,8 @@ Suggests:
     GGally,
     uwot,
     celldex,
-    dittoSeq
+    dittoSeq,
+    plotly
 VignetteBuilder: 
     knitr
 RdMacros:

NAMESPACE

@@ -21,7 +21,6 @@ S3method(mutate,SingleCellExperiment)
 S3method(nest,SingleCellExperiment)
 S3method(pivot_longer,SingleCellExperiment)
 S3method(plot_ly,SingleCellExperiment)
-S3method(plot_ly,default)
 S3method(print,SingleCellExperiment)
 S3method(pull,SingleCellExperiment)
 S3method(rename,SingleCellExperiment)
@@ -45,7 +44,6 @@ S3method(unite,SingleCellExperiment)
 S3method(unnest,tidySingleCellExperiment_nested)
 export("%>%")
 export(join_transcripts)
-export(plot_ly)
 export(tidy)
 export(unnest_single_cell_experiment)
 exportMethods(aggregate_cells)
@@ -111,7 +109,6 @@ importFrom(pillar,get_extent)
 importFrom(pillar,style_subtle)
 importFrom(pillar,tbl_format_header)
 importFrom(pkgconfig,get_config)
-importFrom(plotly,plot_ly)
 importFrom(purrr,as_mapper)
 importFrom(purrr,imap)
 importFrom(purrr,map)
@@ -156,6 +153,7 @@ importFrom(ttservice,aggregate_cells)
 importFrom(ttservice,bind_cols)
 importFrom(ttservice,bind_rows)
 importFrom(ttservice,join_features)
+importFrom(ttservice,plot_ly)
 importFrom(utils,data)
 importFrom(utils,packageDescription)
 importFrom(utils,tail)

R/dplyr_methods.R

@@ -326,6 +326,35 @@ rowwise.SingleCellExperiment <- function(data, ...) {
         dplyr::rowwise(...)
 }
 
+.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, ...)
+
+        # 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
@@ -336,34 +365,19 @@ 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
 #' @export
-left_join.SingleCellExperiment <- 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)
-    }
-
-    z <- x |>
-        as_tibble() |>
-        dplyr::left_join(y, by=by, copy=copy, suffix=suffix, ...)
-
-    # If duplicated cells returns tibble
-    if (any(duplicated(z[[c_(x)$name]]))) {
-        message(duplicated_cell_names)
-        return(z)
-    }
-
-    # Otherwise return updated tidySingleCellExperiment
-    colData(x) <- z |> as_meta_data(x)
-    return(x)
-}
+left_join.SingleCellExperiment <- .join_factory(dplyr::left_join, FALSE)
 
 #' @name inner_join
 #' @rdname inner_join
@@ -381,30 +395,7 @@ left_join.SingleCellExperiment <- function(x, y,
 #' @importFrom dplyr inner_join
 #' @importFrom dplyr pull
 #' @export
-inner_join.SingleCellExperiment <- 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)
-    }
-
-    z <- x |>
-        as_tibble() |>
-        dplyr::inner_join(y, by=by, copy=copy, suffix=suffix, ...)
-
-    # If duplicated cells returns tibble
-    if (any(duplicated(z[[c_(x)$name]]))) {
-        message(duplicated_cell_names)
-        return(z)
-    }
-
-    # Otherwise return updated tidySingleCellExperiment
-    new_obj <- x[, pull(z, c_(x)$name)]
-    colData(new_obj) <- z |> as_meta_data(new_obj)
-    return(new_obj)
-}
+inner_join.SingleCellExperiment <- .join_factory(dplyr::inner_join, TRUE)
 
 #' @name right_join
 #' @rdname right_join
@@ -422,30 +413,7 @@ inner_join.SingleCellExperiment <- function(x, y,
 #' @importFrom dplyr right_join
 #' @importFrom dplyr pull
 #' @export
-right_join.SingleCellExperiment <- 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)
-    }
-
-    z <- x |>
-        as_tibble() |>
-        dplyr::right_join(y, by=by, copy=copy, suffix=suffix, ...)
-
-    # If duplicated cells returns tibble
-    if (any(duplicated(z[[c_(x)$name]]))) {
-        message(duplicated_cell_names)
-        return(z)
-    } 
-
-    # Otherwise return updated tidySingleCellExperiment
-    new_obj <- x[, pull(z, c_(x)$name)]
-    colData(new_obj) <- z |> as_meta_data(new_obj)
-    return(new_obj)
-}
+right_join.SingleCellExperiment <- .join_factory(dplyr::right_join, TRUE)
 
 #' @name full_join
 #' @rdname full_join
@@ -459,30 +427,7 @@ right_join.SingleCellExperiment <- function(x, y,
 #' @importFrom dplyr full_join
 #' @importFrom dplyr pull
 #' @export
-full_join.SingleCellExperiment <- 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)
-    }
-
-    z <- x |>
-        as_tibble() |>
-        dplyr::full_join(y, by=by, copy=copy, suffix=suffix, ...) 
-
-    # If duplicated cells returns tibble
-    if (any(duplicated(z[[c_(x)$name]]))) {
-        message(duplicated_cell_names)
-        return(z)
-    }
-
-    # Otherwise return updated tidySingleCellExperiment
-    new_obj <- x[, pull(z, c_(x)$name)]
-    colData(new_obj) <- z |> as_meta_data(x)
-    return(new_obj)
-}
+full_join.SingleCellExperiment <- .join_factory(dplyr::full_join, TRUE)
 
 #' @name slice
 #' @rdname slice

R/plotly_methods.R

@@ -171,32 +171,4 @@ plot_ly.default <- function(data=data.frame(), ..., type=NULL, name=NULL,
             split=split, frame=frame,
             width=width, height=height, source=source
         )
-}
-
-#' @importFrom plotly plot_ly
-#' @export
-plot_ly.SingleCellExperiment <- function(data=data.frame(), ..., type=NULL, name=NULL,
-    color=NULL, colors=NULL, alpha=NULL,
-    stroke=NULL, strokes=NULL, alpha_stroke=1,
-    size=NULL, sizes=c(10, 100),
-    span=NULL, spans=c(1, 20),
-    symbol=NULL, symbols=NULL,
-    linetype=NULL, linetypes=NULL,
-    split=NULL, frame=NULL,
-    width=NULL, height=NULL, source="A") {
-    data %>%
-
-        # This is a trick to not loop the call
-        as_tibble() %>%
-        plot_ly(...,
-            type=type, name=name,
-            color=color, colors=colors, alpha=alpha,
-            stroke=stroke, strokes=strokes, alpha_stroke=alpha_stroke,
-            size=size, sizes=sizes,
-            span=span, spans=spans,
-            symbol=symbol, symbols=symbols,
-            linetype=linetype, linetypes=linetypes,
-            split=split, frame=frame,
-            width=width, height=height, source=source
-        )
-}
+}