From adb25ccef6e47d0e5db24ba7920ccf7ff77ce3b9 Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Mon, 20 May 2024 17:20:14 +0800
Subject: [PATCH 1/8] export the barcode name as a column of plot data

---
 R/extract_data.R             | 105 ++++++++++++++++++++++++++++++
 R/sc-dim-utilities.R         |  23 ++++---
 R/sc-dim.R                   | 122 ++---------------------------------
 R/sc-spatial.R               |   9 +--
 man/geom_scattermore2.Rd     |  34 +++++++---
 man/sc-dim-geom-subset.Rd    |   2 +-
 man/sc-spatial-methods.Rd    |   2 +-
 man/scale_bg_color_manual.Rd |   3 +-
 8 files changed, 157 insertions(+), 143 deletions(-)
 create mode 100644 R/extract_data.R

diff --git a/R/extract_data.R b/R/extract_data.R
new file mode 100644
index 0000000..d1297ba
--- /dev/null
+++ b/R/extract_data.R
@@ -0,0 +1,105 @@
+##' @importFrom methods as
+##' @importFrom SingleCellExperiment reducedDims reducedDimNames
+##' @importFrom SummarizedExperiment assay colData assayNames
+##' @importFrom cli cli_abort
+.extract_sce_data <- function(object, features = NULL, dims = c(1, 2),
+                              reduction = NULL, cells = NULL, slot = 1,
+                              plot.pie = FALSE, density=FALSE, grid.n = 400,
+                              joint = FALSE, joint.fun = prod, sp.coords=NULL){
+    if (!is.null(cells)){
+        object <- object[, cells]
+    }
+
+    xx <- colData(object) |> as.data.frame(check.names=FALSE) |> suppressWarnings()
+    reduced.dat <- NULL
+    if (!is.null(dims)){
+        if (length(reducedDimNames(object)) == 0){
+            cli::cli_abort(c("The {.cls {class(object)}} didn't contain the results of reduction."))
+        }
+        if (is.null(reduction)){
+            reduction <- 1
+        }
+        reduced.dat <- reducedDims(object)[[reduction]][,dims] |>
+            as.data.frame(check.names = FALSE)
+        xx <- cbind(reduced.dat, xx)
+    }
+
+    if (!is.null(features)){
+        if (slot == 'data'){
+            if ('logcounts' %in% assayNames(object)){
+                slot <- 'logcounts'
+            }else{
+                slot <- 1
+            }
+        }
+
+        tmp <- assay(object, slot)
+        tmp <- tmp[features, ,drop=FALSE]
+
+        if (density && !is.null(reduced.dat) && !plot.pie){
+          tmp <- .buildWkde(w = tmp, coords = reduced.dat, n = grid.n,
+                            joint = joint, joint.fun = joint.fun)
+        }else if (density && !is.null(sp.coords) && !plot.pie){
+          tmp <- .buildWkde(w = tmp, coords = sp.coords, n = grid.n,
+                            joint = joint, joint.fun = joint.fun)
+        }else{
+          tmp <- tmp |>
+                 as('matrix') |>
+                 t() |>
+                 as.data.frame(check.names=FALSE)
+        }
+        xx <- cbind(xx, tmp)
+    }
+    xx <- cbind(data.frame(.BarcodeID=rownames(xx)), xx)
+    return(xx)
+}	
+
+get_dim_data <- function(object, features = NULL,
+                    dims=c(1,2), reduction=NULL,
+                    cells=NULL, slot = "data",
+                    plot.pie=FALSE, density = FALSE,
+                    grid.n = 400, joint = FALSE,
+                    joint.fun = prod, sp.coords = NULL
+                    ) {
+    rlang::check_installed('SeuratObject', 'for the internal function `get_dim_data()`.')
+    reduced.dat <- NULL
+
+    if (is.null(cells)) {
+        cells <- colnames(object)
+    }
+    #xx <- data.frame(ident=SeuratObject::Idents(object)[cells])
+    xx <- cbind(data.frame(ident = SeuratObject::Idents(object)[cells]), object@meta.data[cells,,drop=FALSE])
+
+    if (!is.null(dims)) {
+        if (is.null(reduction)) {
+            reduction <- SeuratObject::DefaultDimReduc(object)
+        }
+        dims <- paste0(SeuratObject::Key(object = object[[reduction]]), dims)
+        reduced.dat <- as.data.frame(SeuratObject::Embeddings(object[[reduction]])[cells, dims])
+    }
+
+    if (!is.null(features)){
+        if (is.numeric(features)){
+            features <- features[features <= nrow(object)]
+            features <- rownames(object)[features]
+        }
+        tmp <- SeuratObject::FetchData(object, vars = features, cells = cells, slot = slot)
+        if (density && !is.null(reduced.dat) && !plot.pie){
+            tmp <- .buildWkde(t(tmp), reduced.dat, grid.n, joint, joint.fun)
+            xx <- cbind(reduced.dat, xx, tmp)
+        }else if(density && !is.null(sp.coords) && !plot.pie){
+            tmp <- .buildWkde(t(tmp), sp.coords, grid.n, joint, joint.fun)
+            xx <- cbind(xx, tmp)
+        }else if (!is.null(reduced.dat) && !density){
+            xx <- cbind(reduced.dat, xx, tmp)
+        }else{
+            xx <- cbind(xx, tmp)
+        }
+    }else{
+        if (!is.null(reduced.dat)){
+            xx <- cbind(reduced.dat, xx)
+        }
+    }
+    xx <- cbind(data.frame(.BarcodeID=rownames(xx)), xx)
+    return(xx)
+}
diff --git a/R/sc-dim-utilities.R b/R/sc-dim-utilities.R
index 3e65dbc..1270c8e 100644
--- a/R/sc-dim-utilities.R
+++ b/R/sc-dim-utilities.R
@@ -42,11 +42,11 @@ sc_dim_count <- function(sc_dim_plot) {
     y <- setNames(dd$label, dd$colour)
   } else {
     d2 <- unique(x[, c("colour", "group")])
-    y <- setNames(d2$group -1, d2$colour)
+    y <- setNames(d2$group, d2$colour)
   }
 
   d <- as.data.frame(sort(table(x$colour)))
-  d$group <- y[as.character(d$Var1)]
+  d$group <- y[as.character(d$Var1)] |> as.factor()
   
   rlang::check_installed("forcats", "for sc_dim_count()")
 
@@ -123,7 +123,7 @@ ggplot_add.sc_dim_geom_feature <- function(object, plot, object_name){
                                dims = object$dims, 
                                features = object$features)
     }
-    d <- as_tibble(d, rownames='.ID.NAME')
+    #d <- as_tibble(d, rownames='.ID.NAME')
 
     d <- tidyr::pivot_longer(
            d, 
@@ -131,9 +131,8 @@ ggplot_add.sc_dim_geom_feature <- function(object, plot, object_name){
            names_to = "features"
          ) |> 
          dplyr::select(-c(2, 3, 4)) |>
-         dplyr::left_join(plot$data[,seq_len(3)] |>
-                          tibble::as_tibble(rownames='.ID.NAME'), 
-                          by='.ID.NAME'
+         dplyr::left_join(plot$data[,seq_len(3)],
+                          by='.BarcodeID'
          )
     if (is.numeric(object$features)){
         object$features <- rownames(object$data)[object$features]
@@ -180,11 +179,11 @@ sc_dim_geom_label <- function(geom = ggplot2::geom_text, ...) {
 ##' @method ggplot_add sc_dim_geom_label
 ##' @export
 ggplot_add.sc_dim_geom_label <- function(object, plot, object_name) {
-    dims <- names(plot$data)[seq_len(2)]
+    dims <- names(plot$data)[seq_len(3)]
     lab.text <- plot$labels$colour
     if (is.null(object$data)) {
         object$data <- dplyr::group_by(plot$data, !!rlang::sym(lab.text)) |> 
-            dplyr::summarize(x=mean(get(dims[1])), y=mean(get(dims[2])))
+            dplyr::summarize(x=mean(get(dims[2])), y=mean(get(dims[3])))
     }
 
     geom <- object$geom
@@ -235,10 +234,10 @@ sc_dim_geom_ellipse <- function(mapping = NULL, level = 0.95, ...) {
 ##' @importFrom ggplot2 stat_ellipse
 ##' @export
 ggplot_add.sc_dim_geom_ellipse <- function(object, plot, object_name) {
-    dims <- names(plot$data)[seq_len(2)]
+    dims <- names(plot$data)[seq_len(3)]
     lab.text <- plot$labels$colour
-    default_mapping <- aes(x = .data[[dims[1]]], 
-                           y = .data[[dims[2]]], 
+    default_mapping <- aes(x = .data[[dims[2]]], 
+                           y = .data[[dims[3]]], 
                            group = !!rlang::sym(lab.text))
     if (is.null(object$mapping)) {
         mapping <- default_mapping
@@ -271,7 +270,7 @@ ggplot_add.sc_dim_geom_ellipse <- function(object, plot, object_name) {
 ##' colLabels(sce) <- clusters
 ##' sce <- runUMAP(sce, assay.type = 'logcounts')
 ##' p1 <- sc_dim(sce, reduction = 'UMAP')
-##' f1 <- p1 + sc_dim_geom_sub(subset = c(1, 2), .column = 'label')
+##' f1 <- p1 + sc_dim_geom_sub(subset = c(1, 2), .column = 'label', bg_colour='black')
 sc_dim_geom_sub <- function(mapping = NULL, subset, .column = "ident", ...) {
   structure(list(mapping = mapping, 
         subset = subset, 
diff --git a/R/sc-dim.R b/R/sc-dim.R
index 89e8215..22a7539 100644
--- a/R/sc-dim.R
+++ b/R/sc-dim.R
@@ -110,122 +110,14 @@ setMethod('sc_dim', 'SingleCellExperiment',
 
 })
 
-##' @importFrom methods as
-##' @importFrom SingleCellExperiment reducedDims reducedDimNames
-##' @importFrom SummarizedExperiment assay colData assayNames
-##' @importFrom cli cli_abort
-.extract_sce_data <- function(object, features = NULL, dims = c(1, 2), 
-                              reduction = NULL, cells = NULL, slot = 1, 
-                              plot.pie = FALSE, density=FALSE, grid.n = 400, 
-                              joint = FALSE, joint.fun = prod, sp.coords=NULL){
-    if (!is.null(cells)){
-        object <- object[, cells]
-    }
-    
-    xx <- colData(object) |> data.frame()
-    reduced.dat <- NULL
-    if (!is.null(dims)){
-        if (length(reducedDimNames(object)) == 0){
-            cli::cli_abort(c("The {.cls {class(object)}} didn't contain the results of reduction."))
-        }
-        if (is.null(reduction)){
-            reduction <- 1
-        }
-        reduced.dat <- reducedDims(object)[[reduction]][,dims] |> 
-            as.data.frame(check.names = FALSE)
-        xx <- merge(reduced.dat, xx, by = 0)
-        rownames(xx) <- xx$Row.names
-        xx$Row.names <- NULL
-    }
-
-    if (!is.null(features)){
-        if (slot == 'data'){
-            if ('logcounts' %in% assayNames(object)){
-                slot <- 'logcounts'
-            }else{
-                slot <- 1
-            }
-        }
-        
-        tmp <- assay(object, slot)
-        tmp <- tmp[features, ,drop=FALSE] 
-
-        if (density && !is.null(reduced.dat) && !plot.pie){
-          tmp <- .buildWkde(w = tmp, coords = reduced.dat, n = grid.n, 
-                            joint = joint, joint.fun = joint.fun) 
-        }else if (density && !is.null(sp.coords) && !plot.pie){
-          tmp <- .buildWkde(w = tmp, coords = sp.coords, n = grid.n,
-                            joint = joint, joint.fun = joint.fun)
-        }else{
-          tmp <- tmp |> 
-                 as('matrix') |> 
-                 t() |> 
-                 as.data.frame(check.names=FALSE)
-        }
-
-        xx <- merge(xx, tmp, by = 0)
-        rownames(xx) <- xx$Row.names
-        xx$Row.names <- NULL
-    }
-    return(xx)
-}
-
 ##' @importFrom tidydr theme_dr
 sc_dim_internal <- function(data, mapping, geom = sc_geom_point, ...) {
-    dims <- names(data)[seq_len(2)]
-    p <- ggplot(data, aes(.data[[dims[1]]], .data[[dims[2]]])) 
-    p + geom(mapping, ...) +
-        theme_dr()
+    dims <- names(data)[seq_len(3)]
+    p <- ggplot(data, aes(.data[[dims[2]]], .data[[dims[3]]]))
+    params <- list(...)
+    params$mapping <- mapping
+    layers <- do.call(geom, params)
+    p <- p + layers + theme_dr()
+    return(p)
 } 
 
-get_dim_data <- function(object, features = NULL, 
-                    dims=c(1,2), reduction=NULL, 
-                    cells=NULL, slot = "data", 
-                    plot.pie=FALSE, density = FALSE, 
-                    grid.n = 400, joint = FALSE, 
-                    joint.fun = prod, sp.coords = NULL
-                    ) {
-    rlang::check_installed('SeuratObject', 'for the internal function `get_dim_data()`.')
-    reduced.dat <- NULL
-    
-    if (is.null(cells)) {
-        cells <- colnames(object)
-    }
-    #xx <- data.frame(ident=SeuratObject::Idents(object)[cells])
-    xx <- cbind(data.frame(ident = SeuratObject::Idents(object)[cells]), object@meta.data[cells,,drop=FALSE])
-    
-    if (!is.null(dims)) {
-        if (is.null(reduction)) {
-            reduction <- SeuratObject::DefaultDimReduc(object)
-        }
-        dims <- paste0(SeuratObject::Key(object = object[[reduction]]), dims)
-        reduced.dat <- as.data.frame(SeuratObject::Embeddings(object[[reduction]])[cells, dims])
-    }
-
-    if (!is.null(features)){
-        if (is.numeric(features)){
-            features <- features[features <= nrow(object)]
-            features <- rownames(object)[features]
-        }
-        tmp <- SeuratObject::FetchData(object, vars = features, cells = cells, slot = slot)
-        if (density && !is.null(reduced.dat) && !plot.pie){
-            tmp <- .buildWkde(t(tmp), reduced.dat, grid.n, joint, joint.fun)
-            xx <- cbind(reduced.dat, xx, tmp)
-        }else if(density && !is.null(sp.coords) && !plot.pie){
-            tmp <- .buildWkde(t(tmp), sp.coords, grid.n, joint, joint.fun)
-            xx <- cbind(xx, tmp)
-        }else if (!is.null(reduced.dat) && !density){
-            xx <- cbind(reduced.dat, xx, tmp)
-        }else{
-            xx <- cbind(xx, tmp)
-        }
-    }else{
-        if (!is.null(reduced.dat)){
-            xx <- cbind(reduced.dat, xx)
-        }
-    }
-
-    return(xx)
-}
-
-
diff --git a/R/sc-spatial.R b/R/sc-spatial.R
index 336d595..7d73a7f 100644
--- a/R/sc-spatial.R
+++ b/R/sc-spatial.R
@@ -58,7 +58,7 @@
 ##' eh <- ExperimentHub()
 ##' # query STexampleData datasets
 ##' myfiles <- query(eh, "STexampleData")
-##' spe <- myfiles[["EH7538"]]
+##' spe <- myfiles[["EH9516"]]
 ##' spe <- spe[, colData(spe)$in_tissue == 1]
 ##' set.seed(123)
 ##' genes <- rownames(spe) |> sample(6) 
@@ -250,10 +250,11 @@ setMethod('sc_spatial', 'SingleCellExperiment', function(object,
                                      cells = NULL, slot = slot, plot.pie = plot.pie, density=density, 
                                      grid.n = grid.n, joint = joint, joint.fun = joint.fun, 
                                      sp.coords = coords.da)
+    rownames(features.da) <- features.da$`.BarcodeID`
+    features.da$`.BarcodeID` <- NULL
 
-    d <- merge(coords.da, features.da, by = 0)
-    rownames(d) <- d$Row.names
-    d$Row.names <- NULL
+    d <- merge(coords.da, features.da, by=0)
+    colnames(d)[1] <- '.BarcodeID'
 
     default_mapping <- aes_string(x = colnames(coords.da)[2], y = colnames(coords.da)[1])
     if (!is.null(features)){
diff --git a/man/geom_scattermore2.Rd b/man/geom_scattermore2.Rd
index 546d401..7242c73 100644
--- a/man/geom_scattermore2.Rd
+++ b/man/geom_scattermore2.Rd
@@ -43,15 +43,31 @@ the plot data. The return value must be a \code{data.frame}, and
 will be used as the layer data. A \code{function} can be created
 from a \code{formula} (e.g. \code{~ head(.x, 10)}).}
 
-\item{stat}{The statistical transformation to use on the data for this
-layer, either as a \code{ggproto} \code{Geom} subclass or as a string naming the
-stat stripped of the \code{stat_} prefix (e.g. \code{"count"} rather than
-\code{"stat_count"})}
-
-\item{position}{Position adjustment, either as a string naming the adjustment
-(e.g. \code{"jitter"} to use \code{position_jitter}), or the result of a call to a
-position adjustment function. Use the latter if you need to change the
-settings of the adjustment.}
+\item{stat}{The statistical transformation to use on the data for this layer.
+When using a \verb{geom_*()} function to construct a layer, the \code{stat}
+argument can be used the override the default coupling between geoms and
+stats. The \code{stat} argument accepts the following:
+\itemize{
+\item A \code{Stat} ggproto subclass, for example \code{StatCount}.
+\item A string naming the stat. To give the stat as a string, strip the
+function name of the \code{stat_} prefix. For example, to use \code{stat_count()},
+give the stat as \code{"count"}.
+\item For more information and other ways to specify the stat, see the
+\link[ggplot2:layer_stats]{layer stat} documentation.
+}}
+
+\item{position}{A position adjustment to use on the data for this layer. This
+can be used in various ways, including to prevent overplotting and
+improving the display. The \code{position} argument accepts the following:
+\itemize{
+\item The result of calling a position function, such as \code{position_jitter()}.
+This method allows for passing extra arguments to the position.
+\item A string naming the position adjustment. To give the position as a
+string, strip the function name of the \code{position_} prefix. For example,
+to use \code{position_jitter()}, give the position as \code{"jitter"}.
+\item For more information and other ways to specify the position, see the
+\link[ggplot2:layer_positions]{layer position} documentation.
+}}
 
 \item{...}{Other arguments passed on to \code{\link[ggplot2]{layer}}.}
 
diff --git a/man/sc-dim-geom-subset.Rd b/man/sc-dim-geom-subset.Rd
index 30d49de..569ccd7 100644
--- a/man/sc-dim-geom-subset.Rd
+++ b/man/sc-dim-geom-subset.Rd
@@ -32,7 +32,7 @@ clusters <- clusterCells(sce, assay.type = 'logcounts')
 colLabels(sce) <- clusters
 sce <- runUMAP(sce, assay.type = 'logcounts')
 p1 <- sc_dim(sce, reduction = 'UMAP')
-f1 <- p1 + sc_dim_geom_sub(subset = c(1, 2), .column = 'label')
+f1 <- p1 + sc_dim_geom_sub(subset = c(1, 2), .column = 'label', bg_colour='black')
 }
 \seealso{
 \link{sc_dim_geom_sub}
diff --git a/man/sc-spatial-methods.Rd b/man/sc-spatial-methods.Rd
index b80ba93..5d2dbf8 100644
--- a/man/sc-spatial-methods.Rd
+++ b/man/sc-spatial-methods.Rd
@@ -159,7 +159,7 @@ library(STexampleData)
 eh <- ExperimentHub()
 # query STexampleData datasets
 myfiles <- query(eh, "STexampleData")
-spe <- myfiles[["EH7538"]]
+spe <- myfiles[["EH9516"]]
 spe <- spe[, colData(spe)$in_tissue == 1]
 set.seed(123)
 genes <- rownames(spe) |> sample(6) 
diff --git a/man/scale_bg_color_manual.Rd b/man/scale_bg_color_manual.Rd
index 8b22ad1..dda26de 100644
--- a/man/scale_bg_color_manual.Rd
+++ b/man/scale_bg_color_manual.Rd
@@ -57,7 +57,8 @@ missing values, and do so by default. If you want to remove missing values
 from a discrete scale, specify \code{na.translate = FALSE}.}
     \item{\code{drop}}{Should unused factor levels be omitted from the scale?
 The default, \code{TRUE}, uses the levels that appear in the data;
-\code{FALSE} uses all the levels in the factor.}
+\code{FALSE} includes the levels in the factor. Please note that to display
+every level in a legend, the layer should use \code{show.legend = TRUE}.}
     \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.}
     \item{\code{super}}{The super class to use for the constructed scale}
   }}

From 424decc85c8378de863cf125aae1ee24804f9366 Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Mon, 20 May 2024 22:19:17 +0800
Subject: [PATCH 2/8] add ggsc class

---
 R/sc-dim.R     | 2 ++
 R/sc-feature.R | 2 ++
 R/sc-spatial.R | 4 +++-
 R/utils.R      | 9 ++++++++-
 4 files changed, 15 insertions(+), 2 deletions(-)

diff --git a/R/sc-dim.R b/R/sc-dim.R
index 22a7539..37273a1 100644
--- a/R/sc-dim.R
+++ b/R/sc-dim.R
@@ -83,6 +83,7 @@ setMethod("sc_dim",
     mapping <- .check_aes_mapping(object, mapping, data = d, prefix = 'ident')
 
     p <- sc_dim_internal(d, mapping, ...)
+    p <- .add_class(p, "ggsc")
     return(p)
 })
 
@@ -106,6 +107,7 @@ setMethod('sc_dim', 'SingleCellExperiment',
     mapping <- .check_aes_mapping(object, mapping, data = d, prefix = 'label')
 
     p <- sc_dim_internal(d, mapping, ...)
+    p <- .add_class(p, "ggsc")
     return(p)
 
 })
diff --git a/R/sc-feature.R b/R/sc-feature.R
index 09c83ff..dbaf12d 100644
--- a/R/sc-feature.R
+++ b/R/sc-feature.R
@@ -126,6 +126,7 @@ setMethod('sc_feature', 'Seurat', function(object, features,
     if (!common.legend && length(features) > 1){
         p <- .split.by.feature(p, ncol)
     }
+    p <- .add_class(p, "ggsc")
     return(p)
 })
 
@@ -195,6 +196,7 @@ setMethod("sc_feature", "SingleCellExperiment",
     if (!common.legend && length(features) > 1){
         p <- .split.by.feature(p, ncol)
     }
+    p <- .add_class(p, "ggsc")
     return(p)    
 })
 
diff --git a/R/sc-spatial.R b/R/sc-spatial.R
index 7d73a7f..8feb384 100644
--- a/R/sc-spatial.R
+++ b/R/sc-spatial.R
@@ -204,7 +204,8 @@ setMethod("sc_spatial", 'Seurat',
     if (!common.legend && length(features) > 1 && !plot.pie){
         ncol <- min(length(features), ncol)
         p <- .split.by.feature(p, ncol, joint)
-    }    
+    }
+    p <- .add_class(p, "ggsc") 
     return(p)    
 })
 
@@ -340,6 +341,7 @@ setMethod('sc_spatial', 'SingleCellExperiment', function(object,
         ncol <- min(length(features), ncol)
         p <- .split.by.feature(p, ncol, joint)
     }
+    p <- .add_class(p, "ggsc")
     return(p)
 })
 
diff --git a/R/utils.R b/R/utils.R
index ea8543c..39d0491 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -42,4 +42,11 @@
 }
 
 
-
+.add_class <- function(x, clsnm){
+    old <- class(x)
+    if (clsnm %in% old){
+        return(x)
+    }
+    class(x) <- c(unique(clsnm), union(old))
+    return(x)
+}

From 92f149cb678660f69d3b4a8754090158595a5c14 Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Tue, 21 May 2024 20:31:29 +0800
Subject: [PATCH 3/8] add sc_geom_annot and left_join %<<+% to add the external
 data

---
 NAMESPACE            |  6 ++++
 R/method-left_join.R | 48 ++++++++++++++++++++++++++++++
 R/sc-geom-annot.R    | 69 ++++++++++++++++++++++++++++++++++++++++++++
 R/utils.R            |  2 +-
 man/attacher.Rd      | 20 +++++++++++++
 man/sc_geom_annot.Rd | 68 +++++++++++++++++++++++++++++++++++++++++++
 6 files changed, 212 insertions(+), 1 deletion(-)
 create mode 100644 R/method-left_join.R
 create mode 100644 R/sc-geom-annot.R
 create mode 100644 man/attacher.Rd
 create mode 100644 man/sc_geom_annot.Rd

diff --git a/NAMESPACE b/NAMESPACE
index bdc6edc..c0daa51 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -5,6 +5,9 @@ S3method(ggplot_add,dim_sub)
 S3method(ggplot_add,sc_dim_geom_ellipse)
 S3method(ggplot_add,sc_dim_geom_feature)
 S3method(ggplot_add,sc_dim_geom_label)
+S3method(ggplot_add,sc_geom_annot)
+S3method(left_join,ggsc)
+export("%<<+%")
 export(aes)
 export(draw_key_scattermore2)
 export(geom_scattermore2)
@@ -17,6 +20,7 @@ export(sc_dim_geom_sub)
 export(sc_dim_sub)
 export(sc_dot)
 export(sc_feature)
+export(sc_geom_annot)
 export(sc_geom_point)
 export(sc_spatial)
 export(sc_violin)
@@ -42,6 +46,8 @@ importFrom(SummarizedExperiment,assay)
 importFrom(SummarizedExperiment,assayNames)
 importFrom(SummarizedExperiment,colData)
 importFrom(cli,cli_abort)
+importFrom(cli,cli_warn)
+importFrom(dplyr,left_join)
 importFrom(ggfun,get_aes_var)
 importFrom(ggplot2,"%+replace%")
 importFrom(ggplot2,ScaleDiscreteIdentity)
diff --git a/R/method-left_join.R b/R/method-left_join.R
new file mode 100644
index 0000000..830a606
--- /dev/null
+++ b/R/method-left_join.R
@@ -0,0 +1,48 @@
+#' @importFrom dplyr left_join
+#' @method left_join ggsc
+#' @importFrom cli cli_warn
+#' @export
+left_join.ggsc <- function(x, y, by = NULL, copy = FALSE, suffix=c("", ".y"), ...){
+    dat <- x$data
+    msg <- c("The {.arg suffix} requires a character vector containing 2 different elements,",
+             "The first element must be \"\", and the second element must not be \"\",",
+             "it was set {.code suffix=c(\"\", \".y\")} automatically.")
+    if (all(nchar(suffix)!=0)){
+        cli::cli_warn(msg)
+        suffix[1] = ""
+    }
+    if (all(nchar(suffix)==0)){
+        cli::cli_warn(msg)
+        suffix[2] = ".y"
+    }
+    if (nchar(suffix[1])!=0 && nchar(suffix[2])==0){
+        cli::cli_warn(msg)
+        suffix <- rev(suffix[seq_len(2)])
+    }
+    da <- dplyr::left_join(dat, y, by = by, copy = copy, suffix = suffix, ...) 
+
+    x$data <- da
+
+    return(x)
+}
+
+#' add the external data frame to the ggsc object.
+#' @rdname attacher
+#' @param x ggsc object, the result of \code{sc_dim}, \code{sc_feature} and \code{sc_spatial}.
+#' @param y a data.frame, which the first column should be a barcode id, which is similar with
+#' the x$data$`.BarcodeID`. It also can have another column \code{features}.
+#' @export
+#' @return ggsc object
+`%<<+%` <- function(x, y){
+    if (!inherits(x, 'ggsc')){
+        cli::cli_abort(c("Can not add the `data` in the right to left object, since it is not a `ggsc` class."))
+    }
+    if (missing(y)){
+        cli::cli_abort(c(
+                "Cannot use {.code <+} with a single argument.",
+                "i" = "Did you accidentally put {.code %<<+%} on a new line?"
+        ))
+    }
+    x <- left_join(x, y)
+    return(x)
+}
diff --git a/R/sc-geom-annot.R b/R/sc-geom-annot.R
new file mode 100644
index 0000000..81799e5
--- /dev/null
+++ b/R/sc-geom-annot.R
@@ -0,0 +1,69 @@
+#' @title add the annotation layer for ggsc object
+#' @param data The data to be displayed in this layer. There are three
+#' options:
+#'  If \code{NULL}, the default, the data is inherited from the plot
+#'  data as specified in the call to \code{ggplot()}.
+#'  A \code{data.frame}, will override the plot data. the \code{data.frame}
+#'  should have a barcode id or features column.
+#'  A \code{function} will be called with a single argument, the plot
+#'  data. The return value must be a ‘data.frame’, and will be
+#'  used as the layer data. A \code{function} can be created from a
+#'  ‘formula’ (e.g. ‘~ head(.x, 10)’).
+#' @param mapping Set of aesthetic mappings created by \code{aes()}. If specified
+#' and \code{inherit.aes = TRUE} (the default), it is combined with the default 
+#' mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.
+#' @inheritParams geom_scattermore2
+#' @export
+#' @return layer object
+sc_geom_annot <- function(
+     data=NULL, 
+     mapping=NULL,
+     pointsize = 2, 
+     pixels = c(512, 512),
+     gap_colour = "white",
+     gap_alpha = 1,
+     bg_line_width = 0.3,
+     gap_line_width = 0.1,
+     show.legend = NA,
+     na.rm = FALSE,
+     ...
+){
+    params <- list(...)
+    x <- structure(
+      list(data = data, 
+           mapping = mapping, 
+	   pointsize = pointsize,
+           pixels = pixels, 
+           gap_colour = gap_colour,
+           gap_alpha = gap_alpha,
+           bg_line_width = bg_line_width,
+           gap_line_width = gap_line_width,
+           show.legend = show.legend,
+           na.rm = na.rm, 
+           params=params),
+       class = 'sc_geom_annot'
+    )
+    return(x)
+}
+
+#' @importFrom ggplot2 ggplot_add
+#' @method ggplot_add sc_geom_annot
+#' @export
+ggplot_add.sc_geom_annot <- function(object, plot, object_name){
+    object <- .check_layer_data(object, plot)
+    params <- object$params
+    object$params <- NULL
+    ly <- do.call(geom_scattermore2, c(object, params))
+    ggplot_add(ly, plot, object_name)
+}
+
+
+.check_layer_data <- function(object, plot){
+    if (is.data.frame(object$data)){
+        object$data <- plot$data |> 
+             dplyr::left_join(object$data, suffix = c("", ".y")) |> 
+             suppressMessages()
+    }
+    return(object)
+}
+			    
diff --git a/R/utils.R b/R/utils.R
index 39d0491..60efd91 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -47,6 +47,6 @@
     if (clsnm %in% old){
         return(x)
     }
-    class(x) <- c(unique(clsnm), union(old))
+    class(x) <- c(unique(clsnm), unique(old))
     return(x)
 }
diff --git a/man/attacher.Rd b/man/attacher.Rd
new file mode 100644
index 0000000..6242aa6
--- /dev/null
+++ b/man/attacher.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/method-left_join.R
+\name{\%<<+\%}
+\alias{\%<<+\%}
+\title{add the external data frame to the ggsc object.}
+\usage{
+x \%<<+\% y
+}
+\arguments{
+\item{x}{ggsc object, the result of \code{sc_dim}, \code{sc_feature} and \code{sc_spatial}.}
+
+\item{y}{a data.frame, which the first column should be a barcode id, which is similar with
+the x$data$\code{.BarcodeID}. It also can have another column \code{features}.}
+}
+\value{
+ggsc object
+}
+\description{
+add the external data frame to the ggsc object.
+}
diff --git a/man/sc_geom_annot.Rd b/man/sc_geom_annot.Rd
new file mode 100644
index 0000000..3a18dd1
--- /dev/null
+++ b/man/sc_geom_annot.Rd
@@ -0,0 +1,68 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/sc-geom-annot.R
+\name{sc_geom_annot}
+\alias{sc_geom_annot}
+\title{add the annotation layer for ggsc object}
+\usage{
+sc_geom_annot(
+  data = NULL,
+  mapping = NULL,
+  pointsize = 2,
+  pixels = c(512, 512),
+  gap_colour = "white",
+  gap_alpha = 1,
+  bg_line_width = 0.3,
+  gap_line_width = 0.1,
+  show.legend = NA,
+  na.rm = FALSE,
+  ...
+)
+}
+\arguments{
+\item{data}{The data to be displayed in this layer. There are three
+options:
+If \code{NULL}, the default, the data is inherited from the plot
+data as specified in the call to \code{ggplot()}.
+A \code{data.frame}, will override the plot data. the \code{data.frame}
+should have a barcode id or features column.
+A \code{function} will be called with a single argument, the plot
+data. The return value must be a ‘data.frame’, and will be
+used as the layer data. A \code{function} can be created from a
+‘formula’ (e.g. ‘~ head(.x, 10)’).}
+
+\item{mapping}{Set of aesthetic mappings created by \code{aes()}. If specified
+and \code{inherit.aes = TRUE} (the default), it is combined with the default
+mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.}
+
+\item{pointsize}{Radius of rasterized point. Use ‘0’ for single pixels (fastest).}
+
+\item{pixels}{Vector with X and Y resolution of the raster, default \code{c(512,512)}.}
+
+\item{gap_colour}{colour of gap background between the bottom background
+and top point point layer, default is \code{white}.}
+
+\item{gap_alpha}{numeric the transparency of gap background colour, default is 1.}
+
+\item{bg_line_width}{numeric the line width of background point layer,
+default is \code{0.3}.}
+
+\item{gap_line_width}{numeric the line width of gap between the background and
+top point point layer, default is \code{.1}.}
+
+\item{show.legend}{logical. Should this layer be included in the legends?
+\code{NA}, the default, includes if any aesthetics are mapped.
+\code{FALSE} never includes, and \code{TRUE} always includes.
+It can also be a named logical vector to finely select the aesthetics to
+display.}
+
+\item{na.rm}{If \code{FALSE}, the default, missing values are removed with
+a warning. If \code{TRUE}, missing values are silently removed.}
+
+\item{...}{Other arguments passed on to \code{\link[ggplot2]{layer}}.}
+}
+\value{
+layer object
+}
+\description{
+add the annotation layer for ggsc object
+}

From 0dd9e8a5703f38cd6e4891824076df3baebfb9f7 Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Wed, 22 May 2024 23:00:30 +0800
Subject: [PATCH 4/8] adjust the extraction of ah_id

---
 R/sc-spatial.R            | 3 ++-
 man/sc-spatial-methods.Rd | 3 ++-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/R/sc-spatial.R b/R/sc-spatial.R
index 8feb384..abe9feb 100644
--- a/R/sc-spatial.R
+++ b/R/sc-spatial.R
@@ -58,7 +58,8 @@
 ##' eh <- ExperimentHub()
 ##' # query STexampleData datasets
 ##' myfiles <- query(eh, "STexampleData")
-##' spe <- myfiles[["EH9516"]]
+##' ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC']
+##' spe <- myfiles[[ah_id]]
 ##' spe <- spe[, colData(spe)$in_tissue == 1]
 ##' set.seed(123)
 ##' genes <- rownames(spe) |> sample(6) 
diff --git a/man/sc-spatial-methods.Rd b/man/sc-spatial-methods.Rd
index 5d2dbf8..38edd4d 100644
--- a/man/sc-spatial-methods.Rd
+++ b/man/sc-spatial-methods.Rd
@@ -159,7 +159,8 @@ library(STexampleData)
 eh <- ExperimentHub()
 # query STexampleData datasets
 myfiles <- query(eh, "STexampleData")
-spe <- myfiles[["EH9516"]]
+ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC']
+spe <- myfiles[[ah_id]]
 spe <- spe[, colData(spe)$in_tissue == 1]
 set.seed(123)
 genes <- rownames(spe) |> sample(6) 

From 8ad4e0c73ea42099409d23e8fcd9cd0c3ad5c28b Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Thu, 23 May 2024 11:52:56 +0800
Subject: [PATCH 5/8] release test

---
 .github/workflows/rworkflows.yml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/.github/workflows/rworkflows.yml b/.github/workflows/rworkflows.yml
index 4037ea8..8e6bc3f 100644
--- a/.github/workflows/rworkflows.yml
+++ b/.github/workflows/rworkflows.yml
@@ -30,12 +30,12 @@ jobs:
         - os: macOS-latest
           bioc: release
           r: auto
-          cont: ~
+          cont: ghcr.io/bioconductor/bioconductor_docker:RELEASE_3_19
           rspm: ~
         - os: windows-latest
           bioc: release
           r: auto
-          cont: ~
+          cont: ghcr.io/bioconductor/bioconductor_docker:RELEASE_3_19 
           rspm: ~
     steps:
     - uses: neurogenomics/rworkflows@master

From a7e5e8afd20f826a67313e218e20710b2fa5bf7a Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Fri, 24 May 2024 17:21:57 +0800
Subject: [PATCH 6/8] adjust %<<+% for patchwork

---
 R/internals.R        |  1 +
 R/method-left_join.R | 10 ++++++++--
 man/attacher.Rd      |  4 ++--
 3 files changed, 11 insertions(+), 4 deletions(-)

diff --git a/R/internals.R b/R/internals.R
index 63eb07c..005ff19 100644
--- a/R/internals.R
+++ b/R/internals.R
@@ -23,6 +23,7 @@
    p <- p$data |> dplyr::group_split(.data$features) |>
            lapply(function(i){
               p$data <- i
+              p <- .add_class(p, "ggsc")
               return(p)
             })
 
diff --git a/R/method-left_join.R b/R/method-left_join.R
index 830a606..fdd92c8 100644
--- a/R/method-left_join.R
+++ b/R/method-left_join.R
@@ -29,8 +29,8 @@ left_join.ggsc <- function(x, y, by = NULL, copy = FALSE, suffix=c("", ".y"), ..
 #' add the external data frame to the ggsc object.
 #' @rdname attacher
 #' @param x ggsc object, the result of \code{sc_dim}, \code{sc_feature} and \code{sc_spatial}.
-#' @param y a data.frame, which the first column should be a barcode id, which is similar with
-#' the x$data$`.BarcodeID`. It also can have another column \code{features}.
+#' @param y a data.frame, which should have a barcode id column named \code{.BarcodeID},
+#' it is the same to the x$data$`.BarcodeID`. It also can have another column \code{features}.
 #' @export
 #' @return ggsc object
 `%<<+%` <- function(x, y){
@@ -43,6 +43,12 @@ left_join.ggsc <- function(x, y, by = NULL, copy = FALSE, suffix=c("", ".y"), ..
                 "i" = "Did you accidentally put {.code %<<+%} on a new line?"
         ))
     }
+    if (inherits(x, 'patchwork')){
+        x$patches$plots <- lapply(x$patches$plots, function(p){
+                                  p <- left_join(p, y)
+                                  return(p)}) |>
+                           suppressMessages()
+    }
     x <- left_join(x, y)
     return(x)
 }
diff --git a/man/attacher.Rd b/man/attacher.Rd
index 6242aa6..21e540f 100644
--- a/man/attacher.Rd
+++ b/man/attacher.Rd
@@ -9,8 +9,8 @@ x \%<<+\% y
 \arguments{
 \item{x}{ggsc object, the result of \code{sc_dim}, \code{sc_feature} and \code{sc_spatial}.}
 
-\item{y}{a data.frame, which the first column should be a barcode id, which is similar with
-the x$data$\code{.BarcodeID}. It also can have another column \code{features}.}
+\item{y}{a data.frame, which should have a barcode id column named \code{.BarcodeID},
+it is the same to the x$data$\code{.BarcodeID}. It also can have another column \code{features}.}
 }
 \value{
 ggsc object

From 7183274db0d9899c8bba5fc2683763c333870389 Mon Sep 17 00:00:00 2001
From: xiangpin <xshuangbin@163.com>
Date: Sun, 26 May 2024 19:43:36 +0800
Subject: [PATCH 7/8] mv %<+% to ggfun

---
 DESCRIPTION          |  2 +-
 NAMESPACE            |  6 ++---
 R/method-left_join.R | 54 --------------------------------------------
 R/re-export.R        |  4 ++++
 man/attacher.Rd      | 20 ----------------
 man/reexports.Rd     |  3 +++
 6 files changed, 10 insertions(+), 79 deletions(-)
 delete mode 100644 R/method-left_join.R
 delete mode 100644 man/attacher.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index e7ec72c..40cc561 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -23,7 +23,7 @@ Imports:
   RcppParallel,
   cli,
   dplyr,
-  ggfun,
+  ggfun (> 0.1.4),
   ggplot2,
   grDevices,
   grid,
diff --git a/NAMESPACE b/NAMESPACE
index c0daa51..c7c7c41 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -6,8 +6,7 @@ S3method(ggplot_add,sc_dim_geom_ellipse)
 S3method(ggplot_add,sc_dim_geom_feature)
 S3method(ggplot_add,sc_dim_geom_label)
 S3method(ggplot_add,sc_geom_annot)
-S3method(left_join,ggsc)
-export("%<<+%")
+export("%<+%")
 export(aes)
 export(draw_key_scattermore2)
 export(geom_scattermore2)
@@ -46,8 +45,7 @@ importFrom(SummarizedExperiment,assay)
 importFrom(SummarizedExperiment,assayNames)
 importFrom(SummarizedExperiment,colData)
 importFrom(cli,cli_abort)
-importFrom(cli,cli_warn)
-importFrom(dplyr,left_join)
+importFrom(ggfun,"%<+%")
 importFrom(ggfun,get_aes_var)
 importFrom(ggplot2,"%+replace%")
 importFrom(ggplot2,ScaleDiscreteIdentity)
diff --git a/R/method-left_join.R b/R/method-left_join.R
deleted file mode 100644
index fdd92c8..0000000
--- a/R/method-left_join.R
+++ /dev/null
@@ -1,54 +0,0 @@
-#' @importFrom dplyr left_join
-#' @method left_join ggsc
-#' @importFrom cli cli_warn
-#' @export
-left_join.ggsc <- function(x, y, by = NULL, copy = FALSE, suffix=c("", ".y"), ...){
-    dat <- x$data
-    msg <- c("The {.arg suffix} requires a character vector containing 2 different elements,",
-             "The first element must be \"\", and the second element must not be \"\",",
-             "it was set {.code suffix=c(\"\", \".y\")} automatically.")
-    if (all(nchar(suffix)!=0)){
-        cli::cli_warn(msg)
-        suffix[1] = ""
-    }
-    if (all(nchar(suffix)==0)){
-        cli::cli_warn(msg)
-        suffix[2] = ".y"
-    }
-    if (nchar(suffix[1])!=0 && nchar(suffix[2])==0){
-        cli::cli_warn(msg)
-        suffix <- rev(suffix[seq_len(2)])
-    }
-    da <- dplyr::left_join(dat, y, by = by, copy = copy, suffix = suffix, ...) 
-
-    x$data <- da
-
-    return(x)
-}
-
-#' add the external data frame to the ggsc object.
-#' @rdname attacher
-#' @param x ggsc object, the result of \code{sc_dim}, \code{sc_feature} and \code{sc_spatial}.
-#' @param y a data.frame, which should have a barcode id column named \code{.BarcodeID},
-#' it is the same to the x$data$`.BarcodeID`. It also can have another column \code{features}.
-#' @export
-#' @return ggsc object
-`%<<+%` <- function(x, y){
-    if (!inherits(x, 'ggsc')){
-        cli::cli_abort(c("Can not add the `data` in the right to left object, since it is not a `ggsc` class."))
-    }
-    if (missing(y)){
-        cli::cli_abort(c(
-                "Cannot use {.code <+} with a single argument.",
-                "i" = "Did you accidentally put {.code %<<+%} on a new line?"
-        ))
-    }
-    if (inherits(x, 'patchwork')){
-        x$patches$plots <- lapply(x$patches$plots, function(p){
-                                  p <- left_join(p, y)
-                                  return(p)}) |>
-                           suppressMessages()
-    }
-    x <- left_join(x, y)
-    return(x)
-}
diff --git a/R/re-export.R b/R/re-export.R
index 73e4c38..c48cce5 100644
--- a/R/re-export.R
+++ b/R/re-export.R
@@ -10,3 +10,7 @@ ggplot2::aes
 ##' @importFrom ggplot2 theme
 ##' @export
 ggplot2::theme
+
+##' @importFrom ggfun %<+%
+##' @export
+ggfun::`%<+%`
diff --git a/man/attacher.Rd b/man/attacher.Rd
deleted file mode 100644
index 21e540f..0000000
--- a/man/attacher.Rd
+++ /dev/null
@@ -1,20 +0,0 @@
-% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/method-left_join.R
-\name{\%<<+\%}
-\alias{\%<<+\%}
-\title{add the external data frame to the ggsc object.}
-\usage{
-x \%<<+\% y
-}
-\arguments{
-\item{x}{ggsc object, the result of \code{sc_dim}, \code{sc_feature} and \code{sc_spatial}.}
-
-\item{y}{a data.frame, which should have a barcode id column named \code{.BarcodeID},
-it is the same to the x$data$\code{.BarcodeID}. It also can have another column \code{features}.}
-}
-\value{
-ggsc object
-}
-\description{
-add the external data frame to the ggsc object.
-}
diff --git a/man/reexports.Rd b/man/reexports.Rd
index 0108d61..ae11894 100644
--- a/man/reexports.Rd
+++ b/man/reexports.Rd
@@ -5,6 +5,7 @@
 \alias{reexports}
 \alias{aes}
 \alias{theme}
+\alias{\%<+\%}
 \title{Objects exported from other packages}
 \value{
 Depending on the re-exported function
@@ -15,6 +16,8 @@ These objects are imported from other packages. Follow the links
 below to see their documentation.
 
 \describe{
+  \item{ggfun}{\code{\link[ggfun:attacher]{\%<+\%}}}
+
   \item{ggplot2}{\code{\link[ggplot2]{aes}}, \code{\link[ggplot2]{theme}}}
 }}
 

From ae90099f983339329843e636c5d1f537378c1ef3 Mon Sep 17 00:00:00 2001
From: Guangchuang Yu <guangchuangyu@gmail.com>
Date: Tue, 28 May 2024 15:23:23 +0800
Subject: [PATCH 8/8] Update DESCRIPTION

update ggfun version
---
 DESCRIPTION | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 40cc561..47b2efe 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -23,7 +23,7 @@ Imports:
   RcppParallel,
   cli,
   dplyr,
-  ggfun (> 0.1.4),
+  ggfun (>= 0.1.5),
   ggplot2,
   grDevices,
   grid,