├── .Rbuildignore ├── .github └── workflows │ └── rworkflows.yml ├── .gitignore ├── DESCRIPTION ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R ├── RcppExports.R ├── draw_key.R ├── extract_data.R ├── ggsc-package.R ├── internals.R ├── plot-methods.R ├── pointsGrob2.R ├── re-export.R ├── sc-dim-utilities.R ├── sc-dim.R ├── sc-dot.R ├── sc-feature.R ├── sc-geom-annot.R ├── sc-geom-point.R ├── sc-spatial.R ├── sc-violin.R ├── scales_bg_colour.R └── utils.R ├── README.Rmd ├── README.md ├── man ├── CalWkdeCpp.Rd ├── draw_key_bgpoint.Rd ├── geom_bgpoint.Rd ├── geom_scattermore2.Rd ├── ggsc-package.Rd ├── plot-lisa-feature.Rd ├── reexports.Rd ├── sc-dim-count.Rd ├── sc-dim-geom-ellipse.Rd ├── sc-dim-geom-feature.Rd ├── sc-dim-geom-label.Rd ├── sc-dim-geom-subset.Rd ├── sc-dim-methods.Rd ├── sc-dim-sub.Rd ├── sc-dot-methods.Rd ├── sc-feature-methods.Rd ├── sc-geom-point.Rd ├── sc-spatial-methods.Rd ├── sc-violin-methods.Rd ├── sc_geom_annot.Rd └── scale_bg_color_manual.Rd ├── src ├── .gitignore ├── Makevars ├── Makevars.win ├── RcppExports.cpp └── kde.cpp ├── tests ├── testthat.R └── testthat │ └── test_extract_sce_data.R └── vignettes └── ggsc.Rmd /.Rbuildignore: -------------------------------------------------------------------------------- 1 | Makefile 2 | gh-pages 3 | ^vignettes/*.html$ 4 | ^vignettes/*.R$ 5 | ^README\.md$ 6 | ^README\.Rmd$ 7 | ^CONDUCT\.md$ 8 | ^\.Rproj\.user$ 9 | ^\.Rproj$ 10 | docs 11 | ^\.github 12 | README.html 13 | -------------------------------------------------------------------------------- /.github/workflows/rworkflows.yml: -------------------------------------------------------------------------------- 1 | name: rworkflows 2 | 'on': 3 | push: 4 | branches: 5 | - master 6 | - main 7 | - devel 8 | - RELEASE_** 9 | pull_request: 10 | branches: 11 | - master 12 | - main 13 | - devel 14 | - RELEASE_** 15 | jobs: 16 | rworkflows: 17 | permissions: write-all 18 | runs-on: ${{ matrix.config.os }} 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | container: ${{ matrix.config.cont }} 21 | strategy: 22 | fail-fast: ${{ false }} 23 | matrix: 24 | config: 25 | - os: ubuntu-latest 26 | bioc: devel 27 | r: auto 28 | cont: ghcr.io/bioconductor/bioconductor_docker:devel 29 | rspm: ~ 30 | - os: macOS-latest 31 | bioc: release 32 | r: auto 33 | cont: ~ 34 | rspm: ~ 35 | - os: windows-latest 36 | bioc: release 37 | r: auto 38 | cont: ~ 39 | rspm: ~ 40 | steps: 41 | - uses: neurogenomics/rworkflows@master 42 | with: 43 | run_bioccheck: ${{ false }} 44 | run_rcmdcheck: ${{ true }} 45 | as_cran: ${{ true }} 46 | run_vignettes: ${{ true }} 47 | has_testthat: ${{ true }} 48 | run_covr: ${{ true }} 49 | run_pkgdown: ${{ false }} 50 | has_runit: ${{ false }} 51 | has_latex: ${{ false }} 52 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 53 | run_docker: ${{ false }} 54 | DOCKER_TOKEN: ${{ secrets.DOCKER_TOKEN }} 55 | runner_os: ${{ runner.os }} 56 | cache_version: cache-v1 57 | docker_registry: ghcr.io 58 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | gh-pages 2 | inst/doc 3 | vignettes/*.html 4 | vignettes/*.R 5 | docs 6 | README.html 7 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: ggsc 2 | Title: Visualizing Single Cell and Spatial Transcriptomics 3 | Version: 1.7.0 4 | Authors@R: c( 5 | person("Guangchuang", "Yu", 6 | email = "guangchuangyu@gmail.com", 7 | role = c("aut", "cre", "cph"), 8 | comment = c(ORCID = "0000-0002-6485-8781") 9 | ), 10 | person("Shuangbin", "Xu", 11 | email = "xshuangbin@163.com", 12 | role = "aut", 13 | comment = c(ORCID="0000-0003-3513-5362") 14 | ), 15 | person("Noriaki", "Sato", 16 | email = "nori@hgc.jp", 17 | role = "ctb") 18 | ) 19 | Description: Useful functions to visualize single cell and spatial 20 | data. It supports visualizing 'Seurat', 'SingleCellExperiment' and 'SpatialExperiment' objects through grammar of graphics syntax implemented in 'ggplot2'. 21 | Imports: 22 | Rcpp, 23 | RcppParallel, 24 | cli, 25 | dplyr, 26 | ggfun (>= 0.1.5), 27 | ggplot2, 28 | grDevices, 29 | grid, 30 | methods, 31 | rlang, 32 | scattermore, 33 | stats, 34 | Seurat, 35 | SingleCellExperiment, 36 | SummarizedExperiment, 37 | tidydr, 38 | tidyr, 39 | tibble, 40 | utils, 41 | RColorBrewer, 42 | yulab.utils, 43 | scales 44 | Suggests: 45 | aplot, 46 | BiocParallel, 47 | forcats, 48 | ggforce, 49 | ggnewscale, 50 | igraph, 51 | knitr, 52 | ks, 53 | Matrix, 54 | prettydoc, 55 | rmarkdown, 56 | scran, 57 | scater, 58 | scatterpie (>= 0.2.4), 59 | scuttle, 60 | shadowtext, 61 | sf, 62 | SeuratObject, 63 | SpatialExperiment, 64 | STexampleData, 65 | testthat (>= 3.0.0), 66 | MASS 67 | BugReports: https://github.com/YuLab-SMU/ggsc/issues 68 | URL: https://github.com/YuLab-SMU/ggsc (devel), https://yulab-smu.top/ggsc/ (docs) 69 | biocViews: DimensionReduction, GeneExpression, SingleCell, 70 | Software, Spatial, Transcriptomics,Visualization 71 | VignetteBuilder: knitr 72 | SystemRequirements: GNU make 73 | ByteCompile: true 74 | License: Artistic-2.0 75 | Encoding: UTF-8 76 | Roxygen: list(markdown = TRUE) 77 | RoxygenNote: 7.3.2 78 | Config/testthat/edition: 3 79 | LinkingTo: 80 | Rcpp, 81 | RcppArmadillo, 82 | RcppParallel 83 | Remotes: 84 | YuLab-SMU/SVP 85 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PKGNAME := $(shell sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION) 2 | PKGVERS := $(shell sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION) 3 | PKGSRC := $(shell basename `pwd`) 4 | BIOCVER := RELEASE_3_21 5 | 6 | all: rd check clean 7 | 8 | alldocs: rd readme mkdocs 9 | 10 | crd: 11 | Rscript -e 'Rcpp::compileAttributes()' 12 | 13 | rd: crd 14 | Rscript -e 'roxygen2::roxygenise(".")' 15 | 16 | readme: 17 | Rscript -e 'rmarkdown::render("README.Rmd")' 18 | 19 | readme2: 20 | Rscript -e 'rmarkdown::render("README.Rmd", "html_document")' 21 | 22 | build: 23 | #cd ..;\ 24 | #R CMD build $(PKGSRC) 25 | Rscript -e 'devtools::build()' 26 | 27 | build2: 28 | cd ..;\ 29 | R CMD build --no-build-vignettes $(PKGSRC) 30 | 31 | install: 32 | cd ..;\ 33 | R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz 34 | 35 | check: #build 36 | #cd ..;\ 37 | #Rscript -e 'rcmdcheck::rcmdcheck("$(PKGNAME)_$(PKGVERS).tar.gz")' 38 | Rscript -e 'devtools::check()' 39 | 40 | debug: rd build2 install 41 | 42 | check2: build 43 | cd ..;\ 44 | R CMD check $(PKGNAME)_$(PKGVERS).tar.gz 45 | 46 | bioccheck: 47 | cd ..;\ 48 | Rscript -e 'BiocCheck::BiocCheck("$(PKGNAME)_$(PKGVERS).tar.gz")' 49 | 50 | rmrelease: 51 | git branch -D $(BIOCVER) 52 | 53 | release: 54 | git checkout $(BIOCVER);\ 55 | git fetch --all 56 | 57 | 58 | clean: 59 | cd ..;\ 60 | $(RM) -r $(PKGNAME).Rcheck/ 61 | 62 | update: 63 | git fetch --all;\ 64 | git checkout devel;\ 65 | git merge upstream/devel;\ 66 | git merge origin/devel 67 | 68 | 69 | push: 70 | git push upstream devel;\ 71 | git push origin devel 72 | 73 | 74 | pages: 75 | Rscript -e 'rmarkdown::render("gh-pages/index.Rmd")' 76 | 77 | publish: 78 | cd gh-pages;\ 79 | git add .; git commit -m 'update'; git push 80 | 81 | 82 | 83 | 84 | 85 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(ggplot_add,dim_geom_sub) 4 | S3method(ggplot_add,dim_sub) 5 | S3method(ggplot_add,sc_dim_geom_ellipse) 6 | S3method(ggplot_add,sc_dim_geom_feature) 7 | S3method(ggplot_add,sc_dim_geom_label) 8 | S3method(ggplot_add,sc_geom_annot) 9 | export("%<+%") 10 | export(aes) 11 | export(draw_key_bgpoint) 12 | export(geom_bgpoint) 13 | export(geom_scattermore2) 14 | export(plot_lisa_feature) 15 | export(sc_dim) 16 | export(sc_dim_count) 17 | export(sc_dim_geom_ellipse) 18 | export(sc_dim_geom_feature) 19 | export(sc_dim_geom_label) 20 | export(sc_dim_geom_sub) 21 | export(sc_dim_sub) 22 | export(sc_dot) 23 | export(sc_feature) 24 | export(sc_geom_annot) 25 | export(sc_geom_point) 26 | export(sc_spatial) 27 | export(sc_violin) 28 | export(scale_bg_color_manual) 29 | export(scale_bg_colour_discrete) 30 | export(scale_bg_colour_manual) 31 | export(theme) 32 | exportMethods(sc_dim) 33 | exportMethods(sc_dot) 34 | exportMethods(sc_feature) 35 | exportMethods(sc_spatial) 36 | exportMethods(sc_violin) 37 | importFrom(RColorBrewer,brewer.pal.info) 38 | importFrom(Rcpp,evalCpp) 39 | importFrom(Rcpp,sourceCpp) 40 | importFrom(RcppParallel,RcppParallelLibs) 41 | importFrom(Seurat,DefaultAssay) 42 | importFrom(SingleCellExperiment,int_colData) 43 | importFrom(SingleCellExperiment,int_metadata) 44 | importFrom(SingleCellExperiment,reducedDimNames) 45 | importFrom(SingleCellExperiment,reducedDims) 46 | importFrom(SummarizedExperiment,assay) 47 | importFrom(SummarizedExperiment,assayNames) 48 | importFrom(SummarizedExperiment,colData) 49 | importFrom(cli,cli_abort) 50 | importFrom(ggfun,"%<+%") 51 | importFrom(ggfun,get_aes_var) 52 | importFrom(ggplot2,"%+replace%") 53 | importFrom(ggplot2,ScaleDiscreteIdentity) 54 | importFrom(ggplot2,aes) 55 | importFrom(ggplot2,aes_string) 56 | importFrom(ggplot2,annotation_custom) 57 | importFrom(ggplot2,coord_fixed) 58 | importFrom(ggplot2,coord_flip) 59 | importFrom(ggplot2,discrete_scale) 60 | importFrom(ggplot2,draw_key_point) 61 | importFrom(ggplot2,element_blank) 62 | importFrom(ggplot2,element_rect) 63 | importFrom(ggplot2,element_text) 64 | importFrom(ggplot2,facet_grid) 65 | importFrom(ggplot2,facet_wrap) 66 | importFrom(ggplot2,fill_alpha) 67 | importFrom(ggplot2,geom_blank) 68 | importFrom(ggplot2,geom_col) 69 | importFrom(ggplot2,geom_point) 70 | importFrom(ggplot2,geom_violin) 71 | importFrom(ggplot2,ggplot) 72 | importFrom(ggplot2,ggplot_add) 73 | importFrom(ggplot2,ggtitle) 74 | importFrom(ggplot2,guide_colorbar) 75 | importFrom(ggplot2,guide_legend) 76 | importFrom(ggplot2,guides) 77 | importFrom(ggplot2,label_wrap_gen) 78 | importFrom(ggplot2,labs) 79 | importFrom(ggplot2,layer) 80 | importFrom(ggplot2,layer_data) 81 | importFrom(ggplot2,rel) 82 | importFrom(ggplot2,scale_color_distiller) 83 | importFrom(ggplot2,scale_color_gradient) 84 | importFrom(ggplot2,scale_color_gradientn) 85 | importFrom(ggplot2,scale_color_identity) 86 | importFrom(ggplot2,scale_fill_manual) 87 | importFrom(ggplot2,scale_y_continuous) 88 | importFrom(ggplot2,stat_ellipse) 89 | importFrom(ggplot2,theme) 90 | importFrom(ggplot2,theme_bw) 91 | importFrom(ggplot2,theme_minimal) 92 | importFrom(ggplot2,translate_shape_string) 93 | importFrom(ggplot2,waiver) 94 | importFrom(ggplot2,xlab) 95 | importFrom(ggplot2,ylab) 96 | importFrom(grDevices,as.raster) 97 | importFrom(grDevices,colorRampPalette) 98 | importFrom(grid,gList) 99 | importFrom(grid,gTree) 100 | importFrom(grid,gpar) 101 | importFrom(grid,grid.draw) 102 | importFrom(grid,grobName) 103 | importFrom(grid,grobTree) 104 | importFrom(grid,is.unit) 105 | importFrom(grid,pointsGrob) 106 | importFrom(grid,rasterGrob) 107 | importFrom(grid,unit) 108 | importFrom(methods,as) 109 | importFrom(methods,setMethod) 110 | importFrom(rlang,.data) 111 | importFrom(rlang,list2) 112 | importFrom(scales,alpha) 113 | importFrom(scales,pal_identity) 114 | importFrom(scattermore,geom_scattermore) 115 | importFrom(scattermore,scattermore) 116 | importFrom(stats,as.formula) 117 | importFrom(stats,dist) 118 | importFrom(stats,hclust) 119 | importFrom(stats,setNames) 120 | importFrom(tibble,as_tibble) 121 | importFrom(tidydr,theme_dr) 122 | importFrom(tidyr,pivot_longer) 123 | importFrom(utils,getFromNamespace) 124 | importFrom(utils,modifyList) 125 | importFrom(yulab.utils,get_fun_from_pkg) 126 | useDynLib(ggsc) 127 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # ggsc 1.6.0 2 | 3 | + Bioconductor RELEASE_3_21 (2025-04-17, Thu) 4 | 5 | # ggsc 1.4.0 6 | 7 | + Bioconductor RELEASE_3_20 (2024-10-30, Wed) 8 | 9 | # ggsc 1.3.1 10 | 11 | + add `plot_lisa_feature()` (2024-09-06, #34, #39) 12 | + add `geom_bgpoint()` layer (2024-06-18, Tue, #24) 13 | 14 | # ggsc 1.2.0 15 | 16 | + Bioconductor RELEASE_3_19 (2024-05-01, Wed) 17 | 18 | # ggsc 1.1.4 19 | 20 | + add background outline of umap plot (2024-04-12, Fri, #22) 21 | 22 | # ggsc 1.1.3 23 | 24 | + support plotting pie for spatial data (2023-12-13, Wed, #18) 25 | + extract `meta.data` of Seurat object (2023-12-12, Tue, #17) 26 | 27 | # ggsc 1.1.2 28 | 29 | + add `sc_dot()` methods (2023-11-29, Wed, #15) 30 | + update vignette to link to the online docs () 31 | + add `README.Rmd` and `README.md` in github repo 32 | + optimization: retrieve embedding without `FetchData` (2023-11-27, Mon, #14) 33 | + bug fixed for Seurat object (2023-10-31, Tue, #12, #13) 34 | 35 | # ggsc 1.1.1 36 | 37 | + ignore the tissue section when image is not exist (2023-10-31, Tue, #12) 38 | + introduce `joint` to combine all features with `joint.fun` and speed up calculation of kde using RcppParallel (2023-10-25, Wed, #11) 39 | 40 | # ggsc 1.0.0 41 | 42 | + Bioconductor RELEASE_3_18 (2023-10-25, Wed) 43 | 44 | # ggsc 0.99.11 45 | 46 | + support density visualization for single and spatial transcriptomic data (2023-10-18, Wed) 47 | 48 | # ggsc 0.99.10 49 | 50 | + on Bioconductor (2023-10-16, Mon) 51 | + add `\value` session in the `reexports.Rd` (2023-10-15, Sun) 52 | + add package level man page and update vignette (2023-10-14, Sat) 53 | + add examples in Rd to satisfy BiocCheck (2023-09-18, Mon, #7) 54 | + `sc_dim_count()` function to generate a barplot from a dimension reduction plot (`sc_dim()` plot) to 55 | visualize the number of cells for each clusters (2023-09-13, Wed) 56 | + add 'biocViews' in DESCRIPTION required by Bioconductor 57 | 58 | # ggsc 0.99.0 59 | 60 | + compatible with 'SingleCellExperiment' (2023-09-05, Tue, #5) 61 | + using S4 OOP to reorganize the functions (2023-09-05, Tue, #4) 62 | + rename the package to 'ggsc' as there is a package called 'scplot' in CRAN 63 | + add H&E image to `sc_spatial()` (#3) 64 | 65 | # scplot 0.0.3 66 | 67 | + `sc_spatial` to visualize spatial features (2022-12-07, Wed) 68 | 69 | # scplot 0.0.2 70 | 71 | + `sc_dim_geom_sub` and `sc_dim_sub` (2022-12-03, Sat) 72 | + `sc_dim_geom_ellipse` to draw ellipse on `sc_dim()` (2022-12-02, Fri) 73 | 74 | # scplot 0.0.1 75 | 76 | + several functions implemented (2022-11-09, Wed) 77 | - `sc_dim` 78 | - `sc_dim_geom_feature` 79 | - `sc_dim_geom_label` 80 | - `sc_feature` 81 | - `sc_geom_point` 82 | - `sc_violin` 83 | -------------------------------------------------------------------------------- /R/RcppExports.R: -------------------------------------------------------------------------------- 1 | # Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #' Two-Dimensional Weighted Kernel Density Estimation And Mapping the Result To Original Dimension 5 | #' @param x The 2-D coordinate matrix 6 | #' @param w The weighted sparse matrix, the number columns the same than the number rows than x. 7 | #' @param l The limits of the rectangle covered by the grid as c(xl, xu, yl, yu) 8 | #' @param h The vector of bandwidths for x and y directions, defaults to normal reference bandwidth 9 | #' (see bandwidth.nrd), A scalar value will be taken to apply to both directions (see ks::hpi). 10 | #' @param adjust numeric value to adjust to bandwidth, default is 1. 11 | #' @param n number of grid points in the two directions, default is 400. 12 | CalWkdeCpp <- function(x, w, l, h, adjust = 1.0, n = 400L) { 13 | .Call('_ggsc_CalWkdeCpp', PACKAGE = 'ggsc', x, w, l, h, adjust, n) 14 | } 15 | 16 | -------------------------------------------------------------------------------- /R/draw_key.R: -------------------------------------------------------------------------------- 1 | #' Key drawing functions 2 | #' 3 | #' Each Geom has an associated function that draws the key when the geom needs 4 | #' to be displayed in a legend. These are the options built into ggplot2. 5 | #' 6 | #' @param data A single row data frame containing the scaled aesthetics to 7 | #' display in this key 8 | #' @param params A list of additional parameters supplied to the geom. 9 | #' @param size Width and height of key in mm. 10 | #' @return A grid grob. 11 | #' @name draw_key_bgpoint 12 | #' @export 13 | #' @importFrom scales alpha 14 | #' @importFrom ggplot2 draw_key_point 15 | #' @importFrom grid grobTree pointsGrob 16 | #' @importFrom ggplot2 fill_alpha 17 | #' @export 18 | draw_key_bgpoint <- function(data, params, size){ 19 | if (is.null(data$shape)) { 20 | data$shape <- 19 21 | } else if (is.character(data$shape)) { 22 | data$shape <- translate_shape_string(data$shape) 23 | } 24 | 25 | # NULL means the default stroke size, and NA means no stroke. 26 | stroke_size <- data$stroke %||% 0.5 27 | stroke_size[is.na(stroke_size)] <- 0 28 | cpointsGrob(0.5, 0.5, 29 | pch = data$shape, 30 | bg_colour = data$bg_colour, 31 | gap_colour = alpha(params$gap_colour %||% "black", params$gap_alpha), 32 | bg_line_width = params$bg_line_width, 33 | gap_line_width = params$gap_line_width, 34 | gp = gpar( 35 | col = alpha(data$colour %||% "black", data$alpha), 36 | fill = fill_alpha(data$fill %||% "black", data$alpha), 37 | fontsize = (data$size %||% 1.5) * .pt + stroke_size * .stroke / 2, 38 | lwd = stroke_size * .stroke / 2 39 | ) 40 | ) 41 | } 42 | 43 | .pt <- 2.845276 44 | .stroke <- 3.779528 45 | 46 | `%||%` <- function (a, b){ 47 | if (!is.null(a)) 48 | a 49 | else b 50 | } 51 | 52 | rd_aesthetics <- getFromNamespace("rd_aesthetics", "ggplot2") 53 | -------------------------------------------------------------------------------- /R/extract_data.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom methods as 2 | ##' @importFrom SingleCellExperiment reducedDims reducedDimNames 3 | ##' @importFrom SummarizedExperiment assay colData assayNames 4 | ##' @importFrom cli cli_abort 5 | .extract_sce_data <- function(object, features = NULL, dims = c(1, 2), 6 | reduction = NULL, cells = NULL, slot = 1, 7 | plot.pie = FALSE, density=FALSE, grid.n = 400, 8 | joint = FALSE, joint.fun = prod, sp.coords=NULL){ 9 | if (!is.null(cells)){ 10 | object <- object[, cells] 11 | } 12 | 13 | xx <- colData(object) |> as.data.frame(check.names=FALSE) |> suppressWarnings() 14 | reduced.dat <- NULL 15 | if (!is.null(dims)){ 16 | if (length(reducedDimNames(object)) == 0){ 17 | cli::cli_abort(c("The {.cls {class(object)}} didn't contain the results of reduction.")) 18 | } 19 | if (is.null(reduction)){ 20 | reduction <- 1 21 | } 22 | reduced.dat <- reducedDims(object)[[reduction]][,dims] |> 23 | as.data.frame(check.names = FALSE) 24 | xx <- cbind(reduced.dat, xx) 25 | } 26 | 27 | if (!is.null(features)){ 28 | if (slot == 'data'){ 29 | if ('logcounts' %in% assayNames(object)){ 30 | slot <- 'logcounts' 31 | }else{ 32 | slot <- 1 33 | } 34 | } 35 | 36 | tmp <- .FetchDataFromSCE(object, features, assay.type=slot) 37 | 38 | if (density && !is.null(reduced.dat) && !plot.pie){ 39 | tmp <- .buildWkde(w = tmp, coords = reduced.dat, n = grid.n, 40 | joint = joint, joint.fun = joint.fun) 41 | }else if (density && !is.null(sp.coords) && !plot.pie){ 42 | tmp <- .buildWkde(w = tmp, coords = sp.coords, n = grid.n, 43 | joint = joint, joint.fun = joint.fun) 44 | }else{ 45 | tmp <- tmp |> 46 | as('matrix') |> 47 | t() |> 48 | as.data.frame(check.names=FALSE) 49 | } 50 | xx <- cbind(xx[,!colnames(xx) %in% colnames(tmp),drop=FALSE], tmp) 51 | } 52 | xx <- cbind(data.frame(.BarcodeID=rownames(xx)), xx) 53 | return(xx) 54 | } 55 | 56 | get_dim_data <- function(object, features = NULL, 57 | dims=c(1,2), reduction=NULL, 58 | cells=NULL, slot = "data", 59 | plot.pie=FALSE, density = FALSE, 60 | grid.n = 400, joint = FALSE, 61 | joint.fun = prod, sp.coords = NULL 62 | ) { 63 | rlang::check_installed('SeuratObject', 'for the internal function `get_dim_data()`.') 64 | reduced.dat <- NULL 65 | 66 | if (is.null(cells)) { 67 | cells <- colnames(object) 68 | } 69 | #xx <- data.frame(ident=SeuratObject::Idents(object)[cells]) 70 | xx <- cbind(data.frame(ident = SeuratObject::Idents(object)[cells]), object@meta.data[cells,,drop=FALSE]) 71 | 72 | if (!is.null(dims)) { 73 | if (is.null(reduction)) { 74 | reduction <- SeuratObject::DefaultDimReduc(object) 75 | } 76 | dims <- paste0(SeuratObject::Key(object = object[[reduction]]), dims) 77 | reduced.dat <- as.data.frame(SeuratObject::Embeddings(object[[reduction]])[cells, dims]) 78 | } 79 | 80 | if (!is.null(features)){ 81 | if (is.numeric(features)){ 82 | features <- features[features <= nrow(object)] 83 | features <- rownames(object)[features] 84 | } 85 | tmp <- SeuratObject::FetchData(object, vars = features, cells = cells, slot = slot) 86 | xx <- xx[, !colnames(xx) %in% colnames(tmp),drop=FALSE] 87 | if (density && !is.null(reduced.dat) && !plot.pie){ 88 | tmp <- .buildWkde(t(tmp), reduced.dat, grid.n, joint, joint.fun) 89 | xx <- cbind(reduced.dat, xx, tmp) 90 | }else if(density && !is.null(sp.coords) && !plot.pie){ 91 | tmp <- .buildWkde(t(tmp), sp.coords, grid.n, joint, joint.fun) 92 | xx <- cbind(xx, tmp) 93 | }else if (!is.null(reduced.dat) && !density){ 94 | xx <- cbind(reduced.dat, xx, tmp) 95 | }else{ 96 | xx <- cbind(xx, tmp) 97 | } 98 | }else{ 99 | if (!is.null(reduced.dat)){ 100 | xx <- cbind(reduced.dat, xx) 101 | } 102 | } 103 | xx <- cbind(data.frame(.BarcodeID=rownames(xx)), xx) 104 | return(xx) 105 | } 106 | 107 | 108 | .FetchDataFromSCE <- function(x, features, assay.type = 1){ 109 | if (is.numeric(features)){ 110 | features <- features[features <= nrow(x)] 111 | features <- rownames(x)[features] 112 | } 113 | f1 <- intersect(features, rownames(x)) 114 | y <- NULL 115 | if (length(f1) > 0){ 116 | y <- assay(x, assay.type)[f1, ,drop=FALSE] 117 | } 118 | 119 | features <- setdiff(features, rownames(x)) 120 | if (length(features)==0){ 121 | if (is.null(y)){ 122 | cli::cli_abort("The {.var features} is/are not in the {.cls class(x)}.") 123 | }else{ 124 | return(y) 125 | } 126 | } 127 | 128 | meta.data <- colData(x) |> 129 | as.data.frame(check.names=FALSE) |> 130 | suppressWarnings() 131 | 132 | nm2 <- lapply(seq(ncol(meta.data)), function(x)is.numeric(meta.data[,x])) |> 133 | unlist() 134 | nm2 <- colnames(meta.data)[nm2] 135 | 136 | f2 <- intersect(features, nm2) 137 | if (length(f2) > 0){ 138 | y2 <- meta.data[,f2,drop=FALSE] |> t() 139 | y <- rbind(y, y2) 140 | } 141 | 142 | features <- setdiff(features, nm2) 143 | 144 | if (length(features) == 0){ 145 | return(y) 146 | } 147 | 148 | rds <- reducedDims(x) 149 | rdsnm <- lapply(rds, colnames) 150 | f3 <- intersect(features, unlist(rdsnm)) 151 | 152 | if (length(f3) > 0){ 153 | ind1 <- lapply(rdsnm, function(x) f3 %in% x) 154 | ind2 <- lapply(ind1, any) |> unlist() 155 | y3 <- lapply(rds[ind2], function(x)x[,colnames(x) %in% f3,drop=FALSE]) 156 | y3 <- do.call('cbind', y3) |> t() 157 | y <- rbind(y, y3) 158 | } 159 | return(y) 160 | } 161 | -------------------------------------------------------------------------------- /R/ggsc-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | #' @importFrom Rcpp sourceCpp 5 | #' @importFrom Rcpp evalCpp 6 | #' @importFrom RcppParallel RcppParallelLibs 7 | #' @useDynLib ggsc 8 | NULL 9 | 10 | 11 | -------------------------------------------------------------------------------- /R/internals.R: -------------------------------------------------------------------------------- 1 | .buildWkde <- function(w, coords, n = 400, joint = FALSE, joint.fun = prod){ 2 | rlang::check_installed(c('ks', 'Matrix'), 'for the 2D weighted kernel density estimation.') 3 | if (inherits(w, 'matrix')){ 4 | w <- Matrix::Matrix(w, sparse = TRUE) 5 | } 6 | lims <- c(range(coords[,1]), range(coords[,2])) 7 | h <- c(ks::hpi(coords[,1]), ks::hpi(coords[,2])) 8 | res <- CalWkdeCpp(x=as.matrix(coords[,seq(2),drop=FALSE]), w=w, l=lims, h = h, n = n) 9 | colnames(res) <- rownames(w) 10 | rownames(res) <- colnames(w) 11 | if (joint && !is.null(joint.fun)){ 12 | oldcnm <- colnames(res) 13 | clnm <- paste(colnames(res), collapse="+") 14 | joint.res <- apply(res, 1, joint.fun) 15 | res <- cbind(res, joint.res) 16 | colnames(res) <- c(oldcnm, clnm) 17 | } 18 | return(res) 19 | } 20 | 21 | .split.by.feature <- function(p, ncol, joint = FALSE){ 22 | rlang::check_installed('aplot', 'for split ggplot object by features.') 23 | p <- p$data |> dplyr::group_split(.data$features) |> 24 | lapply(function(i){ 25 | p$data <- i 26 | p <- .add_class(p, "ggsc") 27 | return(p) 28 | }) 29 | 30 | indx <- length(p) 31 | 32 | if (joint){ 33 | p[[indx]] <- p[[indx]] + ggplot2::labs(colour = 'joint_density') 34 | } 35 | 36 | p <- aplot::plot_list(gglist = p, ncol = ncol) 37 | return(p) 38 | } 39 | 40 | #' @importFrom ggfun get_aes_var 41 | .cal_pie_radius <- function(data, mapping){ 42 | x <- ggfun::get_aes_var(mapping, 'x') 43 | y <- ggfun::get_aes_var(mapping, 'y') 44 | r = (max(data[[x]], na.rm=TRUE) - min(data[[x]], na.rm=TRUE)) * (max(data[[y]], na.rm=TRUE) - min(data[[y]], na.rm=TRUE)) 45 | r = sqrt(r / nrow(data) / pi) * .85 46 | return(r) 47 | } 48 | 49 | .cal_ratio <- function(data, mapping){ 50 | x <- ggfun::get_aes_var(mapping, 'x') 51 | y <- ggfun::get_aes_var(mapping, 'y') 52 | 1*max(data[[x]], na.rm=TRUE)/max(data[[y]], na.rm=TRUE) 53 | } 54 | 55 | .set_default_cols <- function(n){ 56 | col2 <- c("#1f78b4", "#ffff33", "#c2a5cf", "#ff7f00", "#810f7c", 57 | "#a6cee3", "#006d2c", "#4d4d4d", "#8c510a", "#d73027", 58 | "#78c679", "#7f0000", "#41b6c4", "#e7298a", "#54278f") 59 | grDevices::colorRampPalette(col2)(n) 60 | } 61 | 62 | # This was refering to the stat_ellipse of ggplot2 63 | .calculate_ellipse <- function(data, vars, type = 't', level= NULL, segments=50){ 64 | dfn <- 2 65 | dfd <- nrow(data) - 1 66 | if (is.null(level)){ 67 | level <- .9 68 | } 69 | 70 | if (!type %in% c("t", "norm", "euclid")) { 71 | cli::cli_inform("Unrecognized ellipse type") 72 | ellipse <- matrix(NA_real_, ncol = 2) 73 | } else if (dfd < 3) { 74 | cli::cli_inform("Too few points to calculate an ellipse") 75 | ellipse <- matrix(NA_real_, ncol = 2) 76 | } else { 77 | if (type == "t") { 78 | v <- MASS::cov.trob(data[,vars]) 79 | } else if (type == "norm") { 80 | v <- stats::cov.wt(data[,vars]) 81 | } else if (type == "euclid") { 82 | v <- stats::cov.wt(data[,vars]) 83 | v$cov <- diag(rep(min(diag(v$cov)), 2)) 84 | } 85 | shape <- v$cov 86 | center <- v$center 87 | chol_decomp <- chol(shape) 88 | if (type == "euclid") { 89 | radius <- level/max(chol_decomp) 90 | } else { 91 | radius <- sqrt(dfn * stats::qf(level, dfn, dfd)) 92 | } 93 | angles <- (0:segments) * 2 * pi/segments 94 | unit.circle <- cbind(cos(angles), sin(angles)) 95 | ellipse <- t(center + radius * t(unit.circle %*% chol_decomp)) 96 | } 97 | 98 | colnames(ellipse) <- vars 99 | res <- stats::cov.wt(ellipse) 100 | res <- res$center |> as.matrix() |> t() |> data.frame() 101 | return(res) 102 | } 103 | 104 | .check_colour <- function(x, y){ 105 | lab.text <- x$labels$colour 106 | flag1 <- is.numeric(x$data[[lab.text]]) 107 | flag2 <- any(c("color", "colour") %in% names(y$mapping)) || any(c("color", "colour") %in% names(y)) 108 | flag1 && !flag2 109 | } 110 | 111 | 112 | -------------------------------------------------------------------------------- /R/plot-methods.R: -------------------------------------------------------------------------------- 1 | ##' @title plot_lisa_feature 2 | ##' @rdname plot-lisa-feature 3 | ##' @param spe SpatialExperiment or SingleCellExperiment object. 4 | ##' @param lisa.res the result returned by \code{SVP::runLISA()}. 5 | ##' @param features selected features to be visualized, default is NULL. 6 | ##' @param assay.type the assay name where data will be used from 7 | ##' (e.g., 'data', 'counts'), default is \code{'logcounts'}. 8 | ##' @param geom the function of geometric layer, default is \code{geom_bgpoint}, 9 | ##' other option is \code{sc_geom_point}. 10 | ##' @param pointsize numeric the size of point, default is \code{2}. 11 | ##' @param hlpointsize numeric the size of point which contains corresbonding 12 | ##' spatially variable gene(i.e., SVG), default is \code{1.8}. 13 | ##' @param clustertype cell type which is from the result of \code{lisa.res}, 14 | ##' default is \code{'High'}. 15 | ##' @param hlcolor the color of circular line which enfolds the point 16 | ##' that contains SVG, default is \code{'black'}. 17 | ##' @param gap_line_width numeric the line width of gap between the background and 18 | ##' top point point layer, default is \code{.1}. 19 | ##' @param bg_line_width numeric the line width of background point layer, 20 | ##' default is \code{0.3}. 21 | ##' @param facet_name the name of facet used in \code{facet_wrap()}, 22 | ##' default is \code{NULL}. 23 | ##' @param reduction reduction method, default is \code{NULL} and will 24 | ##' use the default setting store in the object 25 | ##' @param image.plot logical whether display the image of spatial experiment, default 26 | ##' is FALSE. 27 | ##' @param label_wrap_width numeric maximum number of characters before wrapping the strip. 28 | ##' default is \code{30}. 29 | ##' @param ... additional parameters pass to \code{scattermore::geom_scattermore()} 30 | ##' \itemize{ 31 | ##' \item \code{bg_colour} the colour of background point, default is \code{NA}. 32 | ##' this character also can be set in \code{mappint}. 33 | ##' \item \code{alpha} the transparency of colour, default is 1. 34 | ##' } 35 | ##' @return ggplot object 36 | ##' @importFrom ggplot2 theme element_rect label_wrap_gen 37 | ##' @importFrom stats as.formula 38 | ##' @export 39 | ##' @examples 40 | ##' \dontrun{ 41 | ##' library(ggplot2) 42 | ##' library(SingleCellExperiment) |> suppressPackageStartupMessages() 43 | ##' library(SpatialExperiment) |> suppressPackageStartupMessages() 44 | ##' library(STexampleData) 45 | ##' # create ExperimentHub instance 46 | ##' eh <- ExperimentHub() 47 | ##' # query STexampleData datasets 48 | ##' myfiles <- query(eh, "STexampleData") 49 | ##' ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC'] 50 | ##' spe <- myfiles[[ah_id]] 51 | ##' spe <- spe[, colData(spe)$in_tissue == 1] 52 | ##' spe <-scater::logNormCounts(spe) 53 | ##' genes <- c('MOBP', 'PCP4', 'SNAP25', 'HBB', 'IGKC', 'NPY') 54 | ##' target.features <- rownames(spe)[match(genes, rowData(spe)$gene_name)] 55 | ##' library(SVP) 56 | ##' lisa.res1 <- runLISA(spe, 57 | ##' assay.type='logcounts', 58 | ##' features=target.features[seq(2)], 59 | ##' weight.method='knn', 60 | ##' k=50) 61 | ##' plot_lisa_feature(spe, lisa.res=lisa.res1, features=target.features[seq(2)], 62 | ##' pointsize=2, hlpointsize=2, gap_line_width=.1) 63 | ##' } 64 | plot_lisa_feature <- function(spe, 65 | lisa.res, 66 | features = NULL, 67 | assay.type = 'logcounts', 68 | geom = geom_bgpoint, 69 | pointsize = 2, 70 | hlpointsize = 1.8, 71 | clustertype = 'High', 72 | hlcolor = c('black'), 73 | gap_line_width = .1, 74 | bg_line_width = .3, 75 | facet_name = NULL, 76 | reduction = NULL, 77 | image.plot = FALSE, 78 | label_wrap_width = 30, 79 | ... 80 | ){ 81 | if (missing(lisa.res) || is.null(lisa.res)){ 82 | if (is.null(features)){ 83 | cli::cli_abort("The {.var features} should not be `NULL`, when {.var lisa.res} is missing or NULL.") 84 | }else{ 85 | features.nm <- features 86 | } 87 | }else if(inherits(lisa.res, 'SimpleList') || inherits(lisa.res, "list")){ 88 | if (!is.null(features)){ 89 | lisa.res <- lisa.res[features] 90 | } 91 | names(lisa.res) <- gsub("_", " ", names(lisa.res)) 92 | features.nm <- names(lisa.res) 93 | lisa.res <- lisa.res |> 94 | lapply(function(x)x|>tibble::rownames_to_column(var='.BarcodeID')) |> 95 | dplyr::bind_rows(.id='features') |> 96 | dplyr::mutate(features = factor(.data$features, levels=features.nm)) 97 | } 98 | rownames(spe) <- gsub("_", " ", rownames(spe)) 99 | if (is.null(reduction)){ 100 | cnm <- SpatialExperiment::spatialCoordsNames(spe) 101 | p <- sc_spatial(spe, 102 | features.nm, 103 | mapping = aes(x=!!rlang::sym(cnm[1]), y = !!rlang::sym(cnm[2])), 104 | pointsize = pointsize, 105 | slot = assay.type, 106 | gap_colour = NA, 107 | image.plot = image.plot, 108 | geom = geom, 109 | ... 110 | ) 111 | }else{ 112 | p <- sc_feature( 113 | spe, 114 | features = features.nm, 115 | reduction = reduction, 116 | geom = geom, 117 | pointsize = pointsize, 118 | slot = assay.type, 119 | ... 120 | ) 121 | } 122 | if (missing(lisa.res) || is.null(lisa.res)){ 123 | message("The lisa result is not provided") 124 | return(p) 125 | } 126 | 127 | if (inherits(p, 'patchwork')){ 128 | `%add+%` <- `&` 129 | }else{ 130 | `%add+%` <- `+` 131 | } 132 | p1 <- p %add+% sc_geom_annot( 133 | data = lisa.res, 134 | mapping = aes(bg_colour = !!rlang::sym("cluster.test"), subset = !!rlang::sym("cluster.test") %in% clustertype), 135 | pointsize = hlpointsize, 136 | gap_line_width = gap_line_width, 137 | bg_line_width = bg_line_width 138 | ) %add+% 139 | scale_bg_colour_manual( 140 | values = hlcolor, 141 | guide = guide_legend( 142 | theme = theme( 143 | legend.title = element_text(size = 8), 144 | legend.text = element_text(size = 6), 145 | legend.key.width = grid::unit(.3, "cm"), 146 | legend.key.height = grid::unit(.3, "cm") 147 | ), 148 | order = 1 149 | ) 150 | ) %add+% 151 | guides(colour = guide_colorbar( 152 | theme = theme( 153 | legend.title = element_text(size=8), 154 | legend.text = element_text(size=6), 155 | legend.key.width = grid::unit(.4, "cm"), 156 | legend.key.height = grid::unit(1.5, "cm") 157 | ) 158 | ) 159 | ) %add+% 160 | theme( 161 | strip.background.x=element_rect(color="white") 162 | ) 163 | spe$sample_id |> unique() |> length() -> len 164 | if (len > 1 && !is.null(facet_name)){ 165 | if (length(facet_name) > 1){ 166 | tmpf <- paste0(facet_name, collapse="~") |> as.formula() 167 | }else{ 168 | tmpf <- as.formula("~sample_id") 169 | } 170 | }else{ 171 | tmpf <- as.formula("~features") 172 | } 173 | p1 <- p1 %add+% 174 | facet_wrap(tmpf, labeller = label_wrap_gen(label_wrap_width)) %add+% 175 | theme(strip.background.x=element_rect(color="white")) 176 | return(p1) 177 | } 178 | 179 | -------------------------------------------------------------------------------- /R/pointsGrob2.R: -------------------------------------------------------------------------------- 1 | ##' @importFrom grid unit 2 | ##' @importFrom grid gpar 3 | ##' @importFrom grid gList 4 | ##' @importFrom grid gTree 5 | ##' @importFrom grid is.unit 6 | ##' @importFrom grid rasterGrob 7 | crasterGrob <- function(image, bg.image = NULL, gap.image = NULL, 8 | x = unit(0.5, "npc"), y = unit(0.5, "npc"), 9 | width = NULL, height = NULL, just = "centre", 10 | hjust = NULL, vjust = NULL, interpolate = TRUE, 11 | default.units = "npc", name = NULL, gp = gpar(), 12 | vp = NULL){ 13 | 14 | upperGrob <- rasterGrob(image, x = x, y = y, width = width, height = height, 15 | just = just, hjust = hjust, vjust =vjust, interpolate = interpolate, 16 | default.units = default.units, name = name, gp = gp, vp = vp) 17 | 18 | if (is.null(bg.image)){ 19 | return(upperGrob) 20 | } 21 | 22 | bgGrob <- rasterGrob(bg.image, x = x, y = y, width = width, height = height, 23 | just = just, hjust = hjust, vjust =vjust, 24 | interpolate = interpolate, default.units = default.units, 25 | name = name, gp = gp, vp = vp) 26 | 27 | gapGrob <- rasterGrob(gap.image, x = x, y = y, width = width, height = height, 28 | just = just, hjust = hjust, vjust =vjust, 29 | interpolate = interpolate, default.units = default.units, 30 | name = name, gp = gp, vp = vp) 31 | 32 | grobs <- gList(bgGrob, gapGrob, upperGrob) 33 | gTree(children = grobs) 34 | } 35 | 36 | grid.craster <- function (image, bg.image, gap.image, x = unit(0.5, "npc"), 37 | y = unit(0.5, "npc"), width = NULL, 38 | height = NULL, just = "centre", hjust = NULL, 39 | vjust = NULL, interpolate = TRUE, default.units = "npc", 40 | name = NULL, gp = gpar(), vp = NULL){ 41 | 42 | rg <- crasterGrob(image, bg.image, gap.image, x = x, y = y, 43 | width = width, height = height, just = just, 44 | hjust = hjust, vjust = vjust, interpolate = interpolate, 45 | default.units = default.units, name = name, gp = gp, 46 | vp = vp) 47 | 48 | grid.draw(rg) 49 | } 50 | 51 | 52 | ##' @importFrom grid pointsGrob 53 | cpointsGrob <- function(x = stats::runif(10), y = stats::runif(10), pch = 1, 54 | size = unit(1, "char"), bg_line_width = .3, gap_line_width = .1, 55 | bg_colour = "black", gap_colour = 'white', default.units = "native", 56 | name = NULL, gp = gpar(), vp = NULL){ 57 | 58 | upperPointGrob <- pointsGrob(x = x, y = y, pch = pch, size = size, 59 | default.units = default.units, name = name, 60 | gp = gp, vp = vp) 61 | 62 | if (all(is.null(bg_colour)) || all(is.na(bg_colour))){ 63 | return(upperPointGrob) 64 | } 65 | 66 | gp_bg <- gp 67 | gp_gap <- gp 68 | 69 | gp_bg$col <- bg_colour 70 | gp_gap$col <- gap_colour 71 | 72 | tmpsize <- sqrt(gp$fontsize) 73 | gp_gap_size <- (tmpsize + tmpsize * gap_line_width * 2)^2 74 | gp_bg_size <- gp_gap_size + (sqrt(bg_line_width) + tmpsize * bg_line_width * 2) ^2 75 | gp_gap$fontsize <- gp_gap_size 76 | gp_bg$fontsize <- gp_bg_size 77 | gapPointGrob <- pointsGrob(x = x, y = y, pch = pch, size = size, 78 | default.units = default.units, name = name, 79 | gp = gp_gap, vp = vp) 80 | 81 | bgPointGrob <- pointsGrob(x = x, y = y, pch = pch, size = size, 82 | default.units = default.units, name = name, 83 | gp = gp_bg, vp = vp) 84 | 85 | grobs <- gList(bgPointGrob, gapPointGrob, upperPointGrob) 86 | gTree(children = grobs) 87 | } 88 | 89 | ##' @importFrom grid grid.draw 90 | grid.cpoints <- function(x = stats::runif(10), y = stats::runif(10), pch = 1, 91 | size = unit(1, "char"), bg_line_width = .3, gap_line_width = .1, 92 | bg_colour = "black", gap_colour = 'white', default.units = "native", 93 | name = NULL, gp = gpar(), draw = TRUE, vp = NULL){ 94 | pg <- cpointsGrob(x = x, y = y, pch = pch, size = size, bg_line_width = bg_line_width, 95 | gap_line_width = gap_line_width, bg_colour = bg_colour, 96 | gap_colour = gap_colour, default.units = default.units, name = name, 97 | gp = gp, vp = vp) 98 | if (draw) grid.draw(pg) 99 | invisible(pg) 100 | } 101 | 102 | -------------------------------------------------------------------------------- /R/re-export.R: -------------------------------------------------------------------------------- 1 | #' @name reexports 2 | #' @return Depending on the re-exported function 3 | #' @keywords internal 4 | NULL 5 | 6 | ##' @importFrom ggplot2 aes 7 | ##' @export 8 | ggplot2::aes 9 | 10 | ##' @importFrom ggplot2 theme 11 | ##' @export 12 | ggplot2::theme 13 | 14 | ##' @importFrom ggfun %<+% 15 | ##' @export 16 | ggfun::`%<+%` 17 | -------------------------------------------------------------------------------- /R/sc-dim-utilities.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_dim_count 2 | ##' @rdname sc-dim-count 3 | ##' @param sc_dim_plot dimension reduction plot of single cell data 4 | ##' @return a bar plot to present the cell numbers of different clusters 5 | ##' @importFrom ggplot2 coord_flip 6 | ##' @importFrom ggplot2 layer_data 7 | ##' @importFrom ggplot2 geom_col 8 | ##' @importFrom ggplot2 scale_y_continuous 9 | ##' @importFrom ggplot2 theme_minimal 10 | ##' @importFrom stats setNames 11 | ##' @seealso [sc_dim()] 12 | ##' @export 13 | ##' @examples 14 | ##' library(scuttle) 15 | ##' library(scater) 16 | ##' library(scran) 17 | ##' library(ggplot2) 18 | ##' sce <- mockSCE() 19 | ##' sce <- logNormCounts(sce) 20 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 21 | ##' colLabels(sce) <- clusters 22 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 23 | ##' p <- sc_dim(sce, reduction = 'UMAP') 24 | ##' p1 <- sc_dim_count(p) 25 | sc_dim_count <- function(sc_dim_plot) { 26 | x <- layer_data(sc_dim_plot) 27 | 28 | 29 | if (length(sc_dim_plot$layers) >= 2) { 30 | ## assume label exists 31 | dd <- layer_data(sc_dim_plot, 2) 32 | 33 | pos <- dplyr::group_by(x, .data$colour) |> 34 | dplyr::summarize(x=mean(.data$x), y=mean(.data$y)) 35 | dd <- unique(dd[, c("x", "y", "label")]) 36 | # idx <- match(paste(dd$x, dd$y), paste(pos$x, pos$y)) # find closest one is better 37 | idx <- vapply(seq_len(nrow(dd)), function(i) { 38 | which.min((dd$x[i] - pos$x)^2 + (dd$y[i] - pos$y)^2) 39 | }, FUN.VALUE = numeric(1) 40 | ) 41 | dd$colour <- pos$colour[idx] 42 | y <- setNames(dd$label, dd$colour) 43 | } else { 44 | d2 <- unique(x[, c("colour", "group")]) 45 | y <- setNames(d2$group, d2$colour) 46 | } 47 | 48 | d <- as.data.frame(sort(table(x$colour))) 49 | d$group <- y[as.character(d$Var1)] |> as.factor() 50 | 51 | rlang::check_installed("forcats", "for sc_dim_count()") 52 | 53 | ggplot(d, 54 | aes(forcats::fct_rev(.data$group), 55 | .data$Freq, 56 | fill = I(as.character(.data$Var1)))) + 57 | geom_col() + coord_flip() + 58 | scale_y_continuous(expand=c(0,0)) + 59 | theme_minimal() + 60 | xlab(NULL) + 61 | ylab(NULL) 62 | } 63 | 64 | 65 | ##' @title sc_dim_geom_feature 66 | ##' @rdname sc-dim-geom-feature 67 | ##' @param object Seurat or SingleCellExperiment object 68 | ##' @param features selected features (i.e., genes) 69 | ##' @param dims selected dimensions (must be a two-length vector) that are used 70 | ##' in visualization 71 | ##' @param ncol number of facet columns if 'length(features) > 1' 72 | ##' @param .fun user defined function that will be applied to selected features 73 | ##' (default is to filter out genes with no expression values) 74 | ##' @param ... additional parameters pass to 'scattermore::geom_scattermore()' 75 | ##' @return layer of points for selected features 76 | ##' @export 77 | ##' @seealso [sc_feature()] 78 | ##' @examples 79 | ##' library(scuttle) 80 | ##' library(scater) 81 | ##' library(scran) 82 | ##' library(ggplot2) 83 | ##' sce <- mockSCE() 84 | ##' sce <- logNormCounts(sce) 85 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 86 | ##' colLabels(sce) <- clusters 87 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 88 | ##' p1 <- sc_dim(sce, reduction = 'UMAP') 89 | ##' set.seed(123) 90 | ##' genes <- rownames(sce) |> sample(6) 91 | ##' f1 <- p1 + 92 | ##' sc_dim_geom_feature( 93 | ##' object = sce, 94 | ##' features = genes 95 | ##' ) 96 | sc_dim_geom_feature <- function(object, features, dims = c(1,2), ncol=3, ..., 97 | .fun=function(.data) dplyr::filter(.data, .data$value > 0)) { 98 | params <- list(...) 99 | structure( 100 | list(data=object, features=features, 101 | dims=dims, ncol=ncol, params=params, .fun=.fun), 102 | class = 'sc_dim_geom_feature' 103 | ) 104 | #d <- get_dim_data(object, dims=dims, features=features) 105 | #d <- tidyr::pivot_longer(d, 4:ncol(d), names_to = "features") 106 | #d$features <- factor(d$features, levels = features) 107 | #p <- sc_geom_point(data = .fun(d), ...) 108 | #list(p, 109 | # .feature_setting(features=features, ncol=ncol) 110 | #) 111 | } 112 | 113 | ##' @method ggplot_add sc_dim_geom_feature 114 | ##' @importFrom tibble as_tibble 115 | ##' @export 116 | ggplot_add.sc_dim_geom_feature <- function(object, plot, object_name){ 117 | if (inherits(object$data, 'Seurat')){ 118 | d <- get_dim_data(object$data, 119 | dims=object$dims, 120 | features=object$features) 121 | }else{ 122 | d <- .extract_sce_data(object$data, 123 | dims = object$dims, 124 | features = object$features) 125 | } 126 | #d <- as_tibble(d, rownames='.ID.NAME') 127 | 128 | d <- tidyr::pivot_longer( 129 | d, 130 | seq(ncol(d) - length(object$features) + 1, ncol(d)), 131 | names_to = "features" 132 | ) |> 133 | dplyr::select(-c(2, 3)) |> 134 | dplyr::left_join(plot$data[,seq_len(3)], 135 | by='.BarcodeID' 136 | ) 137 | if (is.numeric(object$features)){ 138 | object$features <- rownames(object$data)[object$features] 139 | } 140 | d$features <- factor(d$features, levels = object$features) 141 | d <- object$.fun(d) 142 | sc.point.params <- object$params 143 | sc.point.params$data <- d 144 | geomfun <- .extract_geom_name(plot) 145 | if (geomfun == 'geom_scattermore2'){ 146 | geomfun <- "sc_geom_point" 147 | }else{ 148 | sc.point.params$pixels <- NULL 149 | } 150 | p <- do.call(geomfun, sc.point.params) 151 | ly <- list(p, 152 | .feature_setting(features=object$features, ncol=object$ncol) 153 | ) 154 | ggplot_add(ly, plot, object_name) 155 | } 156 | 157 | 158 | ##' @title sc_dim_geom_label 159 | ##' @rdname sc-dim-geom-label 160 | ##' @param geom geometric layer (default: geom_text) to display the lables 161 | ##' @param mapping aesthetic mapping 162 | ##' @param ... additional parameters pass to the geom 163 | ##' @return layer of labels 164 | ##' @export 165 | ##' @seealso [sc_dim_geom_label()] 166 | ##' @examples 167 | ##' library(scuttle) 168 | ##' library(scater) 169 | ##' library(scran) 170 | ##' library(ggplot2) 171 | ##' sce <- mockSCE() 172 | ##' sce <- logNormCounts(sce) 173 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 174 | ##' colLabels(sce) <- clusters 175 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 176 | ##' p1 <- sc_dim(sce, reduction = 'UMAP', mapping = aes(colour = Cell_Cycle)) 177 | ##' p2 <- sc_dim(sce, reduction = 'UMAP') 178 | ##' f1 <- p1 + sc_dim_geom_label() 179 | sc_dim_geom_label <- function(geom = ggplot2::geom_text, mapping=NULL, ...) { 180 | structure(list(geom = geom, mapping = mapping, ...), 181 | class = "sc_dim_geom_label") 182 | } 183 | 184 | ##' @importFrom ggplot2 ggplot_add 185 | ##' @importFrom rlang .data 186 | ##' @method ggplot_add sc_dim_geom_label 187 | ##' @export 188 | ggplot_add.sc_dim_geom_label <- function(object, plot, object_name) { 189 | dims <- names(plot$data)[seq_len(3)] 190 | if (!is.null(object$mapping$label)){ 191 | lab.text <- ggfun::get_aes_var(object$mapping, 'label') 192 | object$mapping$label <- NULL 193 | }else{ 194 | lab.text <- plot$labels$colour 195 | } 196 | flag1 <- lab.text %in% colnames(plot$data) && !is.numeric(plot$data[[lab.text]]) 197 | if (is.null(object$data) && flag1) { 198 | object$data <- split(plot$data, plot$data[[lab.text]]) |> 199 | lapply(function(x).calculate_ellipse(x, vars = dims[c(2, 3)], level=object$level)) |> 200 | dplyr::bind_rows(.id=lab.text) 201 | object$level <- NULL 202 | object$data <- .set_label_levels(object$data, plot, lab.text) 203 | }else{ 204 | cli::cli_abort("The `label` in mapping should be specified, and the data should not be numeric type!") 205 | } 206 | 207 | geom <- object$geom 208 | object$geom <- NULL 209 | default_mapping <- aes(x=!!rlang::sym(dims[2]), y = !!rlang::sym(dims[3]), label = !!rlang::sym(lab.text)) 210 | if (is.null(object$mapping)) { 211 | object$mapping <- default_mapping 212 | } else { 213 | object$mapping <- utils::modifyList(default_mapping, object$mapping) 214 | } 215 | 216 | flag2 <- .check_colour(plot, object) 217 | if (flag2){ 218 | object$colour <- 'black' 219 | } 220 | 221 | object <- .set_inherit.aes(object) 222 | 223 | ly <- do.call(geom, object) 224 | ggplot_add(ly, plot, object_name) 225 | } 226 | 227 | 228 | 229 | ##' @title sc_dim_geom_ellipse 230 | ##' @rdname sc-dim-geom-ellipse 231 | ##' @param geom the layer function, default is \code{stat_ellipse}, 232 | ##' other option is \code{geom_mark_hull} of \code{ggforce}. 233 | ##' @param mapping aesthetic mapping 234 | ##' @param level the level at which to draw an ellipse 235 | ##' @param ... additional parameters pass to the stat_ellipse 236 | ##' @return layer of ellipse 237 | ##' @seealso 238 | ##' [stat_ellipse][ggplot2::stat_ellipse]; 239 | ##' @export 240 | ##' @examples 241 | ##' library(scuttle) 242 | ##' library(scater) 243 | ##' library(scran) 244 | ##' library(ggplot2) 245 | ##' sce <- mockSCE() 246 | ##' sce <- logNormCounts(sce) 247 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 248 | ##' colLabels(sce) <- clusters 249 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 250 | ##' p1 <- sc_dim(sce, reduction = 'UMAP', mapping = aes(colour = Cell_Cycle)) 251 | ##' p2 <- sc_dim(sce, reduction = 'UMAP') 252 | ##' f1 <- p1 + sc_dim_geom_ellipse() 253 | sc_dim_geom_ellipse <- function(geom = stat_ellipse, mapping = NULL, level = 0.95, ...) { 254 | structure(list(geom = geom, mapping = mapping, level = level, ...), 255 | class = "sc_dim_geom_ellipse") 256 | } 257 | 258 | ##' @importFrom ggplot2 ggplot_add 259 | ##' @importFrom rlang .data 260 | ##' @method ggplot_add sc_dim_geom_ellipse 261 | ##' @importFrom ggplot2 aes 262 | ##' @importFrom ggplot2 stat_ellipse 263 | ##' @export 264 | ggplot_add.sc_dim_geom_ellipse <- function(object, plot, object_name) { 265 | dims <- names(plot$data)[seq_len(3)] 266 | if (!is.null(object$mapping$group)){ 267 | lab.text <- ggfun::get_aes_var(object$mapping, 'group') 268 | object$mapping$group <- NULL 269 | }else{ 270 | lab.text <- plot$labels$colour 271 | } 272 | flag1 <- lab.text %in% colnames(plot$data) && !is.numeric(plot$data[[lab.text]]) 273 | if (!flag1){ 274 | cli::cli_abort("The `group` in mapping should be specified, and the data should not be numeric type!") 275 | } 276 | default_mapping <- aes(x = !!rlang::sym(dims[2]), 277 | y = !!rlang::sym(dims[3]), 278 | group = !!rlang::sym(lab.text)) 279 | if (is.null(object$mapping)) { 280 | mapping <- default_mapping 281 | } else { 282 | mapping <- modifyList(default_mapping, object$mapping) 283 | } 284 | object$mapping <- mapping 285 | 286 | flag2 <- .check_colour(plot, object) 287 | if (flag2){ 288 | object$colour <- 'black' 289 | } 290 | object <- .set_inherit.aes(object) 291 | geomfun <- object$geom 292 | object$geom <- NULL 293 | 294 | ly <- do.call(geomfun, object) 295 | ggplot_add(ly, plot, object_name) 296 | } 297 | 298 | ##' @title sc_dim_geom_subset 299 | ##' @rdname sc-dim-geom-subset 300 | ##' @param mapping aesthetic mapping 301 | ##' @param subset subset of clusters to be displayed 302 | ##' @param .column which column represents cluster (e.g., 'ident') 303 | ##' @param ... additional parameters pass to sc_geom_point 304 | ##' @return plot with a layer of specified clusters 305 | ##' @export 306 | ##' @seealso [sc_dim_geom_sub] 307 | ##' @examples 308 | ##' library(scuttle) 309 | ##' library(scater) 310 | ##' library(scran) 311 | ##' library(ggplot2) 312 | ##' sce <- mockSCE() 313 | ##' sce <- logNormCounts(sce) 314 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 315 | ##' colLabels(sce) <- clusters 316 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 317 | ##' p1 <- sc_dim(sce, reduction = 'UMAP') 318 | ##' f1 <- p1 + sc_dim_geom_sub(subset = c(1, 2), .column = 'label', bg_colour='black') 319 | sc_dim_geom_sub <- function(mapping = NULL, subset, .column = "ident", ...) { 320 | structure(list(mapping = mapping, 321 | subset = subset, 322 | .column = .column, 323 | ...), 324 | class = "dim_geom_sub") 325 | } 326 | 327 | ##' @method ggplot_add dim_geom_sub 328 | ##' @export 329 | ggplot_add.dim_geom_sub <- function(object, plot, object_name) { 330 | ii <- plot$data[[object$.column]] %in% object$subset 331 | object$data <- plot$data[ii, ] 332 | default_mapping <- aes(color = .data[[object$.column]]) 333 | if (is.null(object$mapping)) { 334 | mapping <- default_mapping 335 | } else { 336 | mapping <- modifyList(default_mapping, object$mapping) 337 | } 338 | object$mapping <- mapping 339 | object$subset <- NULL 340 | object$.column <- NULL 341 | geomfun <- .extract_geom_name(plot) 342 | if (geomfun == 'geom_scattermore2'){ 343 | geomfun <- "sc_geom_point" 344 | }else{ 345 | object$pixels <- NULL 346 | } 347 | ly <- do.call(geomfun, object) 348 | ggplot_add(ly, plot, object_name) 349 | } 350 | 351 | ##' @title sc_dim_sub 352 | ##' @rdname sc-dim-sub 353 | ##' @param subset subset of clusters to be displayed 354 | ##' @param .column which column represents cluster (e.g., 'ident') 355 | ##' @return update plot with only subset displayed 356 | ##' @export 357 | ##' @seealso [sc_dim] 358 | ##' @examples 359 | ##' library(scuttle) 360 | ##' library(scater) 361 | ##' library(scran) 362 | ##' library(ggplot2) 363 | ##' sce <- mockSCE() 364 | ##' sce <- logNormCounts(sce) 365 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 366 | ##' colLabels(sce) <- clusters 367 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 368 | ##' p1 <- sc_dim(sce, reduction = 'UMAP') 369 | ##' f1 <- p1 + sc_dim_sub(subset = c(1, 2), .column = 'label') 370 | sc_dim_sub <- function(subset, .column = "ident") { 371 | structure(list(subset = subset, .column = .column), class = "dim_sub") 372 | } 373 | 374 | ##' @method ggplot_add dim_sub 375 | ##' @export 376 | ggplot_add.dim_sub <- function(object, plot, object_name) { 377 | ii <- plot$data[[object$.column]] %in% object$subset 378 | plot$data <- plot$data[ii, ] 379 | plot 380 | } 381 | -------------------------------------------------------------------------------- /R/sc-dim.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_dim 2 | ##' @rdname sc-dim-methods 3 | ##' @param object Seurat object or SingleCellExperiment object 4 | ##' @param dims selected dimensions (must be a two-length vector) that 5 | ##' are used in visualization 6 | ##' @param reduction reduction method, default is NULL and will use the 7 | ##' default setting store in the object 8 | ##' @param cells selected cells to plot (default is all cells) 9 | ##' @param slot slot to pull expression data from (e.g., 'count' or 'data') 10 | ##' @param mapping aesthetic mapping, the \code{x} and \code{y} is set internally, 11 | ##' other character of geometric layer, such as \code{color}, \code{size}, 12 | ##' \code{alpha} or (\code{shape} when geom = geom_point) can be set manually. 13 | ##' @param geom the function of geometric layer, default is sc_geom_point, 14 | ##' other geometric layer, such as \code{geom_bgpoint} or \code{geom_point} also works. 15 | ##' @param ... additional parameters pass to \code{geom_scattermore2()}. 16 | ##' \itemize{ 17 | ##' \item \code{bg_colour} the colour of background point, default is \code{NA}. 18 | ##' this character also can be set in \code{mappint}. 19 | ##' \item \code{gap_colour} the colour of gap background, default is \code{'white'}. 20 | ##' \item \code{bg_line_width} the line width of background point, 21 | ##' default is \code{.3}. 22 | ##' \item \code{gap_line_width} the gap line width of background point, 23 | ##' default is \code{.1}. 24 | ##' \item \code{alpha} the transparency of colour, default is 1. 25 | ##' \item \code{subset} subset the data frame which meet conditions to display. 26 | ##' this should be set in \code{mapping}. 27 | #' } 28 | ##' @return dimension reduction plot 29 | ##' @seealso 30 | ##' [geom_scattermore][scattermore::geom_scattermore]; 31 | ##' @export 32 | ##' @examples 33 | ##' library(scuttle) 34 | ##' library(scater) 35 | ##' library(scran) 36 | ##' library(ggplot2) 37 | ##' sce <- mockSCE() 38 | ##' sce <- logNormCounts(sce) 39 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 40 | ##' colLabels(sce) <- clusters 41 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 42 | ##' p1 <- sc_dim(sce, reduction = 'UMAP', mapping = aes(colour = Cell_Cycle)) 43 | ##' p2 <- sc_dim(sce, reduction = 'UMAP') 44 | ##' f1 <- p1 + sc_dim_geom_label() 45 | ##' f2 <- p2 + 46 | ##' sc_dim_geom_label( 47 | ##' geom = shadowtext::geom_shadowtext, 48 | ##' color='black', 49 | ##' bg.color='white' 50 | ##' ) 51 | setGeneric('sc_dim', 52 | function(object, 53 | dims=c(1,2), 54 | reduction=NULL, 55 | cells=NULL, 56 | slot = "data", 57 | mapping = NULL, 58 | geom = sc_geom_point, 59 | ...) 60 | standardGeneric('sc_dim') 61 | ) 62 | 63 | #' @importFrom methods setMethod 64 | #' @rdname sc-dim-methods 65 | #' @aliases sc_dim,Seurat 66 | #' @exportMethod sc_dim 67 | setMethod("sc_dim", 68 | 'Seurat', 69 | function( 70 | object, 71 | dims=c(1,2), 72 | reduction=NULL, 73 | cells=NULL, 74 | slot = "data", 75 | mapping = NULL, 76 | geom = sc_geom_point, 77 | ...) 78 | { 79 | d <- get_dim_data(object = object, features = NULL, 80 | dims = dims, reduction = reduction, 81 | cells = cells, slot = slot) 82 | mapping <- .check_aes_mapping(object, mapping, data = d, prefix = 'ident') 83 | 84 | p <- sc_dim_internal(d, mapping, geom = geom, ...) 85 | p <- .add_class(p, "ggsc") 86 | return(p) 87 | }) 88 | 89 | #' @rdname sc-dim-methods 90 | #' @aliases sc_dim,SingleCellExperiment 91 | #' @exportMethod sc_dim 92 | setMethod('sc_dim', 'SingleCellExperiment', 93 | function( 94 | object, 95 | dims = c(1, 2), 96 | reduction = NULL, 97 | cells = NULL, 98 | slot = 'data', 99 | mapping = NULL, 100 | geom = sc_geom_point, 101 | ...) 102 | { 103 | d <- .extract_sce_data(object = object, features = NULL, dims = dims, 104 | reduction = reduction, cells = cells, slot = slot) 105 | 106 | mapping <- .check_aes_mapping(object, mapping, data = d, prefix = 'label') 107 | 108 | p <- sc_dim_internal(d, mapping, geom = geom, ...) 109 | p <- .add_class(p, "ggsc") 110 | return(p) 111 | }) 112 | 113 | ##' @importFrom tidydr theme_dr 114 | sc_dim_internal <- function(data, mapping, geom = sc_geom_point, ...) { 115 | default_mapping <- .set_default_mapping(data) 116 | mapping <- modifyList(default_mapping, mapping) 117 | p <- ggplot(data, mapping) 118 | params <- list(...) 119 | layers <- do.call(geom, params) 120 | p <- p + layers + theme_dr() 121 | return(p) 122 | } 123 | 124 | 125 | .set_default_mapping <- function(data){ 126 | dims <- names(data)[seq_len(3)] 127 | x <- aes(x=!!rlang::sym(dims[2]), y=!!rlang::sym(dims[3])) 128 | return(x) 129 | } 130 | -------------------------------------------------------------------------------- /R/sc-dot.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_dot 2 | ##' @rdname sc-dot-methods 3 | ##' @param object Seurat or SingleCellExperiment object 4 | ##' @param features selected features 5 | ##' @param group.by grouping factor 6 | ##' @param split.by additional split factor 7 | ##' @param cols colors of the points 8 | ##' @param col.min minimum scaled averaged expression threshold 9 | ##' @param col.max maximum scaled averaged expression threshold 10 | ##' @param dot.min the threshold of percentage of cells for the the smallest dot 11 | ##' @param dot.scale Scaling factor for size of points 12 | ##' @param scale whether to scale the expression value (default to TRUE) 13 | ##' @param scale.by scale the size of the points by `size` or `radius` 14 | ##' @param scale.min lower limit of scaling 15 | ##' @param scale.max upper limit of scaling 16 | ##' @param cluster.idents Order identities by hierarchical clusters based on average expression and perventage of expression (default is FALSE) 17 | ##' @param slot slot to pull expression data from (e.g., 'count' or 'data') 18 | ##' @param .fun user defined function that will be applied to selected features (default is NULL and there is no data operation) 19 | ##' @param mapping aesthetic mapping 20 | ##' @param ... additional parameters pass to 'ggplot2::geom_point()' 21 | ##' @seealso 22 | ##' [DotPlot][Seurat::DotPlot]; 23 | ##' @return dot plot to visualize feature expression distribution 24 | ##' @importFrom utils modifyList 25 | ##' @importFrom ggplot2 aes_string 26 | ##' @importFrom ggplot2 ggplot 27 | ##' @importFrom ggplot2 geom_point 28 | ##' @importFrom ggplot2 facet_wrap 29 | ##' @importFrom tidyr pivot_longer 30 | ##' @export 31 | ##' @examples 32 | ##' library(scuttle) 33 | ##' library(scater) 34 | ##' library(scran) 35 | ##' library(ggplot2) 36 | ##' sce <- mockSCE() 37 | ##' sce <- logNormCounts(sce) 38 | ##' set.seed(123) 39 | ##' genes <- rownames(sce) |> sample(6) 40 | ##' sc_dot(sce, genes[1:5], 'Treatment', slot = 'logcounts') 41 | ##' 42 | setGeneric('sc_dot', function(object, features, group.by=NULL, split.by = NULL, 43 | cols = c("lightgrey", "blue"), 44 | col.min = -2.5, col.max = 2.5, 45 | dot.min = 0, dot.scale = 6, 46 | slot = "data", .fun = NULL, mapping = NULL, 47 | scale = TRUE, scale.by = 'radius', 48 | scale.min = NA, scale.max = NA, 49 | cluster.idents = FALSE, 50 | ...) 51 | standardGeneric('sc_dot') 52 | ) 53 | 54 | ##' @rdname sc-dot-methods 55 | ##' @aliases sc_dot,Seurat 56 | ##' @exportMethod sc_dot 57 | setMethod("sc_dot", 'Seurat', function(object, features, 58 | group.by=NULL, split.by = NULL, cols = c("lightgrey", "blue"), 59 | col.min = -2.5, col.max = 2.5, 60 | dot.min = 0, dot.scale = 6, 61 | slot = "data", .fun = NULL, 62 | mapping = NULL, 63 | scale = TRUE, scale.by = 'radius', 64 | scale.min = NA, scale.max = NA, 65 | cluster.idents = FALSE, 66 | ...) { 67 | feature_group <- NULL 68 | if (is.list(features)) { 69 | feature_group <- lapply(names(features), function(feat_name) { 70 | rep(feat_name, length(features[[feat_name]])) |> setNames(features[[feat_name]]) 71 | }) |> unlist(); 72 | features <- unlist(features) 73 | } 74 | d <- get_dim_data(object, dims=NULL, features=features, slot=slot) 75 | 76 | indx.f <- seq(ncol(d) - length(features) + 1, ncol(d)) 77 | d <- tidyr::pivot_longer(d, cols=indx.f, names_to = "features") 78 | 79 | d$features <- factor(d$features, levels = features) 80 | 81 | if (!is.null(.fun)) { 82 | d <- .fun(d) 83 | } 84 | if (is.null(group.by)) { 85 | group.by <- "ident" 86 | } 87 | return(.ReturnDotPlot(d, features, group.by, split.by, cols, 88 | col.min, col.max, dot.min, dot.scale, mapping, scale, scale.by, 89 | scale.min, scale.max, cluster.idents, feature_group, ...)) 90 | }) 91 | 92 | ##' @rdname sc-dot-methods 93 | ##' @aliases sc_dot,SingleCellExperiment 94 | ##' @exportMethod sc_dot 95 | setMethod('sc_dot', 'SingleCellExperiment', 96 | function( 97 | object, features, group.by=NULL, split.by = NULL, 98 | cols = c("lightgrey", "blue"), 99 | col.min=-2.5, col.max=2.5, dot.min=0, dot.scale=6, 100 | slot = 'data', .fun = NULL, mapping = NULL, 101 | scale = TRUE, scale.by = 'radius', 102 | scale.min = NA, scale.max = NA, 103 | cluster.idents = FALSE, 104 | ...){ 105 | feature_group <- NULL 106 | if (is.list(features)) { 107 | feature_group <- lapply(names(features), function(feat_name) { 108 | rep(feat_name, length(features[[feat_name]])) |> setNames(features[[feat_name]]) 109 | }) |> unlist(); 110 | features <- unlist(features) 111 | } 112 | d <- .extract_sce_data(object, dims = NULL, features = features, slot = slot) 113 | d <- tidyr::pivot_longer(d, seq(ncol(d) - length(features) + 1, ncol(d)), names_to = "features") 114 | if (is.numeric(features)){ 115 | features <- rownames(object)[features] 116 | } 117 | d$features <- factor(d$features, levels = features) 118 | if (!is.null(.fun)) { 119 | d <- .fun(d) 120 | } 121 | if (is.null(group.by)) { 122 | group.by <- "label" 123 | } 124 | return(.ReturnDotPlot(d, features, group.by, split.by, cols, 125 | col.min, col.max, dot.min, dot.scale, mapping, scale, scale.by, 126 | scale.min, scale.max, cluster.idents, feature_group, ...)) 127 | }) 128 | 129 | 130 | ##' @importFrom RColorBrewer brewer.pal.info 131 | ##' @importFrom grDevices colorRampPalette 132 | ##' @importFrom stats hclust dist 133 | ##' @importFrom ggplot2 guides guide_legend labs scale_color_identity scale_color_distiller guide_colorbar 134 | .ReturnDotPlot <- function(d, features, group.by, split.by, cols, 135 | col.min, col.max, dot.min, dot.scale, mapping, scale, scale.by, 136 | scale.min, scale.max, cluster.idents, feature_group, ...) { 137 | #Some parts in the function is adapted from Seurat::DotPlot 138 | split.colors <- !is.null(split.by) && !any(cols %in% rownames(RColorBrewer::brewer.pal.info)) 139 | scale.func <- switch( 140 | EXPR = scale.by, 141 | 'size' = ggplot2::scale_size, 142 | 'radius' = ggplot2::scale_radius, 143 | stop("'scale.by' must be either 'size' or 'radius'") 144 | ) 145 | 146 | id.levels <- levels(d[[group.by]]) 147 | if (!is.null(split.by)) { 148 | splits <- d[[split.by]] 149 | if (split.colors) { 150 | if (length(unique(splits)) > length(cols)) { 151 | stop(paste0("Need to specify at least ", length(unique(splits)), " colors using the cols parameter")) 152 | } 153 | cols <- cols[1:length(unique(splits))] 154 | names(cols) <- unique(splits) 155 | } 156 | d[[group.by]] <- paste(d[[group.by]], splits, sep = '_') 157 | unique.splits <- unique(splits) 158 | id.levels <- paste0(rep(x = id.levels, each = length(x = unique.splits)), 159 | "_", rep(x = unique(x = splits), times = length(x = id.levels))) 160 | } 161 | avg.exp <- d |> 162 | dplyr::group_by(.data[[group.by]], .data$features) |> 163 | dplyr::summarise(avg.exp=mean(expm1(.data$value)), 164 | pct.exp=.PercentAbove(.data$value, 0)) 165 | 166 | if (cluster.idents) { 167 | mat <- avg.exp |> 168 | tidyr::pivot_wider(names_from=.data$features, values_from=c(.data$avg.exp, .data$pct.exp)) 169 | mat[[group.by]] <- NULL 170 | mat <- scale(mat) 171 | id.levels <- id.levels[hclust(dist(mat))$order] 172 | } 173 | if (!is.null(id.levels)) { 174 | avg.exp[[group.by]] <- factor(avg.exp[[group.by]], levels = id.levels) 175 | } 176 | 177 | ngroup <- length(id.levels) 178 | if (ngroup == 1) { 179 | scale <- FALSE 180 | warning( 181 | "Only one identity present, the expression values will be not scaled", 182 | call. = FALSE, 183 | immediate. = TRUE 184 | ) 185 | } else if (ngroup < 5 & scale) { 186 | warning( 187 | "Scaling data with a low number of groups may produce misleading results", 188 | call. = FALSE, 189 | immediate. = TRUE 190 | ) 191 | } 192 | 193 | .scale.fun <- function(x) { 194 | if (scale) { 195 | scaled <- scale(log1p(x)) 196 | scaled <- .MinMax(scaled, min=col.min, max=col.max) 197 | } else { 198 | scaled <- log1p(x) 199 | } 200 | return(scaled) 201 | } 202 | 203 | avg.exp <- avg.exp |> 204 | dplyr::group_by(.data$features) |> 205 | dplyr::mutate(avg.exp.scaled=.scale.fun(avg.exp)) 206 | 207 | if (split.colors) { 208 | avg.exp <- avg.exp |> 209 | dplyr::mutate(avg.exp.scaled=as.numeric(cut(.data$avg.exp.scaled, breaks = 20))) 210 | } 211 | avg.exp$pct.exp[avg.exp$pct.exp < dot.min] <- NA 212 | avg.exp$pct.exp <- avg.exp$pct.exp * 100 213 | 214 | if (split.colors) { 215 | splits.use <- unlist(x = lapply( 216 | X = avg.exp[[group.by]], 217 | FUN = function(x) 218 | sub( 219 | paste0(".*_(", 220 | paste(sort(unique(x = splits), decreasing = TRUE), 221 | collapse = '|' 222 | ),")$"), 223 | "\\1", x 224 | ) 225 | ) 226 | ) 227 | avg.exp$colors <- mapply( 228 | FUN = function(color, value) { 229 | return(colorRampPalette(colors = c('grey', color))(20)[value]) 230 | }, 231 | color = cols[splits.use], 232 | value = avg.exp$avg.exp.scaled 233 | ) 234 | } 235 | color.by <- ifelse(test = split.colors, yes = 'colors', no = 'avg.exp.scaled') 236 | if (!is.na(x = scale.min)) { 237 | avg.exp[avg.exp$pct.exp < scale.min, 'pct.exp'] <- scale.min 238 | } 239 | if (!is.na(x = scale.max)) { 240 | avg.exp[avg.exp$pct.exp > scale.max, 'pct.exp'] <- scale.max 241 | } 242 | 243 | default_mapping <- aes_string(color=color.by, size="pct.exp") 244 | if (is.null(mapping)) { 245 | mapping <- default_mapping 246 | } else { 247 | mapping <- modifyList(default_mapping, mapping) 248 | } 249 | if (!is.null(feature_group)) { 250 | avg.exp[["feat.group"]] <- feature_group[avg.exp[["features"]]] 251 | } 252 | p <- ggplot(avg.exp, aes(x=.data$features, y=.data[[group.by]])) + 253 | geom_point(mapping, ...)+ 254 | scale.func(range = c(0, dot.scale), limits = c(scale.min, scale.max))+ 255 | theme(axis.title.x = element_blank(), axis.title.y = element_blank()) + 256 | guides(size = guide_legend(title = 'Percent Expressed')) + 257 | labs( 258 | x = 'Features', 259 | y = ifelse(test = is.null(x = split.by), yes = 'Identity', no = 'Split Identity') 260 | )+ 261 | theme_minimal() 262 | 263 | if (!is.null(feature_group)) { 264 | p <- p + facet_grid( 265 | facets = ~feat.group, 266 | scales = "free_x", 267 | space = "free_x", 268 | switch = "y" 269 | ) + theme( 270 | panel.spacing = unit(x = 1, units = "lines"), 271 | strip.background = element_blank() 272 | ) 273 | } 274 | if (split.colors) { 275 | p <- p + scale_color_identity() 276 | } else if (length(x = cols) == 1) { 277 | p <- p + scale_color_distiller(palette = cols) 278 | } else { 279 | p <- p + scale_color_gradient(low = cols[1], high = cols[2]) 280 | } 281 | if (!split.colors) { 282 | p <- p + guides(color = guide_colorbar(title = 'Average Expression')) 283 | } 284 | return(p) 285 | } 286 | 287 | .PercentAbove <- function(x, threshold) { 288 | return(length(x = x[x > threshold]) / length(x = x)) 289 | } 290 | 291 | .MinMax <- function(data, min, max) { 292 | data2 <- data 293 | data2[data2 > max] <- max 294 | data2[data2 < min] <- min 295 | return(data2) 296 | } 297 | -------------------------------------------------------------------------------- /R/sc-feature.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_feature 2 | ##' @rdname sc-feature-methods 3 | ##' @param object Seurat object 4 | ##' @param features selected features (i.e., genes) 5 | ##' @param dims selected dimensions (must be a two-length vector) 6 | ##' that are used in visualization 7 | ##' @param reduction reduction method, default is NULL and will 8 | ##' use the default setting store in the object 9 | ##' @param cells selected cells to plot (default is all cells) 10 | ##' @param slot slot to pull expression data from (e.g., 'count' or 'data') 11 | ##' @param mapping aesthetic mapping 12 | ##' @param ncol number of facet columns if 'length(features) > 1' 13 | ##' @param density whether plot the 2D weighted kernel density, default is FALSE. 14 | ##' @param grid.n number of grid points in the two directions to estimate 2D 15 | ##' weighted kernel density, default is 100. 16 | ##' @param joint whether joint the multiple features with \code{joint.fun}, 17 | ##' default is FALSE. 18 | ##' @param joint.fun how to joint the multiple features if \code{joint=TRUE}, 19 | ##' default is prod. 20 | ##' @param common.legend whether to use \code{facet_wrap} to display the multiple 21 | ##' \code{features}, default is TRUE. 22 | ##' @param geom the function of geometric layer, default is sc_geom_point, 23 | ##' other geometric layer, such as \code{geom_bgpoint} or \code{geom_point} also works. 24 | ##' @param ... additional parameters pass to 'scattermore::geom_scattermore()' 25 | ##' \itemize{ 26 | ##' \item \code{bg_colour} the colour of background point, default is \code{NA}. 27 | ##' this character also can be set in \code{mappint}. 28 | ##' \item \code{gap_colour} the colour of gap background, default is \code{'white'}. 29 | ##' \item \code{bg_line_width} the line width of background point, 30 | ##' default is \code{.3}. 31 | ##' \item \code{gap_line_width} the gap line width of background point, 32 | ##' default is \code{.1}. 33 | ##' \item \code{alpha} the transparency of colour, default is 1. 34 | ##' \item \code{subset} subset the data frame which meet conditions to display. 35 | ##' this should be set in \code{mapping}. 36 | ##' } 37 | ##' @return dimension reduction plot colored by selected features 38 | ##' @importFrom ggplot2 theme 39 | ##' @importFrom ggplot2 theme_bw 40 | ##' @importFrom ggplot2 ggtitle 41 | ##' @importFrom ggplot2 element_blank 42 | ##' @importFrom ggplot2 element_text 43 | ##' @importFrom ggplot2 scale_color_gradient 44 | ##' @importFrom ggplot2 rel 45 | ##' @export 46 | ##' @examples 47 | ##' library(scuttle) 48 | ##' library(scater) 49 | ##' library(scran) 50 | ##' library(ggplot2) 51 | ##' sce <- mockSCE() 52 | ##' sce <- logNormCounts(sce) 53 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 54 | ##' colLabels(sce) <- clusters 55 | ##' sce <- runTSNE(sce, assay.type = 'logcounts') 56 | ##' set.seed(123) 57 | ##' genes <- rownames(sce) |> sample(6) 58 | ##' p1 <- sc_feature(sce, genes[1], slot='logcounts', reduction = 'TSNE') 59 | ##' p2 <- sc_feature(sce, genes, slot='logcounts', reduction = 'TSNE') 60 | ##' f1 <- sc_dim(sce, slot='logcounts', reduction = 'TSNE') + 61 | ##' sc_dim_geom_feature(sce, genes[1], color='black') 62 | ##' f2 <- sc_dim(sce, alpha=.3, slot='logcounts', reduction = 'TSNE') + 63 | ##' ggnewscale::new_scale_color() + 64 | ##' sc_dim_geom_feature(sce, genes, mapping=aes(color=features)) + 65 | ##' scale_color_viridis_d() 66 | ##' p1 + p2 + f1 + f2 67 | ##' # The features can also be specified the variables from 68 | ##' # colData or reducedDims 69 | ##' pp <- sc_feature(sce, features = 'sizeFactor', reduction='TSNE', geom=geom_bgpoint) 70 | ##' pp 71 | setGeneric('sc_feature', function(object, 72 | features, 73 | dims = c(1, 2), 74 | reduction = NULL, 75 | cells = NULL, 76 | slot = 'data', 77 | mapping = NULL, 78 | ncol = 3, 79 | density = FALSE, 80 | grid.n = 100, 81 | joint = FALSE, 82 | joint.fun = prod, 83 | common.legend = TRUE, 84 | geom = sc_geom_point, 85 | ...) 86 | standardGeneric('sc_feature') 87 | ) 88 | 89 | ##' @rdname sc-feature-methods 90 | ##' @aliases sc_feature,Seurat 91 | ##' @exportMethod sc_feature 92 | setMethod('sc_feature', 'Seurat', function(object, features, 93 | dims=c(1,2), reduction=NULL, 94 | cells=NULL, slot = "data", mapping=NULL, 95 | ncol=3, density = FALSE, grid.n = 100, joint = FALSE, 96 | joint.fun = prod, common.legend = TRUE, geom = sc_geom_point, ...) { 97 | if (is.numeric(features)){ 98 | features <- rownames(object)[features] 99 | } 100 | d <- get_dim_data(object = object, features = features, 101 | dims = dims, reduction = reduction, 102 | cells = cells, slot = slot, density = density, 103 | grid.n = grid.n, joint = joint, joint.fun = joint.fun) 104 | 105 | nm.f <- length(features) 106 | if (density){ 107 | valnm <- 'density' 108 | if(joint){ 109 | valnm <- "joint density" 110 | nm.f <- nm.f + 1 111 | } 112 | }else{ 113 | valnm <- slot 114 | } 115 | 116 | if (!all(features %in% rownames(object))){ 117 | valnm <- "data" 118 | } 119 | 120 | indx.f <- seq(ncol(d)-nm.f + 1, ncol(d)) 121 | 122 | features <- colnames(d)[indx.f] 123 | 124 | d2 <- tidyr::pivot_longer(d, indx.f, names_to = "features", values_to = valnm) 125 | d2$features <- factor(d2$features, features) 126 | 127 | default_mapping <- aes_string(color=valnm) 128 | if (is.null(mapping)) { 129 | mapping <- default_mapping 130 | } else { 131 | mapping <- modifyList(default_mapping, mapping) 132 | } 133 | 134 | p <- sc_dim_internal(d2, mapping, geom = geom, ...) + 135 | scale_color_gradient(low='grey', high='blue') 136 | #scale_color_gradient2(low='blue', mid='grey', high='red') + 137 | 138 | p <- p + .feature_setting(features=features, ncol=ncol) 139 | 140 | if (!common.legend && length(features) > 1){ 141 | p <- .split.by.feature(p, ncol) 142 | } 143 | p <- .add_class(p, "ggsc") 144 | return(p) 145 | }) 146 | 147 | ##' @rdname sc-feature-methods 148 | ##' @aliases sc_feature,SingleCellExperiment 149 | ##' @exportMethod sc_feature 150 | setMethod("sc_feature", "SingleCellExperiment", 151 | function(object, features, dims = c(1, 2), reduction = NULL, 152 | cells = NULL, slot = 'data', mapping = NULL, ncol = 3, 153 | density = FALSE, grid.n = 100, joint = FALSE, 154 | joint.fun = prod, common.legend = TRUE, geom = sc_geom_point, ...){ 155 | if (slot == 'data'){ 156 | if ('logcounts' %in% assayNames(object)){ 157 | slot <- 'logcounts' 158 | }else{ 159 | slot <- 1 160 | } 161 | } 162 | 163 | if (is.numeric(features)){ 164 | features <- rownames(object)[features] 165 | } 166 | 167 | d <- .extract_sce_data(object = object, features = features, dims = dims, 168 | reduction = reduction, cells = cells, slot = slot, 169 | density = density, grid.n = grid.n, joint = joint, 170 | joint.fun = joint.fun 171 | ) 172 | 173 | nm.f <- length(features) 174 | 175 | if (density){ 176 | valnm <- 'density' 177 | if (joint) { 178 | valnm <- "joint" 179 | nm.f <- nm.f + 1 180 | } 181 | }else{ 182 | if (is.numeric(slot)){ 183 | slot <- assayNames(object)[slot] 184 | } 185 | valnm <- slot 186 | } 187 | 188 | if (!all(features %in% rownames(object))){ 189 | valnm <- "data" 190 | } 191 | 192 | indx.f <- seq(ncol(d) - nm.f + 1, ncol(d)) 193 | 194 | d2 <- tidyr::pivot_longer( 195 | d, 196 | indx.f, 197 | names_to = 'features', 198 | values_to = valnm 199 | ) 200 | 201 | features <- colnames(d)[indx.f] 202 | 203 | d2$features <- factor(d2$features, features) 204 | 205 | default_mapping <- aes_string(color=valnm) 206 | if (is.null(mapping)) { 207 | mapping <- default_mapping 208 | } else { 209 | mapping <- modifyList(default_mapping, mapping) 210 | } 211 | 212 | p <- sc_dim_internal(d2, mapping, geom = geom, ...) + 213 | scale_color_gradient(low='grey', high='blue') 214 | #scale_color_gradient2(low='blue', mid='grey', high='red') + 215 | 216 | p <- p + .feature_setting(features=features, ncol=ncol) 217 | 218 | if (!common.legend && length(features) > 1){ 219 | p <- .split.by.feature(p, ncol) 220 | } 221 | p <- .add_class(p, "ggsc") 222 | return(p) 223 | }) 224 | 225 | 226 | .feature_setting <- function(features, ncol, plot.pie=FALSE) { 227 | if (length(features) == 1) { 228 | res <- list(ggtitle(features), 229 | theme(plot.title=element_text(size=rel(1.5), face='bold')) 230 | ) 231 | }else if(missing(features) || is.null(features)){ 232 | res <- theme_bw2() 233 | }else if(!plot.pie) { 234 | res <- list(facet_wrap(~features, ncol=ncol), 235 | theme_bw2() 236 | ) 237 | }else if(plot.pie){ 238 | res <- theme_bw2(legend.title=element_text(size = 16,face="bold"), 239 | legend.text=element_text(size = 15), 240 | legend.key.size = grid::unit(0.45, 'cm')) 241 | } 242 | return(res) 243 | } 244 | 245 | ##' @importFrom ggplot2 %+replace% 246 | theme_bw2 <- function(...) { 247 | theme_bw() %+replace% 248 | theme(axis.text = element_blank(), 249 | axis.title = element_blank(), 250 | axis.ticks = element_blank(), 251 | panel.grid = element_blank() 252 | ) %+replace% 253 | theme(...) 254 | } 255 | 256 | -------------------------------------------------------------------------------- /R/sc-geom-annot.R: -------------------------------------------------------------------------------- 1 | #' @title add the annotation layer for ggsc object 2 | #' @param data The data to be displayed in this layer. There are three 3 | #' options: 4 | #' If \code{NULL}, the default, the data is inherited from the plot 5 | #' data as specified in the call to \code{ggplot()}. 6 | #' A \code{data.frame}, will override the plot data. the \code{data.frame} 7 | #' should have a barcode id or features column. 8 | #' A \code{function} will be called with a single argument, the plot 9 | #' data. The return value must be a ‘data.frame’, and will be 10 | #' used as the layer data. A \code{function} can be created from a 11 | #' ‘formula’ (e.g. ‘~ head(.x, 10)’). 12 | #' @param mapping Set of aesthetic mappings created by \code{aes()}. If specified 13 | #' and \code{inherit.aes = TRUE} (the default), it is combined with the default 14 | #' mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping. 15 | #' @inheritParams geom_scattermore2 16 | #' @export 17 | #' @return layer object 18 | sc_geom_annot <- function( 19 | data=NULL, 20 | mapping=NULL, 21 | pointsize = 2, 22 | pixels = c(512, 512), 23 | gap_colour = "white", 24 | gap_alpha = 1, 25 | bg_line_width = 0.3, 26 | gap_line_width = 0.1, 27 | show.legend = NA, 28 | na.rm = FALSE, 29 | ... 30 | ){ 31 | params <- list(...) 32 | x <- structure( 33 | list(data = data, 34 | mapping = mapping, 35 | pointsize = pointsize, 36 | pixels = pixels, 37 | gap_colour = gap_colour, 38 | gap_alpha = gap_alpha, 39 | bg_line_width = bg_line_width, 40 | gap_line_width = gap_line_width, 41 | show.legend = show.legend, 42 | na.rm = na.rm, 43 | params=params), 44 | class = 'sc_geom_annot' 45 | ) 46 | return(x) 47 | } 48 | 49 | #' @importFrom ggplot2 ggplot_add 50 | #' @method ggplot_add sc_geom_annot 51 | #' @export 52 | ggplot_add.sc_geom_annot <- function(object, plot, object_name){ 53 | object <- .check_layer_data(object, plot) 54 | params <- object$params 55 | object$params <- NULL 56 | geomfun <- .extract_geom_name(plot) 57 | if (geomfun == 'geom_scattermore2'){ 58 | geomfun <- "sc_geom_point" 59 | }else{ 60 | object$pixels <- NULL 61 | } 62 | ly <- do.call(geomfun, c(object, params)) 63 | ggplot_add(ly, plot, object_name) 64 | } 65 | 66 | 67 | .check_layer_data <- function(object, plot){ 68 | if (is.data.frame(object$data)){ 69 | object$data <- plot$data |> 70 | dplyr::left_join(object$data, suffix = c("", ".y")) |> 71 | suppressMessages() 72 | } 73 | return(object) 74 | } 75 | 76 | .extract_geom_name <- function(plot){ 77 | ind <- 1 78 | if (length(plot$layers)>1){ 79 | ind <- 2 80 | } 81 | lay <- plot$layers[[ind]] 82 | x <- snakeize(class(lay$geom))[[1]] 83 | x <- gsub("new_","", x) 84 | return(x) 85 | } 86 | 87 | # this is from the internal function of ggplot2 88 | snakeize <- function(x){ 89 | x <- gsub("([A-Za-z])([A-Z])([a-z])", "\\1_\\2\\3", x) 90 | x <- gsub(".", "_", x, fixed = TRUE) 91 | x <- gsub("([a-z])([A-Z])", "\\1_\\2", x) 92 | to_lower_ascii(x) 93 | } 94 | 95 | upper_ascii <- "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 96 | lower_ascii <- "abcdefghijklmnopqrstuvwxyz" 97 | to_lower_ascii <- function(x){ 98 | chartr(upper_ascii, lower_ascii, x) 99 | } 100 | -------------------------------------------------------------------------------- /R/sc-geom-point.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_geom_point 2 | ##' @rdname sc-geom-point 3 | ##' @param mapping aesthetic mapping 4 | ##' @param ... additional parameters pass to 'scattermore::geom_scattermore()' 5 | ##' @return layer of points 6 | ##' @importFrom scattermore geom_scattermore 7 | ##' @seealso [sc_dim()] and [sc_feature()] 8 | ##' @export 9 | ##' @examples 10 | ##' library(ggplot2) 11 | ##' ggplot(iris, 12 | ##' aes(x= Sepal.Length, y = Petal.Width, color=Species) 13 | ##' ) + 14 | ##' sc_geom_point() 15 | sc_geom_point <- function(mapping=NULL, ...){ 16 | default_params <- list(mapping = mapping, 17 | pointsize = 3, 18 | pixels = c(700, 700) 19 | ) 20 | params <- modifyList(default_params, list(...)) 21 | do.call(geom_scattermore2, params) 22 | } 23 | 24 | #' @title geom_bgpoint 25 | #' @description 26 | #' this add the background color for \code{\link[ggplot2]{geom_point}} 27 | #' @eval rd_aesthetics("geom", "bgpoint") 28 | #' @inheritParams ggplot2::layer 29 | #' @param na.rm If \code{FALSE}, the default, missing values are removed 30 | #' with a warning, if \code{TRUE}, missing values are silently removed. 31 | #' @param gap_colour colour of gap background between the bottom background 32 | #' and top point point layer, default is \code{white}. 33 | #' @param gap_alpha numeric the transparency of gap background colour, default is 1. 34 | #' @param bg_line_width numeric the line width of background point layer, 35 | #' default is \code{0.3}. 36 | #' @param gap_line_width numeric the line width of gap between the background and 37 | #' top point point layer, default is \code{.1}. 38 | #' @param pointsize numeric the size of point, default is NULL, will use the 39 | #' internal size aesthetics of \code{geom_bgpoint} 40 | #' @param ... Other arguments passed on to \code{\link[ggplot2]{layer}}. 41 | #' @details 42 | #' \itemize{ 43 | #' \item \code{colour} the colour of point, default is \code{black}. 44 | #' \item \code{bg_colour} the colour of background point, default is \code{NA}. 45 | #' \item \code{alpha} the transparency of colour, default is 1. 46 | #' \item \code{subset} subset the data frame which meet conditions to display. 47 | #' } 48 | #' @importFrom rlang list2 49 | #' @author Shuangbin Xu 50 | #' @export 51 | #' @examples 52 | ##' library(ggplot2) 53 | ##' ggplot(iris, 54 | ##' aes(x= Sepal.Length, y = Petal.Width, color=Species, bg_colour=Species) 55 | ##' ) + 56 | ##' geom_bgpoint(pointsize=4, gap_line_width = .1, bg_line_width = .3) 57 | geom_bgpoint <- function( 58 | mapping = NULL, 59 | data = NULL, 60 | stat = "identity", 61 | position = "identity", 62 | ..., 63 | na.rm = FALSE, 64 | show.legend = NA, 65 | inherit.aes = TRUE, 66 | gap_colour = 'white', 67 | gap_alpha = 1, 68 | bg_line_width = .3, 69 | gap_line_width = .1, 70 | pointsize = NULL 71 | ){ 72 | 73 | layer( 74 | data = data, 75 | mapping = mapping, 76 | stat = stat, 77 | geom = GeomBgpoint, 78 | position = position, 79 | show.legend = show.legend, 80 | inherit.aes = inherit.aes, 81 | params = list2( 82 | na.rm = na.rm, 83 | gap_colour = gap_colour, 84 | gap_alpha = gap_alpha, 85 | bg_line_width = bg_line_width, 86 | gap_line_width = gap_line_width, 87 | pointsize = pointsize, 88 | ... 89 | ) 90 | ) 91 | } 92 | 93 | 94 | #' @title geom_scattermore2 95 | #' @description 96 | #' this add the background colour for the \code{\link[scattermore]{geom_scattermore}} 97 | #' @eval rd_aesthetics("geom", "scattermore2") 98 | #' @inheritParams ggplot2::layer 99 | #' @param na.rm If `FALSE`, the default, missing values are removed with 100 | #' a warning. If `TRUE`, missing values are silently removed. 101 | #' @param interpolate A logical value indicating whether to linearly interpolate 102 | #' the image (the alternative is to use nearest-neighbour interpolation, 103 | #' which gives a more blocky result). Default \code{FALSE}, 104 | #' passed to \code{\link[grid]{rasterGrob}}. 105 | #' @param pointsize Radius of rasterized point. Use ‘0’ for single pixels (fastest). 106 | #' @param pixels Vector with X and Y resolution of the raster, default \code{c(512,512)}. 107 | #' @param gap_colour colour of gap background between the bottom background 108 | #' and top point point layer, default is \code{white}. 109 | #' @param gap_alpha numeric the transparency of gap background colour, default is 1. 110 | #' @param bg_line_width numeric the line width of background point layer, 111 | #' default is \code{0.3}. 112 | #' @param gap_line_width numeric the line width of gap between the background and 113 | #' top point point layer, default is \code{.1}. 114 | #' @param ... Other arguments passed on to \code{\link[ggplot2]{layer}}. 115 | #' @details 116 | #' \itemize{ 117 | #' \item \code{colour} the colour of point, default is \code{black}. 118 | #' \item \code{bg_colour} the colour of background point, default is \code{NA}. 119 | #' \item \code{alpha} the transparency of colour, default is 1. 120 | #' \item \code{subset} subset the data frame which meet conditions to display. 121 | #' } 122 | #' @return polygonal point layer 123 | #' @importFrom ggplot2 layer 124 | #' @author Shuangbin Xu 125 | #' @export 126 | #' @examples 127 | ##' library(ggplot2) 128 | ##' ggplot(iris, 129 | ##' aes(x= Sepal.Length, y = Petal.Width, color=Species, bg_colour=Species) 130 | ##' ) + 131 | ##' geom_scattermore2(pointsize=4, gap_line_width = .1, bg_line_width = .3) 132 | geom_scattermore2 <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity", ..., 133 | na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, 134 | interpolate = FALSE, pointsize = 0, pixels = c(512, 512), 135 | gap_colour = 'white', gap_alpha = 1, bg_line_width = .3, gap_line_width = .1){ 136 | ggplot2::layer( 137 | data = data, 138 | mapping = mapping, 139 | stat = stat, 140 | position = position, 141 | geom = GeomScattermore2, 142 | show.legend = show.legend, 143 | inherit.aes = inherit.aes, 144 | params = list2( 145 | na.rm = na.rm, 146 | interpolate = interpolate, 147 | pointsize = pointsize, 148 | pixels = pixels, 149 | gap_colour = gap_colour, 150 | gap_alpha = gap_alpha, 151 | bg_line_width = bg_line_width, 152 | gap_line_width = gap_line_width, 153 | ... 154 | ) 155 | ) 156 | } 157 | 158 | 159 | #' @importFrom scattermore scattermore 160 | GeomScattermore2 <- ggplot2::ggproto("GeomScattermore2", ggplot2::Geom, 161 | required_aes = c("x", "y"), 162 | non_missing_aes = c("alpha", "colour"), 163 | optional_aes = c("subset"), 164 | default_aes = ggplot2::aes( 165 | shape = 19, colour = "black", size = 1.5, fill = NA, 166 | alpha = 1, stroke = 0.5, bg_colour = NA 167 | ), 168 | setup_data = function(data, params){ 169 | if (is.null(data$subset)) 170 | return(data) 171 | data[which(data$subset),] 172 | }, 173 | draw_panel = function(data, pp, coord, 174 | pointsize = 0, 175 | interpolate = FALSE, 176 | na.rm = FALSE, 177 | pixels = c(512, 512), 178 | gap_colour = 'white', 179 | gap_alpha = 1, 180 | bg_line_width = .3, 181 | gap_line_width = .1){ 182 | coords <- coord$transform(data, pp) 183 | 184 | upperimage <- scattermore(cbind(coords$x, coords$y), 185 | rgba = grDevices::col2rgb(alpha = TRUE, scales::alpha(coords$colour, coords$alpha)), 186 | cex = pointsize, 187 | xlim = c(0, 1), 188 | ylim = c(0, 1), 189 | size = pixels) 190 | 191 | if (!all(is.null(coords$bg_colour)) && !all(is.na(coords$bg_colour))){ 192 | tmpsize <- sqrt(pointsize) 193 | gapsize <- (tmpsize + tmpsize * gap_line_width * 2)^2 194 | bgsize <- gapsize + (sqrt(bg_line_width) + tmpsize * bg_line_width * 2) ^2 195 | bgimage <- scattermore(cbind(coords$x, coords$y), 196 | rgba = grDevices::col2rgb(alpha = TRUE, scales::alpha(coords$bg_colour, 1)), 197 | cex = bgsize, 198 | xlim = c(0, 1), 199 | ylim = c(0, 1), 200 | size = pixels) 201 | gapimage <- scattermore(cbind(coords$x, coords$y), 202 | rgba = grDevices::col2rgb(alpha = TRUE, scales::alpha(gap_colour, gap_alpha)), 203 | cex = gapsize, 204 | xlim = c(0, 1), 205 | ylim = c(0, 1), 206 | size = pixels) 207 | 208 | }else{ 209 | bgimage <- gapimage <- NULL 210 | } 211 | 212 | ggplot2:::ggname( 213 | "geom_scattermore2", 214 | crasterGrob( 215 | upperimage, bgimage, gapimage, 216 | 0, 0, 1, 1, 217 | default.units = "native", 218 | just = c("left", "bottom"), 219 | interpolate = interpolate 220 | ) 221 | ) 222 | }, 223 | draw_key = draw_key_bgpoint 224 | ) 225 | 226 | #' @importFrom ggplot2 translate_shape_string draw_key_point 227 | GeomBgpoint <- ggplot2::ggproto("GeomBgpoint", ggplot2::Geom, 228 | required_aes = c("x", "y"), 229 | non_missing_aes = c("alpha", "colour"), 230 | optional_aes = c("subset"), 231 | default_aes = ggplot2::aes( 232 | shape = 19, colour = "black", size = 1.5, fill = NA, 233 | alpha = 1, stroke = 0.5, bg_colour = NA 234 | ), 235 | setup_data = function(data, params){ 236 | if (is.null(data$subset)) 237 | return(data) 238 | data[which(data$subset),] 239 | }, 240 | draw_panel = function(self, 241 | data, 242 | panel_params, 243 | coord, 244 | na.rm = FALSE, 245 | gap_colour = 'white', 246 | gap_alpha = 1, 247 | bg_line_width = .3, 248 | gap_line_width = .1, 249 | pointsize = NULL 250 | ){ 251 | if (is.character(data$shape)) { 252 | data$shape <- translate_shape_string(data$shape) 253 | } 254 | 255 | coords <- coord$transform(data, panel_params) 256 | stroke_size <- coords$stroke 257 | stroke_size[is.na(stroke_size)] <- 0 258 | if (is.null(pointsize)){ 259 | pointsize <- coords$size * .pt + stroke_size * .stroke / 2 260 | }else{ 261 | pointsize <- rep(pointsize, nrow(coords)) * .pt + stroke_size * .stroke/2 262 | } 263 | ggname("geom_bgpoint", 264 | cpointsGrob( 265 | coords$x, coords$y, 266 | pch = coords$shape, 267 | bg_line_width = bg_line_width, 268 | gap_line_width = gap_line_width, 269 | bg_colour = coords$bg_colour, 270 | gap_colour = alpha(gap_colour, gap_alpha), 271 | gp = gpar( 272 | col = alpha(coords$colour, coords$alpha), 273 | fill = fill_alpha(coords$fill, coords$alpha), 274 | fontsize = pointsize, 275 | lwd = coords$stroke * .stroke / 2 276 | ) 277 | ) 278 | ) 279 | }, 280 | draw_key = draw_key_bgpoint 281 | ) 282 | 283 | 284 | #' @importFrom grid grobName 285 | ggname <- function (prefix, grob){ 286 | grob$name <- grobName(grob, prefix) 287 | grob 288 | } 289 | 290 | 291 | -------------------------------------------------------------------------------- /R/sc-spatial.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_spatial 2 | ##' @rdname sc-spatial-methods 3 | ##' @param object Seurat object 4 | ##' @param features selected features to be visualized 5 | ##' @param sample.id the index name of sample id, which only 6 | ##' work with SingleCellExperiment or SpatialExperiment. 7 | ##' @param image.id the index name of image id, which only work 8 | ##' with SingleCellExperiment or SpatialExperiment. 9 | ##' @param slot if plotting a feature, which data will be used 10 | ##' (e.g., 'data', 'counts'), the assay name if object 11 | ##' is SingleCellExperiment or SpatialExperiment. 12 | ##' @param plot.pie logical whether plot the features with pie, default is \code{FALSE}. 13 | ##' @param pie.radius.scale numeric scale to the radius of pie only work with \code{plot.pie=TRUE}, 14 | ##' default is 0.3. 15 | ##' @param image.plot whether to display the issue image as background. 16 | ##' @param image.first.operation character which the first operation to 17 | ##' image, 'rotate' or 'mirror', default is 'rotate'. 18 | ##' @param image.rotate.degree integer the degree to ratate image, default is NULL. 19 | ##' @param image.mirror.axis character the direction to mirror the image, default is 'h'. 20 | ##' @param remove.point whether to remove the spot points, it is nice 21 | ##' if your just view the issue image, default is FALSE. 22 | ##' @param mapping aesthetic mapping, default is NULL. 23 | ##' @param ncol integer number of facet columns if 'length(features) > 1', default is 6. 24 | ##' @param density whether plot the 2D weighted kernel density, default is FALSE. 25 | ##' @param grid.n number of grid points in the two directions to estimate 2D 26 | ##' weighted kernel density, default is 100. 27 | ##' @param joint whether joint the multiple features with \code{joint.fun}, 28 | ##' default is FALSE. 29 | ##' @param joint.fun how to joint the multiple features if \code{joint = TRUE}, 30 | ##' default is prod. 31 | ##' @param common.legend whether to use \code{facet_wrap} to display the multiple 32 | ##' \code{features}, default is TRUE. 33 | ##' @param pointsize the size of point, default is 5. 34 | ##' @param geom the layer of point, default is \code{sc_geom_point}, other option is 35 | ##' \code{geom_bgpoint}. 36 | ##' @param ... additional parameters, see also \code{geom_scattermore2()}. 37 | ##' \itemize{ 38 | ##' \item \code{bg_colour} the colour of background point, default is \code{NA}. 39 | ##' this character also can be set in \code{mappint}. 40 | ##' \item \code{gap_colour} the colour of gap background, default is \code{'white'}. 41 | ##' \item \code{bg_line_width} the line width of background point, 42 | ##' default is \code{.3}. 43 | ##' \item \code{gap_line_width} the gap line width of background point, 44 | ##' default is \code{.1}. 45 | ##' \item \code{alpha} the transparency of colour, default is 1. 46 | ##' \item \code{subset} subset the data frame which meet conditions to display. 47 | ##' this should be set in \code{mapping}. 48 | ##' } 49 | ##' @return ggplot object 50 | ##' @importFrom grid rasterGrob unit 51 | ##' @importFrom ggplot2 facet_grid annotation_custom 52 | ##' @importFrom ggplot2 xlab ylab geom_blank coord_fixed 53 | ##' @importFrom ggplot2 scale_color_gradientn 54 | ##' @importFrom Seurat DefaultAssay 55 | ##' @export 56 | ##' @examples 57 | ##' \dontrun{ 58 | ##' library(STexampleData) 59 | ##' # create ExperimentHub instance 60 | ##' eh <- ExperimentHub() 61 | ##' # query STexampleData datasets 62 | ##' myfiles <- query(eh, "STexampleData") 63 | ##' ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC'] 64 | ##' spe <- myfiles[[ah_id]] 65 | ##' spe <- spe[, colData(spe)$in_tissue == 1] 66 | ##' set.seed(123) 67 | ##' genes <- rownames(spe) |> sample(6) 68 | ##' p <- sc_spatial(spe, features = genes, 69 | ##' image.rotate.degree = -90, 70 | ##' image.mirror.axis = NULL, 71 | ##' ncol = 3) 72 | ##' # The features also can be specified 73 | ##' # the variables from colData or reducedDims. 74 | ##' p1 <- sc_spatial(spe, features = 'cell_count', 75 | ##' image.rotate.degree = -90, image.mirror.axis = NULL) 76 | ##' } 77 | setGeneric('sc_spatial', function(object, 78 | features = NULL, 79 | sample.id = NULL, 80 | image.id = NULL, 81 | slot = "data", 82 | plot.pie = FALSE, 83 | pie.radius.scale = 0.3, 84 | image.plot = TRUE, 85 | image.first.operation = 'rotate', 86 | image.rotate.degree = NULL, 87 | image.mirror.axis = NULL, 88 | remove.point = FALSE, 89 | mapping = NULL, 90 | ncol = 6, 91 | density = FALSE, 92 | grid.n = 100, 93 | joint = FALSE, 94 | joint.fun = prod, 95 | common.legend = TRUE, 96 | pointsize = 5, 97 | geom = sc_geom_point, 98 | ...) 99 | standardGeneric('sc_spatial') 100 | ) 101 | 102 | ##' @importFrom grDevices as.raster 103 | ##' @rdname sc-spatial-methods 104 | ##' @aliases sc_spatial,Seurat 105 | ##' @exportMethod sc_spatial 106 | setMethod("sc_spatial", 'Seurat', 107 | function(object, features = NULL, slot = "data", 108 | plot.pie = FALSE, pie.radius.scale = .3, 109 | image.plot = TRUE, image.first.operation = 'rotate', 110 | image.rotate.degree = NULL, image.mirror.axis = 'v', 111 | remove.point = FALSE, mapping = NULL, ncol = 6, 112 | density=FALSE, grid.n = 100, joint = FALSE, 113 | joint.fun = prod, common.legend = TRUE, pointsize = 5, 114 | geom = sc_geom_point, 115 | ...) { 116 | images <- SeuratObject::Images(object = object, 117 | assay = Seurat::DefaultAssay(object = object) 118 | ) 119 | img <- object@images[[images]]@image 120 | if (!is.null(img)) img <- as.raster(img) 121 | 122 | coords.da <- SeuratObject::GetTissueCoordinates(object = object[[images]]) 123 | if (is.numeric(features)){ 124 | features <- rownames(object)[features] 125 | } 126 | 127 | d <- get_dim_data(object = object, features = features, dims = NULL, 128 | density = density, grid.n = grid.n, joint = joint, 129 | joint.fun = joint.fun, sp.coords=coords.da) 130 | 131 | nm.f <- length(features) 132 | 133 | if (density){ 134 | valnm <- 'density' 135 | if (joint){ 136 | #valnm <- "joint_density" 137 | nm.f <- nm.f + 1 138 | } 139 | }else{ 140 | valnm <- slot 141 | } 142 | if (!all(features %in% rownames(object))){ 143 | valnm <- "data" 144 | } 145 | d <- cbind(coords.da, d) 146 | 147 | default_mapping <- aes_string(x = colnames(coords.da)[2], y = colnames(coords.da)[1]) 148 | 149 | if (!is.null(features)){ 150 | 151 | indx.f <- seq(ncol(d) - nm.f + 1, ncol(d)) 152 | features <- colnames(d)[indx.f] 153 | if (plot.pie){ 154 | d <- d[rowSums(d[,features,drop=FALSE]) != 0,,drop=FALSE] 155 | } 156 | d <- tidyr::pivot_longer( 157 | d, 158 | indx.f, 159 | names_to = 'features', 160 | values_to = valnm 161 | ) 162 | d$features <- factor(d$features, levels=features) 163 | if (!plot.pie){ 164 | default_mapping <- modifyList(default_mapping, aes_string(color = valnm)) 165 | }else{ 166 | colnames(d)[colnames(d) == valnm] <- 'value' 167 | } 168 | } 169 | 170 | if (!is.null(mapping)){ 171 | mapping <- modifyList(default_mapping, mapping) 172 | }else{ 173 | mapping <- default_mapping 174 | } 175 | 176 | 177 | if (!plot.pie){ 178 | p <- ggplot(d, mapping) 179 | }else{ 180 | p <- ggplot() 181 | } 182 | 183 | if (image.plot && !is.null(img)){ 184 | img.annot <- .build_img_annot_layer(img, 185 | image.first.operation, 186 | image.rotate.degree, 187 | image.mirror.axis) 188 | p <- p + img.annot 189 | } 190 | 191 | if ((!remove.point && (!is.null(features) || (any(names(mapping) %in% c('color', 'colour')) && is.null(features))) && !plot.pie)){ 192 | params <- list(...) 193 | params$pointsize <- pointsize 194 | pointlayer <- do.call(geom, params) 195 | p <- p + pointlayer 196 | }else if (!remove.point && plot.pie){ 197 | rlang::check_installed('scatterpie', 'is required when `plot.pie=TRUE`') 198 | p <- p + scatterpie::geom_scatterpie(data=d, mapping=mapping, cols='features', long_format=TRUE, pie_scale=pie.radius.scale, ...) 199 | }else{ 200 | p <- p + geom_blank() 201 | } 202 | 203 | p <- p + 204 | .feature_setting(features, ncol, plot.pie) + 205 | ylab(NULL) + 206 | xlab(NULL) + 207 | coord_fixed() + 208 | theme_bw2() 209 | 210 | color.aes <- .check_aes_exits(p$mapping, c('color', 'colour')) 211 | if (!is.null(color.aes)) { 212 | type.color.value <- p$data |> dplyr::pull(!!color.aes) 213 | if (inherits(type.color.value, 'numeric')) { 214 | p <- p + scale_color_gradientn(colours = SpatialColors(n=100)) 215 | } 216 | } 217 | 218 | if (plot.pie){ 219 | Type.cols <- .set_default_cols(length(features)) 220 | p <- p + scale_fill_manual(values=Type.cols, name='Type') 221 | } 222 | 223 | if (!common.legend && length(features) > 1 && !plot.pie){ 224 | ncol <- min(length(features), ncol) 225 | p <- .split.by.feature(p, ncol, joint) 226 | } 227 | p <- .add_class(p, "ggsc") 228 | return(p) 229 | }) 230 | 231 | #' @importFrom SingleCellExperiment int_metadata 232 | #' @importFrom ggplot2 scale_fill_manual 233 | #' @rdname sc-spatial-methods 234 | #' @aliases sc_spatial,SingleCellExperiment 235 | #' @exportMethod sc_spatial 236 | setMethod('sc_spatial', 'SingleCellExperiment', function(object, 237 | features = NULL, 238 | sample.id = NULL, 239 | image.id = NULL, 240 | slot = 1, 241 | plot.pie = FALSE, 242 | pie.radius.scale = .3, 243 | image.plot = TRUE, 244 | image.first.operation = 'rotate', 245 | image.rotate.degree = NULL, 246 | image.mirror.axis = 'v', 247 | remove.point = FALSE, 248 | mapping = NULL, 249 | ncol = 6, 250 | density = FALSE, 251 | grid.n = 100, 252 | joint = FALSE, 253 | joint.fun = prod, 254 | common.legend = TRUE, 255 | pointsize = 5, 256 | geom = sc_geom_point, 257 | ... 258 | ){ 259 | if (!"imgData" %in% names(int_metadata(object))){ 260 | cli::cli_abort(c("The {.cls {class(object)}} didn't have the image data.")) 261 | } 262 | 263 | img.da <- .extract_img_data(object, sample.id = sample.id, image.id = image.id) 264 | 265 | coords.da <- .extract_coords(object, img.da) 266 | 267 | if (is.numeric(features)){ 268 | features <- rownames(object)[features] 269 | } 270 | 271 | features.da <- .extract_sce_data(object, features = features, dims = NULL, 272 | cells = NULL, slot = slot, plot.pie = plot.pie, density=density, 273 | grid.n = grid.n, joint = joint, joint.fun = joint.fun, 274 | sp.coords = coords.da) 275 | rownames(features.da) <- features.da$`.BarcodeID` 276 | features.da$`.BarcodeID` <- NULL 277 | 278 | d <- merge(coords.da, features.da, by=0) 279 | colnames(d)[1] <- '.BarcodeID' 280 | 281 | default_mapping <- aes_string(x = colnames(coords.da)[2], y = colnames(coords.da)[1]) 282 | if (!is.null(features)){ 283 | if (plot.pie){ 284 | d <- d[rowSums(d[,features,drop=FALSE]) != 0,,drop=FALSE] 285 | } 286 | nm.f <- length(features) 287 | if (density){ 288 | valnm <- 'density' 289 | if (joint){ 290 | #valnm <- "joint_density" 291 | nm.f <- nm.f + 1 292 | } 293 | }else{ 294 | if (is.numeric(slot)){ 295 | slot <- assayNames(object)[slot] 296 | } 297 | valnm <- slot 298 | } 299 | 300 | if (!all(features %in% rownames(object))){ 301 | valnm <- 'data' 302 | } 303 | 304 | indx.f <- seq(ncol(d)- nm.f + 1, ncol(d)) 305 | features <- colnames(d)[indx.f] 306 | 307 | d <- tidyr::pivot_longer(d, indx.f, 308 | names_to = 'features', values_to = valnm) 309 | d$features <- factor(d$features, levels=features) 310 | if (!plot.pie){ 311 | default_mapping <- modifyList(default_mapping, aes_string(color = valnm)) 312 | }else{ 313 | colnames(d)[colnames(d) == valnm] <- 'value' 314 | } 315 | } 316 | 317 | if (!is.null(mapping)){ 318 | mapping <- modifyList(default_mapping, mapping) 319 | }else{ 320 | mapping <- default_mapping 321 | } 322 | 323 | if (!plot.pie){ 324 | p <- ggplot(d, mapping) 325 | }else{ 326 | p <- ggplot() 327 | } 328 | 329 | if (image.plot && !is.null(img.da)){ 330 | img.annot <- .build_img_annot_layer(img.da, 331 | image.first.operation, 332 | image.rotate.degree, 333 | image.mirror.axis) 334 | p <- p + img.annot 335 | } 336 | 337 | if ((!remove.point && (!is.null(features) || (any(names(mapping) %in% c('color', 'colour')) && is.null(features))) && !plot.pie)){ 338 | params <- list(...) 339 | params$pointsize <- pointsize 340 | pointlayer <- do.call(geom, params) 341 | p <- p + pointlayer 342 | }else if (!remove.point && plot.pie){ 343 | rlang::check_installed('scatterpie', 'is required when `plot.pie=TRUE`') 344 | p <- p + scatterpie::geom_scatterpie(data=d, mapping=mapping, cols='features', long_format=TRUE, pie_scale = pie.radius.scale, ...) 345 | }else{ 346 | p <- p + geom_blank() 347 | } 348 | 349 | p <- p + 350 | .feature_setting(features, ncol, plot.pie) + 351 | ylab(NULL) + 352 | xlab(NULL) + 353 | coord_fixed() + 354 | theme_bw2() 355 | 356 | color.aes <- .check_aes_exits(p$mapping, c('color', 'colour')) 357 | if (!is.null(color.aes)) { 358 | type.color.value <- p$data |> dplyr::pull(!!color.aes) 359 | if (inherits(type.color.value, 'numeric')) { 360 | p <- p + scale_color_gradientn(colours = SpatialColors(n=100)) 361 | } 362 | } 363 | if (plot.pie){ 364 | Type.cols <- .set_default_cols(length(features)) 365 | p <- p + scale_fill_manual(values=Type.cols, name='Type') 366 | } 367 | 368 | if (!common.legend && length(features) > 1 && !plot.pie){ 369 | ncol <- min(length(features), ncol) 370 | p <- .split.by.feature(p, ncol, joint) 371 | } 372 | p <- .add_class(p, "ggsc") 373 | return(p) 374 | }) 375 | 376 | #' @importFrom SingleCellExperiment int_metadata int_colData 377 | .extract_img_data <- function(x, sample.id = NULL, image.id = NULL){ 378 | img.da <- int_metadata(x)[['imgData']] 379 | if (nrow(img.da)==0){ 380 | return(NULL) 381 | } 382 | if (is.null(sample.id)){ 383 | sample.id <- unique(img.da$sample_id)[1] 384 | } 385 | img.da <- img.da[img.da$sample_id == sample.id, ] 386 | 387 | if (is.null(image.id)){ 388 | img.da <- img.da[1,] 389 | }else{ 390 | img.da <- img.da[img.da$image_id == image.id, ] 391 | } 392 | return(img.da) 393 | } 394 | 395 | .extract_coords <- function(x, image.da){ 396 | if (is.null(image.da)){ 397 | scaleFactor <- 1.0 398 | }else{ 399 | scaleFactor <- image.da$scaleFactor 400 | } 401 | x <- int_colData(x) 402 | x <- x[['spatialCoords']] * scaleFactor 403 | return(x) 404 | } 405 | 406 | .build_img_annot_layer <- function(image.da, 407 | image.first.operation = NULL, 408 | image.rotate.degree = NULL, 409 | image.mirror.axis = NULL){ 410 | if (!is.null(image.first.operation)){ 411 | image.first.operation <- match.arg(image.first.operation, c('rotate', 'mirror')) 412 | }else{ 413 | image.first.operation <- 'rotate' 414 | } 415 | 416 | if (inherits(image.da, 'raster')){ 417 | img <- image.da 418 | }else{ 419 | img <- image.da[['data']][[1]] |> as.raster() 420 | } 421 | 422 | if (image.first.operation == 'rotate'){ 423 | if (!is.null(image.rotate.degree)){ 424 | img <- .rotate.image(img, image.rotate.degree) 425 | } 426 | if (!is.null(image.mirror.axis)){ 427 | img <- .mirror.image(img, image.mirror.axis) 428 | } 429 | }else{ 430 | if (!is.null(image.mirror.axis)){ 431 | img <- .mirror.image(img, image.mirror.axis) 432 | } 433 | if (!is.null(image.rotate.degree)){ 434 | img <- .rotate.image(img, image.rotate.degree) 435 | } 436 | } 437 | 438 | 439 | annotation_custom(grob = grid::rasterGrob(img), 440 | xmin = 1, 441 | ymin = 1, 442 | xmax = dim(img)[2], 443 | ymax = dim(img)[1] 444 | ) 445 | } 446 | 447 | # reference SpatialExperiment 448 | .rotate.image <- function(img.raster, degrees){ 449 | stopifnot(length(degrees) == 1, is.numeric(degrees), degrees%%90 == 0) 450 | s <- sign(degrees) 451 | f <- ifelse(s == 1, function(x) t(apply(x, 2, rev)), function(x) apply(x, 1, rev)) 452 | n <- abs(degrees/90) 453 | for (i in seq_len(n)) { 454 | x <- f(img.raster) 455 | } 456 | as.raster(x) 457 | } 458 | 459 | .mirror.image <- function(img.raster, mirror.axis){ 460 | mirror.axis <- match.arg(mirror.axis, c('h', 'v')) 461 | x <- switch(mirror.axis, 462 | v = apply(img.raster, 2, rev), 463 | h = t(apply(img.raster, 1, rev))) 464 | as.raster(x) 465 | } 466 | 467 | .check_aes_exits <- function(mapping, aesthetic){ 468 | x <- match(aesthetic, names(mapping)) 469 | x <- x[!is.na(x)] 470 | if (length(x)==0){ 471 | return(NULL) 472 | }else{ 473 | x <- names(mapping)[x] 474 | x <- mapping[[x]] 475 | return(x) 476 | } 477 | } 478 | 479 | ##' @importFrom yulab.utils get_fun_from_pkg 480 | SpatialColors <- yulab.utils::get_fun_from_pkg('Seurat', 'SpatialColors') 481 | -------------------------------------------------------------------------------- /R/sc-violin.R: -------------------------------------------------------------------------------- 1 | ##' @title sc_violin 2 | ##' @rdname sc-violin-methods 3 | ##' @param object Seurat object 4 | ##' @param features selected features 5 | ##' @param cells selected cells to plot (default is all cells) 6 | ##' @param slot slot to pull expression data from (e.g., 'count' or 'data') 7 | ##' @param .fun user defined function that will be applied to selected features (default is NULL and there is no data operation) 8 | ##' @param mapping aesthetic mapping 9 | ##' @param ncol number of facet columns if 'length(features) > 1' 10 | ##' @param geom the geom function, default is geom_violin, other option is geom_boxplot 11 | ##' @param ... additional parameters pass to 'ggplot2::geom_geom_violin()' 12 | ##' @return violin plot to visualize feature expression distribution 13 | ##' @seealso 14 | ##' [geom_violin][ggplot2::geom_violin]; 15 | ##' @importFrom utils modifyList 16 | ##' @importFrom ggplot2 aes_string 17 | ##' @importFrom ggplot2 ggplot 18 | ##' @importFrom ggplot2 geom_violin 19 | ##' @importFrom ggplot2 facet_wrap 20 | ##' @importFrom tidyr pivot_longer 21 | ##' @export 22 | ##' @examples 23 | ##' library(scuttle) 24 | ##' library(scater) 25 | ##' library(scran) 26 | ##' library(ggplot2) 27 | ##' sce <- mockSCE() 28 | ##' sce <- logNormCounts(sce) 29 | ##' clusters <- clusterCells(sce, assay.type = 'logcounts') 30 | ##' colLabels(sce) <- clusters 31 | ##' sce <- runUMAP(sce, assay.type = 'logcounts') 32 | ##' set.seed(123) 33 | ##' genes <- rownames(sce) |> sample(6) 34 | ##' sc_violin(sce, genes[1], slot = 'logcounts') 35 | ##' sc_violin(sce, genes[1], slot = 'logcounts', 36 | ##' .fun=function(d) dplyr::filter(d, value > 0) 37 | ##' ) + 38 | ##' ggforce::geom_sina(size=.1) 39 | ##' sc_violin(sce, genes, slot = 'logcounts') + 40 | ##' theme(axis.text.x = element_text(angle=45, hjust=1)) 41 | setGeneric('sc_violin', function(object, features, cells=NULL, 42 | slot = "data", .fun = NULL, 43 | mapping = NULL, ncol=3, 44 | geom = geom_violin, ...) 45 | standardGeneric('sc_violin') 46 | ) 47 | 48 | ##' @rdname sc-violin-methods 49 | ##' @aliases sc_violin,Seurat 50 | ##' @exportMethod sc_violin 51 | setMethod("sc_violin", 'Seurat', function(object, features, 52 | cells=NULL, slot = "data", .fun = NULL, 53 | mapping = NULL, ncol=3, geom = geom_violin, ...) { 54 | d <- get_dim_data(object, dims=NULL, features=features, slot=slot) 55 | indx.f <- seq(ncol(d) - length(features) + 1, ncol(d)) 56 | d <- tidyr::pivot_longer(d, cols=indx.f, names_to = "features") 57 | d$features <- factor(d$features, levels = features) 58 | if (!is.null(.fun)) { 59 | d <- .fun(d) 60 | } 61 | 62 | mapping <- .check_aes_mapping(object, mapping, data= d, prefix = 'ident', aes.character = 'fill') 63 | 64 | mapping <- .add_aes(mapping, object, d, prefix = c('ident', 'value'), aes.character = c('x', 'y')) 65 | 66 | p <- ggplot(d, mapping) + 67 | geom(...) #+ 68 | #ggforce::geom_sina(size=.1) 69 | 70 | if (length(features) > 1) { 71 | p <- p + facet_wrap(~features, ncol=ncol, scales='free') 72 | } 73 | return(p) 74 | }) 75 | 76 | ##' @rdname sc-violin-methods 77 | ##' @aliases sc_violin,SingleCellExperiment 78 | ##' @exportMethod sc_violin 79 | setMethod('sc_violin', 'SingleCellExperiment', 80 | function( 81 | object, features, cells = NULL, slot = 'data', 82 | .fun = NULL, mapping = NULL, ncol = 3, geom = geom_violin, ...){ 83 | 84 | d <- .extract_sce_data(object, dims = NULL, features = features, slot=slot) 85 | 86 | d <- tidyr::pivot_longer(d, seq(ncol(d) - length(features) + 1, ncol(d)), names_to = "features") 87 | 88 | if (is.numeric(features)){ 89 | features <- rownames(object)[features] 90 | } 91 | 92 | d$features <- factor(d$features, levels = features) 93 | if (!is.null(.fun)) { 94 | d <- .fun(d) 95 | } 96 | 97 | mapping <- .check_aes_mapping(object, mapping, data= d, prefix = 'label', aes.character = 'fill') 98 | 99 | mapping <- .add_aes(mapping, object, d, prefix = c('label', 'value'), aes.character = c('x', 'y')) 100 | 101 | p <- ggplot(d, mapping) + 102 | geom(...) #+ 103 | #ggforce::geom_sina(size=.1) 104 | 105 | if (length(features) > 1) { 106 | p <- p + facet_wrap(~features, ncol=ncol, scales = 'free') 107 | } 108 | return(p) 109 | 110 | }) 111 | 112 | 113 | -------------------------------------------------------------------------------- /R/scales_bg_colour.R: -------------------------------------------------------------------------------- 1 | #' Create your own discrete scale 2 | #' 3 | #' @param values a set of aesthetic values to map data values to. If this 4 | #' is a named vector, then the values will be matched based on the names. 5 | #' If unnamed, values will be matched in order (usually alphabetical) with 6 | #' the limits of the scale. Any data values that don't match will be 7 | #' given `na.value`. 8 | #' @param name The name of the scale. Used as the axis or legend title. If 9 | #' \code{waiver()}, the default, the name of the scale is taken from the first 10 | #' mapping used for that aesthetic. If \code{NULL}, the legend title will be 11 | #' omitted. 12 | #' @param guide A function used to create a guide or its name. See 13 | #' \code{\link[ggplot2:guides]{guides()}} for more information. 14 | #' @param aesthetics The names of the aesthetics that this scale works with. 15 | #' @param breaks One of: 16 | #' \itemize{ 17 | #' \item \code{NULL} for no breaks 18 | #' \item \code{waiver()} for the default breaks (the scale limits) 19 | #' \item A character vector of breaks 20 | #' \item A function that takes the limits as input and returns breaks 21 | #' as output. Also accepts rlang \link[rlang:as_function]{lambda} function 22 | #' notation. 23 | #' } 24 | #' @param na.value If \code{na.translate = TRUE}, what aesthetic value should the 25 | #' missing values be displayed as? Does not apply to position scales 26 | #' where \code{NA} is always placed at the far right. 27 | #' @inheritDotParams ggplot2::discrete_scale -expand -position -guide -aesthetics -breaks -na.value -name 28 | #' @name scale_bg_color_manual 29 | #' @return bg_colour scale constructor 30 | #' @importFrom ggplot2 discrete_scale 31 | #' @aliases NULL 32 | NULL 33 | 34 | scale_bg_colour <- function(...){ 35 | discrete_scale("bg_colour", palette = scales::hue_pal(), ...) 36 | } 37 | 38 | #' @rdname scale_bg_color_manual 39 | #' @export 40 | #' @usage NULL 41 | scale_bg_colour_discrete <- scale_bg_colour 42 | 43 | 44 | #' @importFrom ggplot2 ScaleDiscreteIdentity waiver 45 | #' @importFrom scales pal_identity 46 | #' @rdname scale_bg_color_manual 47 | scale_bg_colour_identity <- function(name = waiver(), ..., guide = "none", 48 | aesthetics = "bg_colour") { 49 | discrete_scale( 50 | aesthetics, name = name, 51 | palette = pal_identity(), ..., guide = guide, 52 | super = ScaleDiscreteIdentity 53 | ) 54 | } 55 | 56 | 57 | #' @rdname scale_bg_color_manual 58 | #' @inheritDotParams ggplot2::discrete_scale -expand -position 59 | #' @export 60 | scale_bg_colour_manual <- function(..., values, aesthetics = "bg_colour", 61 | breaks = waiver(), na.value = "grey50") { 62 | manual_scale(aesthetics, values, breaks, ..., na.value = na.value) 63 | } 64 | 65 | #' @rdname scale_bg_color_manual 66 | #' @usage NULL 67 | scale_bg_color_identity <- scale_bg_colour_identity 68 | 69 | #' @export 70 | #' @rdname scale_bg_color_manual 71 | #' @usage NULL 72 | scale_bg_color_manual <- scale_bg_colour_manual 73 | 74 | #' @importFrom utils getFromNamespace 75 | #' @keywords internal 76 | manual_scale <- getFromNamespace("manual_scale", "ggplot2") 77 | 78 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | .check_aes_mapping <- function(object, mapping = NULL, data, prefix='label', aes.character = "colour"){ 2 | if (prefix %in% colnames(data)){ 3 | default_mapping <- aes(!!rlang::sym(prefix)) 4 | }else{ 5 | if (!aes.character %in% names(mapping)){ 6 | cli::cli_warn(c("'{prefix}' is not in the column name metadata of {.cls {class(object)}}.", 7 | "You can set `mapping = aes({aes.character} = AnnotationColumnName)` manually.")) 8 | } 9 | default_mapping <- aes(NULL) 10 | } 11 | names(default_mapping) <- aes.character 12 | 13 | if (is.null(mapping)) { 14 | mapping <- default_mapping 15 | } else { 16 | mapping <- modifyList(default_mapping, mapping) 17 | } 18 | 19 | return(mapping) 20 | } 21 | 22 | 23 | .add_aes_ <- function(x, object, data, prefix = 'label', aes.character = 'x'){ 24 | if (!aes.character %in% names(x)){ 25 | if (prefix %in% colnames(data)){ 26 | new.aes <- aes(!!rlang::sym(prefix)) 27 | }else{ 28 | cli::cli_abort(c("'{prefix}' is not in the column name of metadata of {.cls {class(object)}}", 29 | "Yout can set `mapping = aes({aes.character} = XXX)` manually."), call=NULL) 30 | } 31 | names(new.aes) <- aes.character 32 | x <- modifyList(new.aes, x) 33 | } 34 | return(x) 35 | } 36 | 37 | .add_aes <- function(x, object, data, prefix = c('label', 'value'), aes.character = c('x', 'y')){ 38 | for (i in seq(length(prefix))){ 39 | x <- .add_aes_(x, object, data, prefix = prefix[i], aes.character = aes.character[i]) 40 | } 41 | return(x) 42 | } 43 | 44 | 45 | .add_class <- function(x, clsnm){ 46 | old <- class(x) 47 | if (clsnm %in% old){ 48 | return(x) 49 | } 50 | class(x) <- c(unique(clsnm), unique(old)) 51 | return(x) 52 | } 53 | 54 | .set_label_levels <- function(data, plot, lab.text){ 55 | lab.levels <- levels(plot$data[[lab.text]]) 56 | if (!is.null(lab.levels)){ 57 | data[[lab.text]] <- factor(data[[lab.text]], levels=lab.levels) 58 | } 59 | return(data) 60 | } 61 | 62 | .set_inherit.aes <- function(x){ 63 | if (!'inherit.aes' %in% names(x)){ 64 | x$inherit.aes <- FALSE 65 | } 66 | return(x) 67 | } 68 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "`r read.dcf('DESCRIPTION', fields = 'Package')[1]`" 3 | date: "

README updated: `r format( Sys.Date())`

" 4 | output: 5 | github_document 6 | html_preview: false 7 | --- 8 | 9 | 10 | 11 | 12 | 13 | [![License: Artistic-2.0](https://img.shields.io/badge/license-Artistic--2.0-blue.svg)](https://cran.r-project.org/web/licenses/Artistic-2.0) 14 | [![](https://img.shields.io/badge/devel%20version-1.1.1.002-black.svg)](https://github.com/YuLab-SMU/ggsc) 15 | [![](https://img.shields.io/github/languages/code-size/YuLab-SMU/ggsc.svg)](https://github.com/YuLab-SMU/ggsc) 16 | [![](https://img.shields.io/github/last-commit/YuLab-SMU/ggsc.svg)](https://github.com/YuLab-SMU/ggsc/commits/master) 17 |
18 | [![R build status](https://github.com/YuLab-SMU/ggsc/workflows/rworkflows/badge.svg)](https://github.com/YuLab-SMU/ggsc/actions) 19 | [![](https://codecov.io/gh/YuLab-SMU/ggsc/branch/master/graph/badge.svg)](https://app.codecov.io/gh/YuLab-SMU/ggsc) 20 |
21 | 22 | 23 | 24 | 25 | 26 | ```{r, echo=FALSE, include=FALSE} 27 | pkg <- read.dcf("DESCRIPTION", fields = "Package")[1] 28 | title <- read.dcf("DESCRIPTION", fields = "Title")[1] 29 | description <- read.dcf("DESCRIPTION", fields = "Description")[1] 30 | description <- gsub("\n", " ", description) 31 | URL <- read.dcf('DESCRIPTION', fields = 'URL')[1] 32 | owner <- tolower(strsplit(URL,"/")[[1]][4]) 33 | ``` 34 | 35 | 36 | ## ``r pkg``: `r title` 37 | 38 | `r description` 39 | 40 | 41 | ## :writing_hand: Authors 42 | 43 | Guangchuang YU 44 | 45 | School of Basic Medical Sciences, Southern Medical University 46 | 47 | 48 | 49 | 50 | 52 | 53 | 54 | 55 | 58 | 59 | 60 | ## :arrow_double_down: Installation 61 | 62 | ```R 63 | ## release version 64 | if(!require("BiocManager")) install.packages("BiocManager") 65 | BiocManager::install("ggsc") 66 | 67 | ## devel version 68 | if(!require("remotes")) install.packages("remotes") 69 | remotes::install_github("yulab-smu/ggsc") 70 | ``` 71 | 72 | ## Documentation 73 | 74 | + [Website](https://yulab-smu.top/ggsc) 75 | 76 | 77 |
78 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ggsc 2 | ================ 3 |

4 | README updated: 2023-11-29 5 |

6 | 7 | 8 | 9 | [![License: 10 | Artistic-2.0](https://img.shields.io/badge/license-Artistic--2.0-blue.svg)](https://cran.r-project.org/web/licenses/Artistic-2.0) 11 | [![](https://img.shields.io/badge/devel%20version-1.1.1.002-black.svg)](https://github.com/YuLab-SMU/ggsc) 12 | [![](https://img.shields.io/github/languages/code-size/YuLab-SMU/ggsc.svg)](https://github.com/YuLab-SMU/ggsc) 13 | [![](https://img.shields.io/github/last-commit/YuLab-SMU/ggsc.svg)](https://github.com/YuLab-SMU/ggsc/commits/master) 14 |
[![R build 15 | status](https://github.com/YuLab-SMU/ggsc/workflows/rworkflows/badge.svg)](https://github.com/YuLab-SMU/ggsc/actions) 16 | [![](https://codecov.io/gh/YuLab-SMU/ggsc/branch/master/graph/badge.svg)](https://app.codecov.io/gh/YuLab-SMU/ggsc) 17 |
18 | 19 | 20 | 21 | ## `ggsc`: Visualizing Single Cell and Spatial Transcriptomics 22 | 23 | Useful functions to visualize single cell and spatial data. It supports 24 | visualizing ‘Seurat’, ‘SingleCellExperiment’ and ‘SpatialExperiment’ 25 | objects through grammar of graphics syntax implemented in ‘ggplot2’. 26 | 27 | ## :writing_hand: Authors 28 | 29 | Guangchuang YU 30 | 31 | School of Basic Medical Sciences, Southern Medical University 32 | 33 | 34 | 35 | 37 | 38 | 41 | 42 | ## :arrow_double_down: Installation 43 | 44 | ``` r 45 | ## release version 46 | if(!require("BiocManager")) install.packages("BiocManager") 47 | BiocManager::install("ggsc") 48 | 49 | ## devel version 50 | if(!require("remotes")) install.packages("remotes") 51 | remotes::install_github("yulab-smu/ggsc") 52 | ``` 53 | 54 | ## Documentation 55 | 56 | - [Website](https://yulab-smu.top/ggsc) 57 | 58 |
59 | -------------------------------------------------------------------------------- /man/CalWkdeCpp.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/RcppExports.R 3 | \name{CalWkdeCpp} 4 | \alias{CalWkdeCpp} 5 | \title{Two-Dimensional Weighted Kernel Density Estimation And Mapping the Result To Original Dimension} 6 | \usage{ 7 | CalWkdeCpp(x, w, l, h, adjust = 1, n = 400L) 8 | } 9 | \arguments{ 10 | \item{x}{The 2-D coordinate matrix} 11 | 12 | \item{w}{The weighted sparse matrix, the number columns the same than the number rows than x.} 13 | 14 | \item{l}{The limits of the rectangle covered by the grid as c(xl, xu, yl, yu)} 15 | 16 | \item{h}{The vector of bandwidths for x and y directions, defaults to normal reference bandwidth 17 | (see bandwidth.nrd), A scalar value will be taken to apply to both directions (see ks::hpi).} 18 | 19 | \item{adjust}{numeric value to adjust to bandwidth, default is 1.} 20 | 21 | \item{n}{number of grid points in the two directions, default is 400.} 22 | } 23 | \description{ 24 | Two-Dimensional Weighted Kernel Density Estimation And Mapping the Result To Original Dimension 25 | } 26 | -------------------------------------------------------------------------------- /man/draw_key_bgpoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/draw_key.R 3 | \name{draw_key_bgpoint} 4 | \alias{draw_key_bgpoint} 5 | \title{Key drawing functions} 6 | \usage{ 7 | draw_key_bgpoint(data, params, size) 8 | } 9 | \arguments{ 10 | \item{data}{A single row data frame containing the scaled aesthetics to 11 | display in this key} 12 | 13 | \item{params}{A list of additional parameters supplied to the geom.} 14 | 15 | \item{size}{Width and height of key in mm.} 16 | } 17 | \value{ 18 | A grid grob. 19 | } 20 | \description{ 21 | Each Geom has an associated function that draws the key when the geom needs 22 | to be displayed in a legend. These are the options built into ggplot2. 23 | } 24 | -------------------------------------------------------------------------------- /man/geom_bgpoint.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-geom-point.R 3 | \name{geom_bgpoint} 4 | \alias{geom_bgpoint} 5 | \title{geom_bgpoint} 6 | \usage{ 7 | geom_bgpoint( 8 | mapping = NULL, 9 | data = NULL, 10 | stat = "identity", 11 | position = "identity", 12 | ..., 13 | na.rm = FALSE, 14 | show.legend = NA, 15 | inherit.aes = TRUE, 16 | gap_colour = "white", 17 | gap_alpha = 1, 18 | bg_line_width = 0.3, 19 | gap_line_width = 0.1, 20 | pointsize = NULL 21 | ) 22 | } 23 | \arguments{ 24 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 25 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 26 | at the top level of the plot. You must supply \code{mapping} if there is no plot 27 | mapping.} 28 | 29 | \item{data}{The data to be displayed in this layer. There are three 30 | options: 31 | 32 | If \code{NULL}, the default, the data is inherited from the plot 33 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 34 | 35 | A \code{data.frame}, or other object, will override the plot 36 | data. All objects will be fortified to produce a data frame. See 37 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 38 | 39 | A \code{function} will be called with a single argument, 40 | the plot data. The return value must be a \code{data.frame}, and 41 | will be used as the layer data. A \code{function} can be created 42 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 43 | 44 | \item{stat}{The statistical transformation to use on the data for this layer. 45 | When using a \verb{geom_*()} function to construct a layer, the \code{stat} 46 | argument can be used the override the default coupling between geoms and 47 | stats. The \code{stat} argument accepts the following: 48 | \itemize{ 49 | \item A \code{Stat} ggproto subclass, for example \code{StatCount}. 50 | \item A string naming the stat. To give the stat as a string, strip the 51 | function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, 52 | give the stat as \code{"count"}. 53 | \item For more information and other ways to specify the stat, see the 54 | \link[ggplot2:layer_stats]{layer stat} documentation. 55 | }} 56 | 57 | \item{position}{A position adjustment to use on the data for this layer. This 58 | can be used in various ways, including to prevent overplotting and 59 | improving the display. The \code{position} argument accepts the following: 60 | \itemize{ 61 | \item The result of calling a position function, such as \code{position_jitter()}. 62 | This method allows for passing extra arguments to the position. 63 | \item A string naming the position adjustment. To give the position as a 64 | string, strip the function name of the \code{position_} prefix. For example, 65 | to use \code{position_jitter()}, give the position as \code{"jitter"}. 66 | \item For more information and other ways to specify the position, see the 67 | \link[ggplot2:layer_positions]{layer position} documentation. 68 | }} 69 | 70 | \item{...}{Other arguments passed on to \code{\link[ggplot2]{layer}}.} 71 | 72 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed 73 | with a warning, if \code{TRUE}, missing values are silently removed.} 74 | 75 | \item{show.legend}{logical. Should this layer be included in the legends? 76 | \code{NA}, the default, includes if any aesthetics are mapped. 77 | \code{FALSE} never includes, and \code{TRUE} always includes. 78 | It can also be a named logical vector to finely select the aesthetics to 79 | display.} 80 | 81 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 82 | rather than combining with them. This is most useful for helper functions 83 | that define both data and aesthetics and shouldn't inherit behaviour from 84 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 85 | 86 | \item{gap_colour}{colour of gap background between the bottom background 87 | and top point point layer, default is \code{white}.} 88 | 89 | \item{gap_alpha}{numeric the transparency of gap background colour, default is 1.} 90 | 91 | \item{bg_line_width}{numeric the line width of background point layer, 92 | default is \code{0.3}.} 93 | 94 | \item{gap_line_width}{numeric the line width of gap between the background and 95 | top point point layer, default is \code{.1}.} 96 | 97 | \item{pointsize}{numeric the size of point, default is NULL, will use the 98 | internal size aesthetics of \code{geom_bgpoint}} 99 | } 100 | \description{ 101 | this add the background color for \code{\link[ggplot2]{geom_point}} 102 | } 103 | \details{ 104 | \itemize{ 105 | \item \code{colour} the colour of point, default is \code{black}. 106 | \item \code{bg_colour} the colour of background point, default is \code{NA}. 107 | \item \code{alpha} the transparency of colour, default is 1. 108 | \item \code{subset} subset the data frame which meet conditions to display. 109 | } 110 | } 111 | \section{Aesthetics}{ 112 | 113 | \code{geom_bgpoint()} understands the following aesthetics (required aesthetics are in bold): 114 | \itemize{ 115 | \item \strong{\code{\link[=aes_position]{x}}} 116 | \item \strong{\code{\link[=aes_position]{y}}} 117 | \item \code{\link[=aes_colour_fill_alpha]{alpha}} 118 | \item \code{bg_colour} 119 | \item \code{\link[=aes_colour_fill_alpha]{colour}} 120 | \item \code{\link[=aes_colour_fill_alpha]{fill}} 121 | \item \code{\link[=aes_group_order]{group}} 122 | \item \code{\link[=aes_linetype_size_shape]{shape}} 123 | \item \code{\link[=aes_linetype_size_shape]{size}} 124 | \item \code{stroke} 125 | \item \code{subset} 126 | } 127 | Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. 128 | } 129 | 130 | \examples{ 131 | library(ggplot2) 132 | ggplot(iris, 133 | aes(x= Sepal.Length, y = Petal.Width, color=Species, bg_colour=Species) 134 | ) + 135 | geom_bgpoint(pointsize=4, gap_line_width = .1, bg_line_width = .3) 136 | } 137 | \author{ 138 | Shuangbin Xu 139 | } 140 | -------------------------------------------------------------------------------- /man/geom_scattermore2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-geom-point.R 3 | \name{geom_scattermore2} 4 | \alias{geom_scattermore2} 5 | \title{geom_scattermore2} 6 | \usage{ 7 | geom_scattermore2( 8 | mapping = NULL, 9 | data = NULL, 10 | stat = "identity", 11 | position = "identity", 12 | ..., 13 | na.rm = FALSE, 14 | show.legend = NA, 15 | inherit.aes = TRUE, 16 | interpolate = FALSE, 17 | pointsize = 0, 18 | pixels = c(512, 512), 19 | gap_colour = "white", 20 | gap_alpha = 1, 21 | bg_line_width = 0.3, 22 | gap_line_width = 0.1 23 | ) 24 | } 25 | \arguments{ 26 | \item{mapping}{Set of aesthetic mappings created by \code{\link[ggplot2:aes]{aes()}}. If specified and 27 | \code{inherit.aes = TRUE} (the default), it is combined with the default mapping 28 | at the top level of the plot. You must supply \code{mapping} if there is no plot 29 | mapping.} 30 | 31 | \item{data}{The data to be displayed in this layer. There are three 32 | options: 33 | 34 | If \code{NULL}, the default, the data is inherited from the plot 35 | data as specified in the call to \code{\link[ggplot2:ggplot]{ggplot()}}. 36 | 37 | A \code{data.frame}, or other object, will override the plot 38 | data. All objects will be fortified to produce a data frame. See 39 | \code{\link[ggplot2:fortify]{fortify()}} for which variables will be created. 40 | 41 | A \code{function} will be called with a single argument, 42 | the plot data. The return value must be a \code{data.frame}, and 43 | will be used as the layer data. A \code{function} can be created 44 | from a \code{formula} (e.g. \code{~ head(.x, 10)}).} 45 | 46 | \item{stat}{The statistical transformation to use on the data for this layer. 47 | When using a \verb{geom_*()} function to construct a layer, the \code{stat} 48 | argument can be used the override the default coupling between geoms and 49 | stats. The \code{stat} argument accepts the following: 50 | \itemize{ 51 | \item A \code{Stat} ggproto subclass, for example \code{StatCount}. 52 | \item A string naming the stat. To give the stat as a string, strip the 53 | function name of the \code{stat_} prefix. For example, to use \code{stat_count()}, 54 | give the stat as \code{"count"}. 55 | \item For more information and other ways to specify the stat, see the 56 | \link[ggplot2:layer_stats]{layer stat} documentation. 57 | }} 58 | 59 | \item{position}{A position adjustment to use on the data for this layer. This 60 | can be used in various ways, including to prevent overplotting and 61 | improving the display. The \code{position} argument accepts the following: 62 | \itemize{ 63 | \item The result of calling a position function, such as \code{position_jitter()}. 64 | This method allows for passing extra arguments to the position. 65 | \item A string naming the position adjustment. To give the position as a 66 | string, strip the function name of the \code{position_} prefix. For example, 67 | to use \code{position_jitter()}, give the position as \code{"jitter"}. 68 | \item For more information and other ways to specify the position, see the 69 | \link[ggplot2:layer_positions]{layer position} documentation. 70 | }} 71 | 72 | \item{...}{Other arguments passed on to \code{\link[ggplot2]{layer}}.} 73 | 74 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 75 | a warning. If \code{TRUE}, missing values are silently removed.} 76 | 77 | \item{show.legend}{logical. Should this layer be included in the legends? 78 | \code{NA}, the default, includes if any aesthetics are mapped. 79 | \code{FALSE} never includes, and \code{TRUE} always includes. 80 | It can also be a named logical vector to finely select the aesthetics to 81 | display.} 82 | 83 | \item{inherit.aes}{If \code{FALSE}, overrides the default aesthetics, 84 | rather than combining with them. This is most useful for helper functions 85 | that define both data and aesthetics and shouldn't inherit behaviour from 86 | the default plot specification, e.g. \code{\link[ggplot2:borders]{borders()}}.} 87 | 88 | \item{interpolate}{A logical value indicating whether to linearly interpolate 89 | the image (the alternative is to use nearest-neighbour interpolation, 90 | which gives a more blocky result). Default \code{FALSE}, 91 | passed to \code{\link[grid]{rasterGrob}}.} 92 | 93 | \item{pointsize}{Radius of rasterized point. Use ‘0’ for single pixels (fastest).} 94 | 95 | \item{pixels}{Vector with X and Y resolution of the raster, default \code{c(512,512)}.} 96 | 97 | \item{gap_colour}{colour of gap background between the bottom background 98 | and top point point layer, default is \code{white}.} 99 | 100 | \item{gap_alpha}{numeric the transparency of gap background colour, default is 1.} 101 | 102 | \item{bg_line_width}{numeric the line width of background point layer, 103 | default is \code{0.3}.} 104 | 105 | \item{gap_line_width}{numeric the line width of gap between the background and 106 | top point point layer, default is \code{.1}.} 107 | } 108 | \value{ 109 | polygonal point layer 110 | } 111 | \description{ 112 | this add the background colour for the \code{\link[scattermore]{geom_scattermore}} 113 | } 114 | \details{ 115 | \itemize{ 116 | \item \code{colour} the colour of point, default is \code{black}. 117 | \item \code{bg_colour} the colour of background point, default is \code{NA}. 118 | \item \code{alpha} the transparency of colour, default is 1. 119 | \item \code{subset} subset the data frame which meet conditions to display. 120 | } 121 | } 122 | \section{Aesthetics}{ 123 | 124 | \code{geom_scattermore2()} understands the following aesthetics (required aesthetics are in bold): 125 | \itemize{ 126 | \item \strong{\code{\link[=aes_position]{x}}} 127 | \item \strong{\code{\link[=aes_position]{y}}} 128 | \item \code{\link[=aes_colour_fill_alpha]{alpha}} 129 | \item \code{bg_colour} 130 | \item \code{\link[=aes_colour_fill_alpha]{colour}} 131 | \item \code{\link[=aes_colour_fill_alpha]{fill}} 132 | \item \code{\link[=aes_group_order]{group}} 133 | \item \code{\link[=aes_linetype_size_shape]{shape}} 134 | \item \code{\link[=aes_linetype_size_shape]{size}} 135 | \item \code{stroke} 136 | \item \code{subset} 137 | } 138 | Learn more about setting these aesthetics in \code{vignette("ggplot2-specs")}. 139 | } 140 | 141 | \examples{ 142 | library(ggplot2) 143 | ggplot(iris, 144 | aes(x= Sepal.Length, y = Petal.Width, color=Species, bg_colour=Species) 145 | ) + 146 | geom_scattermore2(pointsize=4, gap_line_width = .1, bg_line_width = .3) 147 | } 148 | \author{ 149 | Shuangbin Xu 150 | } 151 | -------------------------------------------------------------------------------- /man/ggsc-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/ggsc-package.R 3 | \docType{package} 4 | \name{ggsc-package} 5 | \alias{ggsc} 6 | \alias{ggsc-package} 7 | \title{ggsc: Visualizing Single Cell and Spatial Transcriptomics} 8 | \description{ 9 | Useful functions to visualize single cell and spatial data. It supports visualizing 'Seurat', 'SingleCellExperiment' and 'SpatialExperiment' objects through grammar of graphics syntax implemented in 'ggplot2'. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://github.com/YuLab-SMU/ggsc (devel)} 15 | \item \url{https://yulab-smu.top/ggsc/ (docs)} 16 | \item Report bugs at \url{https://github.com/YuLab-SMU/ggsc/issues} 17 | } 18 | 19 | } 20 | \author{ 21 | \strong{Maintainer}: Guangchuang Yu \email{guangchuangyu@gmail.com} (\href{https://orcid.org/0000-0002-6485-8781}{ORCID}) [copyright holder] 22 | 23 | Authors: 24 | \itemize{ 25 | \item Shuangbin Xu \email{xshuangbin@163.com} (\href{https://orcid.org/0000-0003-3513-5362}{ORCID}) 26 | } 27 | 28 | Other contributors: 29 | \itemize{ 30 | \item Noriaki Sato \email{nori@hgc.jp} [contributor] 31 | } 32 | 33 | } 34 | \keyword{internal} 35 | -------------------------------------------------------------------------------- /man/plot-lisa-feature.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/plot-methods.R 3 | \name{plot_lisa_feature} 4 | \alias{plot_lisa_feature} 5 | \title{plot_lisa_feature} 6 | \usage{ 7 | plot_lisa_feature( 8 | spe, 9 | lisa.res, 10 | features = NULL, 11 | assay.type = "logcounts", 12 | geom = geom_bgpoint, 13 | pointsize = 2, 14 | hlpointsize = 1.8, 15 | clustertype = "High", 16 | hlcolor = c("black"), 17 | gap_line_width = 0.1, 18 | bg_line_width = 0.3, 19 | facet_name = NULL, 20 | reduction = NULL, 21 | image.plot = FALSE, 22 | label_wrap_width = 30, 23 | ... 24 | ) 25 | } 26 | \arguments{ 27 | \item{spe}{SpatialExperiment or SingleCellExperiment object.} 28 | 29 | \item{lisa.res}{the result returned by \code{SVP::runLISA()}.} 30 | 31 | \item{features}{selected features to be visualized, default is NULL.} 32 | 33 | \item{assay.type}{the assay name where data will be used from 34 | (e.g., 'data', 'counts'), default is \code{'logcounts'}.} 35 | 36 | \item{geom}{the function of geometric layer, default is \code{geom_bgpoint}, 37 | other option is \code{sc_geom_point}.} 38 | 39 | \item{pointsize}{numeric the size of point, default is \code{2}.} 40 | 41 | \item{hlpointsize}{numeric the size of point which contains corresbonding 42 | spatially variable gene(i.e., SVG), default is \code{1.8}.} 43 | 44 | \item{clustertype}{cell type which is from the result of \code{lisa.res}, 45 | default is \code{'High'}.} 46 | 47 | \item{hlcolor}{the color of circular line which enfolds the point 48 | that contains SVG, default is \code{'black'}.} 49 | 50 | \item{gap_line_width}{numeric the line width of gap between the background and 51 | top point point layer, default is \code{.1}.} 52 | 53 | \item{bg_line_width}{numeric the line width of background point layer, 54 | default is \code{0.3}.} 55 | 56 | \item{facet_name}{the name of facet used in \code{facet_wrap()}, 57 | default is \code{NULL}.} 58 | 59 | \item{reduction}{reduction method, default is \code{NULL} and will 60 | use the default setting store in the object} 61 | 62 | \item{image.plot}{logical whether display the image of spatial experiment, default 63 | is FALSE.} 64 | 65 | \item{label_wrap_width}{numeric maximum number of characters before wrapping the strip. 66 | default is \code{30}.} 67 | 68 | \item{...}{additional parameters pass to \code{scattermore::geom_scattermore()} 69 | \itemize{ 70 | \item \code{bg_colour} the colour of background point, default is \code{NA}. 71 | this character also can be set in \code{mappint}. 72 | \item \code{alpha} the transparency of colour, default is 1. 73 | }} 74 | } 75 | \value{ 76 | ggplot object 77 | } 78 | \description{ 79 | plot_lisa_feature 80 | } 81 | \examples{ 82 | \dontrun{ 83 | library(ggplot2) 84 | library(SingleCellExperiment) |> suppressPackageStartupMessages() 85 | library(SpatialExperiment) |> suppressPackageStartupMessages() 86 | library(STexampleData) 87 | # create ExperimentHub instance 88 | eh <- ExperimentHub() 89 | # query STexampleData datasets 90 | myfiles <- query(eh, "STexampleData") 91 | ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC'] 92 | spe <- myfiles[[ah_id]] 93 | spe <- spe[, colData(spe)$in_tissue == 1] 94 | spe <-scater::logNormCounts(spe) 95 | genes <- c('MOBP', 'PCP4', 'SNAP25', 'HBB', 'IGKC', 'NPY') 96 | target.features <- rownames(spe)[match(genes, rowData(spe)$gene_name)] 97 | library(SVP) 98 | lisa.res1 <- runLISA(spe, 99 | assay.type='logcounts', 100 | features=target.features[seq(2)], 101 | weight.method='knn', 102 | k=50) 103 | plot_lisa_feature(spe, lisa.res=lisa.res1, features=target.features[seq(2)], 104 | pointsize=2, hlpointsize=2, gap_line_width=.1) 105 | } 106 | } 107 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/re-export.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{aes} 7 | \alias{theme} 8 | \alias{\%<+\%} 9 | \title{Objects exported from other packages} 10 | \value{ 11 | Depending on the re-exported function 12 | } 13 | \keyword{internal} 14 | \description{ 15 | These objects are imported from other packages. Follow the links 16 | below to see their documentation. 17 | 18 | \describe{ 19 | \item{ggfun}{\code{\link[ggfun:attacher]{\%<+\%}}} 20 | 21 | \item{ggplot2}{\code{\link[ggplot2]{aes}}, \code{\link[ggplot2]{theme}}} 22 | }} 23 | 24 | -------------------------------------------------------------------------------- /man/sc-dim-count.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim-utilities.R 3 | \name{sc_dim_count} 4 | \alias{sc_dim_count} 5 | \title{sc_dim_count} 6 | \usage{ 7 | sc_dim_count(sc_dim_plot) 8 | } 9 | \arguments{ 10 | \item{sc_dim_plot}{dimension reduction plot of single cell data} 11 | } 12 | \value{ 13 | a bar plot to present the cell numbers of different clusters 14 | } 15 | \description{ 16 | sc_dim_count 17 | } 18 | \examples{ 19 | library(scuttle) 20 | library(scater) 21 | library(scran) 22 | library(ggplot2) 23 | sce <- mockSCE() 24 | sce <- logNormCounts(sce) 25 | clusters <- clusterCells(sce, assay.type = 'logcounts') 26 | colLabels(sce) <- clusters 27 | sce <- runUMAP(sce, assay.type = 'logcounts') 28 | p <- sc_dim(sce, reduction = 'UMAP') 29 | p1 <- sc_dim_count(p) 30 | } 31 | \seealso{ 32 | \code{\link[=sc_dim]{sc_dim()}} 33 | } 34 | -------------------------------------------------------------------------------- /man/sc-dim-geom-ellipse.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim-utilities.R 3 | \name{sc_dim_geom_ellipse} 4 | \alias{sc_dim_geom_ellipse} 5 | \title{sc_dim_geom_ellipse} 6 | \usage{ 7 | sc_dim_geom_ellipse(geom = stat_ellipse, mapping = NULL, level = 0.95, ...) 8 | } 9 | \arguments{ 10 | \item{geom}{the layer function, default is \code{stat_ellipse}, 11 | other option is \code{geom_mark_hull} of \code{ggforce}.} 12 | 13 | \item{mapping}{aesthetic mapping} 14 | 15 | \item{level}{the level at which to draw an ellipse} 16 | 17 | \item{...}{additional parameters pass to the stat_ellipse} 18 | } 19 | \value{ 20 | layer of ellipse 21 | } 22 | \description{ 23 | sc_dim_geom_ellipse 24 | } 25 | \examples{ 26 | library(scuttle) 27 | library(scater) 28 | library(scran) 29 | library(ggplot2) 30 | sce <- mockSCE() 31 | sce <- logNormCounts(sce) 32 | clusters <- clusterCells(sce, assay.type = 'logcounts') 33 | colLabels(sce) <- clusters 34 | sce <- runUMAP(sce, assay.type = 'logcounts') 35 | p1 <- sc_dim(sce, reduction = 'UMAP', mapping = aes(colour = Cell_Cycle)) 36 | p2 <- sc_dim(sce, reduction = 'UMAP') 37 | f1 <- p1 + sc_dim_geom_ellipse() 38 | } 39 | \seealso{ 40 | \link[ggplot2:stat_ellipse]{stat_ellipse}; 41 | } 42 | -------------------------------------------------------------------------------- /man/sc-dim-geom-feature.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim-utilities.R 3 | \name{sc_dim_geom_feature} 4 | \alias{sc_dim_geom_feature} 5 | \title{sc_dim_geom_feature} 6 | \usage{ 7 | sc_dim_geom_feature( 8 | object, 9 | features, 10 | dims = c(1, 2), 11 | ncol = 3, 12 | ..., 13 | .fun = function(.data) dplyr::filter(.data, .data$value > 0) 14 | ) 15 | } 16 | \arguments{ 17 | \item{object}{Seurat or SingleCellExperiment object} 18 | 19 | \item{features}{selected features (i.e., genes)} 20 | 21 | \item{dims}{selected dimensions (must be a two-length vector) that are used 22 | in visualization} 23 | 24 | \item{ncol}{number of facet columns if 'length(features) > 1'} 25 | 26 | \item{...}{additional parameters pass to 'scattermore::geom_scattermore()'} 27 | 28 | \item{.fun}{user defined function that will be applied to selected features 29 | (default is to filter out genes with no expression values)} 30 | } 31 | \value{ 32 | layer of points for selected features 33 | } 34 | \description{ 35 | sc_dim_geom_feature 36 | } 37 | \examples{ 38 | library(scuttle) 39 | library(scater) 40 | library(scran) 41 | library(ggplot2) 42 | sce <- mockSCE() 43 | sce <- logNormCounts(sce) 44 | clusters <- clusterCells(sce, assay.type = 'logcounts') 45 | colLabels(sce) <- clusters 46 | sce <- runUMAP(sce, assay.type = 'logcounts') 47 | p1 <- sc_dim(sce, reduction = 'UMAP') 48 | set.seed(123) 49 | genes <- rownames(sce) |> sample(6) 50 | f1 <- p1 + 51 | sc_dim_geom_feature( 52 | object = sce, 53 | features = genes 54 | ) 55 | } 56 | \seealso{ 57 | \code{\link[=sc_feature]{sc_feature()}} 58 | } 59 | -------------------------------------------------------------------------------- /man/sc-dim-geom-label.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim-utilities.R 3 | \name{sc_dim_geom_label} 4 | \alias{sc_dim_geom_label} 5 | \title{sc_dim_geom_label} 6 | \usage{ 7 | sc_dim_geom_label(geom = ggplot2::geom_text, mapping = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{geom}{geometric layer (default: geom_text) to display the lables} 11 | 12 | \item{mapping}{aesthetic mapping} 13 | 14 | \item{...}{additional parameters pass to the geom} 15 | } 16 | \value{ 17 | layer of labels 18 | } 19 | \description{ 20 | sc_dim_geom_label 21 | } 22 | \examples{ 23 | library(scuttle) 24 | library(scater) 25 | library(scran) 26 | library(ggplot2) 27 | sce <- mockSCE() 28 | sce <- logNormCounts(sce) 29 | clusters <- clusterCells(sce, assay.type = 'logcounts') 30 | colLabels(sce) <- clusters 31 | sce <- runUMAP(sce, assay.type = 'logcounts') 32 | p1 <- sc_dim(sce, reduction = 'UMAP', mapping = aes(colour = Cell_Cycle)) 33 | p2 <- sc_dim(sce, reduction = 'UMAP') 34 | f1 <- p1 + sc_dim_geom_label() 35 | } 36 | \seealso{ 37 | \code{\link[=sc_dim_geom_label]{sc_dim_geom_label()}} 38 | } 39 | -------------------------------------------------------------------------------- /man/sc-dim-geom-subset.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim-utilities.R 3 | \name{sc_dim_geom_sub} 4 | \alias{sc_dim_geom_sub} 5 | \title{sc_dim_geom_subset} 6 | \usage{ 7 | sc_dim_geom_sub(mapping = NULL, subset, .column = "ident", ...) 8 | } 9 | \arguments{ 10 | \item{mapping}{aesthetic mapping} 11 | 12 | \item{subset}{subset of clusters to be displayed} 13 | 14 | \item{.column}{which column represents cluster (e.g., 'ident')} 15 | 16 | \item{...}{additional parameters pass to sc_geom_point} 17 | } 18 | \value{ 19 | plot with a layer of specified clusters 20 | } 21 | \description{ 22 | sc_dim_geom_subset 23 | } 24 | \examples{ 25 | library(scuttle) 26 | library(scater) 27 | library(scran) 28 | library(ggplot2) 29 | sce <- mockSCE() 30 | sce <- logNormCounts(sce) 31 | clusters <- clusterCells(sce, assay.type = 'logcounts') 32 | colLabels(sce) <- clusters 33 | sce <- runUMAP(sce, assay.type = 'logcounts') 34 | p1 <- sc_dim(sce, reduction = 'UMAP') 35 | f1 <- p1 + sc_dim_geom_sub(subset = c(1, 2), .column = 'label', bg_colour='black') 36 | } 37 | \seealso{ 38 | \link{sc_dim_geom_sub} 39 | } 40 | -------------------------------------------------------------------------------- /man/sc-dim-methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim.R 3 | \name{sc_dim} 4 | \alias{sc_dim} 5 | \alias{sc_dim,Seurat-method} 6 | \alias{sc_dim,Seurat} 7 | \alias{sc_dim,SingleCellExperiment-method} 8 | \alias{sc_dim,SingleCellExperiment} 9 | \title{sc_dim} 10 | \usage{ 11 | sc_dim( 12 | object, 13 | dims = c(1, 2), 14 | reduction = NULL, 15 | cells = NULL, 16 | slot = "data", 17 | mapping = NULL, 18 | geom = sc_geom_point, 19 | ... 20 | ) 21 | 22 | \S4method{sc_dim}{Seurat}( 23 | object, 24 | dims = c(1, 2), 25 | reduction = NULL, 26 | cells = NULL, 27 | slot = "data", 28 | mapping = NULL, 29 | geom = sc_geom_point, 30 | ... 31 | ) 32 | 33 | \S4method{sc_dim}{SingleCellExperiment}( 34 | object, 35 | dims = c(1, 2), 36 | reduction = NULL, 37 | cells = NULL, 38 | slot = "data", 39 | mapping = NULL, 40 | geom = sc_geom_point, 41 | ... 42 | ) 43 | } 44 | \arguments{ 45 | \item{object}{Seurat object or SingleCellExperiment object} 46 | 47 | \item{dims}{selected dimensions (must be a two-length vector) that 48 | are used in visualization} 49 | 50 | \item{reduction}{reduction method, default is NULL and will use the 51 | default setting store in the object} 52 | 53 | \item{cells}{selected cells to plot (default is all cells)} 54 | 55 | \item{slot}{slot to pull expression data from (e.g., 'count' or 'data')} 56 | 57 | \item{mapping}{aesthetic mapping, the \code{x} and \code{y} is set internally, 58 | other character of geometric layer, such as \code{color}, \code{size}, 59 | \code{alpha} or (\code{shape} when geom = geom_point) can be set manually.} 60 | 61 | \item{geom}{the function of geometric layer, default is sc_geom_point, 62 | other geometric layer, such as \code{geom_bgpoint} or \code{geom_point} also works.} 63 | 64 | \item{...}{additional parameters pass to \code{geom_scattermore2()}. 65 | \itemize{ 66 | \item \code{bg_colour} the colour of background point, default is \code{NA}. 67 | this character also can be set in \code{mappint}. 68 | \item \code{gap_colour} the colour of gap background, default is \code{'white'}. 69 | \item \code{bg_line_width} the line width of background point, 70 | default is \code{.3}. 71 | \item \code{gap_line_width} the gap line width of background point, 72 | default is \code{.1}. 73 | \item \code{alpha} the transparency of colour, default is 1. 74 | \item \code{subset} subset the data frame which meet conditions to display. 75 | this should be set in \code{mapping}. 76 | }} 77 | } 78 | \value{ 79 | dimension reduction plot 80 | } 81 | \description{ 82 | sc_dim 83 | } 84 | \examples{ 85 | library(scuttle) 86 | library(scater) 87 | library(scran) 88 | library(ggplot2) 89 | sce <- mockSCE() 90 | sce <- logNormCounts(sce) 91 | clusters <- clusterCells(sce, assay.type = 'logcounts') 92 | colLabels(sce) <- clusters 93 | sce <- runUMAP(sce, assay.type = 'logcounts') 94 | p1 <- sc_dim(sce, reduction = 'UMAP', mapping = aes(colour = Cell_Cycle)) 95 | p2 <- sc_dim(sce, reduction = 'UMAP') 96 | f1 <- p1 + sc_dim_geom_label() 97 | f2 <- p2 + 98 | sc_dim_geom_label( 99 | geom = shadowtext::geom_shadowtext, 100 | color='black', 101 | bg.color='white' 102 | ) 103 | } 104 | \seealso{ 105 | \link[scattermore:geom_scattermore]{geom_scattermore}; 106 | } 107 | -------------------------------------------------------------------------------- /man/sc-dim-sub.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dim-utilities.R 3 | \name{sc_dim_sub} 4 | \alias{sc_dim_sub} 5 | \title{sc_dim_sub} 6 | \usage{ 7 | sc_dim_sub(subset, .column = "ident") 8 | } 9 | \arguments{ 10 | \item{subset}{subset of clusters to be displayed} 11 | 12 | \item{.column}{which column represents cluster (e.g., 'ident')} 13 | } 14 | \value{ 15 | update plot with only subset displayed 16 | } 17 | \description{ 18 | sc_dim_sub 19 | } 20 | \examples{ 21 | library(scuttle) 22 | library(scater) 23 | library(scran) 24 | library(ggplot2) 25 | sce <- mockSCE() 26 | sce <- logNormCounts(sce) 27 | clusters <- clusterCells(sce, assay.type = 'logcounts') 28 | colLabels(sce) <- clusters 29 | sce <- runUMAP(sce, assay.type = 'logcounts') 30 | p1 <- sc_dim(sce, reduction = 'UMAP') 31 | f1 <- p1 + sc_dim_sub(subset = c(1, 2), .column = 'label') 32 | } 33 | \seealso{ 34 | \link{sc_dim} 35 | } 36 | -------------------------------------------------------------------------------- /man/sc-dot-methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-dot.R 3 | \name{sc_dot} 4 | \alias{sc_dot} 5 | \alias{sc_dot,Seurat-method} 6 | \alias{sc_dot,Seurat} 7 | \alias{sc_dot,SingleCellExperiment-method} 8 | \alias{sc_dot,SingleCellExperiment} 9 | \title{sc_dot} 10 | \usage{ 11 | sc_dot( 12 | object, 13 | features, 14 | group.by = NULL, 15 | split.by = NULL, 16 | cols = c("lightgrey", "blue"), 17 | col.min = -2.5, 18 | col.max = 2.5, 19 | dot.min = 0, 20 | dot.scale = 6, 21 | slot = "data", 22 | .fun = NULL, 23 | mapping = NULL, 24 | scale = TRUE, 25 | scale.by = "radius", 26 | scale.min = NA, 27 | scale.max = NA, 28 | cluster.idents = FALSE, 29 | ... 30 | ) 31 | 32 | \S4method{sc_dot}{Seurat}( 33 | object, 34 | features, 35 | group.by = NULL, 36 | split.by = NULL, 37 | cols = c("lightgrey", "blue"), 38 | col.min = -2.5, 39 | col.max = 2.5, 40 | dot.min = 0, 41 | dot.scale = 6, 42 | slot = "data", 43 | .fun = NULL, 44 | mapping = NULL, 45 | scale = TRUE, 46 | scale.by = "radius", 47 | scale.min = NA, 48 | scale.max = NA, 49 | cluster.idents = FALSE, 50 | ... 51 | ) 52 | 53 | \S4method{sc_dot}{SingleCellExperiment}( 54 | object, 55 | features, 56 | group.by = NULL, 57 | split.by = NULL, 58 | cols = c("lightgrey", "blue"), 59 | col.min = -2.5, 60 | col.max = 2.5, 61 | dot.min = 0, 62 | dot.scale = 6, 63 | slot = "data", 64 | .fun = NULL, 65 | mapping = NULL, 66 | scale = TRUE, 67 | scale.by = "radius", 68 | scale.min = NA, 69 | scale.max = NA, 70 | cluster.idents = FALSE, 71 | ... 72 | ) 73 | } 74 | \arguments{ 75 | \item{object}{Seurat or SingleCellExperiment object} 76 | 77 | \item{features}{selected features} 78 | 79 | \item{group.by}{grouping factor} 80 | 81 | \item{split.by}{additional split factor} 82 | 83 | \item{cols}{colors of the points} 84 | 85 | \item{col.min}{minimum scaled averaged expression threshold} 86 | 87 | \item{col.max}{maximum scaled averaged expression threshold} 88 | 89 | \item{dot.min}{the threshold of percentage of cells for the the smallest dot} 90 | 91 | \item{dot.scale}{Scaling factor for size of points} 92 | 93 | \item{slot}{slot to pull expression data from (e.g., 'count' or 'data')} 94 | 95 | \item{.fun}{user defined function that will be applied to selected features (default is NULL and there is no data operation)} 96 | 97 | \item{mapping}{aesthetic mapping} 98 | 99 | \item{scale}{whether to scale the expression value (default to TRUE)} 100 | 101 | \item{scale.by}{scale the size of the points by \code{size} or \code{radius}} 102 | 103 | \item{scale.min}{lower limit of scaling} 104 | 105 | \item{scale.max}{upper limit of scaling} 106 | 107 | \item{cluster.idents}{Order identities by hierarchical clusters based on average expression and perventage of expression (default is FALSE)} 108 | 109 | \item{...}{additional parameters pass to 'ggplot2::geom_point()'} 110 | } 111 | \value{ 112 | dot plot to visualize feature expression distribution 113 | } 114 | \description{ 115 | sc_dot 116 | } 117 | \examples{ 118 | library(scuttle) 119 | library(scater) 120 | library(scran) 121 | library(ggplot2) 122 | sce <- mockSCE() 123 | sce <- logNormCounts(sce) 124 | set.seed(123) 125 | genes <- rownames(sce) |> sample(6) 126 | sc_dot(sce, genes[1:5], 'Treatment', slot = 'logcounts') 127 | 128 | } 129 | \seealso{ 130 | \link[Seurat:DotPlot]{DotPlot}; 131 | } 132 | -------------------------------------------------------------------------------- /man/sc-feature-methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-feature.R 3 | \name{sc_feature} 4 | \alias{sc_feature} 5 | \alias{sc_feature,Seurat-method} 6 | \alias{sc_feature,Seurat} 7 | \alias{sc_feature,SingleCellExperiment-method} 8 | \alias{sc_feature,SingleCellExperiment} 9 | \title{sc_feature} 10 | \usage{ 11 | sc_feature( 12 | object, 13 | features, 14 | dims = c(1, 2), 15 | reduction = NULL, 16 | cells = NULL, 17 | slot = "data", 18 | mapping = NULL, 19 | ncol = 3, 20 | density = FALSE, 21 | grid.n = 100, 22 | joint = FALSE, 23 | joint.fun = prod, 24 | common.legend = TRUE, 25 | geom = sc_geom_point, 26 | ... 27 | ) 28 | 29 | \S4method{sc_feature}{Seurat}( 30 | object, 31 | features, 32 | dims = c(1, 2), 33 | reduction = NULL, 34 | cells = NULL, 35 | slot = "data", 36 | mapping = NULL, 37 | ncol = 3, 38 | density = FALSE, 39 | grid.n = 100, 40 | joint = FALSE, 41 | joint.fun = prod, 42 | common.legend = TRUE, 43 | geom = sc_geom_point, 44 | ... 45 | ) 46 | 47 | \S4method{sc_feature}{SingleCellExperiment}( 48 | object, 49 | features, 50 | dims = c(1, 2), 51 | reduction = NULL, 52 | cells = NULL, 53 | slot = "data", 54 | mapping = NULL, 55 | ncol = 3, 56 | density = FALSE, 57 | grid.n = 100, 58 | joint = FALSE, 59 | joint.fun = prod, 60 | common.legend = TRUE, 61 | geom = sc_geom_point, 62 | ... 63 | ) 64 | } 65 | \arguments{ 66 | \item{object}{Seurat object} 67 | 68 | \item{features}{selected features (i.e., genes)} 69 | 70 | \item{dims}{selected dimensions (must be a two-length vector) 71 | that are used in visualization} 72 | 73 | \item{reduction}{reduction method, default is NULL and will 74 | use the default setting store in the object} 75 | 76 | \item{cells}{selected cells to plot (default is all cells)} 77 | 78 | \item{slot}{slot to pull expression data from (e.g., 'count' or 'data')} 79 | 80 | \item{mapping}{aesthetic mapping} 81 | 82 | \item{ncol}{number of facet columns if 'length(features) > 1'} 83 | 84 | \item{density}{whether plot the 2D weighted kernel density, default is FALSE.} 85 | 86 | \item{grid.n}{number of grid points in the two directions to estimate 2D 87 | weighted kernel density, default is 100.} 88 | 89 | \item{joint}{whether joint the multiple features with \code{joint.fun}, 90 | default is FALSE.} 91 | 92 | \item{joint.fun}{how to joint the multiple features if \code{joint=TRUE}, 93 | default is prod.} 94 | 95 | \item{common.legend}{whether to use \code{facet_wrap} to display the multiple 96 | \code{features}, default is TRUE.} 97 | 98 | \item{geom}{the function of geometric layer, default is sc_geom_point, 99 | other geometric layer, such as \code{geom_bgpoint} or \code{geom_point} also works.} 100 | 101 | \item{...}{additional parameters pass to 'scattermore::geom_scattermore()' 102 | \itemize{ 103 | \item \code{bg_colour} the colour of background point, default is \code{NA}. 104 | this character also can be set in \code{mappint}. 105 | \item \code{gap_colour} the colour of gap background, default is \code{'white'}. 106 | \item \code{bg_line_width} the line width of background point, 107 | default is \code{.3}. 108 | \item \code{gap_line_width} the gap line width of background point, 109 | default is \code{.1}. 110 | \item \code{alpha} the transparency of colour, default is 1. 111 | \item \code{subset} subset the data frame which meet conditions to display. 112 | this should be set in \code{mapping}. 113 | }} 114 | } 115 | \value{ 116 | dimension reduction plot colored by selected features 117 | } 118 | \description{ 119 | sc_feature 120 | } 121 | \examples{ 122 | library(scuttle) 123 | library(scater) 124 | library(scran) 125 | library(ggplot2) 126 | sce <- mockSCE() 127 | sce <- logNormCounts(sce) 128 | clusters <- clusterCells(sce, assay.type = 'logcounts') 129 | colLabels(sce) <- clusters 130 | sce <- runTSNE(sce, assay.type = 'logcounts') 131 | set.seed(123) 132 | genes <- rownames(sce) |> sample(6) 133 | p1 <- sc_feature(sce, genes[1], slot='logcounts', reduction = 'TSNE') 134 | p2 <- sc_feature(sce, genes, slot='logcounts', reduction = 'TSNE') 135 | f1 <- sc_dim(sce, slot='logcounts', reduction = 'TSNE') + 136 | sc_dim_geom_feature(sce, genes[1], color='black') 137 | f2 <- sc_dim(sce, alpha=.3, slot='logcounts', reduction = 'TSNE') + 138 | ggnewscale::new_scale_color() + 139 | sc_dim_geom_feature(sce, genes, mapping=aes(color=features)) + 140 | scale_color_viridis_d() 141 | p1 + p2 + f1 + f2 142 | # The features can also be specified the variables from 143 | # colData or reducedDims 144 | pp <- sc_feature(sce, features = 'sizeFactor', reduction='TSNE', geom=geom_bgpoint) 145 | pp 146 | } 147 | -------------------------------------------------------------------------------- /man/sc-geom-point.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-geom-point.R 3 | \name{sc_geom_point} 4 | \alias{sc_geom_point} 5 | \title{sc_geom_point} 6 | \usage{ 7 | sc_geom_point(mapping = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{mapping}{aesthetic mapping} 11 | 12 | \item{...}{additional parameters pass to 'scattermore::geom_scattermore()'} 13 | } 14 | \value{ 15 | layer of points 16 | } 17 | \description{ 18 | sc_geom_point 19 | } 20 | \examples{ 21 | library(ggplot2) 22 | ggplot(iris, 23 | aes(x= Sepal.Length, y = Petal.Width, color=Species) 24 | ) + 25 | sc_geom_point() 26 | } 27 | \seealso{ 28 | \code{\link[=sc_dim]{sc_dim()}} and \code{\link[=sc_feature]{sc_feature()}} 29 | } 30 | -------------------------------------------------------------------------------- /man/sc-spatial-methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-spatial.R 3 | \name{sc_spatial} 4 | \alias{sc_spatial} 5 | \alias{sc_spatial,Seurat-method} 6 | \alias{sc_spatial,Seurat} 7 | \alias{sc_spatial,SingleCellExperiment-method} 8 | \alias{sc_spatial,SingleCellExperiment} 9 | \title{sc_spatial} 10 | \usage{ 11 | sc_spatial( 12 | object, 13 | features = NULL, 14 | sample.id = NULL, 15 | image.id = NULL, 16 | slot = "data", 17 | plot.pie = FALSE, 18 | pie.radius.scale = 0.3, 19 | image.plot = TRUE, 20 | image.first.operation = "rotate", 21 | image.rotate.degree = NULL, 22 | image.mirror.axis = NULL, 23 | remove.point = FALSE, 24 | mapping = NULL, 25 | ncol = 6, 26 | density = FALSE, 27 | grid.n = 100, 28 | joint = FALSE, 29 | joint.fun = prod, 30 | common.legend = TRUE, 31 | pointsize = 5, 32 | geom = sc_geom_point, 33 | ... 34 | ) 35 | 36 | \S4method{sc_spatial}{Seurat}( 37 | object, 38 | features = NULL, 39 | sample.id = NULL, 40 | image.id = NULL, 41 | slot = "data", 42 | plot.pie = FALSE, 43 | pie.radius.scale = 0.3, 44 | image.plot = TRUE, 45 | image.first.operation = "rotate", 46 | image.rotate.degree = NULL, 47 | image.mirror.axis = NULL, 48 | remove.point = FALSE, 49 | mapping = NULL, 50 | ncol = 6, 51 | density = FALSE, 52 | grid.n = 100, 53 | joint = FALSE, 54 | joint.fun = prod, 55 | common.legend = TRUE, 56 | pointsize = 5, 57 | geom = sc_geom_point, 58 | ... 59 | ) 60 | 61 | \S4method{sc_spatial}{SingleCellExperiment}( 62 | object, 63 | features = NULL, 64 | sample.id = NULL, 65 | image.id = NULL, 66 | slot = 1, 67 | plot.pie = FALSE, 68 | pie.radius.scale = 0.3, 69 | image.plot = TRUE, 70 | image.first.operation = "rotate", 71 | image.rotate.degree = NULL, 72 | image.mirror.axis = "v", 73 | remove.point = FALSE, 74 | mapping = NULL, 75 | ncol = 6, 76 | density = FALSE, 77 | grid.n = 100, 78 | joint = FALSE, 79 | joint.fun = prod, 80 | common.legend = TRUE, 81 | pointsize = 5, 82 | geom = sc_geom_point, 83 | ... 84 | ) 85 | } 86 | \arguments{ 87 | \item{object}{Seurat object} 88 | 89 | \item{features}{selected features to be visualized} 90 | 91 | \item{sample.id}{the index name of sample id, which only 92 | work with SingleCellExperiment or SpatialExperiment.} 93 | 94 | \item{image.id}{the index name of image id, which only work 95 | with SingleCellExperiment or SpatialExperiment.} 96 | 97 | \item{slot}{if plotting a feature, which data will be used 98 | (e.g., 'data', 'counts'), the assay name if object 99 | is SingleCellExperiment or SpatialExperiment.} 100 | 101 | \item{plot.pie}{logical whether plot the features with pie, default is \code{FALSE}.} 102 | 103 | \item{pie.radius.scale}{numeric scale to the radius of pie only work with \code{plot.pie=TRUE}, 104 | default is 0.3.} 105 | 106 | \item{image.plot}{whether to display the issue image as background.} 107 | 108 | \item{image.first.operation}{character which the first operation to 109 | image, 'rotate' or 'mirror', default is 'rotate'.} 110 | 111 | \item{image.rotate.degree}{integer the degree to ratate image, default is NULL.} 112 | 113 | \item{image.mirror.axis}{character the direction to mirror the image, default is 'h'.} 114 | 115 | \item{remove.point}{whether to remove the spot points, it is nice 116 | if your just view the issue image, default is FALSE.} 117 | 118 | \item{mapping}{aesthetic mapping, default is NULL.} 119 | 120 | \item{ncol}{integer number of facet columns if 'length(features) > 1', default is 6.} 121 | 122 | \item{density}{whether plot the 2D weighted kernel density, default is FALSE.} 123 | 124 | \item{grid.n}{number of grid points in the two directions to estimate 2D 125 | weighted kernel density, default is 100.} 126 | 127 | \item{joint}{whether joint the multiple features with \code{joint.fun}, 128 | default is FALSE.} 129 | 130 | \item{joint.fun}{how to joint the multiple features if \code{joint = TRUE}, 131 | default is prod.} 132 | 133 | \item{common.legend}{whether to use \code{facet_wrap} to display the multiple 134 | \code{features}, default is TRUE.} 135 | 136 | \item{pointsize}{the size of point, default is 5.} 137 | 138 | \item{geom}{the layer of point, default is \code{sc_geom_point}, other option is 139 | \code{geom_bgpoint}.} 140 | 141 | \item{...}{additional parameters, see also \code{geom_scattermore2()}. 142 | \itemize{ 143 | \item \code{bg_colour} the colour of background point, default is \code{NA}. 144 | this character also can be set in \code{mappint}. 145 | \item \code{gap_colour} the colour of gap background, default is \code{'white'}. 146 | \item \code{bg_line_width} the line width of background point, 147 | default is \code{.3}. 148 | \item \code{gap_line_width} the gap line width of background point, 149 | default is \code{.1}. 150 | \item \code{alpha} the transparency of colour, default is 1. 151 | \item \code{subset} subset the data frame which meet conditions to display. 152 | this should be set in \code{mapping}. 153 | }} 154 | } 155 | \value{ 156 | ggplot object 157 | } 158 | \description{ 159 | sc_spatial 160 | } 161 | \examples{ 162 | \dontrun{ 163 | library(STexampleData) 164 | # create ExperimentHub instance 165 | eh <- ExperimentHub() 166 | # query STexampleData datasets 167 | myfiles <- query(eh, "STexampleData") 168 | ah_id <- myfiles$ah_id[myfiles$title == 'Visium_humanDLPFC'] 169 | spe <- myfiles[[ah_id]] 170 | spe <- spe[, colData(spe)$in_tissue == 1] 171 | set.seed(123) 172 | genes <- rownames(spe) |> sample(6) 173 | p <- sc_spatial(spe, features = genes, 174 | image.rotate.degree = -90, 175 | image.mirror.axis = NULL, 176 | ncol = 3) 177 | # The features also can be specified 178 | # the variables from colData or reducedDims. 179 | p1 <- sc_spatial(spe, features = 'cell_count', 180 | image.rotate.degree = -90, image.mirror.axis = NULL) 181 | } 182 | } 183 | -------------------------------------------------------------------------------- /man/sc-violin-methods.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-violin.R 3 | \name{sc_violin} 4 | \alias{sc_violin} 5 | \alias{sc_violin,Seurat-method} 6 | \alias{sc_violin,Seurat} 7 | \alias{sc_violin,SingleCellExperiment-method} 8 | \alias{sc_violin,SingleCellExperiment} 9 | \title{sc_violin} 10 | \usage{ 11 | sc_violin( 12 | object, 13 | features, 14 | cells = NULL, 15 | slot = "data", 16 | .fun = NULL, 17 | mapping = NULL, 18 | ncol = 3, 19 | geom = geom_violin, 20 | ... 21 | ) 22 | 23 | \S4method{sc_violin}{Seurat}( 24 | object, 25 | features, 26 | cells = NULL, 27 | slot = "data", 28 | .fun = NULL, 29 | mapping = NULL, 30 | ncol = 3, 31 | geom = geom_violin, 32 | ... 33 | ) 34 | 35 | \S4method{sc_violin}{SingleCellExperiment}( 36 | object, 37 | features, 38 | cells = NULL, 39 | slot = "data", 40 | .fun = NULL, 41 | mapping = NULL, 42 | ncol = 3, 43 | geom = geom_violin, 44 | ... 45 | ) 46 | } 47 | \arguments{ 48 | \item{object}{Seurat object} 49 | 50 | \item{features}{selected features} 51 | 52 | \item{cells}{selected cells to plot (default is all cells)} 53 | 54 | \item{slot}{slot to pull expression data from (e.g., 'count' or 'data')} 55 | 56 | \item{.fun}{user defined function that will be applied to selected features (default is NULL and there is no data operation)} 57 | 58 | \item{mapping}{aesthetic mapping} 59 | 60 | \item{ncol}{number of facet columns if 'length(features) > 1'} 61 | 62 | \item{geom}{the geom function, default is geom_violin, other option is geom_boxplot} 63 | 64 | \item{...}{additional parameters pass to 'ggplot2::geom_geom_violin()'} 65 | } 66 | \value{ 67 | violin plot to visualize feature expression distribution 68 | } 69 | \description{ 70 | sc_violin 71 | } 72 | \examples{ 73 | library(scuttle) 74 | library(scater) 75 | library(scran) 76 | library(ggplot2) 77 | sce <- mockSCE() 78 | sce <- logNormCounts(sce) 79 | clusters <- clusterCells(sce, assay.type = 'logcounts') 80 | colLabels(sce) <- clusters 81 | sce <- runUMAP(sce, assay.type = 'logcounts') 82 | set.seed(123) 83 | genes <- rownames(sce) |> sample(6) 84 | sc_violin(sce, genes[1], slot = 'logcounts') 85 | sc_violin(sce, genes[1], slot = 'logcounts', 86 | .fun=function(d) dplyr::filter(d, value > 0) 87 | ) + 88 | ggforce::geom_sina(size=.1) 89 | sc_violin(sce, genes, slot = 'logcounts') + 90 | theme(axis.text.x = element_text(angle=45, hjust=1)) 91 | } 92 | \seealso{ 93 | \link[ggplot2:geom_violin]{geom_violin}; 94 | } 95 | -------------------------------------------------------------------------------- /man/sc_geom_annot.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/sc-geom-annot.R 3 | \name{sc_geom_annot} 4 | \alias{sc_geom_annot} 5 | \title{add the annotation layer for ggsc object} 6 | \usage{ 7 | sc_geom_annot( 8 | data = NULL, 9 | mapping = NULL, 10 | pointsize = 2, 11 | pixels = c(512, 512), 12 | gap_colour = "white", 13 | gap_alpha = 1, 14 | bg_line_width = 0.3, 15 | gap_line_width = 0.1, 16 | show.legend = NA, 17 | na.rm = FALSE, 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{data}{The data to be displayed in this layer. There are three 23 | options: 24 | If \code{NULL}, the default, the data is inherited from the plot 25 | data as specified in the call to \code{ggplot()}. 26 | A \code{data.frame}, will override the plot data. the \code{data.frame} 27 | should have a barcode id or features column. 28 | A \code{function} will be called with a single argument, the plot 29 | data. The return value must be a ‘data.frame’, and will be 30 | used as the layer data. A \code{function} can be created from a 31 | ‘formula’ (e.g. ‘~ head(.x, 10)’).} 32 | 33 | \item{mapping}{Set of aesthetic mappings created by \code{aes()}. If specified 34 | and \code{inherit.aes = TRUE} (the default), it is combined with the default 35 | mapping at the top level of the plot. You must supply \code{mapping} if there is no plot mapping.} 36 | 37 | \item{pointsize}{Radius of rasterized point. Use ‘0’ for single pixels (fastest).} 38 | 39 | \item{pixels}{Vector with X and Y resolution of the raster, default \code{c(512,512)}.} 40 | 41 | \item{gap_colour}{colour of gap background between the bottom background 42 | and top point point layer, default is \code{white}.} 43 | 44 | \item{gap_alpha}{numeric the transparency of gap background colour, default is 1.} 45 | 46 | \item{bg_line_width}{numeric the line width of background point layer, 47 | default is \code{0.3}.} 48 | 49 | \item{gap_line_width}{numeric the line width of gap between the background and 50 | top point point layer, default is \code{.1}.} 51 | 52 | \item{show.legend}{logical. Should this layer be included in the legends? 53 | \code{NA}, the default, includes if any aesthetics are mapped. 54 | \code{FALSE} never includes, and \code{TRUE} always includes. 55 | It can also be a named logical vector to finely select the aesthetics to 56 | display.} 57 | 58 | \item{na.rm}{If \code{FALSE}, the default, missing values are removed with 59 | a warning. If \code{TRUE}, missing values are silently removed.} 60 | 61 | \item{...}{Other arguments passed on to \code{\link[ggplot2]{layer}}.} 62 | } 63 | \value{ 64 | layer object 65 | } 66 | \description{ 67 | add the annotation layer for ggsc object 68 | } 69 | -------------------------------------------------------------------------------- /man/scale_bg_color_manual.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/scales_bg_colour.R 3 | \name{scale_bg_color_manual} 4 | \alias{scale_bg_colour_discrete} 5 | \alias{scale_bg_colour_identity} 6 | \alias{scale_bg_colour_manual} 7 | \alias{scale_bg_color_identity} 8 | \alias{scale_bg_color_manual} 9 | \title{Create your own discrete scale} 10 | \usage{ 11 | scale_bg_colour_identity( 12 | name = waiver(), 13 | ..., 14 | guide = "none", 15 | aesthetics = "bg_colour" 16 | ) 17 | 18 | scale_bg_colour_manual( 19 | ..., 20 | values, 21 | aesthetics = "bg_colour", 22 | breaks = waiver(), 23 | na.value = "grey50" 24 | ) 25 | } 26 | \arguments{ 27 | \item{...}{ 28 | Arguments passed on to \code{\link[ggplot2:discrete_scale]{ggplot2::discrete_scale}}, \code{\link[ggplot2:discrete_scale]{ggplot2::discrete_scale}} 29 | \describe{ 30 | \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale 31 | that should be used for error messages associated with this scale.} 32 | \item{\code{palette}}{A palette function that when called with a single integer 33 | argument (the number of levels in the scale) returns the values that 34 | they should take (e.g., \code{\link[scales:pal_hue]{scales::pal_hue()}}).} 35 | \item{\code{labels}}{One of: 36 | \itemize{ 37 | \item \code{NULL} for no labels 38 | \item \code{waiver()} for the default labels computed by the 39 | transformation object 40 | \item A character vector giving labels (must be same length as \code{breaks}) 41 | \item An expression vector (must be the same length as breaks). See ?plotmath for details. 42 | \item A function that takes the breaks as input and returns labels 43 | as output. Also accepts rlang \link[rlang:as_function]{lambda} function 44 | notation. 45 | }} 46 | \item{\code{limits}}{One of: 47 | \itemize{ 48 | \item \code{NULL} to use the default scale values 49 | \item A character vector that defines possible values of the scale and their 50 | order 51 | \item A function that accepts the existing (automatic) values and returns 52 | new ones. Also accepts rlang \link[rlang:as_function]{lambda} function 53 | notation. 54 | }} 55 | \item{\code{na.translate}}{Unlike continuous scales, discrete scales can easily show 56 | missing values, and do so by default. If you want to remove missing values 57 | from a discrete scale, specify \code{na.translate = FALSE}.} 58 | \item{\code{drop}}{Should unused factor levels be omitted from the scale? 59 | The default, \code{TRUE}, uses the levels that appear in the data; 60 | \code{FALSE} includes the levels in the factor. Please note that to display 61 | every level in a legend, the layer should use \code{show.legend = TRUE}.} 62 | \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} 63 | \item{\code{super}}{The super class to use for the constructed scale} 64 | }} 65 | 66 | \item{name}{The name of the scale. Used as the axis or legend title. If 67 | \code{waiver()}, the default, the name of the scale is taken from the first 68 | mapping used for that aesthetic. If \code{NULL}, the legend title will be 69 | omitted.} 70 | 71 | \item{guide}{A function used to create a guide or its name. See 72 | \code{\link[ggplot2:guides]{guides()}} for more information.} 73 | 74 | \item{aesthetics}{The names of the aesthetics that this scale works with.} 75 | 76 | \item{values}{a set of aesthetic values to map data values to. If this 77 | is a named vector, then the values will be matched based on the names. 78 | If unnamed, values will be matched in order (usually alphabetical) with 79 | the limits of the scale. Any data values that don't match will be 80 | given \code{na.value}.} 81 | 82 | \item{breaks}{One of: 83 | \itemize{ 84 | \item \code{NULL} for no breaks 85 | \item \code{waiver()} for the default breaks (the scale limits) 86 | \item A character vector of breaks 87 | \item A function that takes the limits as input and returns breaks 88 | as output. Also accepts rlang \link[rlang:as_function]{lambda} function 89 | notation. 90 | }} 91 | 92 | \item{na.value}{If \code{na.translate = TRUE}, what aesthetic value should the 93 | missing values be displayed as? Does not apply to position scales 94 | where \code{NA} is always placed at the far right.} 95 | } 96 | \value{ 97 | bg_colour scale constructor 98 | } 99 | \description{ 100 | Create your own discrete scale 101 | } 102 | -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | *.dll 4 | -------------------------------------------------------------------------------- /src/Makevars: -------------------------------------------------------------------------------- 1 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 2 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) $(shell ${R_HOME}/bin/Rscript -e "RcppParallel::RcppParallelLibs()") 3 | PKG_CXXFLAGS += -DARMA_64BIT_WORD 4 | -------------------------------------------------------------------------------- /src/Makevars.win: -------------------------------------------------------------------------------- 1 | PKG_CXXFLAGS = $(SHLIB_OPENMP_CXXFLAGS) 2 | PKG_LIBS = $(SHLIB_OPENMP_CXXFLAGS) $(LAPACK_LIBS) $(BLAS_LIBS) $(FLIBS) 3 | PKG_CXXFLAGS += -DARMA_64BIT_WORD 4 | PKG_LIBS += $(shell "${R_HOME}/bin${R_ARCH_BIN}/Rscript.exe" -e "RcppParallel::RcppParallelLibs()") 5 | -------------------------------------------------------------------------------- /src/RcppExports.cpp: -------------------------------------------------------------------------------- 1 | // Generated by using Rcpp::compileAttributes() -> do not edit by hand 2 | // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 3 | 4 | #include 5 | #include 6 | 7 | using namespace Rcpp; 8 | 9 | #ifdef RCPP_USE_GLOBAL_ROSTREAM 10 | Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); 11 | Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); 12 | #endif 13 | 14 | // CalWkdeCpp 15 | arma::mat CalWkdeCpp(arma::mat& x, arma::sp_mat& w, arma::vec& l, Nullable h, double adjust, int n); 16 | RcppExport SEXP _ggsc_CalWkdeCpp(SEXP xSEXP, SEXP wSEXP, SEXP lSEXP, SEXP hSEXP, SEXP adjustSEXP, SEXP nSEXP) { 17 | BEGIN_RCPP 18 | Rcpp::RObject rcpp_result_gen; 19 | Rcpp::RNGScope rcpp_rngScope_gen; 20 | Rcpp::traits::input_parameter< arma::mat& >::type x(xSEXP); 21 | Rcpp::traits::input_parameter< arma::sp_mat& >::type w(wSEXP); 22 | Rcpp::traits::input_parameter< arma::vec& >::type l(lSEXP); 23 | Rcpp::traits::input_parameter< Nullable >::type h(hSEXP); 24 | Rcpp::traits::input_parameter< double >::type adjust(adjustSEXP); 25 | Rcpp::traits::input_parameter< int >::type n(nSEXP); 26 | rcpp_result_gen = Rcpp::wrap(CalWkdeCpp(x, w, l, h, adjust, n)); 27 | return rcpp_result_gen; 28 | END_RCPP 29 | } 30 | 31 | static const R_CallMethodDef CallEntries[] = { 32 | {"_ggsc_CalWkdeCpp", (DL_FUNC) &_ggsc_CalWkdeCpp, 6}, 33 | {NULL, NULL, 0} 34 | }; 35 | 36 | RcppExport void R_init_ggsc(DllInfo *dll) { 37 | R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); 38 | R_useDynamicSymbols(dll, FALSE); 39 | } 40 | -------------------------------------------------------------------------------- /src/kde.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | using namespace RcppParallel; 4 | using namespace Rcpp; 5 | using namespace arma; 6 | using namespace std; 7 | 8 | arma::vec Quantile(arma::vec x, arma::vec probs) { 9 | const size_t n=x.n_elem, np=probs.n_elem; 10 | if (n==0) return x; 11 | if (np==0) return probs; 12 | arma::vec index = (n-1.0)*probs, y=sort(x), x_hi(np), qs(np); 13 | arma::vec lo = arma::floor(index), hi = arma::ceil(index); 14 | 15 | for (size_t i=0; ilo[i]) && (x_hi[i] != qs[i])) { 19 | double h; 20 | h = index[i]-lo[i]; 21 | qs[i] = (1.-h)*qs[i] + h*x_hi[i]; 22 | } 23 | } 24 | return qs; 25 | } 26 | 27 | uvec findIntervalCpp(arma::vec x, arma::vec breaks) { 28 | uvec out(x.size()); 29 | 30 | vec::iterator it, pos; 31 | uvec::iterator out_it; 32 | 33 | for(it = x.begin(), out_it = out.begin(); it != x.end(); 34 | ++it, ++out_it) { 35 | pos = std::upper_bound(breaks.begin(), breaks.end(), *it); 36 | *out_it = std::distance(breaks.begin(), pos); 37 | } 38 | return (out - 1); 39 | } 40 | 41 | double BandwidthNrdCpp(arma::vec x){ 42 | arma::vec p = {0.25, 0.75}; 43 | arma::vec r = Quantile(x, p); 44 | double h = (r[1] - r[0])/1.349; 45 | double w = pow(x.n_elem, -0.2); 46 | double s = sqrt(var(x)); 47 | double v = 4 * 1.06 * std::min(s, h) * w; 48 | return (v); 49 | } 50 | 51 | arma::vec Kde2dWeightedCpp(arma::mat x, 52 | arma::rowvec w, 53 | arma::mat ax, 54 | arma::mat ay, 55 | arma::vec h, 56 | arma::uvec indx, 57 | arma::uvec indy 58 | ){ 59 | int n = ax.n_rows; 60 | 61 | w = w/sum(w) * w.n_elem; 62 | 63 | ax = ax / h[0]; 64 | ay = ay / h[1]; 65 | 66 | arma::mat v = repelem(w, n, 1); 67 | arma::mat u = arma::normpdf(ax) % v; 68 | arma::mat day = arma::normpdf(ay) % v; 69 | arma::mat daym = day.t(); 70 | 71 | arma::mat z = (u * daym)/(accu(v) * h[0] * h[1]); 72 | 73 | arma::mat sz = z.submat(indx, indy); 74 | arma::vec res = sz.diag(); 75 | return (res); 76 | } 77 | 78 | arma::mat outergrid(arma::vec grid, arma::vec x){ 79 | arma::mat gxm = repelem(grid, 1, x.n_elem); 80 | arma::mat xm = repelem(x, 1, grid.n_elem); 81 | 82 | arma::mat ax = gxm - xm.t(); 83 | 84 | return(ax); 85 | } 86 | 87 | 88 | struct CalWkde : public Worker{ 89 | const arma::mat& x; 90 | const arma::sp_mat& w; 91 | const arma::mat& ax; 92 | const arma::mat& ay; 93 | const arma::vec& H; 94 | const arma::uvec& indx; 95 | const arma::uvec& indy; 96 | 97 | arma::mat& result; 98 | 99 | CalWkde(const arma::mat& x, const arma::sp_mat& w, const arma::mat& ax, 100 | const arma::mat& ay, const arma::vec& H, const arma::uvec& indx, 101 | const arma::uvec& indy, mat& result) 102 | : x(x), w(w), ax(ax), ay(ay), H(H), indx(indx), indy(indy), result(result) { } 103 | 104 | void operator()(std::size_t begin, std::size_t end){ 105 | for (uword i = begin; i < end; i++){ 106 | result.col(i) = Kde2dWeightedCpp(x, w.row(i).as_dense(), ax, ay, H, indx, indy); 107 | } 108 | } 109 | }; 110 | 111 | 112 | //' Two-Dimensional Weighted Kernel Density Estimation And Mapping the Result To Original Dimension 113 | //' @param x The 2-D coordinate matrix 114 | //' @param w The weighted sparse matrix, the number columns the same than the number rows than x. 115 | //' @param l The limits of the rectangle covered by the grid as c(xl, xu, yl, yu) 116 | //' @param h The vector of bandwidths for x and y directions, defaults to normal reference bandwidth 117 | //' (see bandwidth.nrd), A scalar value will be taken to apply to both directions (see ks::hpi). 118 | //' @param adjust numeric value to adjust to bandwidth, default is 1. 119 | //' @param n number of grid points in the two directions, default is 400. 120 | // [[Rcpp::export]] 121 | arma::mat CalWkdeCpp(arma::mat& x, arma::sp_mat& w, arma::vec& l, Nullable h, 122 | double adjust = 1.0, int n = 400) { 123 | 124 | //arma::mat wv = conv_to::from(w); 125 | 126 | arma::mat result(x.n_rows, w.n_rows); 127 | 128 | arma::vec gx = arma::linspace(l[0], l[1], n); 129 | arma::vec gy = arma::linspace(l[2], l[3], n); 130 | 131 | arma::vec H(x.n_cols); 132 | if (h.isNull()){ 133 | for (uword j=0; j < x.n_cols;j ++){ 134 | H[j] = BandwidthNrdCpp(x.col(j)) / 4 * adjust; 135 | } 136 | }else{ 137 | H = as(h); 138 | } 139 | 140 | //mapping to original coords 141 | arma::uvec indx = findIntervalCpp(x.col(0), gx); 142 | arma::uvec indy = findIntervalCpp(x.col(1), gy); 143 | 144 | arma::mat ax = outergrid(gx, x.col(0)); 145 | arma::mat ay = outergrid(gy, x.col(1)); 146 | 147 | uword num = w.n_rows; 148 | CalWkde calWkde(x, w, ax, ay, H, indx, indy, result); 149 | parallelFor(0, num, calWkde); 150 | 151 | return (result); 152 | } 153 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | # This file is part of the standard setup for testthat. 2 | # It is recommended that you do not modify it. 3 | # 4 | # Where should you do additional test configuration? 5 | # Learn more about the roles of various files in: 6 | # * https://r-pkgs.org/tests.html 7 | # * https://testthat.r-lib.org/reference/test_package.html#special-files 8 | 9 | library(testthat) 10 | library(ggsc) 11 | 12 | test_check("ggsc") 13 | -------------------------------------------------------------------------------- /tests/testthat/test_extract_sce_data.R: -------------------------------------------------------------------------------- 1 | context('.extract_sce_data') 2 | 3 | library(ggsc) 4 | sce <- scuttle::mockSCE() 5 | genes <- rownames(sce) |> sample(6) 6 | samples <- colnames(sce) |> sample(6) 7 | 8 | da <- ggsc:::.extract_sce_data(sce, features=genes, dims=NULL) 9 | 10 | test_that("the specified features will be extract",{ 11 | flag <- genes %in% colnames(da) 12 | testthat::expect_true(all(flag)) 13 | }) 14 | 15 | 16 | da2 <- ggsc:::.extract_sce_data(sce, features = genes, 17 | dims = NULL, cells = samples) 18 | 19 | test_that('The specified cells will be extract',{ 20 | flag1 <- length(samples) == nrow(da2) 21 | flag2 <- samples %in% rownames(da2) 22 | testthat::expect_true(all(flag1, flag2)) 23 | }) 24 | -------------------------------------------------------------------------------- /vignettes/ggsc.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "Visualizing single cell data" 3 | author: 4 | - name: Guangchuang Yu and Shuangbin Xu 5 | email: guangchuangyu@gmail.com 6 | affiliation: Department of Bioinformatics, School of Basic Medical Sciences, Southern Medical University 7 | date: "`r Sys.Date()`" 8 | output: 9 | prettydoc::html_pretty: 10 | theme: cayman 11 | highlight: github 12 | pdf_document: 13 | toc: true 14 | vignette: > 15 | %\VignetteIndexEntry{Visualizing single cell data} 16 | %\VignetteEngine{knitr::rmarkdown} 17 | %\usepackage[utf8]{inputenc} 18 | %\VignetteEncoding{UTF-8} 19 | --- 20 | 21 | ```{r style, echo=FALSE, results="asis", message=FALSE} 22 | knitr::opts_chunk$set(tidy = FALSE, 23 | warning = FALSE, 24 | message = FALSE, 25 | fig.width = 9, 26 | fig.height = 6) 27 | ``` 28 | 29 | 30 | Please go to for the full vignette. 31 | 32 | --------------------------------------------------------------------------------