Merge pull request #34 from xiangpin/master

add plot_lisa_feature

DESCRIPTION

@@ -80,3 +80,5 @@ LinkingTo:
   Rcpp,
   RcppArmadillo,
   RcppParallel
+Remotes:
+  YuLab-SMU/SVP

NAMESPACE

@@ -11,6 +11,7 @@ export(aes)
 export(draw_key_bgpoint)
 export(geom_bgpoint)
 export(geom_scattermore2)
+export(plot_lisa_feature)
 export(sc_dim)
 export(sc_dim_count)
 export(sc_dim_geom_ellipse)
@@ -60,6 +61,7 @@ importFrom(ggplot2,coord_flip)
 importFrom(ggplot2,discrete_scale)
 importFrom(ggplot2,draw_key_point)
 importFrom(ggplot2,element_blank)
+importFrom(ggplot2,element_rect)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,facet_grid)
 importFrom(ggplot2,facet_wrap)
@@ -74,6 +76,7 @@ importFrom(ggplot2,ggtitle)
 importFrom(ggplot2,guide_colorbar)
 importFrom(ggplot2,guide_legend)
 importFrom(ggplot2,guides)
+importFrom(ggplot2,label_wrap_gen)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,layer)
 importFrom(ggplot2,layer_data)
@@ -112,6 +115,7 @@ importFrom(scales,alpha)
 importFrom(scales,pal_identity)
 importFrom(scattermore,geom_scattermore)
 importFrom(scattermore,scattermore)
+importFrom(stats,as.formula)
 importFrom(stats,dist)
 importFrom(stats,hclust)
 importFrom(stats,mad)

R/plot-methods.R

@@ -0,0 +1,172 @@
+##' @title plot_lisa_feature
+##' @rdname plot-lisa-feature
+##' @param spe SpatialExperiment or SingleCellExperiment object.
+##' @param lisa.res the result returned by \code{SVP::runLISA()}.
+##' @param features selected features to be visualized, default is NULL.
+##' @param assay.type the assay name where data will be used from
+##' (e.g., 'data', 'counts'), default is \code{'logcounts'}.
+##' @param geom the function of geometric layer, default is \code{geom_bgpoint}, 
+##' other option is \code{sc_geom_point}.
+##' @param pointsize numeric the size of point, default is \code{2}.
+##' @param hlpointsize numeric the size of point which contains corresbonding
+##' spatially variable gene(i.e., SVG), default is \code{1.8}.
+##' @param clustertype cell type which is from the result of \code{lisa.res},
+##' default is \code{'High'}.
+##' @param hlcolor the color of circular line which enfolds the point 
+##' that contains SVG, default is \code{'black'}.
+##' @param gap_line_width numeric the line width of gap between the background and
+##' top point point layer, default is \code{.1}.
+##' @param bg_line_width numeric the line width of background point layer,
+##' default is \code{0.3}.
+##' @param facet_name the name of facet used in \code{facet_wrap()},
+##' default is \code{NULL}.
+##' @param reduction reduction method, default is \code{NULL} and will 
+##' use the default setting store in the object
+##' @param image.plot logical whether display the image of spatial experiment, default
+##' is FALSE.
+##' @param label_wrap_width numeric maximum number of characters before wrapping the strip.
+##' default is \code{30}.
+##' @param ... additional parameters pass to \code{scattermore::geom_scattermore()}
+##' \itemize{
+##'     \item \code{bg_colour} the colour of background point, default is \code{NA}.
+##'      this character also can be set in \code{mappint}.
+##'     \item \code{alpha} the transparency of colour, default is 1.
+##'  }
+##' @return ggplot object
+##' @importFrom ggplot2 theme element_rect label_wrap_gen
+##' @importFrom stats as.formula
+##' @export
+##' @examples
+##' \dontrun{
+##' library(ggplot2)
+##' library(SingleCellExperiment) |> suppressPackageStartupMessages()
+##' library(SpatialExperiment) |> suppressPackageStartupMessages()
+##' library(STexampleData)
+##' # create ExperimentHub instance
+##' eh <- ExperimentHub()
+##' # query STexampleData datasets
+##' myfiles <- query(eh, "STexampleData")
+##' ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC']
+##' spe <- myfiles[[ah_id]]
+##' spe <- spe[, colData(spe)$in_tissue == 1]
+##' spe <-scater::logNormCounts(spe)
+##' genes <- c('MOBP', 'PCP4', 'SNAP25', 'HBB', 'IGKC', 'NPY')
+##' target.features <- rownames(spe)[match(genes, rowData(spe)$gene_name)]
+##' library(SVP)
+##' lisa.res1 <- runLISA(spe,
+##'                      assay.type='logcounts',
+##'                      features=target.features[seq(2)],
+##'                      weight.method='knn', 
+##'                      k=50)
+##' plot_lisa_feature(spe, lisa.res=lisa.res1, features=target.features[seq(2)],
+##'                   pointsize=2, hlpointsize=2, gap_line_width=.1)
+##' }
+plot_lisa_feature <- function(spe,
+                         lisa.res,
+                         features = NULL,
+                         assay.type = 'logcounts',
+                         geom = geom_bgpoint,
+                         pointsize = 2,
+                         hlpointsize = 1.8,
+                         clustertype = 'High',
+                         hlcolor = c('black'),
+                         gap_line_width = .1,
+                         bg_line_width = .3,
+                         facet_name = NULL,
+                         reduction = NULL,
+                         image.plot = FALSE,
+                         label_wrap_width = 30,
+                         ...
+                         ){
+    if (missing(lisa.res) || is.null(lisa.res)){
+        if (is.null(features)){
+            cli::cli_abort("The {.var features} should not be `NULL`, when {.var lisa.res} is missing or NULL.")
+        }
+    }else if(inherits(lisa.res, 'SimpleList') || inherits(lisa.res, "list")){
+        names(lisa.res) <- gsub("_", " ", names(lisa.res))
+        features <- names(lisa.res)
+    }
+    rownames(spe) <- gsub("_", " ", rownames(spe))
+    if (is.null(reduction)){
+        cnm <- SpatialExperiment::spatialCoordsNames(spe)
+        p <- sc_spatial(spe,
+                        features,
+                        mapping = aes(x=!!rlang::sym(cnm[1]), y = !!rlang::sym(cnm[2])),
+                        pointsize = pointsize,
+                        slot = assay.type,
+                        gap_colour = NA,
+                        image.plot = image.plot,
+                        geom = geom,
+                        ...
+        )
+    }else{
+        p <- sc_feature(
+               spe,
+               features = features,
+               reduction = reduction,
+               geom = geom,
+               pointsize = pointsize,
+               slot = assay.type,
+               ...
+        )
+    }
+    if (missing(lisa.res) || is.null(lisa.res)){
+        message("The lisa result is not provided")
+        return(p)
+    }
+
+    if (inherits(lisa.res, 'SimpleList') || inherits(lisa.res, "list")){
+        lisa.res <- lisa.res |>
+                    lapply(function(x)x|>tibble::rownames_to_column(var='.BarcodeID')) |>
+                    dplyr::bind_rows(.id='features')
+    }
+    if (inherits(p, 'patchwork')){
+        `%add+%` <- `&`
+    }else{
+        `%add+%` <- `+`
+    }
+    p1 <- p %add+% sc_geom_annot(
+                    data = lisa.res,
+                    mapping = aes(bg_colour = !!rlang::sym("cluster.test"), subset = !!rlang::sym("cluster.test") %in% clustertype),
+                    pointsize = hlpointsize,
+                    gap_line_width = gap_line_width,
+                    bg_line_width = bg_line_width
+          ) %add+%
+          scale_bg_colour_manual(
+            values = hlcolor,
+            guide = guide_legend(
+              theme = theme(
+                legend.title = element_text(size = 8),
+                legend.text = element_text(size = 6),
+                legend.key.width  = grid::unit(.3, "cm"),
+                legend.key.height  = grid::unit(.3, "cm")
+              ),
+              order = 1
+            )
+          ) %add+%
+          guides(colour = guide_colorbar(
+            theme = theme(
+              legend.title = element_text(size=8),
+              legend.text = element_text(size=6),
+              legend.key.width  = grid::unit(.4, "cm"),
+              legend.key.height = grid::unit(1.5, "cm")
+              )
+            )
+          ) %add+%
+          theme(
+            strip.background.x=element_rect(color="white")
+          )
+    spe$sample_id |> unique() |> length() -> len
+    if (len > 1 && !is.null(facet_name)){
+        if (length(facet_name) > 1){
+           tmpf <- paste0(facet_name, collapse="~") |> as.formula()
+        }else{
+           tmpf <- as.formula("~sample_id")
+        }
+        p1 <- p1 %add+%
+              facet_wrap(tmpf, labeller = label_wrap_gen(label_wrap_width)) %add+%
+              theme(strip.background.x=element_rect(color="white"))
+    }
+    return(p1)
+}
+

R/sc-geom-annot.R

@@ -57,7 +57,7 @@ ggplot_add.sc_geom_annot <- function(object, plot, object_name){
     if (geomfun == 'geom_scattermore2'){
         geomfun <- "sc_geom_point"
     }else{
-        params$pixels <- NULL
+        object$pixels <- NULL
     }
     ly <- do.call(geomfun, c(object, params))
     ggplot_add(ly, plot, object_name)