diff --git a/.Rbuildignore b/.Rbuildignore index 845e27b..181d138 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -8,3 +8,4 @@ ^docs$ ^pkgdown$ ^\.github$ +testout diff --git a/.github/workflows/check-bioc.yml b/.github/workflows/check-bioc.yml index 348cb7a..c2c251a 100644 --- a/.github/workflows/check-bioc.yml +++ b/.github/workflows/check-bioc.yml @@ -52,9 +52,9 @@ jobs: fail-fast: false matrix: config: - - { os: ubuntu-latest, r: '4.3', bioc: '3.18', cont: "bioconductor/bioconductor_docker:RELEASE_3_18", rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest" } - - { os: macOS-latest, r: '4.3', bioc: '3.18'} - - { os: windows-latest, r: '4.3', bioc: '3.18'} + - { os: ubuntu-latest, r: '4.4', bioc: '3.19', cont: "bioconductor/bioconductor_docker:RELEASE_3_19", rspm: "https://packagemanager.rstudio.com/cran/__linux__/jammy/latest" } + - { os: macOS-latest, r: '4.4', bioc: '3.19'} + - { os: windows-latest, r: '4.4', bioc: '3.19'} ## Check https://github.com/r-lib/actions/tree/master/examples ## for examples using the http-user-agent env: @@ -105,16 +105,16 @@ jobs: uses: actions/cache@v4 with: path: ${{ env.R_LIBS_USER }} - key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3- + key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4- - name: Cache R packages on Linux if: "!contains(github.event.head_commit.message, '/nocache') && runner.os == 'Linux' " uses: actions/cache@v4 with: path: /home/runner/work/_temp/Library - key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-${{ hashFiles('.github/depends.Rds') }} - restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3- + key: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-${{ hashFiles('.github/depends.Rds') }} + restore-keys: ${{ env.cache-version }}-${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4- # - name: Install Linux system dependencies # if: runner.os == 'Linux' @@ -303,7 +303,7 @@ jobs: if: failure() uses: actions/upload-artifact@master with: - name: ${{ runner.os }}-biocversion-RELEASE_3_18-r-4.3-results + name: ${{ runner.os }}-biocversion-RELEASE_3_19-r-4.4-results path: check diff --git a/.github/workflows/covr.yml b/.github/workflows/covr.yml index d2727af..fad6253 100644 --- a/.github/workflows/covr.yml +++ b/.github/workflows/covr.yml @@ -4,7 +4,7 @@ name: code coverage on: push: - branches: [ "dev2" ] + branches: [ "dev" ] pull_request: types: closed branches: [ "main" ] diff --git a/.github/workflows/dev_check.yml b/.github/workflows/dev_check.yml index 6fa6420..8e55a35 100644 --- a/.github/workflows/dev_check.yml +++ b/.github/workflows/dev_check.yml @@ -10,7 +10,7 @@ name: Dev Workflow - Test and check on: push: - branches: [ "dev2" ] + branches: [ "dev" ] permissions: contents: read diff --git a/.github/workflows/lintr.yml b/.github/workflows/lintr.yml index 4bd99a8..0bc4074 100644 --- a/.github/workflows/lintr.yml +++ b/.github/workflows/lintr.yml @@ -12,10 +12,10 @@ name: lintr on: push: - branches: [ "dev2" ] + branches: [ "dev" ] pull_request: # The branches below must be a subset of the branches above - branches: [ "dev2" ] + branches: [ "dev" ] schedule: - cron: '16 20 * * 2' diff --git a/.gitignore b/.gitignore index a30ff52..64a71db 100644 --- a/.gitignore +++ b/.gitignore @@ -7,3 +7,4 @@ inst/doc .vscode/* .Rprofile docs +testout diff --git a/DESCRIPTION b/DESCRIPTION index 5cb5e18..e976de9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: GiottoVisuals Title: Visuals for the Giotto spatial biology analysis ecosystem -Version: 0.2.4 +Version: 0.2.6 Authors@R: c( person("Ruben", "Dries", email = "rubendries@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7650-7754")), @@ -23,23 +23,19 @@ BugReports: https://github.com/drieslab/Giotto/issues Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 Depends: - base (>= 4.1.0), - utils (>= 4.1.0), - R (>= 4.1.0), + R (>= 4.4.1) Imports: checkmate, colorRamp2, cowplot (>= 0.9.4), data.table, ggplot2 (>= 3.1.1), - GiottoUtils (>= 0.1.8), - GiottoClass (>= 0.3.1), + GiottoUtils (>= 0.1.12), + GiottoClass (>= 0.3.6), ggrepel, igraph (>= 1.2.4.1), methods, plotly, - RColorBrewer (>= 1.1-2), - reshape2, scales (>= 1.0.0), scattermore, stats, @@ -53,7 +49,6 @@ Suggests: ggsci, GiottoData, htmlwidgets, - Matrix, networkD3, NineteenEightyR, nord, @@ -61,6 +56,7 @@ Suggests: palettetown, png, rcartocolor, + RColorBrewer (>= 1.1-2), remotes, scatterpie, tiff, @@ -86,19 +82,22 @@ Collate: 'generics.R' 'gg_annotation_raster.R' 'gg_info_layers.R' + 'gg_param.R' 'gg_settings.R' 'globals.R' 'gstop.R' 'mixcolor.R' 'plot_dendrogram.R' + 'plot_dotplot.R' 'plot_heatmap.R' 'plot_sankey.R' 'plot_scatter.R' 'plot_violin.R' 'spatialDE_visuals.R' 'suite_reexports.R' - 'vis_spatial.R' + 'vis_spatial_gg.R' 'vis_spatial_in_situ.R' + 'vis_spatial_plotly.R' 'viz_spatial_network.R' 'zzz.R' biocViews: Software, Technology, Spatial diff --git a/NAMESPACE b/NAMESPACE index e881cae..e5b1581 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,10 +1,12 @@ # Generated by roxygen2: do not edit by hand +S3method(print,giotto_plot_save_param) export("sankeyLabel<-") export(FSV_show) export(addGiottoImageToSpatPlot) export(all_plots_save_function) export(colorRamp2) +export(combine_aes) export(create_cluster_dendrogram) export(dimCellPlot) export(dimCellPlot2D) @@ -14,6 +16,7 @@ export(dimGenePlot3D) export(dimPlot) export(dimPlot2D) export(dimPlot3D) +export(dotPlot) export(expand_feature_info) export(geom_label_repel) export(geom_text_repel) @@ -21,8 +24,10 @@ export(getColors) export(getDistinctColors) export(getRainbowColors) export(get_continuous_colors) +export(gg_param) export(gg_simple_scatter) export(giottoSankeyPlan) +export(gpsparam) export(mixHSV) export(mixRGB) export(pal_names) @@ -39,6 +44,7 @@ export(plotTSNE_3D) export(plotUMAP) export(plotUMAP_2D) export(plotUMAP_3D) +export(plot_grid) export(plot_output_handler) export(plotly_axis_scale_2D) export(plotly_axis_scale_3D) @@ -89,6 +95,7 @@ export(spatPlot) export(spatPlot2D) export(spatPlot3D) export(subsetSankeySet) +export(theme_dark2) export(violinPlot) exportClasses(giottoSankeyPlan) exportMethods("+") @@ -98,7 +105,6 @@ exportMethods(sankeyPlot) exportMethods(sankeyRelate) import(GiottoClass) import(GiottoUtils) -import(RColorBrewer) import(cowplot) import(ggplot2) import(ggrepel) @@ -108,6 +114,7 @@ importClassesFrom(data.table,data.table) importFrom(GiottoUtils,getDistinctColors) importFrom(GiottoUtils,getRainbowColors) importFrom(colorRamp2,colorRamp2) +importFrom(cowplot,plot_grid) importFrom(data.table,dcast) importFrom(data.table,dcast.data.table) importFrom(ggrepel,geom_label_repel) @@ -118,7 +125,6 @@ importFrom(methods,setGeneric) importFrom(methods,setMethod) importFrom(methods,slot) importFrom(plotly,add_segments) -importFrom(reshape2,melt) importFrom(scales,rescale_mid) importFrom(stats,cov) importFrom(stats,var) diff --git a/NEWS.md b/NEWS.md index 36bb46b..6b9ed12 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,19 @@ +# GiottoVisuals 0.2.6 (2024/10/27) + +## new +- `combine_aes()` for combining ggplot2 mappings in a last item wins manner. Allows more than 2 aes to be combined at the same time and provides an optional informative warning +- `gg_params()` for combining and sorting ggplot2 mappings, toplevel params, and data into an arg list for plotting. + + +# GiottoVisuals 0.2.5 (2024/09/27) + +## new +- `gpsparam()` for generating an object containing plot saving parameters +- `cowplot::plot_grid()` re-exported +- `dotPlot()` visualization + +## bug fixes +- fix `coord_fix_ratio` passing in `spatFeatPlot2D()` [#972](https://github.com/drieslab/Giotto/issues/972) by kaizen89 # GiottoVisuals 0.2.4 (2024/07/26) diff --git a/R/aux_output.R b/R/aux_output.R index 24a3031..b87a36e 100644 --- a/R/aux_output.R +++ b/R/aux_output.R @@ -25,9 +25,9 @@ #' @examples #' g <- GiottoData::loadGiottoMini("vizgen") #' g_spatplot <- spatPlot2D(g, return_plot = TRUE) -#' +#' #' plot_output_handler(g, plot_object = g_spatplot, save_plot = FALSE) -#' +#' #' @export plot_output_handler <- function( gobject, @@ -41,22 +41,12 @@ plot_output_handler <- function( checkmate::assert_class(gobject, "giotto") ## output settings detection ## - # IF setting is NULL then the appropriate setting from gobject instructions - # will be checked and used. - # IF setting is NOT NULL then the provided value will be used directly. - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot - ) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot - ) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot - ) + show_plot <- show_plot %null% instructions(gobject, param = "show_plot") + save_plot <- save_plot %null% instructions(gobject, param = "save_plot") + return_plot <- return_plot %null% + instructions(gobject, param = "return_plot") + ## handle outputs --------------------------------------------------- ## ## print plot ## if (show_plot) { @@ -67,18 +57,14 @@ plot_output_handler <- function( if (save_plot) { checkmate::assert_character(default_save_name) checkmate::assert_list(save_param) - - do.call( - "all_plots_save_function", - c( - list( - gobject = gobject, - plot_object = plot_object, - default_save_name = default_save_name - ), - save_param - ) + + data_param <- list( + gobject = gobject, + plot_object = plot_object, + default_save_name = default_save_name ) + + do.call("all_plots_save_function", args = c(data_param, save_param)) } ## return plot ## @@ -103,9 +89,9 @@ plot_output_handler <- function( # checkmate::assert_class(gobject, 'giotto') # checkmate::assert_character(default_save_name) # checkmate::assert_list(save_param) -# +# # instr = instructions(gobject) -# +# # ## output settings detection ## # # IF setting is NA then the appropriate setting from gobject instructions # # will be checked and used. @@ -121,12 +107,12 @@ plot_output_handler <- function( # plot_output_handler_do = function(gplot_out) { # checkmate::assert_class(gplot_out, 'giottoPlotOutput') -# +# # ## print plot ## # if(gplot_out$show_plot) { # print(gplot_out$plot_object) # } -# +# # ## save plot ## # if(gplot_out$save_plot) { # do.call('all_plots_save_function', @@ -136,7 +122,7 @@ plot_output_handler <- function( # save_param) # ) # } -# +# # ## return plot ## # if(return_plot) { # invisible(return(plot_object)) diff --git a/R/aux_save.R b/R/aux_save.R index 75d8644..4017ef9 100644 --- a/R/aux_save.R +++ b/R/aux_save.R @@ -1,7 +1,10 @@ #' @title Plot saving #' @name plot_save #' @description -#' Functions to automatically save plots to directory of interest +#' Functions to save plots to directory of interest. +#' `all_plots_save_function()` is used for plot saving operations. `gpsparam()` +#' is used to generate a set of save parameters and filepath based on available +#' parameter and `giottoInstructions` values. #' @param gobject giotto object or giottoInstructions #' @param plot_object ggplot object to plot #' @param save_dir directory to save to @@ -23,8 +26,15 @@ #' pixels. #' @param plot_count manually set the plot count that is appended to a #' default_save_name -#' @param \dots additional parameters to pass downstream save functions -#' @returns a plot file +#' @param GPSPARAM `giotto_plot_save_param` object. If provided, will be +#' used instead of most other general save params. (save_dir, save_folder, +#' save_name, default_save_name, save_format, base_width, base_height, +#' base_aspect_ratio, units, dpi, plot_count) +#' @param \dots additional parameters to pass downstream save functions. +#' [cowplot::save_plot()] is used for `ggplot2` plots. grDevices png, tiff +#' svg, pdf is used for base and general saving +#' @returns `all_plots_save_function` returns a plot file. `gpsparam` returns +#' a `giotto_plot_save_param` object #' @seealso \code{\link{showSaveParameters}} \code{\link[cowplot]{save_plot}} #' \code{\link[grDevices]{png}} #' \code{\link[grDevices]{tiff}} @@ -34,10 +44,17 @@ NULL -#' @describeIn plot_save (internal) ggplot saving. ... -#' passes to cowplot::save_plot -#' @keywords internal -.ggplot_save_function <- function(gobject, + + +#' @rdname plot_save +#' @examples +#' g <- GiottoData::loadGiottoMini("vis") +#' df <- data.frame(x = rnorm(5), y = rnorm(5)) +#' g_plot <- ggplot2::ggplot(df, ggplot2::aes(x,y)) + ggplot2::geom_point() +#' all_plots_save_function(g, g_plot) +#' +#' @export +all_plots_save_function <- function(gobject, plot_object, save_dir = NULL, save_folder = NULL, @@ -55,322 +72,146 @@ NULL dpi = NULL, limitsize = TRUE, plot_count = NULL, + GPSPARAM = NULL, ...) { - if (is.null(plot_object)) { - stop("\t there is no object to plot \t") - } - ## get save information and set defaults - if (is.null(save_dir)) { - save_dir <- readGiottoInstructions(gobject, - param = "save_dir" - ) - } - if (is.null(save_folder)) save_folder <- NULL - if (is.null(plot_count)) plot_count <- getOption("giotto.plot_count") - if (is.null(save_name)) { - save_name <- default_save_name - save_name <- paste0(plot_count, "-", save_name) - options("giotto.plot_count" = plot_count + 1L) - } - if (is.null(save_format)) { - save_format <- readGiottoInstructions(gobject, - param = "plot_format" - ) - } - if (is.null(dpi)) dpi <- readGiottoInstructions(gobject, param = "dpi") - if (is.null(base_width)) { - base_width <- readGiottoInstructions(gobject, - param = "width" - ) - } - if (is.null(base_height)) { - base_height <- readGiottoInstructions(gobject, - param = "height" - ) - } - if (is.null(base_aspect_ratio)) base_aspect_ratio <- 1.1 - if (is.null(units)) { - units <- readGiottoInstructions(gobject, - param = "units" - ) + # get save params + if (is.null(GPSPARAM)) { + type <- "general" + if(any("ggplot" %in% class(plot_object))) type <- "gg" + if (any("plotly" %in% class(plot_object))) type <- "plotly" + + a <- .grab_gpsparam_args() + GPSPARAM <- do.call(gpsparam, args = c( + a, list(instructions = instructions(gobject), type = type) + )) } - ## checking - dpi <- as.numeric(dpi) - base_width <- as.numeric(base_width) - base_height <- as.numeric(base_height) - base_aspect_ratio <- as.numeric(base_aspect_ratio) + checkmate::assert_class(GPSPARAM, "giotto_plot_save_param") - # create saving location - if (!is.null(save_folder)) { - file_location <- paste0(save_dir, "/", save_folder) - } else { - file_location <- save_dir + if (identical(getOption("giotto.verbose"), "debug")) { + print(GPSPARAM) } - if (!file.exists(file_location)) dir.create(file_location, recursive = TRUE) - file_name <- paste0(save_name, ".", save_format) - cowplot::save_plot( - plot = plot_object, - filename = file_name, - path = file_location, - device = save_format, - ncol = ncol, - nrow = nrow, - scale = scale, - base_width = base_width, - base_height = base_height, - base_aspect_ratio = base_aspect_ratio, - units = units, - dpi = dpi, - limitsize = limitsize, - ... - ) - - # show saved plot if requested - if (isTRUE(show_saved_plot)) { - if (save_format == "png") { - if (package_check("png", optional = TRUE)) { - img <- png::readPNG(source = paste0( - file_location, "/", - file_name - )) - grid::grid.raster(img) - } - } else if (save_format == "tiff") { - if (package_check("tiff", optional = TRUE)) { - img <- tiff::readTIFF(source = paste0( - file_location, "/", - file_name - )) - grid::grid.raster(img) - } - } else { - warning("\t only png & tiff are currently supported \t") - } + # perform save + if (any("ggplot" %in% class(plot_object))) { + .ggplot_save_function( + gobject = gobject, + plot_object = plot_object, + show_saved_plot = show_saved_plot, + ncol = ncol, + nrow = nrow, + scale = scale, + limitsize = limitsize, + GPSPARAM = GPSPARAM, + ... + ) + } else { + .general_save_function( + gobject = gobject, + plot_object = plot_object, + show_saved_plot = show_saved_plot, + GPSPARAM = GPSPARAM, + ... + ) } } -#' @describeIn plot_save (internal) base and general saving. -#' ... passes to grDevices png, tiff, pdf, svg -#' @keywords internal -.general_save_function <- function( - gobject, - plot_object, +#' @rdname plot_save +#' @param instructions `giotto` or `giottoInstructions` object +#' @param type `character`. One of `"gg"', '"plotly"', '"general"` to designate +#' which type of plot to save. This affects which types of outputs are +#' possible. +#' @export +gpsparam <- function( + instructions, + type = c("gg", "plotly", "general"), save_dir = NULL, save_folder = NULL, save_name = NULL, default_save_name = "giotto_plot", - save_format = c("png", "tiff", "pdf", "svg"), - show_saved_plot = FALSE, + save_format = NULL, + dpi = NULL, base_width = NULL, base_height = NULL, base_aspect_ratio = NULL, units = NULL, - dpi = NULL, plot_count = NULL, - ...) { - if (is.null(plot_object)) { - stop("\t there is no object to plot \t") + ... # ignored +) { + if (!inherits(instructions, c("giotto", "giottoInstructions"))) { + stop("`instructions` must be either a `giotto` or", + "`giottoInstructions` object.") } - save_format <- match.arg(save_format, - choices = c("png", "tiff", "pdf", "svg") + instrs <- instructions # shortname + checkmate::assert_character(type) + if (!length(type) == 1L) { + stop("Single `type` must be specified.") + } + + ## save format -------------------------------------------------------- ## + save_format <- save_format %null% + instructions(instrs, param = "plot_format") + + save_format <- switch(type, + "gg" = save_format, + "plotly" = "html", + "general" = match.arg(save_format, c("png", "tiff", "pdf", "svg")) ) - if (any("plotly" %in% class(plot_object))) { - save_format <- "html" - } + ## get save information and set defaults ------------------------------ ## + save_dir <- save_dir %null% instructions(instrs, param = "save_dir") + custom_plot_count <- is.null(plot_count) + plot_count <- plot_count %null% getOption("giotto.plot_count", 1) + dpi <- dpi %null% instructions(instrs, param = "dpi") + base_width <- base_width %null% instructions(instrs, param = "width") + base_height <- base_height %null% instructions(instrs, param = "height") + base_aspect_ratio <- base_aspect_ratio %null% 1.1 + units <- units %null% instructions(instrs, param = "units") - ## get save information and set defaults - if (is.null(save_dir)) { - save_dir <- readGiottoInstructions(gobject, - param = "save_dir" - ) - } - if (is.null(save_folder)) save_folder <- NULL - if (is.null(plot_count)) plot_count <- getOption("giotto.plot_count") - if (is.null(save_name)) { - save_name <- default_save_name - save_name <- paste0(plot_count, "-", save_name) - options("giotto.plot_count" = plot_count + 1) - } - if (is.null(save_format)) { - save_format <- readGiottoInstructions(gobject, - param = "plot_format" - ) - } - if (is.null(dpi)) dpi <- readGiottoInstructions(gobject, param = "dpi") - if (is.null(base_width)) { - base_width <- readGiottoInstructions(gobject, - param = "width" - ) - } - if (is.null(base_height)) { - base_height <- readGiottoInstructions(gobject, - param = "height" - ) - } - if (is.null(base_aspect_ratio)) base_aspect_ratio <- 1.1 - if (is.null(units)) { - units <- readGiottoInstructions(gobject, - param = "units" - ) - } - ## checking + ## checking ----------------------------------------------------------- ## dpi <- as.numeric(dpi) base_width <- as.numeric(base_width) base_height <- as.numeric(base_height) base_aspect_ratio <- as.numeric(base_aspect_ratio) + if (is.na(save_dir)) save_dir <- getwd() + + + # build filepath ------------------------------------------------------ ## + if (is.null(save_name)) { + save_name <- default_save_name + save_name <- paste0(plot_count, "-", save_name) + if (custom_plot_count) { + on.exit(options("giotto.plot_count" = plot_count + 1L), # increment + add = TRUE) + } + } - # create saving location if (!is.null(save_folder)) { - file_location <- paste0(save_dir, "/", save_folder) + file_location <- file.path(save_dir, save_folder) } else { file_location <- save_dir } - if (!file.exists(file_location)) dir.create(file_location, recursive = TRUE) - file_name <- paste0(save_name, ".", save_format) - full_location <- paste0(file_location, "/", file_name) - - if (any("plotly" %in% class(plot_object))) { - htmlwidgets::saveWidget(plotly::as_widget(plot_object), - file = full_location - ) - } else { - if (save_format == "png") { - grDevices::png( - filename = full_location, width = base_width, - height = base_height, res = dpi, units = units, ... - ) - print(plot_object) - grDevices::dev.off() - } - if (save_format == "tiff") { - grDevices::tiff( - filename = full_location, width = base_width, - height = base_height, units = units, ... - ) - print(plot_object) - grDevices::dev.off() - } + filename <- paste0(save_name, ".", save_format) + fullpath <- file.path(file_location, filename) - if (save_format == "pdf") { - grDevices::pdf( - file = full_location, width = base_width, - height = base_height, useDingbats = FALSE, ... - ) - print(plot_object) - grDevices::dev.off() - } - - if (save_format == "svg") { - grDevices::svg( - filename = full_location, width = base_width, - height = base_height, ... - ) - print(plot_object) - grDevices::dev.off() - } - - - # show saved plot if requested - if (isTRUE(show_saved_plot)) { - if (save_format == "png") { - if (package_check("png", optional = TRUE)) { - img <- png::readPNG(source = paste0( - file_location, - "/", file_name - )) - grid::grid.raster(img) - } - } else if (save_format == "tiff") { - if (package_check("tiff", optional = TRUE)) { - img <- tiff::readTIFF(source = paste0( - file_location, - "/", file_name - )) - grid::grid.raster(img) - } - } else { - warning("\t only png & tiff are currently supported \t") - } - } - } -} - -#' @rdname plot_save -#' @examples -#' g <- GiottoClass::createGiottoInstructions(save_plot = TRUE) -#' df <- data.frame(x = rnorm(5), y = rnorm(5)) -#' g_plot <- ggplot2::ggplot(df, ggplot2::aes(x,y)) + ggplot2::geom_point() -#' all_plots_save_function(g, g_plot) -#' -#' @export -all_plots_save_function <- function(gobject, - plot_object, - save_dir = NULL, - save_folder = NULL, - save_name = NULL, - default_save_name = "giotto_plot", - save_format = NULL, - show_saved_plot = FALSE, - ncol = 1, - nrow = 1, - scale = 1, - base_width = NULL, - base_height = NULL, - base_aspect_ratio = NULL, - units = NULL, - dpi = NULL, - limitsize = TRUE, - plot_count = NULL, - ...) { - if (any("ggplot" %in% class(plot_object))) { - .ggplot_save_function( - gobject = gobject, - plot_object = plot_object, - save_dir = save_dir, - save_folder = save_folder, - save_name = save_name, - default_save_name = default_save_name, + # create params object ------------------------------------------------ ## + structure( + list( + fullpath = fullpath, save_format = save_format, - show_saved_plot = show_saved_plot, - ncol = ncol, - nrow = nrow, - scale = scale, - base_width = base_width, - base_height = base_height, - base_aspect_ratio = base_aspect_ratio, - units = units, dpi = dpi, - limitsize = limitsize, - plot_count = plot_count, - ... - ) - } else { - .general_save_function( - gobject = gobject, - plot_object = plot_object, - save_dir = save_dir, - save_folder = save_folder, - save_name = save_name, - default_save_name = default_save_name, - save_format = save_format, - show_saved_plot = show_saved_plot, base_width = base_width, base_height = base_height, base_aspect_ratio = base_aspect_ratio, - units = units, - dpi = dpi, - plot_count = plot_count, - ... - ) - } + units = units + ), + class = "giotto_plot_save_param" + ) } @@ -422,3 +263,204 @@ showSaveParameters <- function() { save_param = list(save_name = 'favorite_name', units = 'png'))") } + + + + +# internals #### + +# GPSPARAM should be a `giotto_plot_save_param` object if provided +#' @noMd +#' @keywords internal +.ggplot_save_function <- function( + gobject, + plot_object, + show_saved_plot = FALSE, + ncol = 1, + nrow = 1, + scale = 1, + limitsize = TRUE, + GPSPARAM = NULL, + ... +) { + if (is.null(plot_object)) { + stop("\t there is no object to plot \t") + } + + sparam <- GPSPARAM + + # create saving location + fullpath <- sparam$fullpath + filename <- basename(fullpath) + path <- dirname(fullpath) + save_format <- sparam$save_format + + if (!file.exists(path)) { + dir.create(path, recursive = TRUE) + } + + + cowplot::save_plot( + plot = plot_object, + filename = filename, + path = path, + ncol = ncol, + nrow = nrow, + scale = scale, + device = save_format, + limitsize = limitsize, + # save param items + dpi = sparam$dpi, + units = sparam$units, + base_width = sparam$base_width, + base_height = sparam$base_height, + base_aspect_ratio = sparam$base_aspect_ratio, + ... + ) + + # show saved plot if requested + if (isTRUE(show_saved_plot)) { + if (save_format == "png") { + if (package_check("png", optional = TRUE)) { + img <- png::readPNG(source = fullpath) + grid::grid.raster(img) + } + } else if (save_format == "tiff") { + if (package_check("tiff", optional = TRUE)) { + img <- tiff::readTIFF(source = fullpath) + grid::grid.raster(img) + } + } else { + warning("\t only png & tiff are currently supported \t") + } + } +} + + + +# GPSPARAM should be a `giotto_plot_save_param` object if provided +#' @noMd +#' @keywords internal +.general_save_function <- function( + gobject, + plot_object, + show_saved_plot = FALSE, + GPSPARAM = NULL, + ... +) { + if (is.null(plot_object)) { + stop("\t there is no object to plot \t") + } + + sparam <- GPSPARAM + + fullpath <- sparam$fullpath + save_format <- sparam$save_format + dpi <- sparam$dpi + units <- sparam$units + base_width <- sparam$base_width + base_height <- sparam$base_height + + + # create saving location + path <- dirname(fullpath) + if (!file.exists(path)) { + dir.create(path, recursive = TRUE) + } + + if (any("plotly" %in% class(plot_object))) { + htmlwidgets::saveWidget( + plotly::as_widget(plot_object), + file = fullpath + ) + } else { + + switch(save_format, + "png" = { + grDevices::png( + filename = fullpath, width = base_width, + height = base_height, res = dpi, units = units, ... + ) + print(plot_object) + grDevices::dev.off() + }, + "tiff" = { + grDevices::tiff( + filename = fullpath, width = base_width, + height = base_height, units = units, ... + ) + print(plot_object) + grDevices::dev.off() + }, + "pdf" = { + grDevices::pdf( + file = fullpath, width = base_width, + height = base_height, useDingbats = FALSE, ... + ) + print(plot_object) + grDevices::dev.off() + }, + "svg" = { + grDevices::svg( + filename = fullpath, width = base_width, + height = base_height, ... + ) + print(plot_object) + grDevices::dev.off() + } + ) + + # show saved plot if requested + if (isTRUE(show_saved_plot)) { + switch(save_format, + "png" = { + if (package_check("png", optional = TRUE)) { + img <- png::readPNG(source = fullpath) + grid::grid.raster(img) + } + }, + "tiff" = { + if (package_check("tiff", optional = TRUE)) { + img <- tiff::readTIFF(source = fullpath) + grid::grid.raster(img) + } + }, + warning("\t only png & tiff are currently supported \t") + ) + } + } +} + + +# get expected save params from one stack frame up. +.grab_gpsparam_args <- function() { + expected_save_argnames <- c( + "save_dir", "save_folder", "save_name", "default_save_name", + "save_format", "dpi", "base_width", "base_height", "base_aspect_ratio", + "units", "plot_count" + ) + + get_args_list(toplevel = 2L, keep = expected_save_argnames) +} + + +#' @export +print.giotto_plot_save_param <- function(x, ...) { + cat(sprintf("<%s>\n", class(x))) + print_list(x) +} + +# GPSPARAM should be a `giotto_plot_save_param` +.plot_px_area <- function(GPSPARAM) { + + dims <- c(GPSPARAM$base_height, GPSPARAM$base_width) + pxdims <- switch(GPSPARAM$units, + "in" = dims * GPSPARAM$dpi, + "cm" = (dims / 2.54) * GPSPARAM$dpi, + "mm" = (dims / 25.4) * GPSPARAM$dpi, + "px" = dims + ) + round(prod(pxdims)) +} + + diff --git a/R/aux_visuals.R b/R/aux_visuals.R index 6824742..357726c 100644 --- a/R/aux_visuals.R +++ b/R/aux_visuals.R @@ -51,7 +51,7 @@ NULL expression_values )) ) - expr_values <- get_expression_values( + expr_values <- getExpression( gobject = gobject, spat_unit = spat_unit, feat_type = feat_type, @@ -61,7 +61,7 @@ NULL # subset expression data detected_feats <- feats[feats %in% rownames(expr_values)] - subset_values <- expr_values[rownames(expr_values) %in% detected_feats, ] + # subset_values <- expr_values[rownames(expr_values) %in% detected_feats, ] # metadata cell_metadata <- pDataDT(gobject, @@ -134,7 +134,7 @@ NULL #' start with numeric values #' @keywords internal #' @returns Aesthetics elements -#' +#' aes_string2 <- function(...) { args <- lapply(list(...), function(x) sprintf("`%s`", x)) do.call(ggplot2::aes_string, args) @@ -168,7 +168,7 @@ gg_input <- function(ggobject) { #' @description uses ggplot::geom_point, scattermore::geom_scattermore #' or scattermore::geom_scattermost #' @returns ggplot2::geom_point layer -#' +#' giotto_point <- function( plot_method = c("ggplot", "scattermore", "scattermost"), size = 1, @@ -180,39 +180,29 @@ giotto_point <- function( choices = c("ggplot", "scattermore", "scattermost") ) - if (plot_method == "ggplot") { - ggplot2::geom_point( - size = size, - ... - ) - } else if (plot_method == "scattermore") { - package_check( - pkg_name = "scattermore", - repository = "CRAN" - ) - scattermore::geom_scattermore( - pointsize = size, - ... - ) - } else if (plot_method == "scattermost") { - package_check( - pkg_name = "scattermore", - repository = "CRAN" - ) - scattermore::geom_scattermost( - xy = scattermost_xy, - color = scattermost_color, - pointsize = size - ) - } + switch(plot_method, + "ggplot" = { + ggplot2::geom_point(size = size, ...) + }, + "scattermore" = { + package_check(pkg_name = "scattermore", repository = "CRAN") + scattermore::geom_scattermore(pointsize = size, ...) + }, + "scattermost" = { + package_check(pkg_name = "scattermore", repository = "CRAN") + scattermore::geom_scattermost( + xy = scattermost_xy, + color = scattermost_color, + pointsize = size + ) + } + ) } - - # rescale values #### # based on ggplot2 internal @@ -241,7 +231,7 @@ mid_rescaler <- function(mid) { #' @param z_end default to "sdimz_end" #' #' @returns edges in network as data.table -#' +#' #' @export plotly_network <- function(network, x = "sdimx_begin", @@ -286,17 +276,17 @@ plotly_network <- function(network, #' @returns edges in spatial grid as data.table() #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' +#' #' library(GiottoClass) #' g <- createSpatialGrid(gobject = g, #' sdimx_stepsize = 400, #' sdimy_stepsize = 400, #' minimum_padding = 0) -#' +#' #' my_spatial_grid <- getSpatialGrid(g) -#' +#' #' plotly_grid(my_spatial_grid) -#' +#' #' @export plotly_grid <- function( spatial_grid, @@ -345,10 +335,10 @@ plotly_grid <- function( #' @param custom_ratio set the ratio artificially #' @returns edges in spatial grid as data.table() #' @examples -#' my_cell_locations <- data.frame(x = sample(10), y = sample(10), +#' my_cell_locations <- data.frame(x = sample(10), y = sample(10), #' z = sample(10)) #' plotly_axis_scale_3D(my_cell_locations) -#' +#' #' @export plotly_axis_scale_3D <- function( cell_locations, @@ -398,7 +388,7 @@ plotly_axis_scale_3D <- function( #' @examples #' my_cell_locations <- data.frame(x = sample(10), y = sample(10)) #' plotly_axis_scale_2D(my_cell_locations) -#' +#' #' @export plotly_axis_scale_2D <- function( cell_locations, diff --git a/R/color_palettes.R b/R/color_palettes.R index 219b019..ba9e6be 100644 --- a/R/color_palettes.R +++ b/R/color_palettes.R @@ -156,6 +156,8 @@ getColors <- function( # get palettes #### .get_rcolorbrewer_colors <- function(n, pal, strategy) { + package_check("RColorBrewer") + # DT vars rn <- maxcolors <- NULL @@ -176,10 +178,10 @@ getColors <- function( package_check("ggsci") pal_fullname <- paste0("ggsci::pal_", pal, "()") - + # get first 100 colors pal_cols <- eval(parse(text = pal_fullname))(100) - + get_continuous_colors( col = pal_cols[!is.na(pal_cols)], n = n, @@ -321,7 +323,7 @@ getColors <- function( #' @returns a vector of colors #' @examples #' get_continuous_colors(col = "#eb4034", n = 10, strategy = "interpolate") -#' +#' #' @export get_continuous_colors <- function(col, n, strategy) { strategy <- g_match_arg(strategy, @@ -354,7 +356,7 @@ get_continuous_colors <- function(col, n, strategy) { #' @returns a function #' @examples #' simple_palette_factory(col = "#eb4034") -#' +#' #' @export simple_palette_factory <- function(col, rev = FALSE, strategy = "interpolate") { checkmate::assert_character(col) @@ -393,7 +395,7 @@ simple_palette_factory <- function(col, rev = FALSE, strategy = "interpolate") { #' @returns palette colors #' @examples #' pal_names -#' +#' #' @export pal_names <- list( hcl = grDevices::hcl.pals(), diff --git a/R/dd.R b/R/dd.R index 0f90fe2..a17118a 100644 --- a/R/dd.R +++ b/R/dd.R @@ -139,8 +139,7 @@ NULL #' @param show_image show a tissue background image #' @param gimage a giotto image #' @param image_name name of a giotto image or multiple images with group_by -#' @param largeImage_name name of a giottoLargeImage or multiple images -#' with group_by +#' @param largeImage_name deprecated. Use `image_name` #' @keywords internal #' @returns ggplot NULL diff --git a/R/gg_annotation_raster.R b/R/gg_annotation_raster.R index cd1ada8..4887bc6 100644 --- a/R/gg_annotation_raster.R +++ b/R/gg_annotation_raster.R @@ -19,6 +19,11 @@ #' `giottoLargeImage` passes to automated resampling params see #' `?auto_image_resample` for details #' @return `gg` object with images to plot appended as annotation rasters +#' @examples +#' gimg <- GiottoData::loadSubObjectMini("giottoLargeImage") +#' gg <- ggplot2::ggplot() +#' out <- GiottoVisuals::gg_annotation_raster(gg, gimg) +#' print(out) NULL # * list #### @@ -422,7 +427,7 @@ setMethod( # RGB EXPECTED # # convert to range 0:1 (needed for as.raster()) x <- scales::rescale(x, to = c(0, 1)) - r <- as.raster(x) + r <- grDevices::as.raster(x) } return(r) diff --git a/R/gg_info_layers.R b/R/gg_info_layers.R index ae86de6..a0a3292 100644 --- a/R/gg_info_layers.R +++ b/R/gg_info_layers.R @@ -4,7 +4,9 @@ # are used in the final plot. # # --------------------------------------------------------------------------- # - +# TODO clean up this code a little more +# (there should only be one geom_point() call) +# TODO support dimFeatPlot() # spatial #### @@ -1630,6 +1632,7 @@ plot_point_layer_ggplot <- function(ggobject, size = point_size, alpha = point_alpha ) + # map color for each cell } else if (length(cell_color) > 1) { if (is.numeric(cell_color) | is.factor(cell_color)) { if (nrow(annotated_DT_selected) != length(cell_color)) { @@ -1663,6 +1666,7 @@ plot_point_layer_ggplot <- function(ggobject, ) } } else if (is.character(cell_color)) { + # color by col values if (!cell_color %in% colnames(annotated_DT_selected)) { if (!cell_color %in% grDevices::colors()) { stop(cell_color, " is not a color or a column name \n") @@ -1679,6 +1683,8 @@ plot_point_layer_ggplot <- function(ggobject, } else { class_cell_color <- class(annotated_DT_selected[[cell_color]]) + # if len = 1 + color_as_factor = FALSE + data is numeric, + # assume it means data col index with non-factor data if ((class_cell_color == "integer" | class_cell_color == "numeric") & color_as_factor == FALSE) { # set upper and lower limits @@ -1712,7 +1718,7 @@ plot_point_layer_ggplot <- function(ggobject, } # if you want to show centers or labels then calculate centers - if (show_cluster_center == TRUE | show_center_label == TRUE) { + if (show_cluster_center == TRUE || show_center_label == TRUE) { annotated_DT_centers <- annotated_DT_selected[, .( center_1 = stats::median(get(dims[1])), center_2 = stats::median(get(dims[2])) @@ -1722,6 +1728,10 @@ plot_point_layer_ggplot <- function(ggobject, annotated_DT_centers[[cell_color]] <- factor_center_data } + # if (!is.null(gradient_limits) && !color_as_factor) { + # annotated_DT_selected[, (cell_color) := scales::oob_squish(get(cell_color), gradient_limits)] + # } + pl <- pl + ggplot2::geom_point( data = annotated_DT_selected, aes_string2(x = dims[1], y = dims[2], fill = cell_color), diff --git a/R/gg_param.R b/R/gg_param.R new file mode 100644 index 0000000..f324c03 --- /dev/null +++ b/R/gg_param.R @@ -0,0 +1,184 @@ + +.handle_param_dups <- function(x, warn = TRUE, what = "aes") { + ns <- names(x) + dups <- duplicated(ns, fromLast = TRUE) + + if (sum(dups) > 0L) { + if (warn) { + dup_ns <- unique(ns[dups]) + warning(wrap_txtf( + "Duplicate %s param found for: `%s`. + Using last provided", + what, + paste(dup_ns, collapse = "`, `") + ), call. = FALSE) + } + x <- x[!dups] + } + return(x) +} + + +#' @name combine_aes +#' @title Combine ggplot2 aesthetics +#' @description Utility for combining ggplot2 `aes` lists. Uses the last +#' provided value when aes names overlap. +#' @param ... one or more objects of class `uneval` +#' (output from [ggplot2::aes()]) +#' @param warn_duplicates logical. Warn when aes names overlap +#' @examples +#' a <- ggplot2::aes(a = a1, b = b1, c = c1) +#' b <- ggplot2::aes(x = x1, y = y1, a = a2, c = c2) +#' +#' # warnings turned off +#' combine_aes(a, b, warn_duplicates = FALSE) # b values used for a,c +#' combine_aes(b, a, warn_duplicates = FALSE) # a values used for a,c +#' @family ggplot2 plotting wrangling functions +#' @export +combine_aes <- function(..., warn_duplicates = TRUE) { + input <- list(...) + # checkmate::assert_list(input, "uneval") + res <- do.call(c, input) + res <- .handle_param_dups(res, warn = warn_duplicates, what = "aes") + + class(res) <- "uneval" + return(res) +} + + +#' @name gg_param +#' @title Generate ggplot params +#' @description Based on a set of named inputs, organize them into either +#' ggplot2 aesthetic mappings or toplevel params based on whether they are or +#' are not of the classes `quosure`, `name`, or a language object. The `data` +#' param may be applied here or added afterwards\cr +#' +#' This is mainly a convenience for developers. Users should still use `aes()` +#' and `quo()` for their environment-enclosing characteristics. Inside of +#' packages however, the proper environments for code to run is already +#' available, or can be already processed before passing to plotting. +#' @param data data to plot +#' @param warn_duplicates logical. Warn when aes names provided through ... +#' overlap. +#' @param ... One or more named plotting params. Entries should either be +#' individually named params or lists of named parameters / `aes()` generated +#' aesthetic lists. +#' @examples +#' # data to use +#' library(ggplot2) +#' d <- data.frame( +#' xvals = seq(10), +#' yvals = seq(10), +#' values = seq(0.1, 1, by = 0.1), +#' size_col = seq(5, 1, length.out = 10) +#' ) +#' +#' # ----- single step ----- # +#' p_single <- gg_param( +#' data = d, +#' x = as.name("xvals"), # aes +#' fill = "green", # toplevel +#' aes( +#' size = size_col, # aes +#' y = yvals # aes +#' ), +#' show.legend = TRUE, # toplevel +#' list( +#' shape = 21, # toplevel +#' alpha = as.name("values") # aes +#' ) +#' ) +#' +#' ggplot() + do.call(geom_point, p_single) +#' +#' # ----- multistep appending ----- # +#' +#' p0 <- list() +#' +#' # add aesthetics directly through assignment +#' p0$x <- as.name("xvals") +#' p0$show.legend <- TRUE +#' +#' # add aesthetics through `c()` list concatenation +#' # list objects are unnamed and thus are best added this way +#' p0 <- c(p0, list(fill = "green")) +#' p0 <- c(p0, aes(size = size_col, y = yvals)) +#' p0 <- c(p0, list(shape = 21, alpha = as.name("values"))) +#' +#' # add data +#' p0$data <- d +#' +#' # `quote = TRUE` must be used when using `do.call()` for this +#' p_multi <- do.call(gg_param, p0, quote = TRUE) +#' ggplot() + do.call(geom_point, p_multi) +#' +#' # ----- nested appending ----- # +#' p_nest <- gg_param(p_single, p_multi) +#' p_nest_sub <- gg_param(p_single, p_multi, data = d[1:5,]) # change the data to use +#' +#' ggplot() + do.call(geom_point, p_nest) +#' ggplot() + do.call(geom_point, p_nest_sub) +#' @family ggplot2 plotting wrangling functions +#' @export +gg_param <- function(..., data = NULL, warn_duplicates = TRUE) { + input <- c(...) + + # handle nested aes inputs + in_mapping <- input$mapping + while (!is.null(in_mapping)) { + if (inherits(in_mapping, "uneval")) { + input$mapping <- NULL + input <- c(input, in_mapping) + } else { + stop("`mapping` is a protected param name. Do not use.") + } + in_mapping <- input$mapping + } + + # select last data provided + if ("data" %in% names(input)) { + use_data <- input[[tail(which(names(input) == "data"), 1L)]] + # cleanup `data` entries + while ("data" %in% names(input)) { + input$data <- NULL + } + if (warn_duplicates && is.null(data)) { + warning("multiple `data` objects given. Using last one.") + } + # replace `data` with last entry if not provided through `data` param + data <- data %null% use_data + } + + # empty inputs - return early with empty list (with possible data) + if (length(input) == 0L) { + return(list(data = data)) + } + + # check param names + if (any(is.null(names(input)))) { + stop("All params must be named", call. = FALSE) + } + + # param sorting + is_nse <- vapply( + FUN.VALUE = logical(1L), input, function(param) { + inherits(param, c("quosure", "name")) || is.language(param) + } + ) + + # param dups + a_items <- input[is_nse] + a_items <- combine_aes(a_items, warn_duplicates = warn_duplicates) + p_items <- input[!is_nse] + p_items <- .handle_param_dups( + p_items, warn = warn_duplicates, what = "toplevel" + ) + + p_items$mapping <- a_items + p_items$data <- data + class(p_items) <- "gplot_param" + return(p_items) +} + + + diff --git a/R/gg_settings.R b/R/gg_settings.R index f51d978..20eba2d 100644 --- a/R/gg_settings.R +++ b/R/gg_settings.R @@ -7,6 +7,7 @@ legend_text = 8, axis_title = 8, axis_text = 8, + axis_text_y_angle = 90, background_color = "white", ... ) { @@ -21,7 +22,8 @@ # defaults a$plot.title <- a$plot.title %null% element_text(hjust = 0.5) - a$axis.text.y <- a$axis.text.y %null% element_text(angle = 90, hjust = 0.5) + a$axis.text.y <- a$axis.text.y %null% + element_text(angle = axis_text_y_angle, hjust = 0.5) a$legend.title <- a$legend.title %null% element_blank() a$panel.grid <- a$panel.grid %null% element_blank() @@ -29,6 +31,22 @@ } - +#' @name ggplot_themes +#' @title ggplot2 plotting themes +#' @description +#' ggplot2 themes. It can be applied through the `theme_param` arg. +#' @export +theme_dark2 <- theme( + plot.background = element_rect(fill = "black"), + panel.background = element_rect(fill = "black"), + panel.grid.major = element_blank(), + panel.grid.minor = element_blank(), + text = element_text(color = "white"), + axis.text = element_text(color = "white"), + title = element_text(color = "white"), + legend.background = element_rect(fill = "black"), + legend.text = element_text(color = "white"), + legend.title = element_text(color = "white") +) diff --git a/R/globals.R b/R/globals.R index 6e0c343..ec4fa94 100644 --- a/R/globals.R +++ b/R/globals.R @@ -1 +1 @@ -utils::globalVariables(names = c(":=", ".N", ".SD", ".", "cast")) +globalVariables(names = c(":=", ".N", ".SD", ".", "cast")) diff --git a/R/package_imports.R b/R/package_imports.R index dae25a1..7345e01 100644 --- a/R/package_imports.R +++ b/R/package_imports.R @@ -11,10 +11,8 @@ #' @import utils #' @import cowplot #' @import scattermore -#' @import RColorBrewer #' @importFrom terra as.array #' @import ggrepel -#' @importFrom reshape2 melt #' @importFrom scales rescale_mid #' @importFrom igraph as_data_frame #' @importFrom plotly add_segments diff --git a/R/plot_dendrogram.R b/R/plot_dendrogram.R index 0fc34bd..5a9ab09 100644 --- a/R/plot_dendrogram.R +++ b/R/plot_dendrogram.R @@ -20,7 +20,7 @@ #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' showClusterDendrogram(g, cluster_column = "leiden_clus") -#' +#' #' @export showClusterDendrogram <- function( gobject, @@ -117,18 +117,18 @@ showClusterDendrogram <- function( #' @returns ggdendrogram #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' +#' #' g_expression <- head(GiottoClass::getExpression(g, output = "matrix")) #' g_expression_df <- as.data.frame(as.matrix(g_expression)) #' g_expression_df$feat_ID <- rownames(g_expression) -#' -#' g_expression_melt <- reshape2::melt(g_expression_df, id.vars = "feat_ID", -#' measure.vars = colnames(g_expression), variable.name = "cell_ID", +#' +#' g_expression_melt <- data.table::melt(g_expression_df, id.vars = "feat_ID", +#' measure.vars = colnames(g_expression), variable.name = "cell_ID", #' value.name = "raw_expression") -#' -#' create_cluster_dendrogram(data.table::as.data.table(g_expression_melt), +#' +#' create_cluster_dendrogram(data.table::as.data.table(g_expression_melt), #' var_col = "cell_ID", clus_col = "feat_ID", "raw_expression") -#' +#' #' @export create_cluster_dendrogram <- function(data, clus_col = names(data)[[1]], diff --git a/R/plot_dotplot.R b/R/plot_dotplot.R new file mode 100644 index 0000000..384d253 --- /dev/null +++ b/R/plot_dotplot.R @@ -0,0 +1,338 @@ + + + + + +#' @name dotPlot +#' @title Create a dotplot +#' @description Visualize feature expression statistics applied across +#' clusters/groupings of cells. The default behavior is dot size scaled by +#' what percentage of cells within a particular cluster express the feature, +#' and dot color scaled by mean expression of that feature within the cluster. +#' @inheritParams data_access_params +#' @inheritParams plot_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_output_params +#' @param dot_size,dot_color summary function e.g. `sum`, `mean`, `var`, or +#' other custom function. The default for `dot_size` finds the percentage of +#' cells of a particular cluster that do not have an expression level of 0. +#' @param dot_size_threshold numeric. The minimal value at which a dot is no +#' longer drawn. +#' @param feats character vector or named list. Features to use or named lists +#' of features to use. +#' @param cluster_column character. Clusterings column to use (usually in cell +#' metadata) +#' @param cluster_custom_order character vector. Specific cluster order to use +#' @param dot_scale numeric. Controls size of dots +#' @param dot_color_gradient hex codes or palette name. Color gradient to use. +#' @param gradient_limits numeric vector of length 2. Set minmax value mappings +#' for color gradient +#' @param expression_values character. Expression values to use. +#' @param title character. title for plot +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @examples +#' g <- GiottoData::loadGiottoMini("visium") +#' library(GiottoClass) +#' f1 <- head(featIDs(g), 20) +#' f2 <- tail(featIDs(g), 20) +#' +#' dotPlot(g, cluster_column = "leiden_clus", feats = f1) +#' +#' # make two plots from two named sets of features +#' dotPlot(g, +#' cluster_column = "leiden_clus", +#' feats = list(set1 = f1, set2 = f2) +#' ) +#' +#' # add new cell metadata col that classifies by total expression into +#' # - 0 (< 900) +#' # - 1 (> 900 and < 1200) +#' # - 2 (> 1200) +#' total_expr <- g$total_expr +#' g$expr_class <- findInterval(total_expr, c(900, 1200)) +#' +#' # Create a dotplot while splitting the values based on the above total +#' # expression classifications. +#' dotPlot(g, +#' cluster_column = "leiden_clus", +#' feats = list(set1 = f1, set2 = f2), +#' group_by = "expr_class" +#' ) +#' +#' # Same as before, but focusing on classifications 0 and 2 +#' dotPlot(g, +#' cluster_column = "leiden_clus", +#' feats = list(set1 = f1, set2 = f2), +#' group_by = "expr_class", +#' group_by_subset = c(0, 2) +#' ) +#' +#' # example with an alternate function used for `dot_color` and a different +#' # color gradient +#' dotPlot(g, +#' cluster_column = "leiden_clus", +#' feats = f1, +#' dot_size = mean, +#' dot_color = var, +#' dot_color_gradient = c("#EEEEFF", "#333377") +#' ) +#' @export +dotPlot <- function( + gobject, + feats, + cluster_column, + cluster_custom_order = NULL, + dot_size = function(x) mean(x != 0) * 100, + dot_size_threshold = 0, + dot_scale = 6, + dot_color = mean, + dot_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = "sequential", + gradient_limits = NULL, + group_by = NULL, + group_by_subset = NULL, + spat_unit = NULL, + feat_type = NULL, + expression_values = c( + "normalized", + "scaled", + "custom" + ), + title = NULL, + show_legend = TRUE, + legend_text = 10, + legend_symbol_size = 2, + background_color = "white", + axis_text = 10, + axis_title = 9, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dotPlot" +) { + checkmate::assert_character(cluster_column, len = 1L) + checkmate::assert_class(gobject, "giotto") + if (!is.null(gradient_limits)) { + checkmate::assert_numeric(gradient_limits, len = 2L) + } + title <- title %null% "" + + spat_unit <- set_default_spat_unit( + gobject = gobject, spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, spat_unit = spat_unit, feat_type = feat_type + ) + + expression_values <- match.arg( + expression_values, + unique(c("normalized", "scaled", "custom", expression_values)) + ) + + clus <- spatValues(gobject, spat_unit = spat_unit, feat_type = feat_type, + feats = cluster_column, verbose = FALSE) + expr <- spatValues(gobject, spat_unit = spat_unit, feat_type = feat_type, + feats = unique(unlist(feats)), # unlist to get all feats + expression_values = expression_values, + verbose = FALSE) + + # combine cluster and expression info + ann_dt <- clus[expr, on = "cell_ID"] + + common_args <- get_args_list(keep = c( + "cluster_column", "dot_size_threshold", "dot_size", "dot_color", + "cluster_custom_order", "gradient_limits", "gradient_midpoint", + "dot_color_gradient", "gradient_style", "dot_scale", "theme_param", + "legend_text", "axis_title", "axis_text", "background_color" + )) + common_args$instrs <- instructions(gobject) + # `ann_dt`, `feats`, `title` need to be updated + + # split up ann_dt into lists of ann_dt if `group_by` was given + if (is.null(group_by)) { + adt_list <- list(ann_dt) + } else { + grpby <- spatValues(gobject, + spat_unit = spat_unit, feat_type = feat_type, feats = group_by, + verbose = FALSE + ) + ann_dt <- ann_dt[grpby, on = "cell_ID"] + # consider name collisions + if (identical(group_by, cluster_column)) { + group_by <- paste0("i.", group_by) + } + + unique_groups <- unique(ann_dt[[group_by]]) + # subset unique groups to those selected with `group_by_subset` + if (!is.null(group_by_subset)) { + not_found <- group_by_subset[!group_by_subset %in% unique_groups] + if (length(not_found) > 0) { + message("the following subset was not found: ", not_found) + } + unique_groups <- unique_groups[unique_groups %in% group_by_subset] + } + + # subset ann_dt based on the group_by + adt_list <- lapply(unique_groups, function(ugroup) { + ann_dt[get(group_by) == ugroup] + }) + + # update title + title <- paste(title, unique_groups) + } + + # deal with multiple feature sets + if (!is.list(feats)) { + feats <- list(feats) + } else { + fnames <- names(feats) + if (length(fnames) != length(feats)) { + stop("If `feats` is a list, all list elements must be named") + } + + # duplicate adt_list for however many feature sets there are + # no need to bother with subsetting feat columns + n_adt <- length(adt_list) + n_fts <- length(feats) + adt_list <- rep(adt_list, n_fts) + + # duplicate feats list to match adt list + feats <- rep(feats, n_adt) + + # update title + title <- paste(rep(title, n_fts), fnames) + } + + + pl <- mapply( + function(adt_i, title_i, feats_i) { + specific_args <- list( + ann_dt = adt_i, + feats = feats_i, + title = title_i + ) + do.call(.dplot_single, args = c(specific_args, common_args)) + }, + adt_i = adt_list, title_i = title, feats_i = feats, + SIMPLIFY = FALSE + ) + + if (length(pl) == 1L) pl <- pl[[1L]] + if (length(pl) > 1 && !inherits(pl, "gg")) { + pl <- cowplot::plot_grid( + plotlist = pl, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(pl) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + } + + plot_output_handler( + gobject = gobject, + plot_object = pl, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + ) +} + + +# internals #### + +.dplot_single <- function( + ann_dt, cluster_column, dot_size, dot_color, feats, dot_size_threshold, + cluster_custom_order, gradient_limits, gradient_midpoint, + dot_color_gradient, gradient_style, dot_scale, theme_param, + legend_text, title, axis_title, axis_text, background_color, instrs +) { + # NSE vars + cluster <- feat <- color <- size <- NULL + + dsize <- ann_dt[, lapply(.SD, dot_size), .SDcols = feats, by = cluster_column] + dcol <- ann_dt[, lapply(.SD, dot_color), .SDcols = feats, by = cluster_column] + + dsize <- data.table::melt(dsize, + id.vars = cluster_column, + measure.vars = feats, + value.name = "size", + variable.name = "feat" + ) + dcol <- data.table::melt(dcol, + id.vars = cluster_column, + measure.vars = feats, + value.name = "color", + variable.name = "feat" + ) + plot_dt <- dsize[dcol, on = c(cluster_column, "feat")] + data.table::setnames(plot_dt, old = cluster_column, new = "cluster") + + ## dot size cutoff ## + plot_dt <- plot_dt[size > dot_size_threshold,] + + ## set cluster order ## + if (is.null(cluster_custom_order)) { + plot_dt[, cluster := factor(cluster, levels = mixedsort(unique(cluster)))] + } else { + plot_dt[, cluster := factor(cluster, levels = cluster_custom_order)] + } + + # apply limits + if (!is.null(gradient_limits)) { + plot_dt[, color := scales::oob_squish(color, gradient_limits)] + } + + pl <- ggplot2::ggplot() + + ggplot2::geom_point( + data = plot_dt, + ggplot2::aes(x = cluster, y = feat, color = color, size = size) + ) + + # apply color gradient + if (is.null(gradient_midpoint)) { + gradient_midpoint <- + stats::median(plot_dt$color) + } + pl <- pl + set_default_color_continuous_cell( + colors = dot_color_gradient, + instrs = instrs, + midpoint = gradient_midpoint, + style = gradient_style, + type = "color" + ) + + # size scaling + pl <- pl + scale_size_continuous(range = c(1, dot_scale)) + + ## theme ## + gg_theme_args <- c( + theme_param, + legend_text = legend_text, + axis_title = axis_title, + axis_text = axis_text, + background_color = background_color, + axis_text_y_angle = 0, + axis.ticks = element_blank() + ) + pl <- pl + do.call(.gg_theme, args = gg_theme_args) + + pl <- pl + ggplot2::labs(title = title) + + return(pl) +} + + + diff --git a/R/plot_heatmap.R b/R/plot_heatmap.R index 447a24b..7aac3e2 100644 --- a/R/plot_heatmap.R +++ b/R/plot_heatmap.R @@ -18,7 +18,7 @@ #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' showClusterHeatmap(g, cluster_column = "leiden_clus") -#' +#' #' @export showClusterHeatmap <- function( gobject, @@ -150,7 +150,7 @@ showClusterHeatmap <- function( #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' plotHeatmap(g, feats = c("Gm19935", "Gna12", "Ccnd2", "Btbd17"), #' cluster_column = "leiden_clus") -#' +#' #' @export plotHeatmap <- function( gobject, @@ -445,7 +445,7 @@ plotHeatmap <- function( #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' plotMetaDataHeatmap(g, metadata_cols = "leiden_clus", #' selected_feats = c("Gna12", "Ccnd2", "Btbd17", "Gm19935")) -#' +#' #' @export plotMetaDataHeatmap <- function(gobject, spat_unit = NULL, @@ -567,7 +567,7 @@ plotMetaDataHeatmap <- function(gobject, x = t(testmain_mat), method = feat_cor_method ) - feat_cordist <- stats::as.dist(1 - feat_cormatrix, + feat_cordist <- stats::as.dist(1 - feat_cormatrix, diag = TRUE, upper = TRUE) feat_corclus <- stats::hclust( d = feat_cordist, @@ -646,11 +646,11 @@ plotMetaDataHeatmap <- function(gobject, # print, return and save parameters show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), + readGiottoInstructions(gobject, param = "show_plot"), show_plot ) save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), + readGiottoInstructions(gobject, param = "save_plot"), save_plot ) return_plot <- ifelse(is.null(return_plot), @@ -828,7 +828,7 @@ plotMetaDataHeatmap <- function(gobject, #' @seealso \code{\link{plotMetaDataHeatmap}} for feature expression instead #' of numeric cell annotation data. #' @returns ggplot or data.table -#' +#' #' @export plotMetaDataCellsHeatmap <- function( gobject, @@ -920,7 +920,7 @@ plotMetaDataCellsHeatmap <- function( # for clusters if (is.null(custom_cluster_order)) { cormatrix <- cor_flex(x = testmain_mat, method = clus_cor_method) - cordist <- stats::as.dist(1 - cormatrix, + cordist <- stats::as.dist(1 - cormatrix, diag = TRUE, upper = TRUE) corclus <- stats::hclust(d = cordist, method = clus_cluster_method) clus_names <- rownames(cormatrix) @@ -1123,7 +1123,7 @@ plotMetaDataCellsHeatmap <- function( expression_values, unique(c("normalized", "scaled", "custom", expression_values)) ) - expr_values <- get_expression_values( + expr_values <- getExpression( gobject = gobject, spat_unit = spat_unit, feat_type = feat_type, @@ -1160,13 +1160,11 @@ plotMetaDataCellsHeatmap <- function( ) ## data.table ## - subset_values_DT <- data.table::as.data.table( - reshape2::melt( - as.matrix(subset_values), - varnames = c("feats", "cells"), - value.name = "expression", - as.is = TRUE - ) + subset_values_DT <- melt_matrix( + as.matrix(subset_values), + varnames = c("feats", "cells"), + value.name = "expression", + as.is = TRUE ) subset_values_DT <- merge( subset_values_DT, @@ -1185,7 +1183,7 @@ plotMetaDataCellsHeatmap <- function( subset_values_DT[, feats := factor(feats, unique(detected_feats))] subset_values_DT[, z_scores := scale(expression), by = feats] subset_values_DT[, scale_scores := scales::rescale(x = expression, - to = c(0, 1)), + to = c(0, 1)), by = feats] diff --git a/R/plot_violin.R b/R/plot_violin.R index 0c5a902..f1ae2f9 100644 --- a/R/plot_violin.R +++ b/R/plot_violin.R @@ -70,7 +70,7 @@ violinPlot <- function( expression_values )) ) - expr_data <- get_expression_values( + expr_data <- getExpression( gobject = gobject, feat_type = feat_type, spat_unit = spat_unit, diff --git a/R/suite_reexports.R b/R/suite_reexports.R index b8cef91..47784b4 100644 --- a/R/suite_reexports.R +++ b/R/suite_reexports.R @@ -7,3 +7,7 @@ GiottoUtils::getDistinctColors ggrepel::geom_text_repel #' @export ggrepel::geom_label_repel + +#' @importFrom cowplot plot_grid +#' @export +cowplot::plot_grid diff --git a/R/vis_spatial.R b/R/vis_spatial.R deleted file mode 100644 index 888b35f..0000000 --- a/R/vis_spatial.R +++ /dev/null @@ -1,8633 +0,0 @@ -## * #### -## 2-D ggplots #### -## ----------- ## - - - -## ** spatial plotting #### - - - - - -#' @title .spatPlot2D_single -#' @name .spatPlot2D_single -#' @description Visualize cells according to spatial coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_spatnet_params -#' @inheritParams plot_spatenr_params -#' @param show_image show a tissue background image -#' @param gimage a giotto image -#' @param image_name name of giotto image(s) to plot -#' @param spat_loc_name name of spatial locations -#' @param sdimx x-axis dimension name (default = 'sdimx') -#' @param sdimy y-axis dimension name (default = 'sdimy') -#' @param show_cluster_center plot center of selected clusters -#' @param show_center_label plot label of selected clusters -#' @param center_point_size size of center points -#' @param network_color color of spatial network -#' @param network_alpha alpha of spatial network -#' @param show_grid show spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param grid_color color of spatial grid -#' @param coord_fix_ratio fix ratio between x and y-axis -#' @param vor_border_color border colorr for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparency of voronoi 'cells' -#' @param theme_param list of additional params passed to `ggplot2::theme()` -#' @param verbose be verbose -#' @return ggplot -#' @details Description of parameters. -#' @keywords internal -#' @seealso \code{\link{spatPlot3D}} -.spatPlot2D_single <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - spat_loc_name = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - spat_enr_names = NULL, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = "divergent", - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - point_shape = c("border", "no_border", "voronoi"), - point_size = 3, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - show_cluster_center = FALSE, - show_center_label = FALSE, - center_point_size = 4, - center_point_border_col = "black", - center_point_border_stroke = 0.1, - label_size = 4, - label_fontface = "bold", - show_network = FALSE, - spatial_network_name = "Delaunay_network", - network_color = NULL, - network_alpha = 1, - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - grid_color = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - other_cells_alpha = 0.1, - coord_fix_ratio = 1, - title = NULL, - show_legend = TRUE, - legend_text = 8, - legend_symbol_size = 1, - background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - axis_text = 8, - axis_title = 8, - theme_param = list(), - - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - verbose = FALSE, - save_param = list(), - default_save_name = "spatPlot2D_single") { - # Check params - checkmate::assert_class(gobject, "giotto") - - point_shape <- match.arg( - point_shape, - choices = c("border", "no_border", "voronoi") - ) - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - ## get giotto image(s) ## - if (isTRUE(show_image) && is.null(gimage)) { - gimage <- getGiottoImage( - gobject = gobject, - name = image_name - ) - } - - - ## get spatial cell locations - cell_locations <- get_spatial_locations( - gobject = gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - output = "data.table", - copy_obj = TRUE, - verbose = verbose - ) - if (is.null(cell_locations)) { - return(NULL) - } - - - ## extract spatial network - if (show_network == TRUE) { - spatial_network <- get_spatialNetwork( - gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - ## extract spatial grid - if (show_grid == TRUE) { - spatial_grid <- get_spatialGrid( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - name = spatial_grid_name, - return_grid_Obj = FALSE - ) - } else { - spatial_grid <- NULL - } - - - ## get cell metadata - - if (is.null(spat_loc_name)) { - if (!is.null(slot(gobject, "spatial_locs"))) { - spat_loc_name <- list_spatial_locations_names( - gobject, spat_unit = spat_unit)[[1]] - } else { - spat_loc_name <- NULL - message("No spatial locations have been found") - return(NULL) - } - } - - cell_metadata <- try( - expr = combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - spat_enr_names = spat_enr_names, - verbose = verbose - ), - silent = TRUE - ) - - if (inherits(cell_metadata, "try-error")) { - cell_locations_metadata <- cell_locations - } else if (nrow(cell_metadata) == 0) { - cell_locations_metadata <- cell_locations - } else { - cell_locations_metadata <- cell_metadata - } - - - - ## create subsets if needed - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - message("You have selected both individual cell IDs and a group of - cells") - group_cell_IDs <- cell_locations_metadata[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- cell_locations_metadata[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - cell_locations_metadata_other <- - cell_locations_metadata[!cell_locations_metadata$cell_ID %in% - select_cells] - cell_locations_metadata_selected <- - cell_locations_metadata[cell_locations_metadata$cell_ID %in% - select_cells] - spatial_network <- spatial_network[spatial_network$to %in% - select_cells & spatial_network$from %in% - select_cells] - - # if specific cells are selected - # cell_locations_metadata = cell_locations_metadata_selected - } else if (is.null(select_cells)) { - cell_locations_metadata_selected <- cell_locations_metadata - cell_locations_metadata_other <- NULL - } - - - # update cell_color_code - # only keep names from selected groups - if (!is.null(select_cell_groups) & !is.null(cell_color_code)) { - cell_color_code <- cell_color_code[names(cell_color_code) %in% - select_cell_groups] - } - - # data.table and ggplot variables - sdimx_begin <- sdimy_begin <- sdimx_end <- sdimy_end <- x_start <- - x_end <- y_start <- y_end <- NULL - - - ### create 2D plot with ggplot ### - - if (isTRUE(verbose)) { - message("Data table with selected information (e.g. cells):") - message(cell_locations_metadata_selected[seq_len(5), ]) - - message("Data table with non-selected information (e.g. cells):") - message(cell_locations_metadata_other[seq_len(5), ]) - } - - - pl <- ggplot2::ggplot() - pl <- pl + ggplot2::theme_bw() - - ## plot image ## - if (isTRUE(show_image) && !is.null(gimage)) { - pl <- plot_spat_image_layer_ggplot( - gg_obj = pl, - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - gimage = gimage - ) - } - - - ## plot spatial network - if (!is.null(spatial_network) && isTRUE(show_network)) { - if (is.null(network_color)) network_color <- "red" - pl <- pl + ggplot2::geom_segment( - data = spatial_network, - aes( - x = sdimx_begin, - y = sdimy_begin, - xend = sdimx_end, - yend = sdimy_end - ), - color = network_color, - size = 0.5, - alpha = network_alpha - ) - } - - - ## plot spatial grid - if (!is.null(spatial_grid) && isTRUE(show_grid)) { - if (is.null(grid_color)) grid_color <- "black" - pl <- pl + ggplot2::geom_rect( - data = spatial_grid, - aes( - xmin = x_start, - xmax = x_end, - ymin = y_start, - ymax = y_end - ), - color = grid_color, - fill = NA - ) - } - - - ## plot point layer - point_general_params <- list( - ggobject = pl, - instrs = instructions(gobject), - sdimx = sdimx, - sdimy = sdimy, - cell_locations_metadata_selected = cell_locations_metadata_selected, - cell_locations_metadata_other = cell_locations_metadata_other, - cell_color = cell_color, - color_as_factor = color_as_factor, - cell_color_code = cell_color_code, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - point_size = point_size, - point_alpha = point_alpha, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - label_size = label_size, - label_fontface = label_fontface, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_legend = show_legend - ) - - point_border_specific_params <- list( - point_border_stroke = point_border_stroke, # specific - point_border_col = point_border_col, # specific - center_point_border_col = center_point_border_col, # specific - center_point_border_stroke = center_point_border_stroke # specific - ) - - point_voronoi_specific_params <- list( - background_color = background_color, # specific - vor_border_color = vor_border_color, # specific - vor_max_radius = vor_max_radius, # specific - vor_alpha = vor_alpha # specific - ) - - pl <- switch(point_shape, - "border" = do.call( - plot_spat_point_layer_ggplot, - args = c( - point_general_params, - point_border_specific_params - ) - ), - "no_border" = do.call( - plot_spat_point_layer_ggplot_noFILL, - args = point_general_params - ), - "voronoi" = do.call( - plot_spat_voronoi_layer_ggplot, - args = c( - point_general_params, - point_voronoi_specific_params - ) - ) - ) - - - ## adjust theme settings - gg_theme_args <- c( - theme_param, - legend_text = legend_text, - axis_title = axis_title, - axis_text = axis_text, - background_color = background_color - ) - pl <- pl + do.call(.gg_theme, args = gg_theme_args) - - ## change symbol size of legend - if (isTRUE(color_as_factor)) { - if (point_shape %in% c("border", "voronoi")) { - pl <- pl + - guides(fill = guide_legend( - override.aes = list(size = legend_symbol_size))) - } else if (point_shape == "no_border") { - pl <- pl + - guides(color = guide_legend( - override.aes = list(size = legend_symbol_size))) - } - } - - - # fix coord ratio - if (!is.null(coord_fix_ratio)) { - pl <- pl + ggplot2::coord_fixed(ratio = coord_fix_ratio) - } - - # provide x, y and plot titles - if (is.null(title)) title <- cell_color - pl <- pl + ggplot2::labs(x = "x coordinates", y = "y coordinates", - title = title) - - return(plot_output_handler( - gobject = gobject, - plot_object = pl, - save_plot = save_plot, - return_plot = return_plot, - show_plot = show_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - - - - - - -#' @rdname spatPlot -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_image_params -#' @inheritParams plot_spatenr_params -#' @inheritParams plot_params -#' @param spat_loc_name name of spatial locations -#' @param sdimx x-axis dimension name (default = 'sdimx') -#' @param sdimy y-axis dimension name (default = 'sdimy') -#' @param gradient_midpoint midpoint for color gradient -#' @param gradient_limits vector with lower and upper limits -#' @param select_cell_groups select subset of cells/clusters based on -#' cell_color parameter -#' @param select_cells select subset of cells based on cell IDs -#' @param point_shape shape of points (border, no_border or voronoi) -#' @param point_size size of point (cell) -#' @param point_alpha transparancy of point -#' @param point_border_col color of border around points -#' @param point_border_stroke stroke size of border around points -#' @param show_cluster_center plot center of selected clusters -#' @param show_center_label plot label of selected clusters -#' @param center_point_size size of center points -#' @param center_point_border_col border color of center points -#' @param center_point_border_stroke border stroke size of center points -#' @param label_size size of labels -#' @param label_fontface font of labels -#' @param show_network show underlying spatial network -#' @param spatial_network_name name of spatial network to use -#' @param network_color color of spatial network -#' @param network_alpha alpha of spatial network -#' @param show_grid show spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param grid_color color of spatial grid -#' @param show_other_cells display not selected cells -#' @param other_cell_color color of not selected cells -#' @param other_point_size point size of not selected cells -#' @param other_cells_alpha alpha of not selected cells -#' @param coord_fix_ratio fix ratio between x and y-axis (default = 1) -#' @param title title of plot -#' @param show_legend show legend -#' @param legend_text size of legend text -#' @param legend_symbol_size size of legend symbols -#' @param background_color color of plot background -#' @param vor_border_color border color for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparency of voronoi 'cells' -#' @param theme_param list of additional params passed to `ggplot2::theme()` -#' @details coord_fix_ratio: set to NULL to use default ggplot parameters -#' @returns ggplot -#' @export -spatPlot2D <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - group_by = NULL, - group_by_subset = NULL, - spat_loc_name = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - spat_enr_names = NULL, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - point_shape = c("border", "no_border", "voronoi"), - point_size = 3, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - show_cluster_center = FALSE, - show_center_label = FALSE, - center_point_size = 4, - center_point_border_col = "black", - center_point_border_stroke = 0.1, - label_size = 4, - label_fontface = "bold", - show_network = FALSE, - spatial_network_name = "Delaunay_network", - network_color = NULL, - network_alpha = 1, - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - grid_color = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - other_cells_alpha = 0.1, - coord_fix_ratio = 1, - title = NULL, - show_legend = TRUE, - legend_text = 10, - legend_symbol_size = 2, - background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - theme_param = list(), - default_save_name = "spatPlot2D") { - checkmate::assert_class(gobject, "giotto") - - # deprecation message - if (!is.null(largeImage_name)) { - deprecate_warn( - when = "0.2.0", - what = "spatPlot2D(largeImage_name)", - details = c( - "Use `image_name` argument instead for all images to plot." - ) - ) - image_name <- c(image_name, largeImage_name) - } - - # create args list needed for each call to .spatPlot2D_single() - # 1. - grab all params available - # 2. - subset to those needed - spp_params <- get_args_list(keep = c( - # [gobject params] - "gobject", "spat_unit", "feat_type", - # [image params] - "show_image", "gimage", "image_name", - # [spatlocs params] - "spat_loc_name", "sdimx", "sdimy", - # [access spatial enrichments] - "spat_enr_names", - # [point aes] - "cell_color", "color_as_factor", "cell_color_code", - "cell_color_gradient", - "gradient_midpoint", "gradient_style", "gradient_limits", - "point_shape", "point_size", "point_alpha", "point_border_col", - "point_border_stroke", - # [select cell params] - "select_cell_groups", "select_cells", - # [voronoi-point params] - "vor_border_color", "vor_max_radius", "vor_alpha", - # [others aes] - "show_other_cells", "other_cell_color", "other_point_size", - "other_cells_alpha", - # [cluster aes] - "show_cluster_center", "show_center_label", "center_point_size", - "center_point_border_col", "center_point_border_stroke", - # [label aes] - "label_size", "label_fontface", - # [network aes] - "show_network", "spatial_network_name", "network_color", - "network_alpha", - # [grid aes] - "show_grid", "spatial_grid_name", "grid_color", - # [figure params] - "coord_fix_ratio", "show_legend", "legend_text", - "legend_symbol_size", "background_color", "axis_text", - "axis_title", "title", - # [return params] - "show_plot", "return_plot", "save_plot", "save_param", - "default_save_name", - # [gg params] - "theme_param" - )) - - - ## check group_by - if (is.null(group_by)) { # ----------------------------------------------- # - - do.call(.spatPlot2D_single, args = spp_params) - } else { # -------------------------------------------------------------- # - - # setup for group_by - # params relevant for plotting that are updated in this section prior - # to the for loop MUST be updated in group_by static settings section - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - # ! update spat_unit & feat_type in static settings ! - - ## check metadata for valid group_by information - comb_metadata <- combineMetadata( - gobject = gobject, - spat_loc_name = spat_loc_name, - feat_type = feat_type, - spat_unit = spat_unit, - spat_enr_names = spat_enr_names - ) - possible_meta_groups <- colnames(comb_metadata) - - ## error if group_by col is not found - if (!group_by %in% possible_meta_groups) { - stop("group_by ", group_by, " was not found in pDataDT()") - } - - unique_groups <- unique(comb_metadata[[group_by]]) - - # subset unique_groups - # These unique_groups will be used to iterate through subsetting then - # plotting the giotto object multiple times. - if (!is.null(group_by_subset)) { - not_found <- group_by_subset[!group_by_subset %in% unique_groups] - if (length(not_found) > 0) { - message("the following subset was not found: ", not_found) - } - unique_groups <- unique_groups[unique_groups %in% group_by_subset] - } - - # create matching cell_color_code - if (is.null(cell_color_code)) { - if (is.character(cell_color)) { - if (cell_color %in% colnames(comb_metadata)) { - if (isTRUE(color_as_factor)) { - number_colors <- length( - unique(comb_metadata[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - names(cell_color_code) <- unique( - comb_metadata[[cell_color]]) - cell_color_code <- cell_color_code - } - } - } - } - # ! update cell_color_code in static settings ! - - - - ## plotting ## - savelist <- list() - - # group_by static settings # - # update these params - spp_params$spat_unit <- spat_unit - spp_params$feat_type <- feat_type - spp_params$cell_color_code <- cell_color_code - # apply group_by specific defaults - spp_params$show_plot <- FALSE - spp_params$return_plot <- TRUE - spp_params$save_plot <- FALSE - spp_params$save_param <- list() - spp_params$default_save_name <- "spatPlot2D" - - - for (group_id in seq_along(unique_groups)) { - group <- unique_groups[group_id] - - subset_cell_IDs <- comb_metadata[get(group_by) == group - ][["cell_ID"]] - spp_params$gobject <- subsetGiotto( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - cell_ids = subset_cell_IDs, - verbose = FALSE - ) - - # use a different image per group if there are the same - # number of names provided as there are groups - # Otherwise, use the same image (or NULL) for all groups (default) - if (length(unique_groups) == length(image_name)) { - spp_params$image_name <- image_name[group_id] - } - - pl <- do.call(.spatPlot2D_single, args = spp_params) - - savelist[[group_id]] <- pl - } - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, - rel_widths = cow_rel_w, - align = cow_align - ) - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - return_plot = return_plot, - show_plot = show_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) - } # --------------------------------------------------------------------- # -} - - - - -#' @title spatPlot -#' @name spatPlot -#' @description Visualize cells according to spatial coordinates -#' @param \dots spatPLot(...) passes to spatPlot2D -#' @return ggplot (2D), plotly (3D) -#' @family spatial visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatPlot(g, show_image = TRUE, image_name = "image") -#' -#' # the more specific spatPlot2D with networks shown -#' spatPlot2D(g, show_image = TRUE, image_name = "image", show_network = TRUE) -#' -#' # plotting of some cell metadata (number of different features detected) -#' spatPlot2D(g, -#' show_image = TRUE, -#' image_name = "image", -#' cell_color = "nr_feats", -#' color_as_factor = FALSE, -#' gradient_style = "sequential" -#' ) -#' -#' -#' # load another dataset with 3D data -#' starmap <- GiottoData::loadGiottoMini("starmap", verbose = FALSE) -#' -#' # default is to rescale plot as a 3D cube -#' spatPlot3D(starmap, cell_color = "leiden_clus") -#' # real scaling -#' spatPlot3D(g, cell_color = "leiden_clus", axis_scale = "real") -#' @export -#' @seealso \code{\link{spatPlot3D}} -spatPlot <- function(...) { - spatPlot2D(...) -} - - - - - - - - -## ** spatial deconvolution plotting #### - - -#' @title spatDeconvPlot -#' @name spatDeconvPlot -#' @description Visualize cell type enrichment / deconvolution results -#' in a scatterpie -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @param deconv_name name of deconvolution results to use -#' @param show_image show a tissue background image -#' @param gimage a giotto image -#' @param image_name name of a giotto image -#' @param largeImage_name name of a giottoLargeImage -#' @param spat_loc_name name of spatial locations -#' @param sdimx x-axis dimension name (default = 'sdimx') -#' @param sdimy y-axis dimension name (default = 'sdimy') -#' @param line_color color of line within pie charts -#' @param radius radios of pie charts -#' @param alpha alpha of pie charts -#' @param coord_fix_ratio fix ratio between x and y-axis -#' @param title title of plot -#' @param legend_text size of legend text -#' @param background_color color of plot background -#' @param title title for plot (default = deconv_name) -#' @param axis_text size of axis text -#' @param axis_title size of axis title -#' @param theme_param list of additional params passed to `ggplot2::theme()` -#' @returns ggplot -#' @export -spatDeconvPlot <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - deconv_name = "DWLS", - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - spat_loc_name = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - cell_color_code = NULL, - line_color = NA, - radius = 10, - alpha = 1, - legend_text = 8, - background_color = "white", - title = NULL, - axis_text = 8, - axis_title = 8, - coord_fix_ratio = 1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - theme_param = list(), - default_save_name = "spatDeconvPlot") { - # check for installed packages - package_check(pkg_name = "scatterpie", repository = "CRAN") - - # deprecation message - if (!is.null(largeImage_name)) { - deprecate_warn( - when = "0.2.0", - what = "spatDeconvPlot(largeImage_name)", - details = c( - "Use `image_name` argument instead for all images to plot." - ) - ) - image_name <- c(image_name, largeImage_name) - } - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - ## get giotto image(s) ## - if (isTRUE(show_image) && is.null(gimage)) { - gimage <- getGiottoImage( - gobject = gobject, - name = image_name - ) - } - - - ## get spatial cell locations - spatial_locations <- get_spatial_locations( - gobject = gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - output = "data.table" - ) - if (is.null(spatial_locations)) { - return(NULL) - } - - ## deconvolution results - spatial_enrichment <- get_spatial_enrichment( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - enrichm_name = deconv_name, - output = "data.table" - ) - - - - - ### create 2D plot with ggplot ### - - pl <- ggplot2::ggplot() - pl <- pl + ggplot2::theme_bw() - - ## plot image ## - if (isTRUE(show_image) && !is.null(gimage)) { - pl <- plot_spat_image_layer_ggplot( - gg_obj = pl, - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - gimage = gimage - ) - } - - - ## plot scatterpie ## - pl <- plot_spat_scatterpie_layer_ggplot( - ggobject = pl, - instrs = instructions(gobject), - sdimx = sdimx, - sdimy = sdimy, - spatial_locations = spatial_locations, - spatial_enrichment = spatial_enrichment, - radius = radius, - color = line_color, - alpha = alpha, - cell_color_code = cell_color_code - ) - - - ## adjust theme setting - gg_theme_args <- c( - theme_param, - legend_text = legend_text, - axis_title = axis_title, - axis_text = axis_text, - background_color = background_color - ) - pl <- pl + do.call(.gg_theme, args = gg_theme_args) - - # fix coord ratio - if (!is.null(coord_fix_ratio)) { - pl <- pl + ggplot2::coord_fixed(ratio = coord_fix_ratio) - } - - # provide x, y and plot titles - if (is.null(title)) title <- deconv_name - pl <- pl + - ggplot2::labs(x = "x coordinates", y = "y coordinates", title = title) - - - # print, return and save parameters - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - ## print plot - if (show_plot == TRUE) { - print(pl) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", c(list( - gobject = gobject, - plot_object = pl, - default_save_name = default_save_name - ), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(pl) - } -} - - - - - -# ** dim reduction plotting #### - - - - -# Create a single 2D dimplot. This is looped through by dimPlot2D() if needed. -#' @noRd -#' @keywords internal -.dimPlot2D_single <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = NULL, - dim1_to_use = 1, - dim2_to_use = 2, - spat_enr_names = NULL, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - center_point_border_col = "black", - center_point_border_stroke = 0.1, - label_size = 4, - label_fontface = "bold", - edge_alpha = NULL, - point_shape = c("border", "no_border"), - point_size = 1, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - title = NULL, - show_legend = TRUE, - legend_text = 8, - legend_symbol_size = 1, - background_color = "white", - axis_text = 8, - axis_title = 8, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "dimPlot2D_single") { - checkmate::assert_class(gobject, "giotto") - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # specify dim_reduction_name according to provided feat_type - if (!is.null(dim_reduction_to_use)) { - if (is.null(dim_reduction_name)) { - if (feat_type == "rna") { - dim_reduction_name <- dim_reduction_to_use - } else { - dim_reduction_name <- paste0(feat_type, ".", - dim_reduction_to_use) - } - } - } - - ## point shape ## - point_shape <- match.arg(point_shape, c("border", "no_border")) - - ## dimension reduction ## - # test if dimension reduction was performed - - dim_red_names <- list_dim_reductions_names( - gobject = gobject, data_type = "cells", - spat_unit = spat_unit, feat_type = feat_type, - dim_type = dim_reduction_to_use - ) - - if (!dim_reduction_name %in% dim_red_names) { - stop("\n dimension reduction: ", dim_reduction_to_use, - " or dimension reduction name: ", dim_reduction_name, - " is not available \n") - } - - - dim_dfr <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use)] - - - dim_names <- colnames(dim_dfr) - - # data.table variables - cell_ID <- NULL - - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, cell_ID := as.character(rownames(dim_dfr))] - - ## annotated cell metadata - cell_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_enr_names = spat_enr_names, - spat_loc_name = NULL - ) - - cell_metadata[, cell_ID := as.character(cell_ID)] - - annotated_DT <- data.table::merge.data.table(cell_metadata, - dim_DT, by = "cell_ID") - - - # create input for network - if (show_NN_network == TRUE) { - # nn_network - selected_nn_network <- get_NearestNetwork( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - output = "igraph" - ) - - network_DT <- data.table::as.data.table( - igraph::as_data_frame(selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- merge(network_DT, dim_DT, by.x = "from", - by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = from_dim_names) - - annotated_network_DT <- merge(annotated_network_DT, dim_DT, - by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = to_dim_names) - } - - # add % variance information if reduction is PCA - if (dim_reduction_to_use == "pca") { - pcaObj <- get_dimReduction(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "dimObj" - ) - eigenvalues <- pcaObj@misc$eigenvalues - - if (!is.null(eigenvalues)) { - total <- sum(eigenvalues) - var_expl_vec <- (eigenvalues / total) * 100 - dim1_x_variance <- var_expl_vec[dim1_to_use] - dim2_y_variance <- var_expl_vec[dim2_to_use] - } - } - - - - ## create subsets if needed - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - if (is.null(cell_color)) { - stop("\n selection of cells is based on cell_color paramter, - which is a metadata column \n") - } - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% - select_cells] - annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% - select_cells] - - if (show_NN_network == TRUE) { - annotated_network_DT <- annotated_network_DT[ - annotated_network_DT$to %in% select_cells & - annotated_network_DT$from %in% select_cells] - } - - # if specific cells are selected - annotated_DT <- annotated_DT_selected - } - - ## if no subsets are required - if (is.null(select_cells) & is.null(select_cell_groups)) { - annotated_DT_selected <- annotated_DT - annotated_DT_other <- NULL - } - - - - pl <- ggplot2::ggplot() - pl <- pl + ggplot2::theme_classic() - - ## add network layer - if (show_NN_network == TRUE) { - pl <- plot_network_layer_ggplot( - ggobject = pl, - instrs = instructions(gobject), - annotated_network_DT = annotated_network_DT, - edge_alpha = edge_alpha, - show_legend = show_legend - ) - } - - # return(list(pl, annotated_DT_selected, annotated_DT_other)) - - if (point_shape == "border") { - ## add point layer - pl <- plot_point_layer_ggplot( - ggobject = pl, - instrs = instructions(gobject), - annotated_DT_selected = annotated_DT_selected, - annotated_DT_other = annotated_DT_other, - cell_color = cell_color, - color_as_factor = color_as_factor, - cell_color_code = cell_color_code, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - center_point_border_col = center_point_border_col, - center_point_border_stroke = center_point_border_stroke, - label_size = label_size, - label_fontface = label_fontface, - edge_alpha = edge_alpha, - point_size = point_size, - point_alpha = point_alpha, - point_border_col = point_border_col, - point_border_stroke = point_border_stroke, - show_legend = show_legend - ) - } else if (point_shape == "no_border") { - pl <- plot_point_layer_ggplot_noFILL( - ggobject = pl, - instrs = instructions(gobject), - annotated_DT_selected = annotated_DT_selected, - annotated_DT_other = annotated_DT_other, - cell_color = cell_color, - color_as_factor = color_as_factor, - cell_color_code = cell_color_code, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - label_size = label_size, - label_fontface = label_fontface, - edge_alpha = edge_alpha, - point_size = point_size, - point_alpha = point_alpha, - show_legend = show_legend - ) - } - - - ## add % variance explained to names of plot for PCA ## - if (dim_reduction_to_use == "pca") { - if (!is.null(eigenvalues)) { - x_name <- paste0("pca", "-", dim_names[1]) - y_name <- paste0("pca", "-", dim_names[2]) - - # provide x, y and plot titles - x_title <- sprintf("%s explains %.02f%% of variance", - x_name, var_expl_vec[dim1_to_use]) - y_title <- sprintf("%s explains %.02f%% of variance", - y_name, var_expl_vec[dim2_to_use]) - - if (is.null(title)) title <- cell_color - pl <- pl + ggplot2::labs(x = x_title, y = y_title, title = title) - } - } else { - # provide x, y and plot titles - x_title <- paste0(dim_reduction_to_use, "-", dim_names[1]) - y_title <- paste0(dim_reduction_to_use, "-", dim_names[2]) - - if (is.null(title)) title <- cell_color - pl <- pl + ggplot2::labs(x = x_title, y = y_title, title = title) - } - - ## adjust titles - pl <- pl + ggplot2::theme( - plot.title = element_text(hjust = 0.5), - legend.title = element_blank(), - legend.text = element_text(size = legend_text), - axis.text = element_text(size = axis_text), - axis.title = element_text(size = axis_title), - panel.grid = element_blank(), - panel.background = element_rect(fill = background_color) - ) - - ## change symbol size of legend - if (color_as_factor == TRUE) { - if (point_shape == "border") { - pl <- pl + guides(fill = guide_legend( - override.aes = list(size = legend_symbol_size))) - } else if (point_shape == "no_border") { - pl <- pl + guides(color = guide_legend( - override.aes = list(size = legend_symbol_size))) - } - } - - return(plot_output_handler( - gobject = gobject, - plot_object = pl, - save_plot = save_plot, - return_plot = return_plot, - show_plot = show_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - - - -#' @rdname dimPlot -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_dimred_params -#' @inheritParams plot_nn_net_params -#' @inheritParams plot_spatenr_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_params -#' @returns ggplot -#' @family reduced dimension visualizations -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' dimPlot2D(g) -#' @export -dimPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - group_by = NULL, - group_by_subset = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = NULL, - dim1_to_use = 1, - dim2_to_use = 2, - spat_enr_names = NULL, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - center_point_border_col = "black", - center_point_border_stroke = 0.1, - label_size = 4, - label_fontface = "bold", - edge_alpha = NULL, - point_shape = c("border", "no_border"), - point_size = 1, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - title = NULL, - show_legend = TRUE, - legend_text = 10, - legend_symbol_size = 2, - background_color = "white", - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "dimPlot2D") { - # arg_list <- c(as.list(environment())) # get all args as list - checkmate::assert_class(gobject, "giotto") - - ## check group_by - if (is.null(group_by)) { - .dimPlot2D_single( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - spat_enr_names = spat_enr_names, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - cell_color = cell_color, - color_as_factor = color_as_factor, - cell_color_code = cell_color_code, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - center_point_border_col = center_point_border_col, - center_point_border_stroke = center_point_border_stroke, - label_size = label_size, - label_fontface = label_fontface, - edge_alpha = edge_alpha, - point_shape = point_shape, - point_size = point_size, - point_alpha = point_alpha, - point_border_col = point_border_col, - point_border_stroke = point_border_stroke, - title = title, - show_legend = show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = background_color, - axis_text = axis_text, - axis_title = axis_title, - show_plot = show_plot, - return_plot = return_plot, - save_plot = save_plot, - save_param = save_param, - default_save_name = default_save_name - ) - } else { - comb_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_enr_names = spat_enr_names, - spat_loc_name = NULL - ) - possible_meta_groups <- colnames(comb_metadata) - - ## check if group_by is found - if (!group_by %in% possible_meta_groups) { - stop("group_by ", group_by, " was not found in pDataDT()") - } - - unique_groups <- unique(comb_metadata[[group_by]]) - - # subset unique_groups - if (!is.null(group_by_subset)) { - not_found <- group_by_subset[!group_by_subset %in% unique_groups] - - if (length(not_found) > 0) { - message("the following subset was not found: ", not_found) - } - unique_groups <- unique_groups[unique_groups %in% group_by_subset] - } - - - # create matching cell_color_code for groupby factors - # best done prior to the following groupby subsetGiotto() operation - if (is.null(cell_color_code)) { # TODO add getColors() support - if (is.character(cell_color)) { - if (cell_color %in% colnames(comb_metadata)) { - if (color_as_factor == TRUE) { - number_colors <- length( - unique(comb_metadata[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - names(cell_color_code) <- unique( - comb_metadata[[cell_color]]) - cell_color_code <- cell_color_code - } - } - } - } - - ## plotting ## - savelist <- list() - - - for (group_id in seq_len(length(unique_groups))) { - group <- unique_groups[group_id] - - subset_cell_IDs <- comb_metadata[ - get(group_by) == group][["cell_ID"]] - temp_gobject <- subsetGiotto( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - cell_ids = subset_cell_IDs - ) - - pl <- .dimPlot2D_single( - gobject = temp_gobject, - spat_unit = spat_unit, - feat_type = feat_type, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - spat_enr_names = spat_enr_names, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - cell_color = cell_color, - cell_color_code = cell_color_code, - color_as_factor = color_as_factor, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - center_point_border_col = center_point_border_col, - center_point_border_stroke = center_point_border_stroke, - label_size = label_size, - label_fontface = label_fontface, - edge_alpha = edge_alpha, - point_shape = point_shape, - point_size = point_size, - point_alpha = point_alpha, - point_border_col = point_border_col, - point_border_stroke = point_border_stroke, - title = group, - show_legend = show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = background_color, - axis_text = axis_text, - axis_title = axis_title, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE, - save_param = list(), - default_save_name = default_save_name - ) - - - savelist[[group_id]] <- pl - } - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, - rel_widths = cow_rel_w, - align = cow_align - ) - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - return_plot = return_plot, - show_plot = show_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) - } -} - - - - - -#' @title Plot dimension reduction -#' @name dimPlot -#' @param \dots dimPlot(...) passes to dimPlot2D() -#' @description Visualize cells according to dimension reduction coordinates -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' dimPlot(g) -#' @export -dimPlot <- function(...) { - dimPlot2D(...) -} - - - - - - -#' @title plotUMAP_2D -#' @name plotUMAP_2D -#' @description Short wrapper for UMAP visualization -#' @inheritParams data_access_params -#' @param dim_reduction_name name of UMAP -#' @param default_save_name default save name of UMAP plot -#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters, see \code{\link{dimPlot2D}}. -#' For 3D plots see \code{\link{plotUMAP_3D}} -#' @family reduced dimension visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotUMAP_2D(g) -#' @export -plotUMAP_2D <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "UMAP_2D", - ...) { - checkmate::assert_class(gobject, "giotto") - - dimPlot2D( - gobject = gobject, - dim_reduction_to_use = "umap", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - -#' @title plotUMAP -#' @name plotUMAP -#' @description Short wrapper for UMAP visualization -#' @inheritParams data_access_params -#' @param dim_reduction_name name of UMAP -#' @param default_save_name default save name of UMAP plot -#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @family reduced dimension visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotUMAP(g) -#' -#' @export -plotUMAP <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "UMAP", - ...) { - checkmate::assert_class(gobject, "giotto") - - dimPlot2D( - gobject = gobject, - dim_reduction_to_use = "umap", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - - - - -#' @title plotTSNE_2D -#' @name plotTSNE_2D -#' @description Short wrapper for tSNE visualization -#' @inheritParams data_access_params -#' @param dim_reduction_name name of TSNE -#' @param default_save_name default save name of TSNE plot -#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters, see \code{\link{dimPlot2D}}. -#' For 3D plots see \code{\link{plotTSNE_3D}} -#' @family reduced dimension visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotTSNE_2D(g) -#' -#' @export -plotTSNE_2D <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "tSNE_2D", - ...) { - checkmate::assert_class(gobject, "giotto") - - dimPlot2D( - gobject = gobject, - dim_reduction_to_use = "tsne", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - -#' @title plotTSNE -#' @name plotTSNE -#' @description Short wrapper for tSNE visualization -#' @inheritParams data_access_params -#' @param dim_reduction_name name of TSNE -#' @param default_save_name default save name of TSNE plot -#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters, see \code{\link{dimPlot2D}}. -#' For 3D plots see \code{\link{plotTSNE_3D}} -#' @family reduced dimension visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotTSNE(g) -#' -#' @export -plotTSNE <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "tSNE", - ...) { - checkmate::assert_class(gobject, "giotto") - - dimPlot2D( - gobject = gobject, - dim_reduction_to_use = "tsne", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - - -#' @title plotPCA_2D -#' @name plotPCA_2D -#' @description Short wrapper for PCA visualization -#' @inheritParams data_access_params -#' @param dim_reduction_name name of PCA -#' @param default_save_name default save name of PCA plot -#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters, see \code{\link{dimPlot2D}}. -#' For 3D plots see \code{\link{plotPCA_3D}} -#' @family reduced dimension visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotPCA_2D(g) -#' -#' @export -plotPCA_2D <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "PCA_2D", - ...) { - checkmate::assert_class(gobject, "giotto") - - dimPlot2D( - gobject = gobject, - dim_reduction_to_use = "pca", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - - -#' @title plotPCA -#' @name plotPCA -#' @description Short wrapper for PCA visualization -#' @inheritParams data_access_params -#' @param dim_reduction_name name of PCA -#' @param default_save_name default save name of PCA plot -#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters, see \code{\link{dimPlot2D}}. -#' For 3D plots see \code{\link{plotPCA_3D}} -#' @family reduced dimension visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotPCA(g) -#' -#' @export -plotPCA <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "PCA", - ...) { - checkmate::assert_class(gobject, "giotto") - - dimPlot2D( - gobject = gobject, - dim_reduction_to_use = "pca", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - - - - - - - - - - - -## ** spatial and dim reduction plotting #### - - -#' @title spatDimPlot -#' @name spatDimPlot -#' @description Visualize cells according to spatial AND dimension reduction -#' coordinates 2D -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_spatenr_params -#' @inheritParams plot_dimred_params -#' @inheritParams plot_nn_net_params -#' @inheritParams plot_spatnet_params -#' @inheritParams plot_image_params -#' @inheritParams plot_params -#' @param largeImage_name deprecated -#' @param spat_loc_name name of spatial locations -#' @param plot_alignment direction to align plot -#' @param sdimx = spatial dimension to use on x-axis -#' @param sdimy = spatial dimension to use on y-axis -#' @param spat_point_shape shape of points (border, no_border or voronoi) -#' @param spat_point_size size of spatial points -#' @param spat_point_alpha transparancy of spatial points -#' @param spat_point_border_col border color of spatial points -#' @param spat_point_border_stroke border stroke of spatial points -#' @param dim_show_cluster_center show the center of each cluster -#' @param dim_show_center_label provide a label for each cluster -#' @param dim_center_point_size size of the center point -#' @param dim_center_point_border_col border color of center point -#' @param dim_center_point_border_stroke stroke size of center point -#' @param dim_label_size size of the center label -#' @param dim_label_fontface font of the center label -#' @param spat_show_cluster_center show the center of each cluster -#' @param spat_show_center_label provide a label for each cluster -#' @param spat_center_point_size size of the center point -#' @param spat_center_point_border_col border color of spatial center points -#' @param spat_center_point_border_stroke border strike size of spatial center points -#' @param spat_label_size size of the center label -#' @param spat_label_fontface font of the center label -#' @param show_spatial_grid show spatial grid -#' @param spat_grid_name name of spatial grid to use -#' @param spat_grid_color color of spatial grid -#' @param show_other_cells display not selected cells -#' @param other_cell_color color of not selected cells -#' @param dim_other_point_size size of not selected dim cells -#' @param spat_other_point_size size of not selected spat cells -#' @param spat_other_cells_alpha alpha of not selected spat cells -#' @param dim_show_legend show legend of dimension reduction plot -#' @param spat_show_legend show legend of spatial plot -#' @param dim_background_color background color of points in dim. reduction space -#' @param spat_background_color background color of spatial points -#' @param vor_border_color border color for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparency of voronoi 'cells' -#' @details Description of parameters. -#' @family spatial and dimension reduction visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatDimPlot2D(g) -#' -#' @export -#' @seealso \code{\link{spatDimPlot3D}} -spatDimPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - spat_loc_name = NULL, - plot_alignment = c("vertical", "horizontal"), - dim_reduction_to_use = "umap", - dim_reduction_name = NULL, - dim1_to_use = 1, - dim2_to_use = 2, - sdimx = "sdimx", - sdimy = "sdimy", - spat_enr_names = NULL, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - dim_point_shape = c("border", "no_border"), - dim_point_size = 1, - dim_point_alpha = 1, - dim_point_border_col = "black", - dim_point_border_stroke = 0.1, - spat_point_shape = c("border", "no_border", "voronoi"), - spat_point_size = 1, - spat_point_alpha = 1, - spat_point_border_col = "black", - spat_point_border_stroke = 0.1, - dim_show_cluster_center = FALSE, - dim_show_center_label = TRUE, - dim_center_point_size = 4, - dim_center_point_border_col = "black", - dim_center_point_border_stroke = 0.1, - dim_label_size = 4, - dim_label_fontface = "bold", - spat_show_cluster_center = FALSE, - spat_show_center_label = FALSE, - spat_center_point_size = 4, - spat_center_point_border_col = "blue", - spat_center_point_border_stroke = 0.1, - spat_label_size = 4, - spat_label_fontface = "bold", - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - nn_network_alpha = 0.05, - show_spatial_network = FALSE, - spat_network_name = "Delaunay_network", - spat_network_color = "blue", - spat_network_alpha = 0.5, - show_spatial_grid = FALSE, - spat_grid_name = "spatial_grid", - spat_grid_color = "blue", - show_other_cells = TRUE, - other_cell_color = "lightgrey", - dim_other_point_size = 1, - spat_other_point_size = 1, - spat_other_cells_alpha = 0.5, - dim_show_legend = FALSE, - spat_show_legend = FALSE, - legend_text = 10, - legend_symbol_size = 2, - dim_background_color = "white", - spat_background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - axis_text = 8, - axis_title = 8, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatDimPlot2D") { - - # deprecation message - if (!is.null(largeImage_name)) { - deprecate_warn( - when = "0.2.0", - what = "spatDimPlot2D(largeImage_name)", - details = c( - "Use `image_name` argument instead for all images to plot." - ) - ) - image_name <- c(image_name, largeImage_name) - } - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - plot_alignment <- match.arg(plot_alignment, - choices = c("vertical", "horizontal")) - - - # create matching cell_color_code - if (is.null(cell_color_code)) { - if (is.character(cell_color)) { - cell_metadata <- pDataDT(gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - if (cell_color %in% colnames(cell_metadata)) { - if (color_as_factor == TRUE) { - number_colors <- length( - unique(cell_metadata[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - names(cell_color_code) <- unique( - cell_metadata[[cell_color]]) - cell_color_code <- cell_color_code - } - } - } - } - - # dimension reduction plot - dmpl <- dimPlot2D( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - group_by = NULL, - group_by_subset = NULL, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - spat_enr_names = spat_enr_names, - cell_color = cell_color, - color_as_factor = color_as_factor, - cell_color_code = cell_color_code, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - point_shape = dim_point_shape, - point_size = dim_point_size, - point_alpha = dim_point_alpha, - point_border_col = dim_point_border_col, - point_border_stroke = dim_point_border_stroke, - show_cluster_center = dim_show_cluster_center, - show_center_label = dim_show_center_label, - center_point_size = dim_center_point_size, - center_point_border_col = dim_center_point_border_col, - center_point_border_stroke = dim_center_point_border_stroke, - label_size = dim_label_size, - label_fontface = dim_label_fontface, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - edge_alpha = nn_network_alpha, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = dim_other_point_size, - show_legend = dim_show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = dim_background_color, - axis_text = axis_text, - axis_title = axis_title, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE - ) - - # spatial plot - spl <- spatPlot2D( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - show_image = show_image, - gimage = gimage, - image_name = image_name, - spat_loc_name = spat_loc_name, - group_by = NULL, - group_by_subset = NULL, - sdimx = sdimx, - sdimy = sdimy, - spat_enr_names = spat_enr_names, - cell_color = cell_color, - cell_color_code = cell_color_code, - color_as_factor = color_as_factor, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - point_shape = spat_point_shape, - point_size = spat_point_size, - point_alpha = spat_point_alpha, - point_border_col = spat_point_border_col, - point_border_stroke = spat_point_border_stroke, - show_cluster_center = spat_show_cluster_center, - show_center_label = spat_show_center_label, - center_point_size = spat_center_point_size, - center_point_border_col = spat_center_point_border_col, - center_point_border_stroke = spat_center_point_border_stroke, - label_size = spat_label_size, - label_fontface = spat_label_fontface, - show_network = show_spatial_network, - spatial_network_name = spat_network_name, - network_color = spat_network_color, - network_alpha = spat_network_alpha, - show_grid = show_spatial_grid, - spatial_grid_name = spat_grid_name, - grid_color = spat_grid_color, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = spat_other_point_size, - other_cells_alpha = spat_other_cells_alpha, - coord_fix_ratio = 1, - title = "", - show_legend = spat_show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = spat_background_color, - vor_border_color = vor_border_color, - vor_max_radius = vor_max_radius, - vor_alpha = vor_alpha, - axis_text = axis_text, - axis_title = axis_title, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE - ) - - - if (plot_alignment == "vertical") { - ncol <- 1 - nrow <- 2 - combo_plot <- cowplot::plot_grid(dmpl, spl, ncol = ncol, - nrow = nrow, rel_heights = c(1), - rel_widths = c(1), align = "v") - } else { - ncol <- 2 - nrow <- 1 - combo_plot <- cowplot::plot_grid(dmpl, spl, ncol = ncol, - nrow = nrow, rel_heights = c(1), - rel_widths = c(1), align = "h") - } - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - return_plot = return_plot, - show_plot = show_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - - - -#' @rdname spatDimPlot -#' @param \dots spatDimPlot(...) passes to spatDimPlot2D() -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatDimPlot(g) -#' -#' @export -spatDimPlot <- function(gobject, ...) { - spatDimPlot2D(gobject, ...) -} - - - -## ** spatial feature plotting #### - -#' @title spatFeatPlot2D_single -#' @name spatFeatPlot2D_single -#' @description Visualize cells and feature expression according to -#' spatial coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_image_params -#' @inheritParams plot_params -#' @param largeImage_name deprecated -#' @param spat_loc_name name of spatial locations -#' @param sdimx x-axis dimension name (default = 'sdimx') -#' @param sdimy y-axis dimension name (default = 'sdimy') -#' @param spat_enr_names names of spatial enrichment results to include -#' @param expression_values gene expression values to use -#' @param feats features to show -#' @param order order points according to feature expression -#' @param show_network show underlying spatial network -#' @param network_color color of spatial network -#' @param edge_alpha alpha of spatial network -#' @param spatial_network_name name of spatial network to use -#' @param show_grid show spatial grid -#' @param grid_color color of spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param midpoint expression midpoint -#' @param scale_alpha_with_expression scale expression with -#' ggplot alpha parameter -#' @param point_shape shape of points (border, no_border or voronoi) -#' @param point_size size of point (cell) -#' @param point_alpha transparancy of points -#' @param point_border_col color of border around points -#' @param point_border_stroke stroke size of border around points -#' @param coord_fix_ratio fix ratio between x and y-axis (default = 1) -#' @param vor_border_color border colorr for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparency of voronoi 'cells' -#' @param theme_param list of additional params passed to `ggplot2::theme()` -#' @details Description of parameters. -#' @family spatial feature expression visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatFeatPlot2D_single(g, feats = c("Gna12", "Ccnd2", "Btbd17")) -#' -#' @export -#' @seealso \code{\link{spatFeatPlot3D}} -spatFeatPlot2D_single <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - spat_loc_name = "raw", - sdimx = "sdimx", - sdimy = "sdimy", - spat_enr_names = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats, - order = TRUE, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - show_network = FALSE, - network_color = NULL, - edge_alpha = 0.5, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - midpoint = 0, - scale_alpha_with_expression = FALSE, - point_shape = c("border", "no_border", "voronoi"), - point_size = 1, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - coord_fix_ratio = 1, - show_legend = TRUE, - legend_text = 8, - background_color = "white", - vor_border_color = "white", - vor_alpha = 1, - vor_max_radius = 200, - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - theme_param = list(), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatFeatPlot2D_single" -) { - # data.table variables - cell_ID <- NULL - - # deprecation message - if (!is.null(largeImage_name)) { - deprecate_warn( - when = "0.2.0", - what = "spatFeatPlot2D_single(largeImage_name)", - details = c( - "Use `image_name` argument instead for all images to plot." - ) - ) - image_name <- c(image_name, largeImage_name) - } - - # print, return and save parameters - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - ## get giotto image(s) ## - if (isTRUE(show_image) && is.null(gimage)) { - gimage <- getGiottoImage( - gobject = gobject, - name = image_name - ) - } - - # point shape - point_shape <- match.arg(point_shape, - choices = c("border", "no_border", "voronoi")) - - # expression values - values <- match.arg(expression_values, - unique(c("normalized", "scaled", "custom", - expression_values))) - expr_values <- get_expression_values( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - values = values, - output = "matrix" - ) - - # only keep feats that are in the dataset - selected_feats <- feats - selected_feats <- selected_feats[selected_feats %in% rownames(expr_values)] - - - # get selected feat expression values in data.table format - if (length(selected_feats) == 1) { - subset_expr_data <- expr_values[rownames(expr_values) %in% - selected_feats, ] - t_sub_expr_data_DT <- data.table::data.table( - "selected_feat" = subset_expr_data, - "cell_ID" = colnames(expr_values)) - data.table::setnames(t_sub_expr_data_DT, "selected_feat", - selected_feats) - } else { - subset_expr_data <- expr_values[rownames(expr_values) %in% - selected_feats, ] - t_sub_expr_data <- t_flex(subset_expr_data) - t_sub_expr_data_DT <- data.table::as.data.table( - as.matrix(t_sub_expr_data)) - t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] - } - - - ## extract cell locations - if (is.null(spat_loc_name)) { - if (!is.null(slot(gobject, "spatial_locs"))) { - spat_loc_name <- list_spatial_locations_names( - gobject, spat_unit = spat_unit)[[1]] - } else { - spat_loc_name <- NULL - warning("No spatial locations have been found") - return(NULL) - } - } - - cell_locations <- get_spatial_locations( - gobject = gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - output = "data.table", - copy_obj = TRUE - ) - if (is.null(cell_locations)) { - return(NULL) - } - - ## extract spatial network - if (show_network == TRUE) { - spatial_network <- get_spatialNetwork( - gobject = gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - ## extract spatial grid - if (show_grid == TRUE) { - spatial_grid <- get_spatialGrid( - gobject, - spat_unit = spat_unit, - feat_type = feat_type, - name = spatial_grid_name - ) - } else { - spatial_grid <- NULL - } - - ## extract cell metadata - cell_metadata <- try( - expr = combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - spat_enr_names = spat_enr_names - ), - silent = TRUE - ) - - if (inherits(cell_metadata, "try-error")) { - cell_locations_metadata <- cell_locations - } else if (nrow(cell_metadata) == 0) { - cell_locations_metadata <- cell_locations - } else { - cell_locations_metadata <- cell_metadata - } - - cell_locations_metadata_feats <- merge( - cell_locations_metadata, - t_sub_expr_data_DT, - by = "cell_ID" - ) - - - ## plotting ## - savelist <- list() - - for (feat in selected_feats) { - # order spatial units (e.g. cell IDs) based on expression of feature - if (isTRUE(order)) { - cell_locations_metadata_feats <- cell_locations_metadata_feats[ - order(get(feat))] - } - - - pl <- ggplot2::ggplot() - pl <- pl + ggplot2::theme_classic() - - - ## plot image ## TODO - ## plot image ## - if (isTRUE(show_image) && !is.null(gimage)) { - pl <- plot_spat_image_layer_ggplot( - gg_obj = pl, - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - gimage = gimage - ) - } - - ## plot network or grid first if point_shape is border or no_border - ## point - if (point_shape %in% c("border", "no_border")) { - ## plot spatial network - if (!is.null(spatial_network) && isTRUE(show_network)) { - edge_alpha <- edge_alpha %null% 0.5 - network_color <- network_color %null% "red" - xbegin <- paste0(sdimx, "_begin") - ybegin <- paste0(sdimy, "_begin") - xend <- paste0(sdimx, "_end") - yend <- paste0(sdimy, "_end") - pl <- pl + ggplot2::geom_segment( - data = spatial_network, - aes_string( - x = xbegin, - y = ybegin, - xend = xend, - yend = yend - ), - color = network_color, - size = 0.5, - alpha = edge_alpha - ) - } - - ## plot spatial grid - if (!is.null(spatial_grid) && isTRUE(show_grid)) { - if (is.null(grid_color)) grid_color <- "black" - - xmin <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimx), "_start") - ymin <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimy), "_start") - xmax <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimx), "_end") - ymax <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimy), "_end") - - pl <- pl + ggplot2::geom_rect( - data = spatial_grid, - aes_string( - xmin = xmin, - xmax = xmax, - ymin = ymin, - ymax = ymax - ), - color = grid_color, - fill = NA - ) - } - } - - - - ### plot cells ### - - ## set gradient limits if needed ## - if (!is.null(gradient_limits) & is.vector(gradient_limits) & - length(gradient_limits) == 2) { - lower_lim <- gradient_limits[[1]] - upper_lim <- gradient_limits[[2]] - numeric_data <- cell_locations_metadata_feats[[feat]] - limit_numeric_data <- ifelse(numeric_data > upper_lim, upper_lim, - ifelse(numeric_data < lower_lim, lower_lim, numeric_data) - ) - cell_locations_metadata_feats[[feat]] <- limit_numeric_data - } - - if (is.null(gradient_midpoint)) { - gradient_midpoint <- stats::median( - cell_locations_metadata_feats[[feat]]) - } - - - ## with border ## - if (point_shape == "border") { - if (scale_alpha_with_expression == TRUE) { - pl <- pl + ggplot2::geom_point( - data = cell_locations_metadata_feats, - aes_string2( - x = sdimx, - y = sdimy, - fill = feat, - alpha = feat - ), - shape = 21, - color = point_border_col, size = point_size, - stroke = point_border_stroke, - show.legend = show_legend - ) - } else { - pl <- pl + ggplot2::geom_point( - data = cell_locations_metadata_feats, - aes_string2( - x = sdimx, - y = sdimy, - fill = feat - ), - shape = 21, - color = point_border_col, - size = point_size, - stroke = point_border_stroke, - show.legend = show_legend, - alpha = point_alpha - ) - } - - - ## scale and labs ## - pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") - pl <- pl + set_default_color_continuous_cell( - colors = cell_color_gradient, - instrs = instructions(gobject), - midpoint = gradient_midpoint, - style = gradient_style, - guide = guide_colorbar(title = ""), - type = "fill" - ) - pl <- pl + ggplot2::labs(x = "coord x", y = "coord y", title = feat) - } - - - - ## no border ## - if (point_shape == "no_border") { - if (scale_alpha_with_expression == TRUE) { - pl <- pl + ggplot2::geom_point( - data = cell_locations_metadata_feats, - aes_string2( - x = sdimx, - y = sdimy, - color = feat, - alpha = feat - ), - shape = 19, - size = point_size, - show.legend = show_legend - ) - } else { - pl <- pl + ggplot2::geom_point( - data = cell_locations_metadata_feats, - aes_string2( - x = sdimx, - y = sdimy, - color = feat - ), - shape = 19, - size = point_size, - show.legend = show_legend, - alpha = point_alpha - ) - } - - - ## scale and labs ## - pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") - pl <- pl + set_default_color_continuous_cell( - colors = cell_color_gradient, - instrs = instructions(gobject), - midpoint = gradient_midpoint, - style = gradient_style, - guide = guide_colorbar(title = ""), - type = "color" - ) - pl <- pl + ggplot2::labs(x = "coord x", y = "coord y", title = feat) - } - - - ## voronoi ## - if (point_shape == "voronoi") { - if (scale_alpha_with_expression == TRUE) { - pl <- pl + ggforce::geom_voronoi_tile( - data = cell_locations_metadata_feats, - aes_string( - x = sdimx, y = sdimy, - group = "-1L", - fill = feat, alpha = feat - ), - colour = vor_border_color, - max.radius = vor_max_radius, - show.legend = show_legend - ) - } else { - pl <- pl + ggforce::geom_voronoi_tile( - data = cell_locations_metadata_feats, - aes_string( - x = sdimx, y = sdimy, - group = "-1L", - fill = feat - ), - colour = vor_border_color, - max.radius = vor_max_radius, - show.legend = show_legend, - alpha = vor_alpha - ) - } - - - ## plot spatial network - if (!is.null(spatial_network) & show_network == TRUE) { - if (is.null(network_color)) { - network_color <- "red" - } - xbegin <- paste0(sdimx, "_begin") - ybegin <- paste0(sdimy, "_begin") - xend <- paste0(sdimx, "_end") - yend <- paste0(sdimy, "_end") - pl <- pl + ggplot2::geom_segment( - data = spatial_network, aes_string( - x = xbegin, y = ybegin, - xend = xend, yend = yend - ), - color = network_color, size = 0.5, alpha = 0.5 - ) - } - - ## plot spatial grid - if (!is.null(spatial_grid) & show_grid == TRUE) { - if (is.null(grid_color)) grid_color <- "black" - - xmin <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimx), "_start") - ymin <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimy), "_start") - xmax <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimx), "_end") - ymax <- paste0(gsub(pattern = "sdim", - replacement = "", x = sdimy), "_end") - - pl <- pl + ggplot2::geom_rect( - data = spatial_grid, aes_string( - xmin = xmin, xmax = xmax, - ymin = ymin, ymax = ymax - ), - color = grid_color, fill = NA - ) - } - - - ## scale and labs ## - pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") - pl <- pl + set_default_color_continuous_cell( - colors = cell_color_gradient, - instrs = instructions(gobject), - midpoint = gradient_midpoint, - style = gradient_style, - guide = guide_colorbar(title = ""), - type = "fill" - ) - pl <- pl + ggplot2::labs(x = "coord x", y = "coord y", title = feat) - } - - ## adjust theme setting - gg_theme_args <- c( - theme_param, - legend_text = legend_text, - axis_title = axis_title, - axis_text = axis_text, - background_color = background_color - ) - pl <- pl + do.call(.gg_theme, args = gg_theme_args) - - if (!is.null(coord_fix_ratio)) { - pl <- pl + ggplot2::coord_fixed(ratio = coord_fix_ratio) - } - - savelist[[feat]] <- pl - } - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, - rel_widths = cow_rel_w, - align = cow_align - ) - - - ## print plot - if (show_plot == TRUE) { - print(combo_plot) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = combo_plot, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(combo_plot) - } -} - - -#' @title Plot data in physical space 2D -#' @name spatFeatPlot2D -#' @description Visualize cells and feature expression according to -#' spatial coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_image_params -#' @inheritParams plot_params -#' @inheritParams plot_spatnet_params -#' @param largeImage_name deprecated -#' @param spat_loc_name name of spatial locations -#' @param sdimx x-axis dimension name (default = 'sdimx') -#' @param sdimy y-axis dimension name (default = 'sdimy') -#' @param expression_values gene expression values to use -#' @param feats features to show -#' @param order order points according to feature expression -#' @param show_network show underlying spatial network -#' @param network_color color of spatial network -#' @param edge_alpha alpha of spatial network -#' @param show_grid show spatial grid -#' @param grid_color color of spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param midpoint expression midpoint -#' @param scale_alpha_with_expression scale expression with ggplot alpha parameter -#' @param coord_fix_ratio fix ratio between x and y-axis (default = 1) -#' @param background_color color of plot background -#' @param vor_border_color border colorr for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparency of voronoi 'cells' -#' @param axis_text size of axis text -#' @param axis_title size of axis title -#' @param theme_param list of additional params passed to `ggplot2::theme()` -#' @details Description of parameters. -#' @family spatial feature expression visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatFeatPlot2D(g, feats = "Gna12") -#' -#' @export -#' @seealso \code{\link{spatFeatPlot3D}} -spatFeatPlot2D <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - spat_loc_name = NULL, - group_by = NULL, - group_by_subset = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - expression_values = c("normalized", "scaled", "custom"), - feats, - order = TRUE, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - show_network = FALSE, - network_color = NULL, - edge_alpha = NULL, - spatial_network_name = "Delaunay_network", - show_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - midpoint = 0, - scale_alpha_with_expression = FALSE, - point_shape = c("border", "no_border", "voronoi"), - point_size = 1, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - coord_fix_ratio = 1, - show_legend = TRUE, - legend_text = 8, - background_color = "white", - vor_border_color = "white", - vor_alpha = 1, - vor_max_radius = 200, - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - theme_param = list(), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatFeatPlot2D") { - - # deprecation message - if (!is.null(largeImage_name)) { - deprecate_warn( - when = "0.2.0", - what = "spatFeatPlot2D(largeImage_name)", - details = c( - "Use `image_name` argument instead for all images to plot." - ) - ) - image_name <- c(image_name, largeImage_name) - } - - # create args list needed for each call to spatFeatPlot2D_single() - # 1. - grab all params available - # 2. - subset to those needed - sfp_params <- get_args_list() - sfp_params <- sfp_params[c( - # [gobject params] - "gobject", "feat_type", "spat_unit", - # [image params] - "show_image", "gimage", "image_name", - # [spatlocs params] - "spat_loc_name", "sdimx", "sdimy", - # [expression params] - "expression_values", "feats", "order", - # [point aes] - "cell_color_gradient", "gradient_midpoint", "gradient_style", - "gradient_limits", "midpoint", "scale_alpha_with_expression", - "point_shape", - "point_size", "point_alpha", "point_border_col", "point_border_stroke", - # [voronoi-point params] - "vor_border_color", "vor_alpha", "vor_max_radius", - # [network aes] - "show_network", "network_color", "edge_alpha", "spatial_network_name", - # [grid aes] - "show_grid", "grid_color", "spatial_grid_name", - # [figure params] - "show_legend", "legend_text", "background_color", "axis_text", - "axis_title", - "cow_n_col", "cow_rel_h", "cow_rel_w", "cow_align", - # [return params] - "show_plot", "return_plot", "save_plot", "save_param", - "default_save_name", - # [theme params] - "theme_param" - )] - - ## check group_by - if (is.null(group_by)) { # ----------------------------------------------- # - - do.call(spatFeatPlot2D_single, args = sfp_params) - } else { # -------------------------------------------------------------- # - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit - ) - # ! update spat_unit & feat_type in static params ! # - - ## check metadata for valid group_by information - comb_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - feat_type = feat_type - ) - possible_meta_groups <- colnames(comb_metadata) - - ## error if group_by col is not found - if (!group_by %in% possible_meta_groups) { - stop("group_by ", group_by, " was not found in pDataDT()") - } - - unique_groups <- unique(comb_metadata[[group_by]]) - - # subset unique_groups - # These unique_groups will be used to iterate through subsetting then - # plotting the giotto object multiple times. - if (!is.null(group_by_subset)) { - not_found <- group_by_subset[!group_by_subset %in% unique_groups] - if (length(not_found) > 0) { - message("the following subset was not found: ", not_found) - } - unique_groups <- unique_groups[unique_groups %in% group_by_subset] - } - - - # group_by static settings # - # update these params - sfp_params$spat_unit <- spat_unit - sfp_params$feat_type <- feat_type - # apply group_by specific defaults - sfp_params$cow_n_col <- 1 - sfp_params$show_plot <- FALSE - sfp_params$return_plot <- TRUE - sfp_params$save_plot <- FALSE - sfp_params$default_save_name <- "spatFeatPlot2D" - - - ## plotting ## - savelist <- list() - - for (group_id in seq_along(unique_groups)) { - group <- unique_groups[group_id] - - subset_cell_IDs <- comb_metadata[ - get(group_by) == group][["cell_ID"]] - sfp_params$gobject <- subsetGiotto( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - cell_ids = subset_cell_IDs, - verbose = FALSE - ) - - # use a different image per group if there are the same number of - # names provided as there are groups - # Otherwise, use the same image (or NULL) for all groups (default) - if (length(unique_groups) == length(image_name)) { - sfp_params$image_name <- image_name[group_id] - } - - - pl <- do.call(spatFeatPlot2D_single, args = sfp_params) - - savelist[[group_id]] <- pl - } - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, - rel_widths = cow_rel_w, - align = cow_align - ) - - # output - return( - plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - return_plot = return_plot, - show_plot = show_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - ) - ) - } # --------------------------------------------------------------------- # -} - - - - - - - - -## ** dim reduction feature plotting #### - -#' @title dimFeatPlot2D -#' @name dimFeatPlot2D -#' @description Visualize gene expression according to dimension reduction -#' coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_nn_net_params -#' @inheritParams plot_dimred_params -#' @inheritParams plot_params -#' @param expression_values gene expression values to use -#' @param feats features to show -#' @param order order points according to feature expression -#' @param scale_alpha_with_expression scale expression with ggplot alpha -#' parameter -#' @details Description of parameters. -#' @family dimension reduction feature expression visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' dimFeatPlot2D(g, feats = c("Gna12", "Ccnd2", "Btbd17")) -#' -#' @export -dimFeatPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats = NULL, - order = TRUE, - dim_reduction_to_use = "umap", - dim_reduction_name = NULL, - dim1_to_use = 1, - dim2_to_use = 2, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - network_color = "lightgray", - edge_alpha = NULL, - scale_alpha_with_expression = FALSE, - point_shape = c("border", "no_border"), - point_size = 1, - point_alpha = 1, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - point_border_col = "black", - point_border_stroke = 0.1, - show_legend = TRUE, - legend_text = 10, - background_color = "white", - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "dimFeatPlot2D") { - # print, return and save parameters - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - # point shape - point_shape <- match.arg(point_shape, choices = c("border", "no_border")) - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # specify dim_reduction_name according to provided feat_type - if (!is.null(dim_reduction_to_use)) { - if (is.null(dim_reduction_name)) { - if (feat_type == "rna") { - dim_reduction_name <- dim_reduction_to_use - } else { - dim_reduction_name <- paste0(feat_type, ".", - dim_reduction_to_use) - } - } - } - - - # expression values - values <- match.arg(expression_values, - unique(c("normalized", "scaled", "custom", - expression_values))) - expr_values <- get_expression_values( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - values = values, - output = "matrix" - ) - - # only keep feats that are in the dataset - selected_feats <- feats - selected_feats <- selected_feats[selected_feats %in% rownames(expr_values)] - - # - if (length(selected_feats) == 1) { - subset_expr_data <- expr_values[ - rownames(expr_values) %in% selected_feats, ] - t_sub_expr_data_DT <- data.table::data.table( - "selected_feat" = subset_expr_data, - "cell_ID" = colnames(expr_values)) - data.table::setnames(t_sub_expr_data_DT, "selected_feat", - selected_feats) - } else { - subset_expr_data <- expr_values[rownames(expr_values) %in% - selected_feats, ] - t_sub_expr_data <- t_flex(subset_expr_data) - t_sub_expr_data_DT <- data.table::as.data.table( - as.matrix(t_sub_expr_data)) - - # data.table variables - cell_ID <- NULL - - t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] - } - - - ## dimension reduction ## - dim_dfr <- get_dimReduction( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - - dim_names <- colnames(dim_dfr) - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, cell_ID := rownames(dim_dfr)] - - ## annotated cell metadata - cell_metadata <- get_cell_metadata(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - output = "data.table", - copy_obj = TRUE - ) - - annotated_DT <- data.table::merge.data.table(cell_metadata, - dim_DT, by = "cell_ID") - - ## merge feat info - annotated_feat_DT <- data.table::merge.data.table(annotated_DT, - t_sub_expr_data_DT, - by = "cell_ID") - - # create input for network - if (show_NN_network == TRUE) { - # nn_network - selected_nn_network <- get_NearestNetwork( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - output = "igraph" - ) - - network_DT <- data.table::as.data.table( - igraph::as_data_frame(selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- data.table::merge.data.table( - network_DT, dim_DT, by.x = "from", by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = from_dim_names) - - annotated_network_DT <- data.table::merge.data.table( - annotated_network_DT, dim_DT, by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = to_dim_names) - } - - ## visualize multiple plots ## - ## 2D plots ## - savelist <- list() - - - for (feat in selected_feats) { - # order spatial units (e.g. cell IDs) based on expression of feature - if (isTRUE(order)) { - annotated_feat_DT <- annotated_feat_DT[order(get(feat))] - } - - - ## OLD need to be combined ## - pl <- ggplot2::ggplot() - pl <- pl + ggplot2::theme_classic() - - # network layer - if (show_NN_network == TRUE) { - if (is.null(edge_alpha)) { - edge_alpha <- 0.5 - pl <- pl + ggplot2::geom_segment( - data = annotated_network_DT, - aes_string( - x = from_dim_names[1], y = from_dim_names[2], - xend = to_dim_names[1], yend = to_dim_names[2] - ), - alpha = edge_alpha, color = network_color, size = 0.1, - show.legend = FALSE - ) - } else if (is.numeric(edge_alpha)) { - pl <- pl + ggplot2::geom_segment( - data = annotated_network_DT, - aes_string( - x = from_dim_names[1], y = from_dim_names[2], - xend = to_dim_names[1], yend = to_dim_names[2] - ), - alpha = edge_alpha, color = network_color, size = 0.1, - show.legend = FALSE - ) - } else if (is.character(edge_alpha)) { - if (edge_alpha %in% colnames(annotated_network_DT)) { - pl <- pl + ggplot2::geom_segment( - data = annotated_network_DT, - aes_string( - x = from_dim_names[1], y = from_dim_names[2], - xend = to_dim_names[1], - yend = to_dim_names[2], alpha = edge_alpha - ), - color = network_color, - show.legend = FALSE - ) - } - } - } - - - ## point layer ## - if (is.null(feats)) { - cell_color <- "lightblue" - message("no feats selected") - pl <- pl + ggplot2::geom_point( - data = annotated_feat_DT, - aes_string(x = dim_names[1], dim_names[2]), - fill = cell_color, show.legend = show_legend, - size = point_size, alpha = point_alpha - ) - } else { - ## set gradient limits if needed ## - if (!is.null(gradient_limits) & is.vector(gradient_limits) & - length(gradient_limits) == 2) { - lower_lim <- gradient_limits[[1]] - upper_lim <- gradient_limits[[2]] - numeric_data <- annotated_feat_DT[[feat]] - limit_numeric_data <- ifelse(numeric_data > upper_lim, - upper_lim, - ifelse(numeric_data < lower_lim, lower_lim, numeric_data) - ) - annotated_feat_DT[[feat]] <- limit_numeric_data - } - - if (is.null(gradient_midpoint)) { - gradient_midpoint <- stats::median(annotated_feat_DT[[feat]]) - } - - - - ## with border ## - if (point_shape == "border") { - if (scale_alpha_with_expression == TRUE) { - pl <- pl + ggplot2::geom_point( - data = annotated_feat_DT, aes_string2( - x = dim_names[1], - y = dim_names[2], - fill = feat, alpha = feat - ), - show.legend = show_legend, shape = 21, - size = point_size, - color = point_border_col, stroke = point_border_stroke - ) - } else { - pl <- pl + ggplot2::geom_point( - data = annotated_feat_DT, aes_string2( - x = dim_names[1], - y = dim_names[2], - fill = feat - ), - show.legend = show_legend, shape = 21, - size = point_size, - color = point_border_col, stroke = point_border_stroke, - alpha = point_alpha - ) - } - - ## scale and labs ## - pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") - pl <- pl + set_default_color_continuous_cell( - colors = cell_color_gradient, - instrs = instructions(gobject), - midpoint = gradient_midpoint, - style = gradient_style, - guide = guide_colorbar(title = ""), - type = "fill" - ) - } - - - ## without border ## - if (point_shape == "no_border") { - if (scale_alpha_with_expression == TRUE) { - pl <- pl + ggplot2::geom_point( - data = annotated_feat_DT, aes_string2( - x = dim_names[1], - y = dim_names[2], - color = feat, alpha = feat - ), - show.legend = show_legend, shape = 19, size = point_size - ) - } else { - pl <- pl + ggplot2::geom_point( - data = annotated_feat_DT, aes_string2( - x = dim_names[1], - y = dim_names[2], - color = feat - ), - show.legend = show_legend, shape = 19, - size = point_size, - alpha = point_alpha - ) - } - - ## scale and labs ## - pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") - pl <- pl + set_default_color_continuous_cell( - colors = cell_color_gradient, - instrs = instructions(gobject), - midpoint = gradient_midpoint, - style = gradient_style, - guide = guide_colorbar(title = ""), - type = "color" - ) - } - } - - ## add title - pl <- pl + ggplot2::labs(x = "coord x", y = "coord y", title = feat) - - ## aesthetics - pl <- pl + ggplot2::theme( - plot.title = element_text(hjust = 0.5), - legend.title = element_blank(), - legend.text = element_text(size = legend_text), - axis.title = element_text(size = axis_title), - axis.text = element_text(size = axis_text), - panel.grid = element_blank(), - panel.background = element_rect(fill = background_color) - ) - - savelist[[feat]] <- pl - } - - - - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, rel_widths = cow_rel_w, - align = cow_align - ) - - - ## print plot - if (show_plot == TRUE) { - print(combo_plot) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = combo_plot, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(combo_plot) - } -} - - - - - - -## ** spatial and dim reduction feature plotting #### - - -#' @title spatDimFeatPlot2D -#' @name spatDimFeatPlot2D -#' @description Visualize cells according to spatial AND dimension reduction -#' coordinates in ggplot mode -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_image_params -#' @inheritParams plot_params -#' @inheritParams plot_dimred_params -#' @inheritParams plot_spatnet_params -#' @inheritParams plot_nn_net_params -#' @param expression_values feat expression values to use -#' @param plot_alignment direction to align plot -#' @param feats features to show -#' @param order order points according to feature expression -#' @param network_name name of NN network to use, if show_NN_network = TRUE -#' @param dim_network_color color of NN network -#' @param dim_edge_alpha dim reduction plot: column to use for alpha of the -#' edges -#' @param scale_alpha_with_expression scale expression with ggplot alpha -#' parameter -#' @param sdimx spatial x-axis dimension name (default = 'sdimx') -#' @param sdimy spatial y-axis dimension name (default = 'sdimy') -#' @param show_spatial_grid show spatial grid -#' @param grid_color color of spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param spat_point_shape spatial points with border or -#' not (border or no_border) -#' @param spat_point_size spatial plot: point size -#' @param spat_point_alpha transparency of spatial points -#' @param spat_point_border_col color of border around points -#' @param spat_point_border_stroke stroke size of border around points -#' @param spat_edge_alpha edge alpha -#' @param dim_background_color color of plot background for dimension plot -#' @param spat_background_color color of plot background for spatial plot -#' @param vor_border_color border colorr for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparancy of voronoi 'cells' -#' @details Description of parameters. -#' @family spatial and dimension reduction feature expression visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatDimFeatPlot2D(g, feats = c("Gna12", "Ccnd2", "Btbd17")) -#' -#' @export -spatDimFeatPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - expression_values = c("normalized", "scaled", "custom"), - plot_alignment = c("vertical", "horizontal"), - feats, - order = TRUE, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - dim_point_shape = c("border", "no_border"), - dim_point_size = 1, - dim_point_alpha = 1, - dim_point_border_col = "black", - dim_point_border_stroke = 0.1, - show_NN_network = FALSE, - show_spatial_network = FALSE, - dim_network_color = "gray", - nn_network_to_use = "sNN", - network_name = "sNN.pca", - dim_edge_alpha = NULL, - scale_alpha_with_expression = FALSE, - sdimx = "sdimx", - sdimy = "sdimy", - spatial_network_name = "Delaunay_network", - spatial_network_color = NULL, - show_spatial_grid = FALSE, - grid_color = NULL, - spatial_grid_name = "spatial_grid", - spat_point_shape = c("border", "no_border", "voronoi"), - spat_point_size = 1, - spat_point_alpha = 1, - spat_point_border_col = "black", - spat_point_border_stroke = 0.1, - spat_edge_alpha = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_legend = TRUE, - legend_text = 10, - dim_background_color = "white", - spat_background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - axis_text = 8, - axis_title = 8, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatDimFeatPlot2D") { - plot_alignment <- match.arg(plot_alignment, - choices = c("vertical", "horizontal")) - - # dimension reduction plot - dmpl <- dimFeatPlot2D( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - expression_values = expression_values, - feats = feats, - order = order, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - network_color = dim_network_color, - edge_alpha = dim_edge_alpha, - scale_alpha_with_expression = scale_alpha_with_expression, - point_shape = dim_point_shape, - point_size = dim_point_size, - point_alpha = dim_point_alpha, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - point_border_col = dim_point_border_col, - point_border_stroke = dim_point_border_stroke, - show_legend = show_legend, - legend_text = legend_text, - background_color = dim_background_color, - axis_text = axis_text, - axis_title = axis_title, - cow_n_col = cow_n_col, - cow_rel_h = cow_rel_h, - cow_rel_w = cow_rel_w, - cow_align = cow_align, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE - ) - - # spatial plot - spl <- spatFeatPlot2D( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - show_image = show_image, - gimage = gimage, - image_name = image_name, - largeImage_name = largeImage_name, - sdimx = sdimx, - sdimy = sdimy, - expression_values = expression_values, - feats = feats, - order = order, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - show_network = show_spatial_network, - network_color = spatial_network_color, - spatial_network_name = spatial_network_name, - edge_alpha = spat_edge_alpha, - show_grid = show_spatial_grid, - grid_color = grid_color, - spatial_grid_name = spatial_grid_name, - scale_alpha_with_expression = scale_alpha_with_expression, - point_shape = spat_point_shape, - point_size = spat_point_size, - point_alpha = spat_point_alpha, - point_border_col = spat_point_border_col, - point_border_stroke = spat_point_border_stroke, - show_legend = show_legend, - legend_text = legend_text, - background_color = spat_background_color, - vor_border_color = vor_border_color, - vor_max_radius = vor_max_radius, - vor_alpha = vor_alpha, - axis_text = axis_text, - axis_title = axis_title, - cow_n_col = cow_n_col, - cow_rel_h = cow_rel_h, - cow_rel_w = cow_rel_w, - cow_align = cow_align, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE - ) - - - if (plot_alignment == "vertical") { - ncol <- 1 - nrow <- 2 - combo_plot <- cowplot::plot_grid( - dmpl, spl, ncol = ncol, nrow = nrow, rel_heights = c(1), - rel_widths = c(1), align = "v") - } else { - ncol <- 2 - nrow <- 1 - combo_plot <- cowplot::plot_grid( - dmpl, spl, ncol = ncol, nrow = nrow, rel_heights = c(1), - rel_widths = c(1), align = "h") - } - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - show_plot = show_plot, - save_plot = save_plot, - return_plot = return_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - - - - - - - - - - - - - -#' @title spatCellPlot -#' @name spatCellPlot -#' @description Visualize cells according to spatial coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_params -#' @inheritParams plot_spatenr_params -#' @inheritParams plot_image_params -#' @inheritParams plot_spatnet_params -#' @param sdimx x-axis dimension name (default = 'sdimx') -#' @param sdimy y-axis dimension name (default = 'sdimy') -#' @param cell_annotation_values numeric cell annotation columns -#' @param show_network show underlying spatial network -#' @param network_color color of spatial network -#' @param network_alpha alpha of spatial network -#' @param show_grid show spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param grid_color color of spatial grid -#' @param coord_fix_ratio fix ratio between x and y-axis -#' @param vor_border_color border colorr for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparency of voronoi 'cells' -#' @param theme_param list of additional params passed to `ggplot2::theme()` -#' @details Description of parameters. -#' @family spatial cell annotation visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatCellPlot2D(g, cell_annotation_values = "leiden_clus") -#' -#' @export -spatCellPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - spat_enr_names = NULL, - cell_annotation_values = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - point_shape = c("border", "no_border", "voronoi"), - point_size = 3, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - show_cluster_center = FALSE, - show_center_label = FALSE, - center_point_size = 4, - center_point_border_col = "black", - center_point_border_stroke = 0.1, - label_size = 4, - label_fontface = "bold", - show_network = FALSE, - spatial_network_name = "Delaunay_network", - network_color = NULL, - network_alpha = 1, - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - grid_color = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - other_cells_alpha = 0.1, - coord_fix_ratio = 1, - show_legend = TRUE, - legend_text = 8, - legend_symbol_size = 1, - background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - theme_param = list(), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatCellPlot2D") { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - comb_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_enr_names = spat_enr_names - ) - - # keep only available columns - possible_value_cols <- colnames(comb_metadata) - if (is.null(cell_annotation_values)) { - stop("you need to choose which continuous/numerical cell - annotations or enrichments you want to visualize") - } - cell_annotation_values <- as.character(cell_annotation_values) - cell_annotation_values <- cell_annotation_values[ - cell_annotation_values %in% possible_value_cols] - - ## plotting ## - savelist <- list() - - for (annot in cell_annotation_values) { - pl <- spatPlot2D( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - show_image = show_image, - gimage = gimage, - image_name = image_name, - largeImage_name = largeImage_name, - group_by = NULL, - group_by_subset = NULL, - sdimx = sdimx, - sdimy = sdimy, - spat_enr_names = spat_enr_names, - cell_color = annot, - color_as_factor = FALSE, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - point_shape = point_shape, - point_size = point_size, - point_alpha = point_alpha, - point_border_col = point_border_col, - point_border_stroke = point_border_stroke, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - center_point_border_col = center_point_border_col, - center_point_border_stroke = center_point_border_stroke, - label_size = label_size, - label_fontface = label_fontface, - show_network = show_network, - spatial_network_name = spatial_network_name, - network_color = network_color, - network_alpha = network_alpha, - show_grid = show_grid, - spatial_grid_name = spatial_grid_name, - grid_color = grid_color, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - other_cells_alpha = other_cells_alpha, - coord_fix_ratio = coord_fix_ratio, - title = annot, - show_legend = show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = background_color, - vor_border_color = vor_border_color, - vor_max_radius = vor_max_radius, - vor_alpha = vor_alpha, - axis_text = axis_text, - axis_title = axis_title, - theme_param = theme_param, - # hardcoded on purpose below - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE, - save_param = list(), - default_save_name = "spatPlot2D" - ) - - - savelist[[annot]] <- pl - } - - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, - rel_widths = cow_rel_w, - align = cow_align - ) - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - show_plot = show_plot, - return_plot = return_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - -#' @rdname spatCellPlot -#' @param \dots spatCellPlot(...) passes to spatCellPlot2D() -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatCellPlot(g, cell_annotation_values = "leiden_clus") -#' -#' @export -spatCellPlot <- function(...) { - spatCellPlot2D(...) -} - - - - - -#' @title dimCellPlot -#' @name dimCellPlot -#' @description Visualize cells according to dimension reduction coordinates. -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_dimred_params -#' @inheritParams plot_nn_net_params -#' @inheritParams plot_spatenr_params -#' @inheritParams plot_params -#' @param cell_annotation_values numeric cell annotation columns -#' @details Description of parameters. For 3D plots see \code{\link{dimPlot3D}} -#' @family dimension reduction cell annotation visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' dimCellPlot2D( -#' g, spat_enr_names = "cluster_metagene", -#' cell_annotation_values = as.character(seq(4)) -#' ) -#' -#' @export -dimCellPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - spat_enr_names = NULL, - cell_annotation_values = NULL, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - center_point_border_col = "black", - center_point_border_stroke = 0.1, - label_size = 4, - label_fontface = "bold", - edge_alpha = NULL, - point_shape = c("border", "no_border"), - point_size = 1, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - show_legend = TRUE, - legend_text = 8, - legend_symbol_size = 1, - background_color = "white", - axis_text = 8, - axis_title = 8, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "dimCellPlot2D") { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - comb_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_enr_names = spat_enr_names - ) - - # keep only available columns - possible_value_cols <- colnames(comb_metadata) - if (is.null(cell_annotation_values)) { - stop("you need to choose which continuous/numerical cell annotations - or enrichments you want to visualize") - } - cell_annotation_values <- cell_annotation_values[ - cell_annotation_values %in% possible_value_cols] - - ## plotting ## - savelist <- list() - - for (annot in cell_annotation_values) { - pl <- dimPlot2D( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - group_by = NULL, - group_by_subset = NULL, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - spat_enr_names = spat_enr_names, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - cell_color = annot, - color_as_factor = FALSE, - cell_color_code = cell_color_code, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - center_point_border_col = center_point_border_col, - center_point_border_stroke = center_point_border_stroke, - label_size = label_size, - label_fontface = label_fontface, - edge_alpha = edge_alpha, - point_shape = point_shape, - point_size = point_size, - point_alpha = point_alpha, - point_border_col = point_border_col, - point_border_stroke = point_border_stroke, - title = annot, - show_legend = show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = background_color, - axis_text = axis_text, - axis_title = axis_title, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE, - save_param = list(), - default_save_name = "dimPlot2D" - ) - - - savelist[[annot]] <- pl - } - - - # combine plots with cowplot - combo_plot <- cowplot::plot_grid( - plotlist = savelist, - ncol = set_default_cow_n_col( - cow_n_col = cow_n_col, - nr_plots = length(savelist) - ), - rel_heights = cow_rel_h, - rel_widths = cow_rel_w, - align = cow_align - ) - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - show_plot = show_plot, - return_plot = return_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - - - -#' @rdname dimCellPlot -#' @param ... dimCellPlot(...) passes to dimCellPlot2D() -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' dimCellPlot(g, cell_annotation_values = "leiden_clus") -#' -#' @export -dimCellPlot <- function(gobject, ...) { - dimCellPlot2D(gobject = gobject, ...) -} - - - - -#' @title spatDimCellPlot2D -#' @name spatDimCellPlot2D -#' @description Visualize numerical features of cells according to spatial -#' AND dimension reduction coordinates in 2D -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @inheritParams plot_cow_params -#' @inheritParams plot_image_params -#' @inheritParams plot_spatenr_params -#' @inheritParams plot_dimred_params -#' @inheritParams plot_nn_net_params -#' @inheritParams plot_params -#' @param plot_alignment direction to align plot -#' @param cell_annotation_values numeric cell annotation columns -#' @param sdimx = spatial dimension to use on x-axis -#' @param sdimy = spatial dimension to use on y-axis -#' @param spat_point_shape shape of points (border, no_border or voronoi) -#' @param spat_point_size size of spatial points -#' @param spat_point_alpha transparency of spatial points -#' @param spat_point_border_col border color of spatial points -#' @param spat_point_border_stroke border stroke of spatial points -#' @param dim_show_cluster_center show the center of each cluster -#' @param dim_show_center_label provide a label for each cluster -#' @param dim_center_point_size size of the center point -#' @param dim_center_point_border_col border color of center point -#' @param dim_center_point_border_stroke stroke size of center point -#' @param dim_label_size size of the center label -#' @param dim_label_fontface font of the center label -#' @param spat_show_cluster_center show the center of each cluster -#' @param spat_show_center_label provide a label for each cluster -#' @param spat_center_point_size size of the spatial center points -#' @param spat_center_point_border_col border color of the spatial center points -#' @param spat_center_point_border_stroke stroke size of the spatial center -#' points -#' @param spat_label_size size of the center label -#' @param spat_label_fontface font of the center label -#' @param dim_edge_alpha column to use for alpha of the edges -#' @param spat_show_network show spatial network -#' @param spatial_network_name name of spatial network to use -#' @param spat_network_color color of spatial network -#' @param spat_network_alpha alpha of spatial network -#' @param spat_show_grid show spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param spat_grid_color color of spatial grid -#' @param dim_other_point_size size of not selected dim cells -#' @param spat_other_point_size size of not selected spat cells -#' @param spat_other_cells_alpha alpha of not selected spat cells -#' @param coord_fix_ratio ratio for coordinates -#' @param dim_background_color background color of points in dim. reduction -#' space -#' @param spat_background_color background color of spatial points -#' @param vor_border_color border colorr for voronoi plot -#' @param vor_max_radius maximum radius for voronoi 'cells' -#' @param vor_alpha transparancy of voronoi 'cells' -#' @details Description of parameters. -#' @family spatial and dimension reduction cell annotation visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatDimCellPlot2D(g, cell_annotation_values = "leiden_clus") -#' -#' @export -spatDimCellPlot2D <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - plot_alignment = c("vertical", "horizontal"), - spat_enr_names = NULL, - cell_annotation_values = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - sdimx = "sdimx", - sdimy = "sdimy", - cell_color_gradient = NULL, - gradient_midpoint = NULL, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - dim_point_shape = c("border", "no_border"), - dim_point_size = 1, - dim_point_alpha = 1, - dim_point_border_col = "black", - dim_point_border_stroke = 0.1, - spat_point_shape = c("border", "no_border", "voronoi"), - spat_point_size = 1, - spat_point_alpha = 1, - spat_point_border_col = "black", - spat_point_border_stroke = 0.1, - dim_show_cluster_center = FALSE, - dim_show_center_label = TRUE, - dim_center_point_size = 4, - dim_center_point_border_col = "black", - dim_center_point_border_stroke = 0.1, - dim_label_size = 4, - dim_label_fontface = "bold", - spat_show_cluster_center = FALSE, - spat_show_center_label = FALSE, - spat_center_point_size = 4, - spat_center_point_border_col = "black", - spat_center_point_border_stroke = 0.1, - spat_label_size = 4, - spat_label_fontface = "bold", - show_NN_network = FALSE, - nn_network_to_use = "sNN", - nn_network_name = "sNN.pca", - dim_edge_alpha = 0.5, - spat_show_network = FALSE, - spatial_network_name = "Delaunay_network", - spat_network_color = "red", - spat_network_alpha = 0.5, - spat_show_grid = FALSE, - spatial_grid_name = "spatial_grid", - spat_grid_color = "green", - show_other_cells = TRUE, - other_cell_color = "grey", - dim_other_point_size = 0.5, - spat_other_point_size = 0.5, - spat_other_cells_alpha = 0.5, - show_legend = TRUE, - legend_text = 8, - legend_symbol_size = 1, - dim_background_color = "white", - spat_background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - axis_text = 8, - axis_title = 8, - coord_fix_ratio = 1, - cow_n_col = NULL, - cow_rel_h = 1, - cow_rel_w = 1, - cow_align = "h", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatDimCellPlot2D") { - plot_alignment <- match.arg(plot_alignment, - choices = c("vertical", "horizontal")) - - # dimension reduction plot - dmpl <- dimCellPlot2D( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - spat_enr_names = spat_enr_names, - cell_annotation_values = cell_annotation_values, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - point_shape = dim_point_shape, - point_size = dim_point_size, - point_alpha = dim_point_alpha, - point_border_col = dim_point_border_col, - point_border_stroke = dim_point_border_stroke, - show_cluster_center = dim_show_cluster_center, - show_center_label = dim_show_center_label, - center_point_size = dim_center_point_size, - center_point_border_col = dim_center_point_border_col, - center_point_border_stroke = dim_center_point_border_stroke, - label_size = dim_label_size, - label_fontface = dim_label_fontface, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = nn_network_name, - edge_alpha = dim_edge_alpha, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = dim_other_point_size, - show_legend = show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = dim_background_color, - axis_text = axis_text, - axis_title = axis_title, - cow_n_col = cow_n_col, - cow_rel_h = cow_rel_h, - cow_rel_w = cow_rel_w, - cow_align = cow_align, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE - ) - - # spatial plot - spl <- spatCellPlot2D( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - show_image = show_image, - gimage = gimage, - image_name = image_name, - largeImage_name = largeImage_name, - sdimx = sdimx, - sdimy = sdimy, - spat_enr_names = spat_enr_names, - cell_annotation_values = cell_annotation_values, - cell_color_gradient = cell_color_gradient, - gradient_midpoint = gradient_midpoint, - gradient_style = gradient_style, - gradient_limits = gradient_limits, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - point_shape = spat_point_shape, - point_size = spat_point_size, - point_alpha = spat_point_alpha, - point_border_col = spat_point_border_col, - point_border_stroke = spat_point_border_stroke, - show_cluster_center = spat_show_cluster_center, - show_center_label = spat_show_center_label, - center_point_size = spat_center_point_size, - center_point_border_col = spat_center_point_border_col, - center_point_border_stroke = spat_center_point_border_stroke, - label_size = spat_label_size, - label_fontface = spat_label_fontface, - show_network = spat_show_network, - spatial_network_name = spatial_network_name, - network_color = spat_network_color, - network_alpha = spat_network_alpha, - show_grid = spat_show_grid, - spatial_grid_name = spatial_grid_name, - grid_color = spat_grid_color, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = spat_other_point_size, - other_cells_alpha = spat_other_cells_alpha, - coord_fix_ratio = coord_fix_ratio, - show_legend = show_legend, - legend_text = legend_text, - legend_symbol_size = legend_symbol_size, - background_color = spat_background_color, - vor_border_color = vor_border_color, - vor_max_radius = vor_max_radius, - vor_alpha = vor_alpha, - axis_text = axis_text, - axis_title = axis_title, - cow_n_col = cow_n_col, - cow_rel_h = cow_rel_h, - cow_rel_w = cow_rel_w, - cow_align = cow_align, - show_plot = FALSE, - return_plot = TRUE, - save_plot = FALSE - ) - - - if (plot_alignment == "vertical") { - ncol <- 1 - nrow <- 2 - combo_plot <- cowplot::plot_grid(dmpl, spl, ncol = ncol, nrow = nrow, - rel_heights = c(1), rel_widths = c(1), - align = "v") - } else { - ncol <- 2 - nrow <- 1 - combo_plot <- cowplot::plot_grid(dmpl, spl, ncol = ncol, nrow = nrow, - rel_heights = c(1), rel_widths = c(1), - align = "h") - } - - return(plot_output_handler( - gobject = gobject, - plot_object = combo_plot, - save_plot = save_plot, - show_plot = show_plot, - return_plot = return_plot, - default_save_name = default_save_name, - save_param = save_param, - else_return = NULL - )) -} - - - - -#' @title spatDimCellPlot -#' @name spatDimCellPlot -#' @description Visualize numerical features of cells according to spatial -#' AND dimension reduction coordinates in 2D -#' @inheritDotParams spatDimCellPlot2D -#' @details Description of parameters. -#' @family spatial and dimension reduction cell annotation visualizations -#' @returns ggplot -#' @examples -#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' spatDimCellPlot(g, cell_annotation_values = "leiden_clus") -#' -#' @export -spatDimCellPlot <- function(...) { - spatDimCellPlot2D(...) -} - - - - - - -# * #### -## 3-D plotly #### -## ----------- ## - -# ** dimension plot #### - - -#' @title .dimPlot_2d_plotly -#' @name .dimPlot_2d_plotly -#' @description Visualize cells at their 2D dimension reduction coordinates -#' with plotly -#' @returns plotly object -#' @keywords internal -.dimPlot_2d_plotly <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - spat_enr_names = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - color_as_factor = TRUE, - cell_color = NULL, - cell_color_code = NULL, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 4, - edge_alpha = NULL, - point_size = 5) { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # data.table variables - cell_ID <- NULL - - ## dimension reduction ## - dim_dfr <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - - dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use)] - dim_names <- colnames(dim_dfr) - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, "cell_ID" := rownames(dim_dfr)] - - - ## annotated cell metadata - cell_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_enr_names = spat_enr_names - ) - annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") - - - # create input for network - if (show_NN_network == TRUE) { - # nn_network - selected_nn_network <- get_NearestNetwork( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - output = "igraph" - ) - network_DT <- data.table::as.data.table(igraph::as_data_frame( - selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- merge(network_DT, dim_DT, by.x = "from", - by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = from_dim_names) - - annotated_network_DT <- merge(annotated_network_DT, dim_DT, - by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = to_dim_names) - } - - - if (dim_reduction_to_use == "pca") { - pca_object <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "dimObj" - ) - eigenvalues <- slot(pca_object, "misc")$eigenvalues - - if (!is.null(eigenvalues)) { - total <- sum(eigenvalues) - var_expl_vec <- (eigenvalues / total) * 100 - dim1_x_variance <- var_expl_vec[dim1_to_use] - dim2_y_variance <- var_expl_vec[dim2_to_use] - } - } - - - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - if (is.null(cell_color)) { - stop("\n selection of cells is based on cell_color paramter, - which is a metadata column \n") - } - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - - if (!is.null(select_cells)) { - annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% - select_cells] - annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% - select_cells] - - if (show_NN_network == TRUE) { - annotated_network_DT <- annotated_network_DT[ - annotated_network_DT$to %in% select_cells & - annotated_network_DT$from %in% select_cells] - } - - # if specific cells are selected - # annotated_DT = annotated_DT_selected - } - - - ## if no subsets are required - if (is.null(select_cells) & is.null(select_cell_groups)) { - annotated_DT_selected <- annotated_DT - annotated_DT_other <- NULL - } - - - ## annotated_DT_selected = all selected cells or all cells if no selection - ## annotated_DT_other = all not selected cells or NULL if no selection - - - pl <- plotly::plot_ly() - if (show_NN_network == TRUE) { - if (is.null(edge_alpha)) { - edge_alpha <- 0.5 - } else if (is.character(edge_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - edge_alpha <- 0.5 - } - - pl <- pl %>% plotly::add_segments( - name = network_name, - type = "scatter", - x = annotated_network_DT[[from_dim_names[1]]], - y = annotated_network_DT[[from_dim_names[2]]], - xend = annotated_network_DT[[to_dim_names[1]]], - yend = annotated_network_DT[[to_dim_names[2]]], - line = list( - color = "lightgray", - width = 0.5 - ), - opacity = edge_alpha - ) - } - - if (is.null(cell_color)) { - cell_color <- "lightblue" - pl <- pl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - color = cell_color, - colors = cell_color, - marker = list(size = point_size) - ) - } else if (cell_color %in% colnames(annotated_DT_selected)) { - if (is.null(cell_color_code)) { - number_colors <- length(unique(annotated_DT[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - } - if (color_as_factor) { - annotated_DT_selected[[cell_color]] <- as.factor( - annotated_DT_selected[[cell_color]]) - } - - - pl <- pl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - color = annotated_DT_selected[[cell_color]], - colors = cell_color_code, - legendgroup = annotated_DT_selected[[cell_color]], - marker = list(size = point_size) - ) - - if (!is.null(select_cells) & show_other_cells) { - pl <- pl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - # legendgroup = annotated_DT[[cell_color]], - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - - if (show_cluster_center == TRUE | show_center_label == TRUE) { - annotated_DT_centers <- annotated_DT_selected[, .( - center_1 = stats::median(get(dim_names[1])), - center_2 = stats::median(get(dim_names[2])) - ), - by = cell_color - ] - annotated_DT_centers[[cell_color]] <- as.factor( - annotated_DT_centers[[cell_color]]) - if (show_cluster_center == TRUE) { - pl <- pl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_centers[["center_1"]], - y = annotated_DT_centers[["center_2"]], - color = annotated_DT_centers[[cell_color]], - colors = cell_color_code, - legendgroup = annotated_DT_centers[[cell_color]], - marker = list(size = center_point_size, symbol = "x", - symbols = "x"), - showlegend = FALSE - ) - } - - if (show_center_label == TRUE) { - pl <- pl %>% - plotly::add_text( - x = annotated_DT_centers[["center_1"]], - y = annotated_DT_centers[["center_2"]], - type = "scatter", mode = "text", - text = annotated_DT_centers[[cell_color]], - textposition = "middle right", - textfont = list(color = "#000000", size = 16), - showlegend = FALSE - ) - } - } - } else { - stop("cell_color does not exist!\n") - } - - - - if (dim_reduction_to_use == "pca") { - if (!is.null(eigenvalues)) { - x_name <- paste0("pca", "-", dim_names[1]) - y_name <- paste0("pca", "-", dim_names[2]) - x_title <- sprintf("%s explains %.02f%% of variance", - x_name, var_expl_vec[1]) - y_title <- sprintf("%s explains %.02f%% of variance", y_name, - var_expl_vec[2]) - } - } else { - x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - } - pl <- pl %>% plotly::layout( - xaxis = list(title = x_title), - yaxis = list(title = y_title), - legend = list(x = 100, y = 0.5, font = list(family = "sans-serif", - size = 12)) - ) - - return(pl) -} - - -#' @title .dimPlot_3d_plotly -#' @name .dimPlot_3d_plotly -#' @description Visualize cells at their 3D dimension reduction coordinates -#' with plotly -#' @returns plotly object -#' @keywords internal -.dimPlot_3d_plotly <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - dim3_to_use = 3, - spat_enr_names = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - color_as_factor = TRUE, - cell_color = NULL, - cell_color_code = NULL, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 4, - edge_alpha = NULL, - point_size = 1) { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # data.table variables - cell_ID <- NULL - - ## dimension reduction ## - dim_dfr <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] - dim_names <- colnames(dim_dfr) - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, cell_ID := rownames(dim_dfr)] - - - ## annotated cell metadata - cell_metadata <- combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_enr_names = spat_enr_names - ) - annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") - - - # create input for network - if (show_NN_network == TRUE) { - # nn_network - selected_nn_network <- get_NearestNetwork( - gobject = gobject, spat_unit = spat_unit, - feat_type = feat_type, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - output = "igraph" - ) - network_DT <- data.table::as.data.table(igraph::as_data_frame( - selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- merge(network_DT, dim_DT, by.x = "from", - by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = from_dim_names) - - annotated_network_DT <- merge(annotated_network_DT, dim_DT, - by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = to_dim_names) - } - - if (dim_reduction_to_use == "pca") { - pca_object <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "dimObj" - ) - - eigenvalues <- slot(pca_object, "misc")$eigenvalues - if (!is.null(eigenvalues)) { - total <- sum(eigenvalues) - var_expl_vec <- (eigenvalues / total) * 100 - dim1_x_variance <- var_expl_vec[dim1_to_use] - dim2_y_variance <- var_expl_vec[dim2_to_use] - } - } - - ## create subsets if needed - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - if (is.null(cell_color)) { - stop("\n selection of cells is based on cell_color parameter, - which is a metadata column \n") - } - message("You have selected both individual cell IDs and a group of - cells") - group_cell_IDs <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% - select_cells] - annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% - select_cells] - - if (show_NN_network == TRUE) { - annotated_network_DT <- annotated_network_DT[ - annotated_network_DT$to %in% select_cells & - annotated_network_DT$from %in% select_cells] - } - - # if specific cells are selected - annotated_DT <- annotated_DT_selected - } - - ## if no subsets are required - if (is.null(select_cells) & is.null(select_cell_groups)) { - annotated_DT_selected <- annotated_DT - annotated_DT_other <- NULL - } - - ## annotated_DT_selected = all selected cells or all cells if no selection - ## annotated_DT_other = all not selected cells or NULL if no selection - - - pl <- plotly::plot_ly() - if (is.null(cell_color)) { - cell_color <- "lightblue" - pl <- pl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - z = annotated_DT_selected[[dim_names[3]]], - color = cell_color, - colors = cell_color, - marker = list(size = 2), - legendgroup = annotated_DT_selected[[cell_color]] - ) - } else { - if (cell_color %in% colnames(annotated_DT_selected)) { - if (is.null(cell_color_code)) { - number_colors <- length( - unique(annotated_DT_selected[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - } - if (color_as_factor) { - annotated_DT_selected[[cell_color]] <- as.factor( - annotated_DT_selected[[cell_color]]) - } - - pl <- pl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - z = annotated_DT_selected[[dim_names[3]]], - color = annotated_DT_selected[[cell_color]], - colors = cell_color_code, - marker = list(size = point_size), - legendgroup = annotated_DT_selected[[cell_color]] - ) - - if (!is.null(select_cells) & show_other_cells) { - pl <- pl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - z = annotated_DT_other[[dim_names[3]]], - # colors = other_cell_color, - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - - - if (show_cluster_center == TRUE | show_center_label == TRUE) { - annotated_DT_centers <- annotated_DT_selected[, .( - center_1 = stats::median(get(dim_names[1])), - center_2 = stats::median(get(dim_names[2])), - center_3 = stats::median(get(dim_names[3])) - ), - by = cell_color - ] - annotated_DT_centers[[cell_color]] <- as.factor( - annotated_DT_centers[[cell_color]]) - if (show_cluster_center == TRUE) { - pl <- pl %>% plotly::add_trace( - mode = "markers", - type = "scatter3d", - data = annotated_DT_centers, - x = ~center_1, - y = ~center_2, - z = ~center_3, - color = annotated_DT_centers[[cell_color]], - colors = cell_color_code, - inherit = FALSE, - marker = list(size = 2, symbol = "x", symbols = "x"), - legendgroup = annotated_DT_centers[[cell_color]], - showlegend = FALSE - ) - } - if (show_center_label == TRUE) { - message(" center label is not clear to see in 3D plot\n You - can shut it down with show_center_label = FALSE") - pl <- pl %>% plotly::add_trace( - mode = "text", - type = "scatter3d", - data = annotated_DT_centers, - x = ~center_1, - y = ~center_2, - z = ~center_3, - text = annotated_DT_centers[[cell_color]], - legendgroup = annotated_DT_centers[[cell_color]], - inherit = FALSE, - showlegend = FALSE - ) - } - } - } else { - stop("cell_color does not exist!\n") - } - } - - if (show_NN_network) { - edges <- plotly_network( - annotated_network_DT, - "from_Dim.1", "from_Dim.2", "from_Dim.3", - "to_Dim.1", "to_Dim.2", "to_Dim.3" - ) - if (is.null(edge_alpha)) { - edge_alpha <- 0.5 - } else if (is.character(edge_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - edge_alpha <- 0.5 - } - - pl <- pl %>% plotly::add_trace( - name = network_name, - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, y = ~y, z = ~z, - inherit = FALSE, - line = list(color = "lightgray", width = 0.5), - opacity = edge_alpha - ) - } - - if (dim_reduction_to_use == "pca") { - if (!is.null(eigenvalues)) { - x_name <- paste0("pca", "-", dim_names[1]) - y_name <- paste0("pca", "-", dim_names[2]) - z_name <- paste0("pca", "-", dim_names[3]) - x_title <- sprintf("%s explains %.02f%% of variance", - x_name, var_expl_vec[1]) - y_title <- sprintf("%s explains %.02f%% of variance", - y_name, var_expl_vec[2]) - z_title <- sprintf("%s explains %.02f%% of variance", - z_name, var_expl_vec[3]) - } - } else { - x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - z_title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") - } - pl <- pl %>% plotly::layout( - scene = list( - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - ), - legend = list(x = 100, y = 0.5, - font = list(family = "sans-serif", size = 12)) - ) - return(pl) -} - - - - - - - -#' @rdname dimPlot -#' @returns plotly (dimplot3D only) -#' @export -dimPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - dim3_to_use = 3, - spat_enr_names = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 2, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - color_as_factor = TRUE, - cell_color = NULL, - cell_color_code = NULL, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 4, - edge_alpha = NULL, - point_size = 3, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "dim3D") { - if (is.null(dim3_to_use)) { - message("create 2D plot") - - pl <- .dimPlot_2d_plotly( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - spat_enr_names = spat_enr_names, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - color_as_factor = color_as_factor, - cell_color = cell_color, - cell_color_code = cell_color_code, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - label_size = label_size, - edge_alpha = edge_alpha, - point_size = point_size - ) - } else { - message("create 3D plot") - pl <- .dimPlot_3d_plotly( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - dim_reduction_to_use = dim_reduction_to_use, - dim_reduction_name = dim_reduction_name, - dim1_to_use = dim1_to_use, - dim2_to_use = dim2_to_use, - dim3_to_use = dim3_to_use, - spat_enr_names = spat_enr_names, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_NN_network = show_NN_network, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - color_as_factor = color_as_factor, - cell_color = cell_color, - cell_color_code = cell_color_code, - show_cluster_center = show_cluster_center, - show_center_label = show_center_label, - center_point_size = center_point_size, - label_size = label_size, - edge_alpha = edge_alpha, - point_size = point_size - ) - } - - - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - ## print plot - if (show_plot == TRUE) { - print(pl) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = pl, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(pl) - } -} - - -#' @title plotUMAP_3D -#' @name plotUMAP_3D -#' @description Visualize cells according to dimension reduction coordinates -#' @param gobject giotto object -#' @param dim_reduction_name name of UMAP -#' @param default_save_name default save name of UMAP plot -#' @inheritDotParams dimPlot3D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters. -#' @family reduced dimension visualizations -#' @returns plotly -#' @examples -#' g <- GiottoData::loadGiottoMini("starmap") -#' plotUMAP_3D(g, dim_reduction_name = "3D_umap") -#' -#' @export -plotUMAP_3D <- function(gobject, - dim_reduction_name = "umap", - default_save_name = "UMAP_3D", - ...) { - dimPlot3D( - gobject = gobject, - dim_reduction_to_use = "umap", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - -#' @title plotTSNE_3D -#' @name plotTSNE_3D -#' @description Visualize cells according to dimension reduction coordinates -#' @param gobject giotto object -#' @param dim_reduction_name name of TSNE -#' @param default_save_name default save name of TSNE plot -#' @inheritDotParams dimPlot3D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters. -#' @family reduced dimension visualizations -#' @returns plotly -#' @examples -#' g <- GiottoData::loadGiottoMini("starmap") -#' plotTSNE_3D(g) -#' -#' @export -plotTSNE_3D <- function(gobject, - dim_reduction_name = "tsne", - default_save_name = "TSNE_3D", - ...) { - dimPlot3D( - gobject = gobject, - dim_reduction_to_use = "tsne", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - -#' @title plotPCA_3D -#' @name plotPCA_3D -#' @description Visualize cells according to 3D PCA dimension reduction -#' @param gobject giotto object -#' @param dim_reduction_name name of PCA -#' @param default_save_name default save name of PCA plot -#' @inheritDotParams dimPlot3D -gobject -dim_reduction_to_use -#' -dim_reduction_name -default_save_name -#' @details Description of parameters. -#' @family reduced dimension visualizations -#' @returns plotly -#' @examples -#' g <- GiottoData::loadGiottoMini("starmap") -#' plotPCA_3D(g) -#' -#' @export -plotPCA_3D <- function(gobject, - dim_reduction_name = "pca", - default_save_name = "PCA_3D", - ...) { - dimPlot3D( - gobject = gobject, - dim_reduction_to_use = "pca", - dim_reduction_name = dim_reduction_name, - default_save_name = default_save_name, - ... - ) -} - - - - - - -# ** #### -# ** spatial 3D plot #### - -#' @title .spatPlot_2d_plotly -#' @name .spatPlot_2d_plotly -#' @description Visualize cells at their 2D spatial locations with plotly -#' @returns plotly object -#' @keywords internal -.spatPlot_2d_plotly <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - sdimx = NULL, - sdimy = NULL, - spat_enr_names = NULL, - point_size = 3, - cell_color = NULL, - cell_color_code = NULL, - color_as_factor = TRUE, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_network = FALSE, - spatial_network_name = "spatial_network", - network_color = "lightgray", - network_alpha = 1, - other_cell_alpha = 0.5, - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - grid_color = NULL, - grid_alpha = 1, - show_legend = TRUE, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - show_plot = FALSE) { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - ## get spatial cell locations - cell_locations <- get_spatial_locations(gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - output = "data.table" - ) - if (is.null(cell_locations)) { - return(NULL) - } - - - ## extract spatial network - if (show_network == TRUE) { - spatial_network <- get_spatialNetwork(gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - ## extract spatial grid - if (show_grid == TRUE) { - spatial_grid <- get_spatialGrid(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spatial_grid_name - ) - } else { - spatial_grid <- NULL - } - - ## get cell metadata - cell_metadata <- try( - expr = combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - spat_enr_names = spat_enr_names - ), - silent = TRUE - ) - - - if (inherits(cell_metadata, "try-error")) { - cell_locations_metadata <- cell_locations - } else if (nrow(cell_metadata) == 0) { - cell_locations_metadata <- cell_locations - } else { - cell_locations_metadata <- cell_metadata - } - - ## create subsets if needed - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- cell_locations_metadata[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- cell_locations_metadata[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - - if (!is.null(select_cells)) { - cell_locations_metadata_other <- cell_locations_metadata[ - !cell_locations_metadata$cell_ID %in% select_cells] - cell_locations_metadata_selected <- cell_locations_metadata[ - cell_locations_metadata$cell_ID %in% select_cells] - spatial_network <- spatial_network[spatial_network$to %in% - select_cells & spatial_network$from %in% - select_cells] - - # if specific cells are selected - # cell_locations_metadata = cell_locations_metadata_selected - } else if (is.null(select_cells)) { - cell_locations_metadata_selected <- cell_locations_metadata - cell_locations_metadata_other <- NULL - } - - - - ### set scale - axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) - - ### set ratio - ratio <- plotly_axis_scale_2D(cell_locations, - sdimx = sdimx, - sdimy = sdimy, - mode = axis_scale, - custom_ratio = custom_ratio - ) - - - - pl <- plotly::plot_ly() - - ## create network - if (show_network == TRUE) { - if (is.null(spatial_network)) { - stop("No usable spatial network specified! Please choose a - network with spatial_network_name=xxx") - } else { - if (is.null(network_alpha)) { - network_alpha <- 0.5 - } else if (is.character(network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - network_alpha <- 0.5 - } - pl <- pl %>% plotly::add_segments( - name = spatial_network_name, - type = "scatter", - x = spatial_network[["sdimx_begin"]], - y = spatial_network[["sdimy_begin"]], - xend = spatial_network[["sdimx_end"]], - yend = spatial_network[["sdimy_end"]], - line = list( - color = network_color, - width = 0.5 - ), - opacity = network_alpha - ) - } - } - - ## create grid - if (show_grid == TRUE) { - if (is.null(spatial_grid)) { - stop("No usable spatial grid specified! Please choose a - network with spatial_grid_name=xxx") - } else { - if (is.null(grid_color)) { - grid_color <- "black" - } - edges <- plotly_grid(spatial_grid) - pl <- pl %>% plotly::add_segments( - name = "spatial_grid", - type = "scatter", - data = edges, - x = ~x, - y = ~y, - xend = ~x_end, - yend = ~y_end, - line = list( - color = grid_color, - width = 1 - ), - opacity = grid_alpha - ) - } - } - - - - if (!is.null(cell_color)) { - if (cell_color %in% colnames(cell_locations_metadata_selected)) { - if (is.null(cell_color_code)) { - number_colors <- length(unique( - cell_locations_metadata_selected[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - } - cell_locations_metadata_selected[[cell_color]] <- as.factor( - cell_locations_metadata_selected[[cell_color]]) - pl <- pl %>% plotly::add_trace( - type = "scatter", - mode = "markers", - x = cell_locations_metadata_selected[[sdimx]], - y = cell_locations_metadata_selected[[sdimy]], - color = cell_locations_metadata_selected[[cell_color]], - colors = cell_color_code, - marker = list(size = point_size) - ) - - - if (!is.null(select_cells) & show_other_cells) { - pl <- pl %>% plotly::add_trace( - type = "scatter", - mode = "markers", - data = cell_locations_metadata_other, - name = "unselected cells", - x = ~sdimx, - y = ~sdimy, - marker = list(size = other_point_size, - color = other_cell_color), - opacity = other_cell_alpha - ) - } - } else { - message("cell_color does not exist!") - } - } else { - pl <- pl %>% plotly::add_trace( - type = "scatter", - mode = "markers", - name = "selected cells", - x = cell_locations_metadata_selected[[sdimx]], - y = cell_locations_metadata_selected[[sdimy]], - colors = "lightblue", - marker = list(size = point_size) - ) - - if (!is.null(select_cells) & show_other_cells) { - pl <- pl %>% plotly::add_trace( - type = "scatter", - mode = "markers", - data = cell_locations_metadata_other, - name = "unselected cells", - x = ~sdimx, - y = ~sdimy, - marker = list( - size = other_point_size, - color = other_cell_color - ), - opacity = other_cell_alpha - ) - } - } - - - pl <- pl %>% - plotly::layout( - list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks) - ), - legend = list( - x = 100, y = 0.5, - font = list( - family = "sans-serif", - size = 12 - ) - ) - ) - - - return((pl)) -} - - - -#' @title .spatPlot_3d_plotly -#' @name .spatPlot_3d_plotly -#' @description Visualize cells at their 3D spatial locations with plotly -#' @returns plotly object -#' @keywords internal -.spatPlot_3d_plotly <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - sdimx = NULL, - sdimy = NULL, - sdimz = NULL, - spat_enr_names = NULL, - point_size = 3, - cell_color = NULL, - cell_color_code = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_network = FALSE, - spatial_network_name = "spatial_network", - network_color = NULL, - network_alpha = 1, - other_cell_alpha = 0.5, - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - title = "", - show_legend = TRUE, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - show_plot = FALSE) { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - ## get spatial cell locations - cell_locations <- get_spatial_locations(gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - output = "data.table" - ) - if (is.null(cell_locations)) { - return(NULL) - } - - ## extract spatial network - if (show_network == TRUE) { - spatial_network <- get_spatialNetwork(gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - ## extract spatial grid - if (show_grid == TRUE) { - spatial_grid <- get_spatialGrid(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spatial_grid_name - ) - } else { - spatial_grid <- NULL - } - - ## get cell metadata - cell_metadata <- try( - expr = combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - spat_enr_names = spat_enr_names - ), - silent = TRUE - ) - - - if (inherits(cell_metadata, "try-error")) { - cell_locations_metadata <- cell_locations - } else if (nrow(cell_metadata) == 0) { - cell_locations_metadata <- cell_locations - } else { - cell_locations_metadata <- cell_metadata - } - - - ## create subsets if needed - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - message("You have selected both individual cell IDs and a group of - cells") - group_cell_IDs <- cell_locations_metadata[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- cell_locations_metadata[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - cell_locations_metadata_other <- cell_locations_metadata[ - !cell_locations_metadata$cell_ID %in% select_cells] - cell_locations_metadata_selected <- cell_locations_metadata[ - cell_locations_metadata$cell_ID %in% select_cells] - spatial_network <- spatial_network[spatial_network$to %in% - select_cells & spatial_network$from %in% select_cells] - - # if specific cells are selected - # cell_locations_metadata = cell_locations_metadata_selected - } else if (is.null(select_cells)) { - cell_locations_metadata_selected <- cell_locations_metadata - cell_locations_metadata_other <- NULL - } - - - - ### set scale - axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) - - ### set ratio - ratio <- plotly_axis_scale_3D(cell_locations, - sdimx = sdimx, - sdimy = sdimy, - sdimz = sdimz, - mode = axis_scale, - custom_ratio = custom_ratio - ) - - - - pl <- plotly::plot_ly() - if (!is.null(cell_color)) { - if (cell_color %in% colnames(cell_locations_metadata_selected)) { - if (is.null(cell_color_code)) { - number_colors <- length(unique( - cell_locations_metadata_selected[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - } - cell_locations_metadata_selected[[cell_color]] <- as.factor( - cell_locations_metadata_selected[[cell_color]]) - pl <- pl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - data = cell_locations_metadata_selected, - x = ~sdimx, y = ~sdimy, z = ~sdimz, - color = cell_locations_metadata_selected[[cell_color]], - colors = cell_color_code, - marker = list(size = point_size) - ) - - - if (!is.null(select_cells) & show_other_cells) { - pl <- pl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - data = cell_locations_metadata_other, - name = "unselected cells", - x = ~sdimx, - y = ~sdimy, - z = ~sdimz, - marker = list( - size = other_point_size, - color = other_cell_color - ), - opacity = other_cell_alpha - ) - } - } else { - message("cell_color does not exist!") - } - } else { - pl <- pl %>% plotly::add_trace( - type = "scatter3d", - data = cell_locations_metadata_selected, - x = ~sdimx, - y = ~sdimy, - z = ~sdimz, - mode = "markers", - marker = list(size = point_size), - colors = "lightblue", name = "selected cells" - ) - - if (!is.null(select_cells) & show_other_cells) { - pl <- pl %>% plotly::add_trace( - type = "scatter3d", - mode = "markers", - data = cell_locations_metadata_other, - name = "unselected cells", - x = ~sdimx, y = ~sdimy, z = ~sdimz, - marker = list( - size = other_point_size, - color = other_cell_color - ), - opacity = other_cell_alpha - ) - } - } - - - ## plot spatial network - if (!is.null(spatial_network) & show_network == TRUE) { - if (is.null(network_color)) { - network_color <- "red" - } - edges <- plotly_network(spatial_network) - - pl <- pl %>% plotly::add_trace( - name = "sptial network", - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, - y = ~y, - z = ~z, - line = list(color = network_color, width = 0.5), - opacity = network_alpha - ) - } - - ## plot spatial grid - # 3D grid is not clear to view - - - pl <- pl %>% - plotly::layout( - scene = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - legend = list( - x = 100, y = 0.5, - font = list(family = "sans-serif", size = 12) - ) - ) - - - return(pl) -} - - - - - -#' @rdname spatPlot -#' @param sdimz z-axis dimension name (default = 'sdimy') -#' @param grid_alpha opacity of spatial grid -#' @param axis_scale the way to scale the axis -#' @param custom_ratio customize the scale of the plot -#' @param x_ticks set the number of ticks on the x-axis -#' @param y_ticks set the number of ticks on the y-axis -#' @param z_ticks set the number of ticks on the z-axis -#' @export -spatPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - spat_enr_names = NULL, - point_size = 3, - cell_color = NULL, - cell_color_code = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - other_cell_alpha = 0.5, - show_network = FALSE, - spatial_network_name = "Delaunay_network", - network_color = NULL, - network_alpha = 1, - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - grid_color = NULL, - grid_alpha = 1, - title = "", - show_legend = TRUE, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spat3D") { - if (is.null(sdimz)) { - message("create 2D plot") - - pl <- .spatPlot_2d_plotly( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - sdimx = sdimx, - sdimy = sdimy, - point_size = point_size, - cell_color = cell_color, - cell_color_code = cell_color_code, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_network = show_network, - network_color = network_color, - network_alpha = network_alpha, - other_cell_alpha = other_cell_alpha, - spatial_network_name = spatial_network_name, - show_grid = show_grid, - grid_color = grid_color, - grid_alpha = grid_alpha, - spatial_grid_name = spatial_grid_name, - show_legend = show_legend, - axis_scale = axis_scale, - custom_ratio = custom_ratio, - x_ticks = x_ticks, - y_ticks = y_ticks, - show_plot = FALSE - ) - } else { - message("create 3D plot") - pl <- .spatPlot_3d_plotly( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - sdimx = sdimx, - sdimy = sdimy, - sdimz = sdimz, - point_size = point_size, - cell_color = cell_color, - cell_color_code = cell_color_code, - select_cell_groups = select_cell_groups, - select_cells = select_cells, - show_other_cells = show_other_cells, - other_cell_color = other_cell_color, - other_point_size = other_point_size, - show_network = show_network, - network_color = network_color, - network_alpha = network_alpha, - other_cell_alpha = other_cell_alpha, - spatial_network_name = spatial_network_name, - spatial_grid_name = spatial_grid_name, - show_legend = show_legend, - axis_scale = axis_scale, - custom_ratio = custom_ratio, - x_ticks = x_ticks, - y_ticks = y_ticks, - z_ticks = z_ticks, - show_plot = FALSE - ) - } - - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - ## print plot - if (show_plot == TRUE) { - print(pl) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = pl, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(pl) - } -} - - - - - - - - - -# ** #### -# ** spatial & dimension 3D plot #### - -#' @title spatDimPlot3D -#' @name spatDimPlot3D -#' @description Visualize cells according to spatial AND dimension -#' reduction coordinates in plotly mode -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @inheritParams plot_cell_params -#' @param plot_alignment direction to align plot -#' @param dim_reduction_to_use dimension reduction to use -#' @param dim_reduction_name dimension reduction name -#' @param dim1_to_use dimension to use on x-axis -#' @param dim2_to_use dimension to use on y-axis -#' @param dim3_to_use dimension to use on z-axis -#' -#' @param spat_loc_name name for spatial locations -#' @param sdimx = spatial dimension to use on x-axis -#' @param sdimy = spatial dimension to use on y-axis -#' @param sdimz = spatial dimension to use on z-axis -#' -#' @param spat_enr_names names of spatial enrichment results to include -#' @param show_NN_network show underlying NN network -#' @param nn_network_to_use type of NN network to use (kNN vs sNN) -#' @param network_name name of NN network to use, if show_NN_network = TRUE -#' @param show_cluster_center show the center of each cluster -#' @param show_center_label provide a label for each cluster -#' @param center_point_size size of the center point -#' @param label_size size of the center label -#' -#' @param select_cell_groups select subset of cells/clusters based on -#' cell_color parameter -#' @param select_cells select subset of cells based on cell IDs -#' @param show_other_cells display not selected cells -#' @param other_cell_color color of not selected cells -#' @param other_point_size size of not selected cells -#' -#' @param dim_point_size size of points in dim. reduction space -#' @param nn_network_color color of nn network -#' @param nn_network_alpha column to use for alpha of the edges -#' @param show_spatial_network show spatial network -#' @param spatial_network_name name of spatial network to use -#' @param spatial_network_color color of spatial network -#' -#' @param show_spatial_grid show spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' @param spatial_grid_color color of spatial grid -#' @param spatial_grid_alpha alpha of spatial grid -#' @param spatial_point_size size of spatial points -#' @param spatial_network_color color of spatial network -#' @param spatial_network_alpha alpha of spatial network -#' -#' @param axis_scale the way to scale the axis -#' @param custom_ratio customize the scale of the plot -#' @param x_ticks set the number of ticks on the x-axis -#' @param y_ticks set the number of ticks on the y-axis -#' @param z_ticks set the number of ticks on the z-axis -#' @param legend_text_size size of legend -#' @returns plotly -#' @details Description of parameters. -#' @family spatial and dimension reduction visualizations -#' @export -spatDimPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - plot_alignment = c("horizontal", "vertical"), - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - dim3_to_use = 3, - spat_loc_name = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - spat_enr_names = NULL, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - nn_network_color = "lightgray", - nn_network_alpha = 0.5, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 16, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1.5, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - dim_point_size = 3, - show_spatial_network = FALSE, - spatial_network_name = "Delaunay_network", - spatial_network_color = "lightgray", - spatial_network_alpha = 0.5, - show_spatial_grid = FALSE, - spatial_grid_name = "spatial_grid", - spatial_grid_color = NULL, - spatial_grid_alpha = 0.5, - spatial_point_size = 3, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - legend_text_size = 12, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatDimPlot3D") { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # data.table variables - cell_ID <- NULL - - plot_alignment <- match.arg(plot_alignment, - choices = c("horizontal", "vertical")) - - # ********data prepare********# - ## dimension reduction ## - dim_dfr <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] - dim_names <- colnames(dim_dfr) - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, cell_ID := rownames(dim_dfr)] - - - ## annotated cell metadata - cell_metadata <- combineMetadata( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - spat_enr_names = spat_enr_names - ) - annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") - spatial_locations <- getSpatialLocations( - gobject, - spat_unit = spat_unit, - name = spat_loc_name, - output = "data.table" - ) - if (is.null(spatial_locations)) { - return(NULL) - } - - annotated_DT <- merge(annotated_DT, spatial_locations, by = "cell_ID") - - - if (dim_reduction_to_use == "pca") { - pca_object <- get_dimReduction( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "dimObj" - ) - eigenvalues <- slot(pca_object, "misc")$eigenvalues - - if (!is.null(eigenvalues)) { - total <- sum(eigenvalues) - var_expl_vec <- (eigenvalues / total) * 100 - dim1_x_variance <- var_expl_vec[dim1_to_use] - dim2_y_variance <- var_expl_vec[dim2_to_use] - if (!is.null(dim3_to_use)) { - dim3_z_variance <- var_expl_vec[3] - } - } - } - - - - ## nn network - if (show_NN_network) { - # nn_network - selected_nn_network <- get_NearestNetwork( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - output = "igraph" - ) - network_DT <- data.table::as.data.table(igraph::as_data_frame( - selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- merge(network_DT, dim_DT, by.x = "from", - by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = from_dim_names) - - annotated_network_DT <- merge(annotated_network_DT, dim_DT, - by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = to_dim_names) - } - - - - - ## extract spatial network - if (show_spatial_network == TRUE) { - spatial_network <- get_spatialNetwork(gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - - ## extract spatial grid - if (show_spatial_grid == TRUE) { - spatial_grid <- get_spatialGrid(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spatial_grid_name - ) - } else { - spatial_grid <- NULL - } - - - # create matching cell_color_code - if (is.null(cell_color_code)) { - if (is.character(cell_color)) { - cell_metadata <- pDataDT(gobject, - feat_type = feat_type, - spat_unit = spat_unit - ) - if (cell_color %in% colnames(cell_metadata)) { - if (color_as_factor == TRUE) { - number_colors <- length(unique(cell_metadata[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject))(n = number_colors) - names(cell_color_code) <- unique( - cell_metadata[[cell_color]]) - } - } - } - } - - - ## subset cell selection ## - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - if (is.null(cell_color)) { - stop("\n selection of cells is based on cell_color paramter, - which is a metadata column \n") - } - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- annotated_DT[get(cell_color) %in% - select_cell_groups][["cell_ID"]] - } - - - if (!is.null(select_cells)) { - annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% - select_cells] - annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% - select_cells] - - if (show_NN_network == TRUE) { - annotated_network_DT <- annotated_network_DT[ - annotated_network_DT$to %in% select_cells & - annotated_network_DT$from %in% select_cells] - } - if (show_spatial_network == TRUE) { - spatial_network <- spatial_network[spatial_network$to %in% - select_cells & - spatial_network$from %in% - select_cells] - } - - # if specific cells are selected - # annotated_DT = annotated_DT_selected - } - - - ## if no subsets are required - if (is.null(select_cells) & is.null(select_cell_groups)) { - annotated_DT_selected <- annotated_DT - annotated_DT_other <- NULL - } - - ## annotated_DT_selected = all selected cells or all cells if no selection - ## annotated_DT_other = all not selected cells or NULL if no selection - - - - ########### dim plot ########### - # 2D plot - if (is.null(dim3_to_use)) { - dpl <- plotly::plot_ly() - if (show_NN_network == TRUE) { - if (is.null(nn_network_alpha)) { - nn_network_alpha <- 0.5 - } else if (is.character(nn_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - nn_network_alpha <- 0.5 - } - dpl <- dpl %>% plotly::add_segments( - name = network_name, - type = "scatter", - x = annotated_network_DT[[from_dim_names[1]]], - y = annotated_network_DT[[from_dim_names[2]]], - xend = annotated_network_DT[[to_dim_names[1]]], - yend = annotated_network_DT[[to_dim_names[2]]], - line = list( - color = nn_network_color, - width = 0.5 - ), - opacity = nn_network_alpha - ) - } - - if (is.null(cell_color)) { - # cell_color = "lightblue" - dpl <- dpl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - # color = "lightblue", - # colors ="lightblue", - marker = list( - size = dim_point_size, - color = "lightblue" - ), - showlegend = FALSE - ) - } else if (cell_color %in% colnames(annotated_DT_selected)) { - if (color_as_factor) { - annotated_DT_selected[[cell_color]] <- as.factor( - annotated_DT_selected[[cell_color]]) - } - - - dpl <- dpl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - color = annotated_DT_selected[[cell_color]], - colors = cell_color_code, - legendgroup = annotated_DT_selected[[cell_color]], - marker = list(size = dim_point_size) - ) - } else { - stop("cell_color does not exist!\n") - } - - - if ((show_cluster_center == TRUE | show_center_label == TRUE) & - !is.null(cell_color)) { - annotated_DT_centers <- annotated_DT_selected[, .( - center_1 = stats::median(get(dim_names[1])), - center_2 = stats::median(get(dim_names[2])) - ), - by = cell_color - ] - annotated_DT_centers[[cell_color]] <- as.factor( - annotated_DT_centers[[cell_color]]) - if (show_cluster_center == TRUE) { - dpl <- dpl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_centers[["center_1"]], - y = annotated_DT_centers[["center_2"]], - color = annotated_DT_centers[[cell_color]], - colors = cell_color_code, - legendgroup = annotated_DT_centers[[cell_color]], - marker = list(size = center_point_size, symbol = "x", - symbols = "x"), - showlegend = FALSE - ) - } - - if (show_center_label == TRUE) { - dpl <- dpl %>% plotly::add_text( - x = annotated_DT_centers[["center_1"]], - y = annotated_DT_centers[["center_2"]], - type = "scatter", mode = "text", - text = annotated_DT_centers[[cell_color]], - textposition = "middle right", - textfont = list( - color = "#000000", - size = label_size - ), - showlegend = FALSE - ) - } - } - if (show_other_cells == TRUE) { - dpl <- dpl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - if (dim_reduction_to_use == "pca") { - if (!is.null(eigenvalues)) { - x_name <- paste0("pca", "-", dim_names[1]) - y_name <- paste0("pca", "-", dim_names[2]) - x_title <- sprintf("%s explains %.02f%% of variance", - x_name, var_expl_vec[1]) - y_title <- sprintf("%s explains %.02f%% of variance", - y_name, var_expl_vec[2]) - } - } else { - x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - } - dpl <- dpl %>% plotly::layout( - xaxis = list(title = x_title), - yaxis = list(title = y_title), - legend = list(x = 100, y = 0.5, - font = list(family = "sans-serif", - size = legend_text_size)) - ) - } - # 3D plot - else if (!is.null(dim3_to_use)) { - dpl <- plotly::plot_ly(scene = "scene1") - if (is.null(cell_color)) { - # cell_color = "lightblue" - dpl <- dpl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - z = annotated_DT_selected[[dim_names[3]]], - color = "lightblue", - colors = "lightblue", - marker = list(size = dim_point_size), - showlegend = FALSE - ) - # legendgroup = annotated_DT_selected[[cell_color]]) - } else { - if (cell_color %in% colnames(annotated_DT_selected)) { - if (is.null(cell_color_code)) { - number_colors <- length(unique( - annotated_DT_selected[[cell_color]])) - cell_color_code <- set_default_color_discrete_cell( - instrs = instructions(gobject) - )(n = number_colors) - } - if (color_as_factor) { - annotated_DT_selected[[cell_color]] <- as.factor( - annotated_DT_selected[[cell_color]]) - } - dpl <- dpl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_selected[[dim_names[1]]], - y = annotated_DT_selected[[dim_names[2]]], - z = annotated_DT_selected[[dim_names[3]]], - color = annotated_DT_selected[[cell_color]], - colors = cell_color_code, - marker = list(size = dim_point_size), - legendgroup = annotated_DT_selected[[cell_color]] - ) - } else { - stop("cell_color does not exist!\n") - } - } - if (show_other_cells == TRUE) { - dpl <- dpl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - z = annotated_DT_other[[dim_names[3]]], - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - - if (show_NN_network) { - edges <- plotly_network( - annotated_network_DT, - "from_Dim.1", "from_Dim.2", "from_Dim.3", - "to_Dim.1", "to_Dim.2", "to_Dim.3" - ) - if (is.null(nn_network_alpha)) { - nn_network_alpha <- 0.5 - } else if (is.character(nn_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - nn_network_alpha <- 0.5 - } - - dpl <- dpl %>% plotly::add_trace( - name = network_name, - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, y = ~y, z = ~z, - line = list(color = nn_network_color), - opacity = nn_network_alpha - ) - } - if ((show_cluster_center == TRUE | show_center_label == TRUE) & - !is.null(cell_color)) { - annotated_DT_centers <- annotated_DT_selected[, .( - center_1 = stats::median(get(dim_names[1])), - center_2 = stats::median(get(dim_names[2])), - center_3 = stats::median(get(dim_names[3])) - ), - by = cell_color - ] - annotated_DT_centers[[cell_color]] <- as.factor( - annotated_DT_centers[[cell_color]]) - if (show_cluster_center == TRUE) { - dpl <- dpl %>% - plotly::add_trace( - mode = "markers", - type = "scatter3d", - data = annotated_DT_centers, - x = ~center_1, - y = ~center_2, - z = ~center_3, - color = annotated_DT_centers[[cell_color]], - colors = cell_color_code, - marker = list(size = 2, symbol = "x", symbols = "x"), - legendgroup = annotated_DT_centers[[cell_color]], - showlegend = FALSE - ) - } - if (show_center_label == TRUE) { - message(" center label is not clear to see in 3D plot. - You can shut it down with show_center_label = FALSE") - dpl <- dpl %>% - plotly::add_trace( - mode = "text", - type = "scatter3d", - data = annotated_DT_centers, - x = ~center_1, - y = ~center_2, - z = ~center_3, - text = annotated_DT_centers[[cell_color]], - legendgroup = annotated_DT_centers[[cell_color]], - showlegend = FALSE - ) - } - } - if (dim_reduction_to_use == "pca") { - x_name <- paste0("pca", "-", dim_names[1]) - y_name <- paste0("pca", "-", dim_names[2]) - z_name <- paste0("pca", "-", dim_names[3]) - x_title <- sprintf("%s explains %.02f%% of variance", - x_name, var_expl_vec[1]) - y_title <- sprintf("%s explains %.02f%% of variance", - y_name, var_expl_vec[2]) - z_title <- sprintf("%s explains %.02f%% of variance", - z_name, var_expl_vec[3]) - } else { - x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - z_title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") - } - } - - - - ############ spatial plot ########## - if (is.null(sdimx) | is.null(sdimy)) { - # cat('first and second dimension need to be defined, default is - # first 2 \n') - sdimx <- "sdimx" - sdimy <- "sdimy" - } - - ## 2D plot ## - if (is.null(sdimz)) { - spl <- plotly::plot_ly() - - if (show_spatial_network == TRUE) { - if (is.null(spatial_network)) { - stop("No usable spatial network specified! Please choose - a network with spatial_network_name=xxx") - } else { - if (is.null(spatial_network_alpha)) { - spatial_network_alpha <- 0.5 - } else if (is.character(spatial_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - spatial_network_alpha <- 0.5 - } - spl <- spl %>% plotly::add_segments( - name = spatial_network_name, - type = "scatter", - x = spatial_network[["sdimx_begin"]], - y = spatial_network[["sdimy_begin"]], - xend = spatial_network[["sdimx_end"]], - yend = spatial_network[["sdimy_end"]], - line = list( - color = spatial_network_color, - width = 0.5 - ), - opacity = spatial_network_alpha - ) - } - } - - - if (show_spatial_grid == TRUE) { - if (is.null(spatial_grid)) { - stop("No usable spatial grid specified! Please choose a - network with spatial_grid_name=xxx") - } else { - if (is.null(spatial_grid_color)) { - spatial_grid_color <- "black" - } - edges <- plotly_grid(spatial_grid) - spl <- spl %>% plotly::add_segments( - name = "spatial_grid", - type = "scatter", - data = edges, - x = ~x, - y = ~y, - xend = ~x_end, - yend = ~y_end, - line = list( - color = spatial_grid_color, - width = 1 - ), - opacity = spatial_grid_alpha - ) - } - } - if (is.null(cell_color)) { - # cell_color = "lightblue" - spl <- spl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_selected[[sdimx]], - y = annotated_DT_selected[[sdimy]], - # color = "lightblue", - # colors = "lightblue", - marker = list( - size = spatial_point_size, - color = "lightblue" - ), - showlegend = FALSE - ) - } else if (cell_color %in% colnames(annotated_DT_selected)) { - if (color_as_factor) { - annotated_DT_selected[[cell_color]] <- as.factor( - annotated_DT_selected[[cell_color]] - ) - } - - - spl <- spl %>% - plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_selected[[sdimx]], - y = annotated_DT_selected[[sdimy]], - color = annotated_DT_selected[[cell_color]], - colors = cell_color_code, - legendgroup = annotated_DT_selected[[cell_color]], - marker = list(size = spatial_point_size), - showlegend = FALSE - ) - } else { - stop("cell_color doesn't exist!\n") - } - if (show_other_cells == TRUE) { - spl <- spl %>% plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_other[[sdimx]], - y = annotated_DT_other[[sdimy]], - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - spl <- spl %>% plotly::layout( - xaxis = list(title = "X"), - yaxis = list(title = "Y"), - legend = list(x = 100, y = 0.5, - font = list(family = "sans-serif", - size = legend_text_size)) - ) - } - - - ## 3D plot ## - else { - axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) - - ratio <- plotly_axis_scale_3D(annotated_DT_selected, - sdimx = sdimx, sdimy = sdimy, sdimz = sdimz, - mode = axis_scale, custom_ratio = custom_ratio - ) - spl <- plotly::plot_ly(scene = "scene2") - if (!is.null(cell_color)) { - if (cell_color %in% colnames(annotated_DT_selected)) { - annotated_DT_selected[[cell_color]] <- as.factor( - annotated_DT_selected[[cell_color]]) - spl <- spl %>% - plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_selected[[sdimx]], - y = annotated_DT_selected[[sdimy]], - z = annotated_DT_selected[[sdimz]], - color = annotated_DT_selected[[cell_color]], - colors = cell_color_code, - legendgroup = annotated_DT_selected[[cell_color]], - marker = list(size = spatial_point_size), - showlegend = FALSE - ) - } else { - stop("cell_color doesn't exist!\n") - } - } else { - spl <- spl %>% - plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_selected$sdimx, - y = annotated_DT_selected$sdimy, - z = annotated_DT_selected$sdimz, - color = "lightblue", - colors = "lightblue", - # legendgroup = annotated_DT_selected[[cell_color]], - marker = list(size = spatial_point_size), - showlegend = FALSE - ) - } - if (show_other_cells == TRUE) { - spl <- spl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_other[[sdimx]], - y = annotated_DT_other[[sdimy]], - z = annotated_DT_other[[sdimz]], - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - if (show_spatial_network == TRUE) { - if (is.null(spatial_network)) { - stop("No usable spatial network specified! Please choose a - network with spatial_network_name=xxx") - } else { - if (is.null(spatial_network_alpha)) { - spatial_network_alpha <- 0.5 - } else if (is.character(spatial_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - spatial_network_alpha <- 0.5 - } - edges <- plotly_network(spatial_network) - - spl <- spl %>% plotly::add_trace( - name = "sptial network", - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, y = ~y, z = ~z, - line = list(color = spatial_network_color), - opacity = spatial_network_alpha - ) - } - } - - if (show_spatial_grid == TRUE) { - message("3D grid is not clear to view\n") - } - } - - - - - if (is.null(dim3_to_use) & is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot(dpl, spl, nrows = 2, - titleX = TRUE, titleY = TRUE) - } else { - combo_plot <- plotly::subplot(dpl, spl, titleX = TRUE, - titleY = TRUE) - } - } else if (!is.null(dim3_to_use) & is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot(dpl, spl, nrows = 2, titleX = TRUE, - titleY = TRUE) %>% - plotly::layout(scene = list( - domain = list(x = c(0, 1), y = c(0, 0.5)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - )) - } else { - combo_plot <- plotly::subplot(dpl, spl, titleX = TRUE, - titleY = TRUE) %>% - plotly::layout(scene = list( - domain = list(x = c(0, 0.5), y = c(0, 1)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - )) - } - } else if (is.null(dim3_to_use) & !is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot(dpl, spl, nrows = 2, titleX = TRUE, - titleY = TRUE) %>% - plotly::layout(scene2 = list( - domain = list(x = c(0, 1), y = c(0.5, 1)), - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - )) - } else { - combo_plot <- plotly::subplot(dpl, spl, titleX = TRUE, - titleY = TRUE) %>% - plotly::layout(scene2 = list( - domain = list(x = c(0.5, 1), y = c(0, 1)), - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - )) - } - } else if (!is.null(dim3_to_use) & !is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot(dpl, spl, nrows = 2, titleX = TRUE, - titleY = TRUE) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 1), y = c(0, 0.5)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - ), - scene2 = list( - domain = list(x = c(0, 1), y = c(0.5, 1)), - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ) - ) - } else { - combo_plot <- plotly::subplot(dpl, spl, titleX = TRUE, - titleY = TRUE) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 0.5), y = c(0, 1)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - ), - scene2 = list( - domain = list(x = c(0.5, 1), y = c(0, 1)), - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ) - ) - } - } - - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - ## print plot - if (show_plot == TRUE) { - print(combo_plot) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = combo_plot, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(combo_plot) - } -} - - - - -# ** #### -# ** feature 3D plot #### - -#' @title spatFeatPlot3D -#' @name spatFeatPlot3D -#' @description Visualize cells and gene expression according to spatial -#' coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @param spat_loc_name name of spatial locations to use -#' @param expression_values gene expression values to use -#' @param feats feats to show -#' @param spat_enr_names names of spatial enrichment results to include -#' -#' @param cluster_column cluster column to select groups -#' @param select_cell_groups select subset of cells/clusters based on -#' cell_color parameter -#' @param select_cells select subset of cells based on cell IDs -#' @param show_other_cells display not selected cells -#' @param other_cell_color color of not selected cells -#' @param other_point_size size of not selected cells -#' -#' @param genes_high_color color represents high gene expression -#' @param genes_mid_color color represents middle gene expression -#' @param genes_low_color color represents low gene expression -#' @param show_network show underlying spatial network -#' @param network_color color of spatial network -#' @param spatial_network_name name of spatial network to use -#' @param edge_alpha alpha of edges -#' @param show_grid show spatial grid -#' @param spatial_grid_name name of spatial grid to use -#' -#' @param point_size size of point (cell) -#' @param show_legend show legend -#' -#' @param axis_scale the way to scale the axis -#' @param custom_ratio customize the scale of the plot -#' @param x_ticks set the number of ticks on the x-axis -#' @param y_ticks set the number of ticks on the y-axis -#' @param z_ticks set the number of ticks on the z-axis -#' @param ... additional params to pass -#' @family spatial gene expression visualizations -#' @returns plotly -#' @examples -#' g <- GiottoData::loadGiottoMini("starmap") -#' spatFeatPlot3D(g, feats = "Slc17a7") -#' -#' @export -spatFeatPlot3D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = "raw", - expression_values = c("normalized", "scaled", "custom"), - feats, - spat_enr_names = NULL, - show_network = FALSE, - network_color = NULL, - spatial_network_name = "Delaunay_network", - edge_alpha = NULL, - cluster_column = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = FALSE, - other_cell_color = "lightgrey", - other_point_size = 1, - genes_high_color = NULL, - genes_mid_color = "white", - genes_low_color = "blue", - show_grid = FALSE, - spatial_grid_name = "spatial_grid", - point_size = 2, - show_legend = TRUE, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatFeatPlot3D", - ... -) { - - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # data.table variables - cell_ID <- NULL - - selected_genes <- feats - - values <- match.arg(expression_values, c("normalized", "scaled", "custom")) - expr_values <- getExpression( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - values = values, - output = "matrix" - ) - - # only keep genes that are in the dataset - selected_genes <- selected_genes[selected_genes %in% rownames(expr_values)] - - # get selected feature expression values in data.table format - if (length(selected_genes) == 1) { - subset_expr_data <- expr_values[rownames(expr_values) %in% - selected_genes, ] - t_sub_expr_data_DT <- data.table::data.table( - "selected_gene" = subset_expr_data, - "cell_ID" = colnames(expr_values)) - data.table::setnames(t_sub_expr_data_DT, - "selected_gene", selected_genes) - } else { - subset_expr_data <- expr_values[rownames(expr_values) %in% - selected_genes, ] - t_sub_expr_data <- t_flex(subset_expr_data) - t_sub_expr_data_DT <- data.table::as.data.table( - as.matrix(t_sub_expr_data)) - t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] - } - - - ## extract cell locations - cell_locations <- getSpatialLocations( - gobject = gobject, - spat_unit = spat_unit, - name = spat_loc_name, - output = "data.table" - ) - if (is.null(cell_locations)) { - return(NULL) - } - - - ## extract spatial network - if (show_network == TRUE) { - spatial_network <- get_spatialNetwork(gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - ## extract spatial grid - if (show_grid == TRUE) { - spatial_grid <- get_spatialGrid(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spatial_grid_name - ) - } else { - spatial_grid <- NULL - } - - ## extract cell metadata - cell_metadata <- try( - expr = combineMetadata( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spat_loc_name = spat_loc_name, - spat_enr_names = spat_enr_names - ), - silent = TRUE - ) - - - if (inherits(cell_metadata, "try-error")) { - cell_locations_metadata <- cell_locations - } else if (nrow(cell_metadata) == 0) { - cell_locations_metadata <- cell_locations - } else { - cell_locations_metadata <- cell_metadata - } - - - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- cell_locations_metadata[get(cluster_column) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- cell_locations_metadata[get(cluster_column) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - cell_locations_metadata_other <- cell_locations_metadata[ - !cell_locations_metadata$cell_ID %in% select_cells] - cell_locations_metadata_selected <- cell_locations_metadata[ - cell_locations_metadata$cell_ID %in% select_cells] - spatial_network <- spatial_network[spatial_network$to %in% - select_cells & spatial_network$from %in% select_cells] - - # if specific cells are selected - cell_locations_metadata <- cell_locations_metadata_selected - } - - cell_locations_metadata_genes <- merge(cell_locations_metadata, - t_sub_expr_data_DT, by = "cell_ID") - - - - ## plotting ## - axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) - - ratio <- plotly_axis_scale_3D(cell_locations_metadata_genes, - sdimx = "sdimx", sdimy = "sdimy", sdimz = "sdimz", - mode = axis_scale, custom_ratio = custom_ratio - ) - - - ## spatial network data - if (!is.null(spatial_network) & show_network == TRUE) { - edges <- plotly_network(spatial_network) - } - - ## Point layer - if (length(selected_genes) > 4) { - stop("\n The max number of genes showed together is 4.Otherwise - it will be too small to see\n - \n If you have more genes to show, please divide them - into groups\n") - } - savelist <- list() - for (i in seq_len(length(selected_genes))) { - gene <- selected_genes[i] - if (!is.null(genes_high_color)) { - if (length(genes_high_color) != length(selected_genes) & - length(genes_high_color) != 1) { - stop("\n The number of genes and their corresbonding do - not match\n") - } else if (length(genes_high_color) == 1) { - genes_high_color <- rep(genes_high_color, - length(selected_genes)) - } - } else { - genes_high_color <- rep("red", length(selected_genes)) - } - pl <- plotly::plot_ly( - name = gene, - scene = paste("scene", i, sep = "") - ) %>% - plotly::add_trace( - data = cell_locations_metadata_genes, - type = "scatter3d", mode = "markers", - x = ~sdimx, y = ~sdimy, z = ~sdimz, - marker = list(size = point_size), - color = cell_locations_metadata_genes[[gene]], - colors = c(genes_low_color, genes_mid_color, - genes_high_color[i]) - ) - - if (show_other_cells == TRUE) { - pl <- pl %>% plotly::add_trace( - name = "unselected cells", - data = cell_locations_metadata_other, - type = "scatter3d", mode = "markers", - x = ~sdimx, y = ~sdimy, z = ~sdimz, - marker = list(size = other_point_size, color = other_cell_color) - ) - } - - - ## plot spatial network - if (show_network == TRUE) { - if (is.null(network_color)) { - network_color <- "lightblue" - } - if (is.null(edge_alpha)) { - edge_alpha <- 0.5 - } else if (is.character(edge_alpha)) { - edge_alpha <- 0.5 - message("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set") - } - pl <- pl %>% plotly::add_trace( - name = "sptial network", - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, y = ~y, z = ~z, - line = list(color = network_color, width = 0.5), - opacity = edge_alpha, - showlegend = FALSE - ) - } - - - ## plot spatial grid - if (!is.null(spatial_grid) & show_grid == TRUE) { - message("spatial grid is not clear in 3D plot") - } - - pl <- pl %>% plotly::colorbar(title = gene) - savelist[[gene]] <- pl - } - - - if (length(savelist) == 1) { - cowplot <- savelist[[1]] %>% plotly::layout(scene = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - )) - } else if (length(savelist) == 2) { - cowplot <- plotly::subplot(savelist) %>% - plotly::layout( - scene = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - # annotations = annotations, - legend = list(x = 100, y = 0) - ) - } else if (length(savelist) == 3) { - cowplot <- plotly::subplot(savelist) %>% - plotly::layout( - scene = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - scene3 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - legend = list(x = 100, y = 0) - ) - } else if (length(savelist) == 4) { - cowplot <- plotly::subplot(savelist) %>% - plotly::layout( - scene = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - scene3 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - scene4 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ), - legend = list(x = 100, y = 0) - ) - } - - - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - ## print plot - if (show_plot == TRUE) { - print(cowplot) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = cowplot, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(cowplot) - } -} - -#' @describeIn spatFeatPlot3D deprecated -#' @export -spatGenePlot3D <- function(...) { - deprecate_warn( - when = "0.2.0", - what = "spatGenePlot3D()", - with = "spatFeatPlot3D()" - ) - spatFeatPlot3D(...) -} - - -#' @title dimFeatPlot3D -#' @name dimFeatPlot3D -#' @description Visualize cells and gene expression according to -#' dimension reduction coordinates -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @param expression_values gene expression values to use -#' @param genes genes to show -#' @param dim_reduction_to_use dimension reduction to use -#' @param dim_reduction_name dimension reduction name -#' @param dim1_to_use dimension to use on x-axis -#' @param dim2_to_use dimension to use on y-axis -#' @param dim3_to_use dimension to use on z-axis -#' -#' @param show_NN_network show underlying NN network -#' @param nn_network_to_use type of NN network to use (kNN vs sNN) -#' @param network_name name of NN network to use, if show_NN_network = TRUE -#' @param network_color color of NN network -#' -#' @param cluster_column cluster column to select groups -#' @param select_cell_groups select subset of cells/clusters based on -#' cell_color parameter -#' @param select_cells select subset of cells based on cell IDs -#' @param show_other_cells display not selected cells -#' @param other_cell_color color of not selected cells -#' @param other_point_size size of not selected cells -#' -#' @param edge_alpha column to use for alpha of the edges -#' @param point_size size of point (cell) -#' -#' @param genes_high_color color for high expression levels -#' @param genes_mid_color color for medium expression levels -#' @param genes_low_color color for low expression levels -#' -#' @param show_legend show legend -#' @details Description of parameters. -#' @family dimension reduction gene expression visualizations -#' @returns plotly -#' @examples -#' g <- GiottoData::loadGiottoMini("starmap") -#' -#' dimFeatPlot3D(g, genes = "Slc17a7", dim_reduction_name = "3D_umap") -#' @export -dimFeatPlot3D <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - expression_values = c("normalized", "scaled", "custom"), - genes = NULL, - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - dim3_to_use = 3, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - network_name = "sNN.pca", - network_color = "lightgray", - cluster_column = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - edge_alpha = NULL, - point_size = 2, - genes_high_color = NULL, - genes_mid_color = "white", - genes_low_color = "blue", - show_legend = TRUE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "dimFeatPlot3D") { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - ## select genes ## - selected_genes <- genes - values <- match.arg(expression_values, c("normalized", "scaled", "custom")) - expr_values <- getExpression( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - values = values, - output = "matrix" - ) - - # only keep genes that are in the dataset - selected_genes <- selected_genes[selected_genes %in% rownames(expr_values)] - - # - if (length(selected_genes) == 1) { - subset_expr_data <- expr_values[ - rownames(expr_values) %in% selected_genes, ] - t_sub_expr_data_DT <- data.table::data.table( - "selected_gene" = subset_expr_data, - "cell_ID" = colnames(expr_values)) - data.table::setnames( - t_sub_expr_data_DT, "selected_gene", selected_genes) - } else { - subset_expr_data <- expr_values[ - rownames(expr_values) %in% selected_genes, ] - t_sub_expr_data <- t_flex(subset_expr_data) - t_sub_expr_data_DT <- data.table::as.data.table( - as.matrix(t_sub_expr_data)) - - # data.table variables - cell_ID <- NULL - - t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] - } - - - ## dimension reduction ## - dim_dfr <- getDimReduction(gobject, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] - dim_names <- colnames(dim_dfr) - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, cell_ID := rownames(dim_dfr)] - - ## annotated cell metadata - cell_metadata <- pDataDT(gobject, - feat_type = feat_type, - spat_unit = spat_unit - ) - annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") - - - - # create input for network - if (show_NN_network == TRUE) { - # nn_network - selected_nn_network <- getNearestNetwork( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - nn_type = nn_network_to_use, - name = network_name, - output = "igraph" - ) - network_DT <- data.table::as.data.table(igraph::as_data_frame( - selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- merge( - network_DT, dim_DT, by.x = "from", by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = from_dim_names) - - annotated_network_DT <- merge( - annotated_network_DT, dim_DT, by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames(annotated_network_DT, old = old_dim_names, - new = to_dim_names) - } - - - ## create subsets if needed - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - if (is.null(cluster_column)) { - stop("\n selection of cells is based on cell_color paramter, - which is a metadata column \n") - } - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- annotated_DT[get(cluster_column) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- annotated_DT[get(cluster_column) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - annotated_DT_other <- annotated_DT[ - !annotated_DT$cell_ID %in% select_cells] - annotated_DT_selected <- annotated_DT[ - annotated_DT$cell_ID %in% select_cells] - - if (show_NN_network == TRUE) { - annotated_network_DT <- annotated_network_DT[ - annotated_network_DT$to %in% select_cells & - annotated_network_DT$from %in% select_cells] - } - - # if specific cells are selected - annotated_DT <- annotated_DT_selected - } - - ## if no subsets are required - if (is.null(select_cells) & is.null(select_cell_groups)) { - annotated_DT_selected <- annotated_DT - annotated_DT_other <- NULL - } - - ## merge gene info - annotated_gene_DT <- merge(annotated_DT, t_sub_expr_data_DT, by = "cell_ID") - - - - ## visualize multipe plots ## - ## 3D plots ## - - - if (show_NN_network == TRUE) { - edges <- plotly_network( - annotated_network_DT, - "from_Dim.1", "from_Dim.2", "from_Dim.3", - "to_Dim.1", "to_Dim.2", "to_Dim.3" - ) - } - ## Point layer - if (length(selected_genes) > 4) { - stop("\n The max number of genes showed together is 4.Otherwise - it will be too small to see\n - \n If you have more genes to show, please divide them into - groups\n") - } - if (!is.null(genes_high_color)) { - if (length(genes_high_color) != length(selected_genes) & - length(genes_high_color) != 1) { - stop("\n The number of genes and their corresbonding do not - match\n") - } - } else if (is.null(genes_high_color)) { - genes_high_color <- rep("red", length(selected_genes)) - } else { - genes_high_color <- rep(genes_high_color, length(selected_genes)) - } - - titleX <- title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - titleY <- title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - titleZ <- title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") - savelist <- list() - for (i in seq_len(length(selected_genes))) { - gene <- selected_genes[i] - - pl <- plotly::plot_ly(name = gene, scene = paste("scene", i, sep = "")) - pl <- pl %>% plotly::add_trace( - data = annotated_gene_DT, type = "scatter3d", mode = "markers", - x = annotated_gene_DT[[dim_names[1]]], - y = annotated_gene_DT[[dim_names[2]]], - z = annotated_gene_DT[[dim_names[3]]], - color = annotated_gene_DT[[gene]], - colors = c(genes_low_color, genes_mid_color, genes_high_color[i]), - marker = list(size = point_size) - ) - if (show_other_cells == TRUE) { - pl <- pl %>% plotly::add_trace( - name = "unselected cells", - data = annotated_DT_other, - type = "scatter3d", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - z = annotated_DT_other[[dim_names[3]]], - marker = list(size = other_point_size, color = other_cell_color) - ) - } - - ## plot spatial network - if (show_NN_network == TRUE) { - pl <- pl %>% plotly::add_trace( - name = "sptial network", mode = "lines", - type = "scatter3d", opacity = edge_alpha, - showlegend = FALSE, - data = edges, - x = ~x, y = ~y, z = ~z, - line = list( - color = network_color, - width = 0.5 - ) - ) - } - pl <- pl %>% plotly::colorbar(title = gene) - savelist[[gene]] <- pl - } - - if (length(savelist) == 1) { - cowplot <- savelist[[1]] %>% plotly::layout(scene = list( - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - )) - } else if (length(savelist) == 2) { - cowplot <- plotly::subplot( - savelist, titleX = TRUE, titleY = TRUE) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 0.5), y = c(0, 1)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - scene2 = list( - domain = list(x = c(0.5, 1), y = c(0, 1)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - legend = list(x = 100, y = 0) - ) - } else if (length(savelist) == 3) { - cowplot <- plotly::subplot( - savelist, titleX = TRUE, titleY = TRUE) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 0.5), y = c(0, 0.5)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - scene2 = list( - domain = list(x = c(0.5, 1), y = c(0, 0.5)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - scene3 = list( - domain = list(x = c(0, 0.5), y = c(0.5, 1)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - legend = list(x = 100, y = 0) - ) - } else if (length(savelist) == 4) { - cowplot <- plotly::subplot(savelist) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 0.5), y = c(0, 0.5)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - scene2 = list( - domain = list(x = c(0.5, 1), y = c(0, 0.5)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - scene3 = list( - domain = list(x = c(0, 0.5), y = c(0.5, 1)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - scene4 = list( - domain = list(x = c(0.5, 1), y = c(0.5, 1)), - xaxis = list(title = titleX), - yaxis = list(title = titleY), - zaxis = list(title = titleZ) - ), - legend = list(x = 100, y = 0) - ) - } - - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - ## print plot - if (show_plot == TRUE) { - print(cowplot) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = cowplot, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(cowplot) - } -} - -#' @describeIn dimFeatPlot3D deprecated -#' @param ... additional params to pass -#' @export -dimGenePlot3D <- function(...) { - deprecate_warn( - when = "0.2.0", - what = "dimGenePlot3D()", - with = "dimFeatPlot3D()" - ) - dimFeatPlot3D(...) -} - - - -#' @title spatDimFeatPlot3D -#' @name spatDimFeatPlot3D -#' @description Visualize cells according to spatial AND dimension -#' reduction coordinates in ggplot mode -#' @inheritParams data_access_params -#' @inheritParams plot_output_params -#' @param spat_loc_name name of spatial locations to use -#' @param expression_values gene expression values to use -#' @param plot_alignment direction to align plot -#' @param dim_reduction_to_use dimension reduction to use -#' @param dim_reduction_name dimension reduction name -#' @param dim1_to_use dimension to use on x-axis -#' @param dim2_to_use dimension to use on y-axis -#' @param dim3_to_use dimension to use on z-axis -#' @param sdimx spatial dimension to use on x-axis -#' @param sdimy spatial dimension to use on y-axis -#' @param sdimz spatial dimension to use on z-axis -#' @param genes genes to show -#' -#' @param cluster_column cluster column to select groups -#' @param select_cell_groups select subset of cells/clusters based on -#' cell_color parameter -#' @param select_cells select subset of cells based on cell IDs -#' @param show_other_cells display not selected cells -#' @param other_cell_color color of not selected cells -#' @param other_point_size size of not selected cells -#' -#' @param dim_point_size dim reduction plot: point size -#' @param show_NN_network show underlying NN network -#' @param nn_network_to_use type of NN network to use (kNN vs sNN) -#' @param nn_network_color color of NN network -#' @param nn_network_alpha alpha of NN network -#' @param network_name name of NN network to use, if show_NN_network = TRUE -#' -#' @param label_size size of labels -#' @param genes_high_color color for high expression levels -#' @param genes_mid_color color for medium expression levels -#' @param genes_low_color color for low expression levels -#' -#' @param show_spatial_network show spatial network (boolean) -#' @param spatial_network_name name of spatial network to use -#' @param spatial_network_color color of spatial network -#' @param spatial_network_alpha alpha of spatial network -#' -#' @param show_spatial_grid show spatial grid (boolean) -#' @param spatial_grid_name name of spatial grid to use -#' @param spatial_grid_color color of spatial grid -#' @param spatial_grid_alpha alpha of spatial grid -#' -#' @param spatial_point_size spatial plot: point size -#' @param legend_text_size size of legend -#' -#' @param axis_scale the way to scale the axis -#' @param custom_ratio customize the scale of the plot -#' @param x_ticks set the number of ticks on the x-axis -#' @param y_ticks set the number of ticks on the y-axis -#' @param z_ticks set the number of ticks on the z-axis -#' @details Description of parameters. -#' @family spatial and dimension reduction gene expression visualizations -#' @returns plotly -#' @examples -#' g <- GiottoData::loadGiottoMini("starmap") -#' spatDimFeatPlot3D(g, genes = "Slc17a7") -#' -#' @export -spatDimFeatPlot3D <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - spat_loc_name = NULL, - expression_values = c("normalized", "scaled", "custom"), - plot_alignment = c("horizontal", "vertical"), - dim_reduction_to_use = "umap", - dim_reduction_name = "umap", - dim1_to_use = 1, - dim2_to_use = 2, - dim3_to_use = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - sdimz = "sdimz", - genes, - cluster_column = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1.5, - show_NN_network = FALSE, - nn_network_to_use = "sNN", - nn_network_color = "lightgrey", - nn_network_alpha = 0.5, - network_name = "sNN.pca", - label_size = 16, - genes_low_color = "blue", - genes_mid_color = "white", - genes_high_color = "red", - dim_point_size = 3, - show_spatial_network = FALSE, - spatial_network_name = "Delaunay_network", - spatial_network_color = "lightgray", - spatial_network_alpha = 0.5, - show_spatial_grid = FALSE, - spatial_grid_name = "spatial_grid", - spatial_grid_color = NULL, - spatial_grid_alpha = 0.5, - spatial_point_size = 3, - legend_text_size = 12, - axis_scale = c("cube", "real", "custom"), - custom_ratio = NULL, - x_ticks = NULL, - y_ticks = NULL, - z_ticks = NULL, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatDimFeatPlot3D") { - # Set feat_type and spat_unit - spat_unit <- set_default_spat_unit( - gobject = gobject, - spat_unit = spat_unit - ) - feat_type <- set_default_feat_type( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type - ) - - # data.table variables - cell_ID <- NULL - - plot_alignment <- match.arg(plot_alignment, - choices = c("horizontal", "vertical")) - - ########### data prepare ########### - ## select genes ## - if (length(genes) > 1) { - warning("\n Now 3D mode can just accept one gene, only the first - gene will be plot\n") - genes <- genes[1] - } - selected_genes <- genes - values <- match.arg(expression_values, c("normalized", "scaled", "custom")) - expr_values <- get_expression_values( - gobject = gobject, - spat_unit = spat_unit, - feat_type = feat_type, - values = values, - output = "matrix" - ) - - # only keep genes that are in the dataset - selected_genes <- selected_genes[selected_genes %in% rownames(expr_values)] - subset_expr_data <- expr_values[rownames(expr_values) %in% selected_genes, ] - t_sub_expr_data_DT <- data.table::data.table( - "selected_gene" = subset_expr_data, "cell_ID" = colnames(expr_values)) - data.table::setnames(t_sub_expr_data_DT, "selected_gene", selected_genes) - - - ## dimension reduction ## - dim_dfr <- get_dimReduction(gobject, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" - ) - dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] - dim_names <- colnames(dim_dfr) - dim_DT <- data.table::as.data.table(dim_dfr) - dim_DT[, cell_ID := rownames(dim_dfr)] - - - ## annotated cell metadata - cell_metadata <- pDataDT(gobject, - feat_type = feat_type, - spat_unit = spat_unit - ) - cell_locations <- get_spatial_locations( - gobject = gobject, - spat_unit = spat_unit, - spat_loc_name = spat_loc_name, - output = "data.table" - ) - if (is.null(cell_locations)) { - return(NULL) - } - - annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") - annotated_DT <- merge(annotated_DT, cell_locations, by = "cell_ID") - annotated_DT <- merge(annotated_DT, t_sub_expr_data_DT, by = "cell_ID") - - - ## nn network - if (show_NN_network) { - # nn_network - selected_nn_network <- get_NearestNetwork( - gobject = gobject, - feat_type = feat_type, - spat_unit = spat_unit, - nn_network_to_use = nn_network_to_use, - network_name = network_name, - output = "igraph" - ) - network_DT <- data.table::as.data.table(igraph::as_data_frame( - selected_nn_network, what = "edges")) - - # annotated network - old_dim_names <- dim_names - - annotated_network_DT <- merge( - network_DT, dim_DT, by.x = "from", by.y = "cell_ID") - from_dim_names <- paste0("from_", old_dim_names) - data.table::setnames( - annotated_network_DT, old = old_dim_names, new = from_dim_names) - - annotated_network_DT <- merge(annotated_network_DT, dim_DT, - by.x = "to", by.y = "cell_ID") - to_dim_names <- paste0("to_", old_dim_names) - data.table::setnames( - annotated_network_DT, old = old_dim_names, new = to_dim_names) - } - - - ## extract spatial network - if (show_spatial_network == TRUE) { - spatial_network <- get_spatialNetwork(gobject, - spat_unit = spat_unit, - name = spatial_network_name, - output = "networkDT" - ) - } else { - spatial_network <- NULL - } - - ## extract spatial grid - if (show_spatial_grid == TRUE) { - spatial_grid <- get_spatialGrid(gobject, - spat_unit = spat_unit, - feat_type = feat_type, - spatial_grid_name - ) - } else { - spatial_grid <- NULL - } - - - ## select subset of cells ## - if (!is.null(select_cells) & !is.null(select_cell_groups)) { - if (is.null(cluster_column)) { - stop("\n selection of cells is based on cell_color paramter, - which is a metadata column \n") - } - message("You have selected both individual cell IDs and a group - of cells") - group_cell_IDs <- annotated_DT[get(cluster_column) %in% - select_cell_groups][["cell_ID"]] - select_cells <- unique(c(select_cells, group_cell_IDs)) - } else if (!is.null(select_cell_groups)) { - select_cells <- annotated_DT[get(cluster_column) %in% - select_cell_groups][["cell_ID"]] - } - - if (!is.null(select_cells)) { - annotated_DT_other <- annotated_DT[ - !annotated_DT$cell_ID %in% select_cells] - annotated_DT_selected <- annotated_DT[ - annotated_DT$cell_ID %in% select_cells] - - if (show_NN_network == TRUE) { - annotated_network_DT <- annotated_network_DT[ - annotated_network_DT$to %in% select_cells & - annotated_network_DT$from %in% select_cells] - } - if (show_spatial_network == TRUE) { - spatial_network <- spatial_network[ - spatial_network$to %in% select_cells & - spatial_network$from %in% select_cells] - } - - # if specific cells are selected - annotated_DT <- annotated_DT_selected - } - - ## if no subsets are required - if (is.null(select_cells) & is.null(select_cell_groups)) { - annotated_DT_selected <- annotated_DT - annotated_DT_other <- NULL - } - - - - - ########### dim plot ########### - # 2D plot - if (is.null(dim3_to_use)) { - dpl <- plotly::plot_ly() - if (show_NN_network == TRUE) { - if (is.null(nn_network_alpha)) { - nn_network_alpha <- 0.5 - } else if (is.character(nn_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - nn_network_alpha <- 0.5 - } - dpl <- dpl %>% plotly::add_segments( - name = network_name, - type = "scatter", - x = annotated_network_DT[[from_dim_names[1]]], - y = annotated_network_DT[[from_dim_names[2]]], - xend = annotated_network_DT[[to_dim_names[1]]], - yend = annotated_network_DT[[to_dim_names[2]]], - line = list( - color = nn_network_color, - width = 0.5 - ), - opacity = nn_network_alpha - ) - } - - dpl <- dpl %>% - plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT[[dim_names[1]]], - y = annotated_DT[[dim_names[2]]], - color = annotated_DT[[selected_genes]], - colors = c( - genes_low_color, genes_mid_color, - genes_high_color - ), - marker = list(size = dim_point_size), - showlegend = FALSE - ) - - if (show_other_cells == TRUE) { - dpl <- dpl %>% - plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - marker = list( - size = other_point_size, - color = other_cell_color - ), - showlegend = FALSE - ) - } - - x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - - dpl <- dpl %>% plotly::layout( - xaxis = list(title = x_title), - yaxis = list(title = y_title), - legend = list(x = 100, y = 0.5, - font = list(family = "sans-serif", - size = legend_text_size)) - ) - } - # 3D plot - else if (!is.null(dim3_to_use)) { - dpl <- plotly::plot_ly(scene = "scene1") - - dpl <- dpl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT[[dim_names[1]]], - y = annotated_DT[[dim_names[2]]], - z = annotated_DT[[dim_names[3]]], - color = annotated_DT[[selected_genes]], - colors = c(genes_low_color, genes_mid_color, genes_high_color), - marker = list(size = dim_point_size), - showlegend = FALSE - ) - # legendgroup = annotated_DT[[cell_color]]) - if (show_other_cells == TRUE) { - dpl <- dpl %>% plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_other[[dim_names[1]]], - y = annotated_DT_other[[dim_names[2]]], - z = annotated_DT_other[[dim_names[3]]], - marker = list(size = other_point_size, - color = other_cell_color), - showlegend = FALSE - ) - } - - if (show_NN_network) { - edges <- plotly_network( - annotated_network_DT, - "from_Dim.1", "from_Dim.2", "from_Dim.3", - "to_Dim.1", "to_Dim.2", "to_Dim.3" - ) - if (is.null(nn_network_alpha)) { - nn_network_alpha <- 0.5 - } else if (is.character(nn_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - nn_network_alpha <- 0.5 - } - - dpl <- dpl %>% plotly::add_trace( - name = network_name, - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, y = ~y, z = ~z, - line = list(color = nn_network_color), - opacity = nn_network_alpha - ) - } - - - x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") - y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") - z_title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") - } - dpl <- dpl %>% plotly::colorbar(title = selected_genes) - - - ########### spatial plot ########### - if (is.null(sdimx) | is.null(sdimy)) { - # cat('first and second dimenion need to be defined, - # default is first 2 \n') - sdimx <- "sdimx" - sdimy <- "sdimy" - } - - # 2D plot - if (is.null(sdimz)) { - spl <- plotly::plot_ly() - - if (show_spatial_network == TRUE) { - if (is.null(spatial_network)) { - stop("No usable spatial network specified! Please choose a - network with spatial_network_name=xxx") - } else { - if (is.null(spatial_network_alpha)) { - spatial_network_alpha <- 0.5 - } else if (is.character(spatial_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - spatial_network_alpha <- 0.5 - } - spl <- spl %>% plotly::add_segments( - name = spatial_network_name, - type = "scatter", - x = spatial_network[["sdimx_begin"]], - y = spatial_network[["sdimy_begin"]], - xend = spatial_network[["sdimx_end"]], - yend = spatial_network[["sdimy_end"]], - line = list( - color = spatial_network_color, - width = 0.5 - ), - opacity = spatial_network_alpha - ) - } - } - if (show_spatial_grid == TRUE) { - if (is.null(spatial_grid)) { - stop("No usable spatial grid specified! Please choose a - network with spatial_grid_name=xxx") - } else { - if (is.null(spatial_grid_color)) { - spatial_grid_color <- "black" - } - edges <- plotly_grid(spatial_grid) - spl <- spl %>% plotly::add_segments( - name = "spatial_grid", - type = "scatter", - data = edges, - x = ~x, - y = ~y, - xend = ~x_end, - yend = ~y_end, - line = list( - color = spatial_grid_color, - width = 1 - ), - opacity = spatial_grid_alpha - ) - } - } - - spl <- spl %>% - plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT[[sdimx]], - y = annotated_DT[[sdimy]], - color = annotated_DT[[selected_genes]], - colors = c( - genes_low_color, genes_mid_color, - genes_high_color - ), - marker = list(size = spatial_point_size), - showlegend = FALSE - ) - if (show_other_cells == TRUE) { - spl <- spl %>% - plotly::add_trace( - type = "scatter", mode = "markers", - x = annotated_DT_other[[sdimx]], - y = annotated_DT_other[[sdimy]], - marker = list( - size = other_point_size, - color = other_cell_color - ), - showlegend = FALSE - ) - } - - spl <- spl %>% plotly::layout( - xaxis = list(title = "X"), - yaxis = list(title = "Y"), - legend = list(x = 100, y = 0.5, - font = list(family = "sans-serif", - size = legend_text_size)) - ) - } - - - # 3D plot - else { - axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) - ratio <- plotly_axis_scale_3D(annotated_DT, - sdimx = sdimx, sdimy = sdimy, sdimz = sdimz, - mode = axis_scale, custom_ratio = custom_ratio - ) - - - spl <- plotly::plot_ly(scene = "scene2") - - spl <- spl %>% - plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT[[sdimx]], - y = annotated_DT[[sdimy]], - z = annotated_DT[[sdimz]], - color = annotated_DT[[selected_genes]], - colors = c( - genes_low_color, genes_mid_color, - genes_high_color - ), - # legendgroup = annotated_DT[[cell_color]], - marker = list(size = spatial_point_size), - showlegend = FALSE - ) - if (show_other_cells == TRUE) { - spl <- spl %>% - plotly::add_trace( - type = "scatter3d", mode = "markers", - x = annotated_DT_other[[sdimx]], - y = annotated_DT_other[[sdimy]], - z = annotated_DT_other[[sdimz]], - marker = list( - size = other_point_size, - color = other_cell_color - ), - showlegend = FALSE - ) - } - - if (show_spatial_network == TRUE) { - if (is.null(spatial_network)) { - stop("No usable spatial network specified! Please choose a - network with spatial_network_name=xxx") - } else { - if (is.null(spatial_network_alpha)) { - spatial_network_alpha <- 0.5 - } else if (is.character(spatial_network_alpha)) { - warning("Edge_alpha for plotly mode is not adjustable yet. - Default 0.5 will be set\n") - spatial_network_alpha <- 0.5 - } - edges <- plotly_network(spatial_network) - - spl <- spl %>% plotly::add_trace( - name = "sptial network", - mode = "lines", - type = "scatter3d", - data = edges, - x = ~x, y = ~y, z = ~z, - line = list(color = spatial_network_color), - opacity = spatial_network_alpha - ) - } - } - - if (show_spatial_grid == TRUE) { - message("3D grid is not clear to view") - } - } - - - - spl <- plotly::hide_colorbar(spl) - if (is.null(dim3_to_use) & is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot( - dpl, spl, nrows = 2, titleX = TRUE, titleY = TRUE) - } else { - combo_plot <- plotly::subplot( - dpl, spl, titleX = TRUE, titleY = TRUE) - } - } else if (!is.null(dim3_to_use) & is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot( - dpl, spl, nrows = 2, titleX = TRUE, titleY = TRUE) %>% - plotly::layout(scene = list( - domain = list(x = c(0, 1), y = c(0, 0.5)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - )) - } else { - combo_plot <- plotly::subplot( - dpl, spl, titleX = TRUE, titleY = TRUE) %>% - plotly::layout(scene = list( - domain = list(x = c(0, 0.5), y = c(0, 1)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - )) - } - } else if (is.null(dim3_to_use) & !is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot( - dpl, spl, nrows = 2, titleX = TRUE, titleY = TRUE) %>% - plotly::layout(scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - )) - } else { - combo_plot <- plotly::subplot( - dpl, spl, titleX = TRUE, titleY = TRUE) %>% - plotly::layout(scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - )) - } - } else if (!is.null(dim3_to_use) & !is.null(sdimz)) { - if (plot_alignment == "vertical") { - combo_plot <- plotly::subplot( - dpl, spl, nrows = 2, titleX = TRUE, titleY = TRUE) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 1), y = c(0, 0.5)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - ), - scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ) - ) - } else { - combo_plot <- plotly::subplot( - dpl, spl, titleX = TRUE, titleY = TRUE) %>% - plotly::layout( - scene = list( - domain = list(x = c(0, 0.5), y = c(0, 1)), - xaxis = list(title = x_title), - yaxis = list(title = y_title), - zaxis = list(title = z_title) - ), - scene2 = list( - xaxis = list(title = "X", nticks = x_ticks), - yaxis = list(title = "Y", nticks = y_ticks), - zaxis = list(title = "Z", nticks = z_ticks), - aspectmode = "manual", - aspectratio = list( - x = ratio[[1]], - y = ratio[[2]], - z = ratio[[3]] - ) - ) - ) - } - } - - show_plot <- ifelse(is.null(show_plot), - readGiottoInstructions(gobject, param = "show_plot"), - show_plot) - save_plot <- ifelse(is.null(save_plot), - readGiottoInstructions(gobject, param = "save_plot"), - save_plot) - return_plot <- ifelse(is.null(return_plot), - readGiottoInstructions(gobject, param = "return_plot"), - return_plot) - - ## print plot - if (show_plot == TRUE) { - print(combo_plot) - } - - ## save plot - if (save_plot == TRUE) { - do.call("all_plots_save_function", - c(list(gobject = gobject, plot_object = combo_plot, - default_save_name = default_save_name), save_param)) - } - - ## return plot - if (return_plot == TRUE) { - return(combo_plot) - } -} - -#' @describeIn spatDimFeatPlot3D deprecated -#' @param ... additional params to pass -#' @export -spatDimGenePlot3D <- function(...) { - deprecate_warn( - when = "0.2.0", - what = "spatDimGenePlot3D()", - with = "spatDimFeatPlot3D()" - ) - spatDimFeatPlot3D(...) -} - - - diff --git a/R/vis_spatial_gg.R b/R/vis_spatial_gg.R new file mode 100644 index 0000000..17ad184 --- /dev/null +++ b/R/vis_spatial_gg.R @@ -0,0 +1,4565 @@ +## * #### +## 2-D ggplots #### +## ----------- ## + + + +## ** spatial plotting #### + + + + + +#' @title .spatPlot2D_single +#' @name .spatPlot2D_single +#' @description Visualize cells according to spatial coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_spatnet_params +#' @inheritParams plot_spatenr_params +#' @param show_image show a tissue background image +#' @param gimage a giotto image +#' @param image_name name of giotto image(s) to plot +#' @param spat_loc_name name of spatial locations +#' @param sdimx x-axis dimension name (default = 'sdimx') +#' @param sdimy y-axis dimension name (default = 'sdimy') +#' @param show_cluster_center plot center of selected clusters +#' @param show_center_label plot label of selected clusters +#' @param center_point_size size of center points +#' @param network_color color of spatial network +#' @param network_alpha alpha of spatial network +#' @param show_grid show spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param grid_color color of spatial grid +#' @param coord_fix_ratio fix ratio between x and y-axis +#' @param vor_border_color border colorr for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparency of voronoi 'cells' +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @param verbose be verbose +#' @return ggplot +#' @details Description of parameters. +#' @keywords internal +#' @seealso \code{\link{spatPlot3D}} +.spatPlot2D_single <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + spat_loc_name = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + spat_enr_names = NULL, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = "divergent", + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + point_shape = c("border", "no_border", "voronoi"), + point_size = 3, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + show_cluster_center = FALSE, + show_center_label = FALSE, + center_point_size = 4, + center_point_border_col = "black", + center_point_border_stroke = 0.1, + label_size = 4, + label_fontface = "bold", + show_network = FALSE, + spatial_network_name = "Delaunay_network", + network_color = NULL, + network_alpha = 1, + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + grid_color = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + other_cells_alpha = 0.1, + coord_fix_ratio = 1, + title = NULL, + show_legend = TRUE, + legend_text = 8, + legend_symbol_size = 1, + background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + axis_text = 8, + axis_title = 8, + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + verbose = FALSE, + save_param = list(), + default_save_name = "spatPlot2D_single") { + # Check params + checkmate::assert_class(gobject, "giotto") + + point_shape <- match.arg( + point_shape, + choices = c("border", "no_border", "voronoi") + ) + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + ## get giotto image(s) ## + if (isTRUE(show_image) && is.null(gimage)) { + gimage <- getGiottoImage( + gobject = gobject, + name = image_name + ) + } + + + ## get spatial cell locations + cell_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table", + copy_obj = TRUE, + verbose = verbose + ) + if (is.null(cell_locations)) { + return(NULL) + } + + + ## extract spatial network + if (show_network == TRUE) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT", + verbose = verbose + ) + } else { + spatial_network <- NULL + } + + ## extract spatial grid + if (show_grid == TRUE) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name, + return_grid_Obj = FALSE + ) + } else { + spatial_grid <- NULL + } + + + ## get cell metadata + + if (is.null(spat_loc_name)) { + if (!is.null(slot(gobject, "spatial_locs"))) { + spat_loc_name <- list_spatial_locations_names( + gobject, + spat_unit = spat_unit + )[[1]] + } else { + spat_loc_name <- NULL + message("No spatial locations have been found") + return(NULL) + } + } + + cell_metadata <- try( + expr = combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + spat_enr_names = spat_enr_names, + verbose = verbose + ), + silent = TRUE + ) + + if (inherits(cell_metadata, "try-error")) { + cell_locations_metadata <- cell_locations + } else if (nrow(cell_metadata) == 0) { + cell_locations_metadata <- cell_locations + } else { + cell_locations_metadata <- cell_metadata + } + + + + ## create subsets if needed + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + message("You have selected both individual cell IDs and a group of + cells") + group_cell_IDs <- cell_locations_metadata[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- cell_locations_metadata[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + cell_locations_metadata_other <- + cell_locations_metadata[!cell_locations_metadata$cell_ID %in% + select_cells] + cell_locations_metadata_selected <- + cell_locations_metadata[cell_locations_metadata$cell_ID %in% + select_cells] + spatial_network <- spatial_network[spatial_network$to %in% + select_cells & spatial_network$from %in% + select_cells] + + # if specific cells are selected + # cell_locations_metadata = cell_locations_metadata_selected + } else if (is.null(select_cells)) { + cell_locations_metadata_selected <- cell_locations_metadata + cell_locations_metadata_other <- NULL + } + + + # update cell_color_code + # only keep names from selected groups + if (!is.null(select_cell_groups) & !is.null(cell_color_code)) { + cell_color_code <- cell_color_code[names(cell_color_code) %in% + select_cell_groups] + } + + # data.table and ggplot variables + sdimx_begin <- sdimy_begin <- sdimx_end <- sdimy_end <- x_start <- + x_end <- y_start <- y_end <- NULL + + + ### create 2D plot with ggplot ### + + if (isTRUE(verbose)) { + message("Data table with selected information (e.g. cells):") + message(cell_locations_metadata_selected[seq_len(5), ]) + + message("Data table with non-selected information (e.g. cells):") + message(cell_locations_metadata_other[seq_len(5), ]) + } + + + pl <- ggplot2::ggplot() + pl <- pl + ggplot2::theme_bw() + + ## plot image ## + if (isTRUE(show_image) && !is.null(gimage)) { + pl <- plot_spat_image_layer_ggplot( + gg_obj = pl, + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + gimage = gimage + ) + } + + + ## plot spatial network + if (!is.null(spatial_network) && isTRUE(show_network)) { + if (is.null(network_color)) network_color <- "red" + pl <- pl + ggplot2::geom_segment( + data = spatial_network, + aes( + x = sdimx_begin, + y = sdimy_begin, + xend = sdimx_end, + yend = sdimy_end + ), + color = network_color, + size = 0.5, + alpha = network_alpha + ) + } + + + ## plot spatial grid + if (!is.null(spatial_grid) && isTRUE(show_grid)) { + if (is.null(grid_color)) grid_color <- "black" + pl <- pl + ggplot2::geom_rect( + data = spatial_grid, + aes( + xmin = x_start, + xmax = x_end, + ymin = y_start, + ymax = y_end + ), + color = grid_color, + fill = NA + ) + } + + + ## plot point layer + point_general_params <- list( + ggobject = pl, + instrs = instructions(gobject), + sdimx = sdimx, + sdimy = sdimy, + cell_locations_metadata_selected = cell_locations_metadata_selected, + cell_locations_metadata_other = cell_locations_metadata_other, + cell_color = cell_color, + color_as_factor = color_as_factor, + cell_color_code = cell_color_code, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + point_size = point_size, + point_alpha = point_alpha, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + label_size = label_size, + label_fontface = label_fontface, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_legend = show_legend + ) + + point_border_specific_params <- list( + point_border_stroke = point_border_stroke, # specific + point_border_col = point_border_col, # specific + center_point_border_col = center_point_border_col, # specific + center_point_border_stroke = center_point_border_stroke # specific + ) + + point_voronoi_specific_params <- list( + background_color = background_color, # specific + vor_border_color = vor_border_color, # specific + vor_max_radius = vor_max_radius, # specific + vor_alpha = vor_alpha # specific + ) + + pl <- switch(point_shape, + "border" = do.call( + plot_spat_point_layer_ggplot, + args = c( + point_general_params, + point_border_specific_params + ) + ), + "no_border" = do.call( + plot_spat_point_layer_ggplot_noFILL, + args = point_general_params + ), + "voronoi" = do.call( + plot_spat_voronoi_layer_ggplot, + args = c( + point_general_params, + point_voronoi_specific_params + ) + ) + ) + + + ## adjust theme settings + gg_theme_args <- c( + theme_param, + legend_text = legend_text, + axis_title = axis_title, + axis_text = axis_text, + background_color = background_color + ) + pl <- pl + do.call(.gg_theme, args = gg_theme_args) + + ## change symbol size of legend + if (isTRUE(color_as_factor)) { + if (point_shape %in% c("border", "voronoi")) { + pl <- pl + + guides(fill = guide_legend( + override.aes = list(size = legend_symbol_size) + )) + } else if (point_shape == "no_border") { + pl <- pl + + guides(color = guide_legend( + override.aes = list(size = legend_symbol_size) + )) + } + } + + + # fix coord ratio + if (!is.null(coord_fix_ratio)) { + pl <- pl + ggplot2::coord_fixed(ratio = coord_fix_ratio) + } + + # provide x, y and plot titles + if (is.null(title)) title <- cell_color + pl <- pl + ggplot2::labs( + x = "x coordinates", y = "y coordinates", + title = title + ) + + return(plot_output_handler( + gobject = gobject, + plot_object = pl, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + + + + + + +#' @rdname spatPlot +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_image_params +#' @inheritParams plot_spatenr_params +#' @inheritParams plot_params +#' @param spat_loc_name name of spatial locations +#' @param sdimx x-axis dimension name (default = 'sdimx') +#' @param sdimy y-axis dimension name (default = 'sdimy') +#' @param gradient_midpoint midpoint for color gradient +#' @param gradient_limits vector with lower and upper limits +#' @param select_cell_groups select subset of cells/clusters based on +#' cell_color parameter +#' @param select_cells select subset of cells based on cell IDs +#' @param point_shape shape of points (border, no_border or voronoi) +#' @param point_size size of point (cell) +#' @param point_alpha transparancy of point +#' @param point_border_col color of border around points +#' @param point_border_stroke stroke size of border around points +#' @param show_cluster_center plot center of selected clusters +#' @param show_center_label plot label of selected clusters +#' @param center_point_size size of center points +#' @param center_point_border_col border color of center points +#' @param center_point_border_stroke border stroke size of center points +#' @param label_size size of labels +#' @param label_fontface font of labels +#' @param show_network show underlying spatial network +#' @param spatial_network_name name of spatial network to use +#' @param network_color color of spatial network +#' @param network_alpha alpha of spatial network +#' @param show_grid show spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param grid_color color of spatial grid +#' @param show_other_cells display not selected cells +#' @param other_cell_color color of not selected cells +#' @param other_point_size point size of not selected cells +#' @param other_cells_alpha alpha of not selected cells +#' @param coord_fix_ratio fix ratio between x and y-axis (default = 1) +#' @param title title of plot +#' @param show_legend show legend +#' @param legend_text size of legend text +#' @param legend_symbol_size size of legend symbols +#' @param background_color color of plot background +#' @param vor_border_color border color for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparency of voronoi 'cells' +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @details coord_fix_ratio: set to NULL to use default ggplot parameters +#' @returns ggplot +#' @export +spatPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + group_by = NULL, + group_by_subset = NULL, + spat_loc_name = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + spat_enr_names = NULL, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + point_shape = c("border", "no_border", "voronoi"), + point_size = 3, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + show_cluster_center = FALSE, + show_center_label = FALSE, + center_point_size = 4, + center_point_border_col = "black", + center_point_border_stroke = 0.1, + label_size = 4, + label_fontface = "bold", + show_network = FALSE, + spatial_network_name = "Delaunay_network", + network_color = NULL, + network_alpha = 1, + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + grid_color = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + other_cells_alpha = 0.1, + coord_fix_ratio = 1, + title = NULL, + show_legend = TRUE, + legend_text = 10, + legend_symbol_size = 2, + background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + theme_param = list(), + default_save_name = "spatPlot2D") { + checkmate::assert_class(gobject, "giotto") + + # deprecation message + if (!is.null(largeImage_name)) { + deprecate_warn( + when = "0.2.0", + what = "spatPlot2D(largeImage_name)", + details = c( + "Use `image_name` argument instead for all images to plot." + ) + ) + image_name <- c(image_name, largeImage_name) + } + + # create args list needed for each call to .spatPlot2D_single() + # 1. - grab all params available + # 2. - subset to those needed + spp_params <- get_args_list(keep = c( + # [gobject params] + "gobject", "spat_unit", "feat_type", + # [image params] + "show_image", "gimage", "image_name", + # [spatlocs params] + "spat_loc_name", "sdimx", "sdimy", + # [access spatial enrichments] + "spat_enr_names", + # [point aes] + "cell_color", "color_as_factor", "cell_color_code", + "cell_color_gradient", + "gradient_midpoint", "gradient_style", "gradient_limits", + "point_shape", "point_size", "point_alpha", "point_border_col", + "point_border_stroke", + # [select cell params] + "select_cell_groups", "select_cells", + # [voronoi-point params] + "vor_border_color", "vor_max_radius", "vor_alpha", + # [others aes] + "show_other_cells", "other_cell_color", "other_point_size", + "other_cells_alpha", + # [cluster aes] + "show_cluster_center", "show_center_label", "center_point_size", + "center_point_border_col", "center_point_border_stroke", + # [label aes] + "label_size", "label_fontface", + # [network aes] + "show_network", "spatial_network_name", "network_color", + "network_alpha", + # [grid aes] + "show_grid", "spatial_grid_name", "grid_color", + # [figure params] + "coord_fix_ratio", "show_legend", "legend_text", + "legend_symbol_size", "background_color", "axis_text", + "axis_title", "title", + # [return params] + "show_plot", "return_plot", "save_plot", "save_param", + "default_save_name", + # [gg params] + "theme_param" + )) + + + ## check group_by + if (is.null(group_by)) { # ----------------------------------------------- # + + do.call(.spatPlot2D_single, args = spp_params) + } else { # -------------------------------------------------------------- # + + # setup for group_by + # params relevant for plotting that are updated in this section prior + # to the for loop MUST be updated in group_by static settings section + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + # ! update spat_unit & feat_type in static settings ! + + ## check metadata for valid group_by information + comb_metadata <- combineMetadata( + gobject = gobject, + spat_loc_name = spat_loc_name, + feat_type = feat_type, + spat_unit = spat_unit, + spat_enr_names = spat_enr_names + ) + possible_meta_groups <- colnames(comb_metadata) + + ## error if group_by col is not found + if (!group_by %in% possible_meta_groups) { + stop("group_by ", group_by, " was not found in pDataDT()") + } + + unique_groups <- unique(comb_metadata[[group_by]]) + + # subset unique_groups + # These unique_groups will be used to iterate through subsetting then + # plotting the giotto object multiple times. + if (!is.null(group_by_subset)) { + not_found <- group_by_subset[!group_by_subset %in% unique_groups] + if (length(not_found) > 0) { + message("the following subset was not found: ", not_found) + } + unique_groups <- unique_groups[unique_groups %in% group_by_subset] + } + + # create matching cell_color_code + if (is.null(cell_color_code)) { + if (is.character(cell_color)) { + if (cell_color %in% colnames(comb_metadata)) { + if (isTRUE(color_as_factor)) { + number_colors <- length( + unique(comb_metadata[[cell_color]]) + ) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + names(cell_color_code) <- unique( + comb_metadata[[cell_color]] + ) + cell_color_code <- cell_color_code + } + } + } + } + # ! update cell_color_code in static settings ! + + + + ## plotting ## + savelist <- list() + + # group_by static settings # + # update these params + spp_params$spat_unit <- spat_unit + spp_params$feat_type <- feat_type + spp_params$cell_color_code <- cell_color_code + # apply group_by specific defaults + spp_params$show_plot <- FALSE + spp_params$return_plot <- TRUE + spp_params$save_plot <- FALSE + spp_params$save_param <- list() + spp_params$default_save_name <- "spatPlot2D" + + + for (group_id in seq_along(unique_groups)) { + group <- unique_groups[group_id] + + subset_cell_IDs <- comb_metadata[get(group_by) == group][["cell_ID"]] + spp_params$gobject <- subsetGiotto( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + cell_ids = subset_cell_IDs, + verbose = FALSE + ) + + # use a different image per group if there are the same + # number of names provided as there are groups + # Otherwise, use the same image (or NULL) for all groups (default) + if (length(unique_groups) == length(image_name)) { + spp_params$image_name <- image_name[group_id] + } + + pl <- do.call(.spatPlot2D_single, args = spp_params) + + savelist[[group_id]] <- pl + } + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) + } # --------------------------------------------------------------------- # +} + + + + +#' @title spatPlot +#' @name spatPlot +#' @description Visualize cells according to spatial coordinates +#' @param \dots spatPLot(...) passes to spatPlot2D +#' @return ggplot (2D), plotly (3D) +#' @family spatial visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatPlot(g, show_image = TRUE, image_name = "image") +#' +#' # the more specific spatPlot2D with networks shown +#' spatPlot2D(g, show_image = TRUE, image_name = "image", show_network = TRUE) +#' +#' # plotting of some cell metadata (number of different features detected) +#' spatPlot2D(g, +#' show_image = TRUE, +#' image_name = "image", +#' cell_color = "nr_feats", +#' color_as_factor = FALSE, +#' gradient_style = "sequential" +#' ) +#' +#' +#' # load another dataset with 3D data +#' starmap <- GiottoData::loadGiottoMini("starmap", verbose = FALSE) +#' +#' # default is to rescale plot as a 3D cube +#' spatPlot3D(starmap, cell_color = "leiden_clus") +#' # real scaling +#' spatPlot3D(g, cell_color = "leiden_clus", axis_scale = "real") +#' @export +#' @seealso \code{\link{spatPlot3D}} +spatPlot <- function(...) { + spatPlot2D(...) +} + + + + + + + + +## ** spatial deconvolution plotting #### + + +#' @title spatDeconvPlot +#' @name spatDeconvPlot +#' @description Visualize cell type enrichment / deconvolution results +#' in a scatterpie +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @param deconv_name name of deconvolution results to use +#' @param show_image show a tissue background image +#' @param gimage a giotto image +#' @param image_name name of a giotto image +#' @param largeImage_name name of a giottoLargeImage +#' @param spat_loc_name name of spatial locations +#' @param sdimx x-axis dimension name (default = 'sdimx') +#' @param sdimy y-axis dimension name (default = 'sdimy') +#' @param line_color color of line within pie charts +#' @param radius radios of pie charts +#' @param alpha alpha of pie charts +#' @param coord_fix_ratio fix ratio between x and y-axis +#' @param title title of plot +#' @param legend_text size of legend text +#' @param background_color color of plot background +#' @param title title for plot (default = deconv_name) +#' @param axis_text size of axis text +#' @param axis_title size of axis title +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @returns ggplot +#' @export +spatDeconvPlot <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + deconv_name = "DWLS", + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + spat_loc_name = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + cell_color_code = NULL, + line_color = NA, + radius = 10, + alpha = 1, + legend_text = 8, + background_color = "white", + title = NULL, + axis_text = 8, + axis_title = 8, + coord_fix_ratio = 1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + theme_param = list(), + default_save_name = "spatDeconvPlot") { + # check for installed packages + package_check(pkg_name = "scatterpie", repository = "CRAN") + + # deprecation message + if (!is.null(largeImage_name)) { + deprecate_warn( + when = "0.2.0", + what = "spatDeconvPlot(largeImage_name)", + details = c( + "Use `image_name` argument instead for all images to plot." + ) + ) + image_name <- c(image_name, largeImage_name) + } + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + ## get giotto image(s) ## + if (isTRUE(show_image) && is.null(gimage)) { + gimage <- getGiottoImage( + gobject = gobject, + name = image_name + ) + } + + + ## get spatial cell locations + spatial_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table" + ) + if (is.null(spatial_locations)) { + return(NULL) + } + + ## deconvolution results + spatial_enrichment <- getSpatialEnrichment( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = deconv_name, + output = "data.table" + ) + + + + + ### create 2D plot with ggplot ### + + pl <- ggplot2::ggplot() + pl <- pl + ggplot2::theme_bw() + + ## plot image ## + if (isTRUE(show_image) && !is.null(gimage)) { + pl <- plot_spat_image_layer_ggplot( + gg_obj = pl, + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + gimage = gimage + ) + } + + + ## plot scatterpie ## + pl <- plot_spat_scatterpie_layer_ggplot( + ggobject = pl, + instrs = instructions(gobject), + sdimx = sdimx, + sdimy = sdimy, + spatial_locations = spatial_locations, + spatial_enrichment = spatial_enrichment, + radius = radius, + color = line_color, + alpha = alpha, + cell_color_code = cell_color_code + ) + + + ## adjust theme setting + gg_theme_args <- c( + theme_param, + legend_text = legend_text, + axis_title = axis_title, + axis_text = axis_text, + background_color = background_color + ) + pl <- pl + do.call(.gg_theme, args = gg_theme_args) + + # fix coord ratio + if (!is.null(coord_fix_ratio)) { + pl <- pl + ggplot2::coord_fixed(ratio = coord_fix_ratio) + } + + # provide x, y and plot titles + if (is.null(title)) title <- deconv_name + pl <- pl + + ggplot2::labs(x = "x coordinates", y = "y coordinates", title = title) + + + # print, return and save parameters + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + ## print plot + if (show_plot == TRUE) { + print(pl) + } + + ## save plot + if (save_plot == TRUE) { + do.call("all_plots_save_function", c(list( + gobject = gobject, + plot_object = pl, + default_save_name = default_save_name + ), save_param)) + } + + ## return plot + if (return_plot == TRUE) { + return(pl) + } +} + + + + + +# ** dim reduction plotting #### + + + + +# Create a single 2D dimplot. This is looped through by dimPlot2D() if needed. +#' @noRd +#' @keywords internal +.dimPlot2D_single <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = NULL, + dim1_to_use = 1, + dim2_to_use = 2, + spat_enr_names = NULL, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + center_point_border_col = "black", + center_point_border_stroke = 0.1, + label_size = 4, + label_fontface = "bold", + edge_alpha = NULL, + point_shape = c("border", "no_border"), + point_size = 1, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + title = NULL, + show_legend = TRUE, + legend_text = 8, + legend_symbol_size = 1, + background_color = "white", + axis_text = 8, + axis_title = 8, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dimPlot2D_single") { + checkmate::assert_class(gobject, "giotto") + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # specify dim_reduction_name according to provided feat_type + if (!is.null(dim_reduction_to_use)) { + if (is.null(dim_reduction_name)) { + if (feat_type == "rna") { + dim_reduction_name <- dim_reduction_to_use + } else { + dim_reduction_name <- paste0( + feat_type, ".", + dim_reduction_to_use + ) + } + } + } + + ## point shape ## + point_shape <- match.arg(point_shape, c("border", "no_border")) + + ## dimension reduction ## + # test if dimension reduction was performed + + dim_red_names <- list_dim_reductions_names( + gobject = gobject, data_type = "cells", + spat_unit = spat_unit, feat_type = feat_type, + dim_type = dim_reduction_to_use + ) + + if (!dim_reduction_name %in% dim_red_names) { + stop( + "\n dimension reduction: ", dim_reduction_to_use, + " or dimension reduction name: ", dim_reduction_name, + " is not available \n" + ) + } + + + dim_dfr <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "data.table" + ) + dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use)] + + + dim_names <- colnames(dim_dfr) + + # data.table variables + cell_ID <- NULL + + dim_DT <- data.table::as.data.table(dim_dfr) + dim_DT[, cell_ID := as.character(rownames(dim_dfr))] + + ## annotated cell metadata + cell_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_enr_names = spat_enr_names, + spat_loc_name = NULL + ) + + cell_metadata[, cell_ID := as.character(cell_ID)] + + annotated_DT <- data.table::merge.data.table(cell_metadata, + dim_DT, + by = "cell_ID" + ) + + + # create input for network + if (show_NN_network == TRUE) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + + network_DT <- data.table::as.data.table( + igraph::as_data_frame(selected_nn_network, what = "edges") + ) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- merge(network_DT, dim_DT, + by.x = "from", + by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = from_dim_names + ) + + annotated_network_DT <- merge(annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = to_dim_names + ) + } + + # add % variance information if reduction is PCA + if (dim_reduction_to_use == "pca") { + pcaObj <- getDimReduction(gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "dimObj" + ) + eigenvalues <- pcaObj@misc$eigenvalues + + if (!is.null(eigenvalues)) { + total <- sum(eigenvalues) + var_expl_vec <- (eigenvalues / total) * 100 + dim1_x_variance <- var_expl_vec[dim1_to_use] + dim2_y_variance <- var_expl_vec[dim2_to_use] + } + } + + + + ## create subsets if needed + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + if (is.null(cell_color)) { + stop("\n selection of cells is based on cell_color paramter, + which is a metadata column \n") + } + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% + select_cells] + annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% + select_cells] + + if (show_NN_network == TRUE) { + annotated_network_DT <- annotated_network_DT[ + annotated_network_DT$to %in% select_cells & + annotated_network_DT$from %in% select_cells + ] + } + + # if specific cells are selected + annotated_DT <- annotated_DT_selected + } + + ## if no subsets are required + if (is.null(select_cells) & is.null(select_cell_groups)) { + annotated_DT_selected <- annotated_DT + annotated_DT_other <- NULL + } + + + + pl <- ggplot2::ggplot() + pl <- pl + ggplot2::theme_classic() + + ## add network layer + if (show_NN_network == TRUE) { + pl <- plot_network_layer_ggplot( + ggobject = pl, + instrs = instructions(gobject), + annotated_network_DT = annotated_network_DT, + edge_alpha = edge_alpha, + show_legend = show_legend + ) + } + + # return(list(pl, annotated_DT_selected, annotated_DT_other)) + + if (point_shape == "border") { + ## add point layer + pl <- plot_point_layer_ggplot( + ggobject = pl, + instrs = instructions(gobject), + annotated_DT_selected = annotated_DT_selected, + annotated_DT_other = annotated_DT_other, + cell_color = cell_color, + color_as_factor = color_as_factor, + cell_color_code = cell_color_code, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + center_point_border_col = center_point_border_col, + center_point_border_stroke = center_point_border_stroke, + label_size = label_size, + label_fontface = label_fontface, + edge_alpha = edge_alpha, + point_size = point_size, + point_alpha = point_alpha, + point_border_col = point_border_col, + point_border_stroke = point_border_stroke, + show_legend = show_legend + ) + } else if (point_shape == "no_border") { + pl <- plot_point_layer_ggplot_noFILL( + ggobject = pl, + instrs = instructions(gobject), + annotated_DT_selected = annotated_DT_selected, + annotated_DT_other = annotated_DT_other, + cell_color = cell_color, + color_as_factor = color_as_factor, + cell_color_code = cell_color_code, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + label_size = label_size, + label_fontface = label_fontface, + edge_alpha = edge_alpha, + point_size = point_size, + point_alpha = point_alpha, + show_legend = show_legend + ) + } + + + ## add % variance explained to names of plot for PCA ## + if (dim_reduction_to_use == "pca") { + if (!is.null(eigenvalues)) { + x_name <- paste0("pca", "-", dim_names[1]) + y_name <- paste0("pca", "-", dim_names[2]) + + # provide x, y and plot titles + x_title <- sprintf( + "%s explains %.02f%% of variance", + x_name, var_expl_vec[dim1_to_use] + ) + y_title <- sprintf( + "%s explains %.02f%% of variance", + y_name, var_expl_vec[dim2_to_use] + ) + + if (is.null(title)) title <- cell_color + pl <- pl + ggplot2::labs(x = x_title, y = y_title, title = title) + } + } else { + # provide x, y and plot titles + x_title <- paste0(dim_reduction_to_use, "-", dim_names[1]) + y_title <- paste0(dim_reduction_to_use, "-", dim_names[2]) + + if (is.null(title)) title <- cell_color + pl <- pl + ggplot2::labs(x = x_title, y = y_title, title = title) + } + + ## adjust titles + pl <- pl + ggplot2::theme( + plot.title = element_text(hjust = 0.5), + legend.title = element_blank(), + legend.text = element_text(size = legend_text), + axis.text = element_text(size = axis_text), + axis.title = element_text(size = axis_title), + panel.grid = element_blank(), + panel.background = element_rect(fill = background_color) + ) + + ## change symbol size of legend + if (color_as_factor == TRUE) { + if (point_shape == "border") { + pl <- pl + guides(fill = guide_legend( + override.aes = list(size = legend_symbol_size) + )) + } else if (point_shape == "no_border") { + pl <- pl + guides(color = guide_legend( + override.aes = list(size = legend_symbol_size) + )) + } + } + + return(plot_output_handler( + gobject = gobject, + plot_object = pl, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + + + +#' @rdname dimPlot +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_dimred_params +#' @inheritParams plot_nn_net_params +#' @inheritParams plot_spatenr_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_params +#' @returns ggplot +#' @family reduced dimension visualizations +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' dimPlot2D(g) +#' @export +dimPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + group_by = NULL, + group_by_subset = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = NULL, + dim1_to_use = 1, + dim2_to_use = 2, + spat_enr_names = NULL, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + center_point_border_col = "black", + center_point_border_stroke = 0.1, + label_size = 4, + label_fontface = "bold", + edge_alpha = NULL, + point_shape = c("border", "no_border"), + point_size = 1, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + title = NULL, + show_legend = TRUE, + legend_text = 10, + legend_symbol_size = 2, + background_color = "white", + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dimPlot2D") { + # arg_list <- c(as.list(environment())) # get all args as list + checkmate::assert_class(gobject, "giotto") + + ## check group_by + if (is.null(group_by)) { + .dimPlot2D_single( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + spat_enr_names = spat_enr_names, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + cell_color = cell_color, + color_as_factor = color_as_factor, + cell_color_code = cell_color_code, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + center_point_border_col = center_point_border_col, + center_point_border_stroke = center_point_border_stroke, + label_size = label_size, + label_fontface = label_fontface, + edge_alpha = edge_alpha, + point_shape = point_shape, + point_size = point_size, + point_alpha = point_alpha, + point_border_col = point_border_col, + point_border_stroke = point_border_stroke, + title = title, + show_legend = show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = background_color, + axis_text = axis_text, + axis_title = axis_title, + show_plot = show_plot, + return_plot = return_plot, + save_plot = save_plot, + save_param = save_param, + default_save_name = default_save_name + ) + } else { + comb_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_enr_names = spat_enr_names, + spat_loc_name = NULL + ) + possible_meta_groups <- colnames(comb_metadata) + + ## check if group_by is found + if (!group_by %in% possible_meta_groups) { + stop("group_by ", group_by, " was not found in pDataDT()") + } + + unique_groups <- unique(comb_metadata[[group_by]]) + + # subset unique_groups + if (!is.null(group_by_subset)) { + not_found <- group_by_subset[!group_by_subset %in% unique_groups] + + if (length(not_found) > 0) { + message("the following subset was not found: ", not_found) + } + unique_groups <- unique_groups[unique_groups %in% group_by_subset] + } + + + # create matching cell_color_code for groupby factors + # best done prior to the following groupby subsetGiotto() operation + if (is.null(cell_color_code)) { # TODO add getColors() support + if (is.character(cell_color)) { + if (cell_color %in% colnames(comb_metadata)) { + if (color_as_factor == TRUE) { + number_colors <- length( + unique(comb_metadata[[cell_color]]) + ) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + names(cell_color_code) <- unique( + comb_metadata[[cell_color]] + ) + cell_color_code <- cell_color_code + } + } + } + } + + ## plotting ## + savelist <- list() + + + for (group_id in seq_len(length(unique_groups))) { + group <- unique_groups[group_id] + + subset_cell_IDs <- comb_metadata[ + get(group_by) == group + ][["cell_ID"]] + temp_gobject <- subsetGiotto( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + cell_ids = subset_cell_IDs + ) + + pl <- .dimPlot2D_single( + gobject = temp_gobject, + spat_unit = spat_unit, + feat_type = feat_type, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + spat_enr_names = spat_enr_names, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + cell_color = cell_color, + cell_color_code = cell_color_code, + color_as_factor = color_as_factor, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + center_point_border_col = center_point_border_col, + center_point_border_stroke = center_point_border_stroke, + label_size = label_size, + label_fontface = label_fontface, + edge_alpha = edge_alpha, + point_shape = point_shape, + point_size = point_size, + point_alpha = point_alpha, + point_border_col = point_border_col, + point_border_stroke = point_border_stroke, + title = group, + show_legend = show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = background_color, + axis_text = axis_text, + axis_title = axis_title, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE, + save_param = list(), + default_save_name = default_save_name + ) + + + savelist[[group_id]] <- pl + } + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) + } +} + + + + + +#' @title Plot dimension reduction +#' @name dimPlot +#' @param \dots dimPlot(...) passes to dimPlot2D() +#' @description Visualize cells according to dimension reduction coordinates +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' dimPlot(g) +#' @export +dimPlot <- function(...) { + dimPlot2D(...) +} + + + + + + +#' @title plotUMAP_2D +#' @name plotUMAP_2D +#' @description Short wrapper for UMAP visualization +#' @inheritParams data_access_params +#' @param dim_reduction_name name of UMAP +#' @param default_save_name default save name of UMAP plot +#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters, see \code{\link{dimPlot2D}}. +#' For 3D plots see \code{\link{plotUMAP_3D}} +#' @family reduced dimension visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' plotUMAP_2D(g) +#' @export +plotUMAP_2D <- function(gobject, + dim_reduction_name = NULL, + default_save_name = "UMAP_2D", + ...) { + checkmate::assert_class(gobject, "giotto") + + dimPlot2D( + gobject = gobject, + dim_reduction_to_use = "umap", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + +#' @title plotUMAP +#' @name plotUMAP +#' @description Short wrapper for UMAP visualization +#' @inheritParams data_access_params +#' @param dim_reduction_name name of UMAP +#' @param default_save_name default save name of UMAP plot +#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @family reduced dimension visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' plotUMAP(g) +#' +#' @export +plotUMAP <- function(gobject, + dim_reduction_name = NULL, + default_save_name = "UMAP", + ...) { + checkmate::assert_class(gobject, "giotto") + + dimPlot2D( + gobject = gobject, + dim_reduction_to_use = "umap", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + + + + +#' @title plotTSNE_2D +#' @name plotTSNE_2D +#' @description Short wrapper for tSNE visualization +#' @inheritParams data_access_params +#' @param dim_reduction_name name of TSNE +#' @param default_save_name default save name of TSNE plot +#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters, see \code{\link{dimPlot2D}}. +#' For 3D plots see \code{\link{plotTSNE_3D}} +#' @family reduced dimension visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' plotTSNE_2D(g) +#' +#' @export +plotTSNE_2D <- function(gobject, + dim_reduction_name = NULL, + default_save_name = "tSNE_2D", + ...) { + checkmate::assert_class(gobject, "giotto") + + dimPlot2D( + gobject = gobject, + dim_reduction_to_use = "tsne", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + +#' @title plotTSNE +#' @name plotTSNE +#' @description Short wrapper for tSNE visualization +#' @inheritParams data_access_params +#' @param dim_reduction_name name of TSNE +#' @param default_save_name default save name of TSNE plot +#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters, see \code{\link{dimPlot2D}}. +#' For 3D plots see \code{\link{plotTSNE_3D}} +#' @family reduced dimension visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' plotTSNE(g) +#' +#' @export +plotTSNE <- function(gobject, + dim_reduction_name = NULL, + default_save_name = "tSNE", + ...) { + checkmate::assert_class(gobject, "giotto") + + dimPlot2D( + gobject = gobject, + dim_reduction_to_use = "tsne", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + + +#' @title plotPCA_2D +#' @name plotPCA_2D +#' @description Short wrapper for PCA visualization +#' @inheritParams data_access_params +#' @param dim_reduction_name name of PCA +#' @param default_save_name default save name of PCA plot +#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters, see \code{\link{dimPlot2D}}. +#' For 3D plots see \code{\link{plotPCA_3D}} +#' @family reduced dimension visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' plotPCA_2D(g) +#' +#' @export +plotPCA_2D <- function(gobject, + dim_reduction_name = NULL, + default_save_name = "PCA_2D", + ...) { + checkmate::assert_class(gobject, "giotto") + + dimPlot2D( + gobject = gobject, + dim_reduction_to_use = "pca", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + + +#' @title plotPCA +#' @name plotPCA +#' @description Short wrapper for PCA visualization +#' @inheritParams data_access_params +#' @param dim_reduction_name name of PCA +#' @param default_save_name default save name of PCA plot +#' @inheritDotParams dimPlot2D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters, see \code{\link{dimPlot2D}}. +#' For 3D plots see \code{\link{plotPCA_3D}} +#' @family reduced dimension visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' plotPCA(g) +#' +#' @export +plotPCA <- function(gobject, + dim_reduction_name = NULL, + default_save_name = "PCA", + ...) { + checkmate::assert_class(gobject, "giotto") + + dimPlot2D( + gobject = gobject, + dim_reduction_to_use = "pca", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + + + + + + + + + + + +## ** spatial and dim reduction plotting #### + + +#' @title spatDimPlot +#' @name spatDimPlot +#' @description Visualize cells according to spatial AND dimension reduction +#' coordinates 2D +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_spatenr_params +#' @inheritParams plot_dimred_params +#' @inheritParams plot_nn_net_params +#' @inheritParams plot_spatnet_params +#' @inheritParams plot_image_params +#' @inheritParams plot_params +#' @param largeImage_name deprecated +#' @param spat_loc_name name of spatial locations +#' @param plot_alignment direction to align plot +#' @param sdimx = spatial dimension to use on x-axis +#' @param sdimy = spatial dimension to use on y-axis +#' @param spat_point_shape shape of points (border, no_border or voronoi) +#' @param spat_point_size size of spatial points +#' @param spat_point_alpha transparancy of spatial points +#' @param spat_point_border_col border color of spatial points +#' @param spat_point_border_stroke border stroke of spatial points +#' @param dim_show_cluster_center show the center of each cluster +#' @param dim_show_center_label provide a label for each cluster +#' @param dim_center_point_size size of the center point +#' @param dim_center_point_border_col border color of center point +#' @param dim_center_point_border_stroke stroke size of center point +#' @param dim_label_size size of the center label +#' @param dim_label_fontface font of the center label +#' @param spat_show_cluster_center show the center of each cluster +#' @param spat_show_center_label provide a label for each cluster +#' @param spat_center_point_size size of the center point +#' @param spat_center_point_border_col border color of spatial center points +#' @param spat_center_point_border_stroke border strike size of spatial center points +#' @param spat_label_size size of the center label +#' @param spat_label_fontface font of the center label +#' @param show_spatial_grid show spatial grid +#' @param spat_grid_name name of spatial grid to use +#' @param spat_grid_color color of spatial grid +#' @param show_other_cells display not selected cells +#' @param other_cell_color color of not selected cells +#' @param dim_other_point_size size of not selected dim cells +#' @param spat_other_point_size size of not selected spat cells +#' @param spat_other_cells_alpha alpha of not selected spat cells +#' @param dim_show_legend show legend of dimension reduction plot +#' @param spat_show_legend show legend of spatial plot +#' @param dim_background_color background color of points in dim. reduction space +#' @param spat_background_color background color of spatial points +#' @param vor_border_color border color for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparency of voronoi 'cells' +#' @details Description of parameters. +#' @family spatial and dimension reduction visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatDimPlot2D(g) +#' +#' @export +#' @seealso \code{\link{spatDimPlot3D}} +spatDimPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + spat_loc_name = NULL, + plot_alignment = c("vertical", "horizontal"), + dim_reduction_to_use = "umap", + dim_reduction_name = NULL, + dim1_to_use = 1, + dim2_to_use = 2, + sdimx = "sdimx", + sdimy = "sdimy", + spat_enr_names = NULL, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + dim_point_shape = c("border", "no_border"), + dim_point_size = 1, + dim_point_alpha = 1, + dim_point_border_col = "black", + dim_point_border_stroke = 0.1, + spat_point_shape = c("border", "no_border", "voronoi"), + spat_point_size = 1, + spat_point_alpha = 1, + spat_point_border_col = "black", + spat_point_border_stroke = 0.1, + dim_show_cluster_center = FALSE, + dim_show_center_label = TRUE, + dim_center_point_size = 4, + dim_center_point_border_col = "black", + dim_center_point_border_stroke = 0.1, + dim_label_size = 4, + dim_label_fontface = "bold", + spat_show_cluster_center = FALSE, + spat_show_center_label = FALSE, + spat_center_point_size = 4, + spat_center_point_border_col = "blue", + spat_center_point_border_stroke = 0.1, + spat_label_size = 4, + spat_label_fontface = "bold", + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + nn_network_alpha = 0.05, + show_spatial_network = FALSE, + spat_network_name = "Delaunay_network", + spat_network_color = "blue", + spat_network_alpha = 0.5, + show_spatial_grid = FALSE, + spat_grid_name = "spatial_grid", + spat_grid_color = "blue", + show_other_cells = TRUE, + other_cell_color = "lightgrey", + dim_other_point_size = 1, + spat_other_point_size = 1, + spat_other_cells_alpha = 0.5, + dim_show_legend = FALSE, + spat_show_legend = FALSE, + legend_text = 10, + legend_symbol_size = 2, + dim_background_color = "white", + spat_background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + axis_text = 8, + axis_title = 8, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatDimPlot2D") { + # deprecation message + if (!is.null(largeImage_name)) { + deprecate_warn( + when = "0.2.0", + what = "spatDimPlot2D(largeImage_name)", + details = c( + "Use `image_name` argument instead for all images to plot." + ) + ) + image_name <- c(image_name, largeImage_name) + } + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + plot_alignment <- match.arg(plot_alignment, + choices = c("vertical", "horizontal") + ) + + + # create matching cell_color_code + if (is.null(cell_color_code)) { + if (is.character(cell_color)) { + cell_metadata <- pDataDT(gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + if (cell_color %in% colnames(cell_metadata)) { + if (color_as_factor == TRUE) { + number_colors <- length( + unique(cell_metadata[[cell_color]]) + ) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + names(cell_color_code) <- unique( + cell_metadata[[cell_color]] + ) + cell_color_code <- cell_color_code + } + } + } + } + + # dimension reduction plot + dmpl <- dimPlot2D( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + group_by = NULL, + group_by_subset = NULL, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + spat_enr_names = spat_enr_names, + cell_color = cell_color, + color_as_factor = color_as_factor, + cell_color_code = cell_color_code, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + point_shape = dim_point_shape, + point_size = dim_point_size, + point_alpha = dim_point_alpha, + point_border_col = dim_point_border_col, + point_border_stroke = dim_point_border_stroke, + show_cluster_center = dim_show_cluster_center, + show_center_label = dim_show_center_label, + center_point_size = dim_center_point_size, + center_point_border_col = dim_center_point_border_col, + center_point_border_stroke = dim_center_point_border_stroke, + label_size = dim_label_size, + label_fontface = dim_label_fontface, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + edge_alpha = nn_network_alpha, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = dim_other_point_size, + show_legend = dim_show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = dim_background_color, + axis_text = axis_text, + axis_title = axis_title, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE + ) + + # spatial plot + spl <- spatPlot2D( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + show_image = show_image, + gimage = gimage, + image_name = image_name, + spat_loc_name = spat_loc_name, + group_by = NULL, + group_by_subset = NULL, + sdimx = sdimx, + sdimy = sdimy, + spat_enr_names = spat_enr_names, + cell_color = cell_color, + cell_color_code = cell_color_code, + color_as_factor = color_as_factor, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + point_shape = spat_point_shape, + point_size = spat_point_size, + point_alpha = spat_point_alpha, + point_border_col = spat_point_border_col, + point_border_stroke = spat_point_border_stroke, + show_cluster_center = spat_show_cluster_center, + show_center_label = spat_show_center_label, + center_point_size = spat_center_point_size, + center_point_border_col = spat_center_point_border_col, + center_point_border_stroke = spat_center_point_border_stroke, + label_size = spat_label_size, + label_fontface = spat_label_fontface, + show_network = show_spatial_network, + spatial_network_name = spat_network_name, + network_color = spat_network_color, + network_alpha = spat_network_alpha, + show_grid = show_spatial_grid, + spatial_grid_name = spat_grid_name, + grid_color = spat_grid_color, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = spat_other_point_size, + other_cells_alpha = spat_other_cells_alpha, + coord_fix_ratio = 1, + title = "", + show_legend = spat_show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = spat_background_color, + vor_border_color = vor_border_color, + vor_max_radius = vor_max_radius, + vor_alpha = vor_alpha, + axis_text = axis_text, + axis_title = axis_title, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE + ) + + + if (plot_alignment == "vertical") { + ncol <- 1 + nrow <- 2 + combo_plot <- cowplot::plot_grid(dmpl, spl, + ncol = ncol, + nrow = nrow, rel_heights = c(1), + rel_widths = c(1), align = "v" + ) + } else { + ncol <- 2 + nrow <- 1 + combo_plot <- cowplot::plot_grid(dmpl, spl, + ncol = ncol, + nrow = nrow, rel_heights = c(1), + rel_widths = c(1), align = "h" + ) + } + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + + + +#' @rdname spatDimPlot +#' @param \dots spatDimPlot(...) passes to spatDimPlot2D() +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatDimPlot(g) +#' +#' @export +spatDimPlot <- function(gobject, ...) { + spatDimPlot2D(gobject, ...) +} + + + +## ** spatial feature plotting #### + +#' @title spatFeatPlot2D_single +#' @name spatFeatPlot2D_single +#' @description Visualize cells and feature expression according to +#' spatial coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_image_params +#' @inheritParams plot_params +#' @param largeImage_name deprecated +#' @param spat_loc_name name of spatial locations +#' @param sdimx x-axis dimension name (default = 'sdimx') +#' @param sdimy y-axis dimension name (default = 'sdimy') +#' @param spat_enr_names names of spatial enrichment results to include +#' @param expression_values gene expression values to use +#' @param feats features to show +#' @param order order points according to feature expression +#' @param show_network show underlying spatial network +#' @param network_color color of spatial network +#' @param edge_alpha alpha of spatial network +#' @param spatial_network_name name of spatial network to use +#' @param show_grid show spatial grid +#' @param grid_color color of spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param midpoint expression midpoint +#' @param scale_alpha_with_expression scale expression with +#' ggplot alpha parameter +#' @param point_shape shape of points (border, no_border or voronoi) +#' @param point_size size of point (cell) +#' @param point_alpha transparancy of points +#' @param point_border_col color of border around points +#' @param point_border_stroke stroke size of border around points +#' @param coord_fix_ratio fix ratio between x and y-axis (default = 1) +#' @param vor_border_color border colorr for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparency of voronoi 'cells' +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @details Description of parameters. +#' @family spatial feature expression visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatFeatPlot2D_single(g, feats = c("Gna12", "Ccnd2", "Btbd17")) +#' +#' @export +#' @seealso \code{\link{spatFeatPlot3D}} +spatFeatPlot2D_single <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + spat_loc_name = "raw", + sdimx = "sdimx", + sdimy = "sdimy", + spat_enr_names = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats, + order = TRUE, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + show_network = FALSE, + network_color = NULL, + edge_alpha = 0.5, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + midpoint = 0, + scale_alpha_with_expression = FALSE, + point_shape = c("border", "no_border", "voronoi"), + point_size = 1, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + coord_fix_ratio = 1, + show_legend = TRUE, + legend_text = 8, + background_color = "white", + vor_border_color = "white", + vor_alpha = 1, + vor_max_radius = 200, + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatFeatPlot2D_single") { + # data.table variables + cell_ID <- NULL + + # deprecation message + if (!is.null(largeImage_name)) { + deprecate_warn( + when = "0.2.0", + what = "spatFeatPlot2D_single(largeImage_name)", + details = c( + "Use `image_name` argument instead for all images to plot." + ) + ) + image_name <- c(image_name, largeImage_name) + } + + # print, return and save parameters + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + ## get giotto image(s) ## + if (isTRUE(show_image) && is.null(gimage)) { + gimage <- getGiottoImage( + gobject = gobject, + name = image_name + ) + } + + # point shape + point_shape <- match.arg(point_shape, + choices = c("border", "no_border", "voronoi") + ) + + # expression values + values <- match.arg( + expression_values, + unique(c( + "normalized", "scaled", "custom", + expression_values + )) + ) + expr_values <- getExpression( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + values = values, + output = "matrix" + ) + + # only keep feats that are in the dataset + selected_feats <- feats + selected_feats <- selected_feats[selected_feats %in% rownames(expr_values)] + + + # get selected feat expression values in data.table format + if (length(selected_feats) == 1) { + subset_expr_data <- expr_values[rownames(expr_values) %in% + selected_feats, ] + t_sub_expr_data_DT <- data.table::data.table( + "selected_feat" = subset_expr_data, + "cell_ID" = colnames(expr_values) + ) + data.table::setnames( + t_sub_expr_data_DT, "selected_feat", + selected_feats + ) + } else { + subset_expr_data <- expr_values[rownames(expr_values) %in% + selected_feats, ] + t_sub_expr_data <- t_flex(subset_expr_data) + t_sub_expr_data_DT <- data.table::as.data.table( + as.matrix(t_sub_expr_data) + ) + t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] + } + + + ## extract cell locations + if (is.null(spat_loc_name)) { + if (!is.null(slot(gobject, "spatial_locs"))) { + spat_loc_name <- list_spatial_locations_names( + gobject, + spat_unit = spat_unit + )[[1]] + } else { + spat_loc_name <- NULL + warning("No spatial locations have been found") + return(NULL) + } + } + + cell_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table", + copy_obj = TRUE + ) + if (is.null(cell_locations)) { + return(NULL) + } + + ## extract spatial network + if (show_network) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT" + ) + } else { + spatial_network <- NULL + } + + ## extract spatial grid + if (show_grid) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name + ) + } else { + spatial_grid <- NULL + } + + ## extract cell metadata + cell_metadata <- try( + expr = combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + spat_enr_names = spat_enr_names + ), + silent = TRUE + ) + + if (inherits(cell_metadata, "try-error")) { + cell_locations_metadata <- cell_locations + } else if (nrow(cell_metadata) == 0) { + cell_locations_metadata <- cell_locations + } else { + cell_locations_metadata <- cell_metadata + } + + cell_locations_metadata_feats <- merge( + cell_locations_metadata, + t_sub_expr_data_DT, + by = "cell_ID" + ) + + + ## plotting ## + savelist <- list() + + for (feat in selected_feats) { + # order spatial units (e.g. cell IDs) based on expression of feature + if (isTRUE(order)) { + cell_locations_metadata_feats <- cell_locations_metadata_feats[ + order(get(feat)) + ] + } + + + pl <- ggplot2::ggplot() + pl <- pl + ggplot2::theme_classic() + + + ## plot image ## TODO + ## plot image ## + if (isTRUE(show_image) && !is.null(gimage)) { + pl <- plot_spat_image_layer_ggplot( + gg_obj = pl, + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + gimage = gimage + ) + } + + ## plot network or grid first if point_shape is border or no_border + ## point + if (point_shape %in% c("border", "no_border")) { + ## plot spatial network + if (!is.null(spatial_network) && isTRUE(show_network)) { + edge_alpha <- edge_alpha %null% 0.5 + network_color <- network_color %null% "red" + xbegin <- paste0(sdimx, "_begin") + ybegin <- paste0(sdimy, "_begin") + xend <- paste0(sdimx, "_end") + yend <- paste0(sdimy, "_end") + pl <- pl + ggplot2::geom_segment( + data = spatial_network, + aes_string( + x = xbegin, + y = ybegin, + xend = xend, + yend = yend + ), + color = network_color, + size = 0.5, + alpha = edge_alpha + ) + } + + ## plot spatial grid + if (!is.null(spatial_grid) && isTRUE(show_grid)) { + if (is.null(grid_color)) grid_color <- "black" + + xmin <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimx + ), "_start") + ymin <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimy + ), "_start") + xmax <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimx + ), "_end") + ymax <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimy + ), "_end") + + pl <- pl + ggplot2::geom_rect( + data = spatial_grid, + aes_string( + xmin = xmin, + xmax = xmax, + ymin = ymin, + ymax = ymax + ), + color = grid_color, + fill = NA + ) + } + } + + + + ### plot cells ### + + ## set gradient limits if needed ## + if (!is.null(gradient_limits) && + is.vector(gradient_limits) && + length(gradient_limits) == 2) { + cell_locations_metadata_feats[[feat]] <- + scales::oob_squish(cell_locations_metadata_feats[[feat]], + range = gradient_limits) + } + + if (is.null(gradient_midpoint)) { + gradient_midpoint <- stats::median( + cell_locations_metadata_feats[[feat]] + ) + } + + + if (point_shape %in% c("border", "no_border")) { + + # assemble points plotting params + # * aes - dynamic values found in the `data` + # * args - static values to set + + points_aes <- aes_string2(x = sdimx, y = sdimy) + + points_args <- list() + # common args + points_args$size <- point_size + points_args$show.legend <- show_legend + + if (isTRUE(scale_alpha_with_expression)) { + points_aes$alpha <- as.name(feat) + } else { + points_args$alpha <- point_alpha + } + + switch(point_shape, + "border" = { + points_aes$fill <- as.name(feat) + + points_args$shape <- 21 + points_args$color <- point_border_col + points_args$stroke <- point_border_stroke + scale_type <- "fill" + }, + "no_border" = { + points_aes$color <- as.name(feat) + + points_args$shape <- 19 + scale_type <- "color" + } + ) + + # other data to add + points_args$data <- cell_locations_metadata_feats + points_args$mapping <- points_aes + + # add points + pl <- pl + do.call(ggplot2::geom_point, args = points_args) + + ## scale and labs ## + pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") + pl <- pl + set_default_color_continuous_cell( + colors = cell_color_gradient, + instrs = instructions(gobject), + midpoint = gradient_midpoint, + style = gradient_style, + guide = guide_colorbar(title = ""), + type = scale_type + ) + pl <- pl + ggplot2::labs( + x = "coord x", + y = "coord y", + title = feat) + } + + + ## voronoi ## + if (point_shape == "voronoi") { + if (scale_alpha_with_expression == TRUE) { + pl <- pl + ggforce::geom_voronoi_tile( + data = cell_locations_metadata_feats, + aes_string( + x = sdimx, y = sdimy, + group = "-1L", + fill = feat, + alpha = feat + ), + colour = vor_border_color, + max.radius = vor_max_radius, + show.legend = show_legend + ) + } else { + pl <- pl + ggforce::geom_voronoi_tile( + data = cell_locations_metadata_feats, + aes_string( + x = sdimx, y = sdimy, + group = "-1L", + fill = feat + ), + colour = vor_border_color, + max.radius = vor_max_radius, + show.legend = show_legend, + alpha = vor_alpha + ) + } + + + ## plot spatial network + if (!is.null(spatial_network) && show_network == TRUE) { + if (is.null(network_color)) { + network_color <- "red" + } + xbegin <- paste0(sdimx, "_begin") + ybegin <- paste0(sdimy, "_begin") + xend <- paste0(sdimx, "_end") + yend <- paste0(sdimy, "_end") + pl <- pl + ggplot2::geom_segment( + data = spatial_network, aes_string( + x = xbegin, y = ybegin, + xend = xend, yend = yend + ), + color = network_color, size = 0.5, alpha = 0.5 + ) + } + + ## plot spatial grid + if (!is.null(spatial_grid) & show_grid == TRUE) { + if (is.null(grid_color)) grid_color <- "black" + + xmin <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimx + ), "_start") + ymin <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimy + ), "_start") + xmax <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimx + ), "_end") + ymax <- paste0(gsub( + pattern = "sdim", + replacement = "", x = sdimy + ), "_end") + + pl <- pl + ggplot2::geom_rect( + data = spatial_grid, aes_string( + xmin = xmin, xmax = xmax, + ymin = ymin, ymax = ymax + ), + color = grid_color, fill = NA + ) + } + + + ## scale and labs ## + pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") + pl <- pl + set_default_color_continuous_cell( + colors = cell_color_gradient, + instrs = instructions(gobject), + midpoint = gradient_midpoint, + style = gradient_style, + guide = guide_colorbar(title = ""), + type = "fill" + ) + pl <- pl + ggplot2::labs(x = "coord x", y = "coord y", title = feat) + } + + ## adjust theme setting + gg_theme_args <- c( + theme_param, + legend_text = legend_text, + axis_title = axis_title, + axis_text = axis_text, + background_color = background_color + ) + pl <- pl + do.call(.gg_theme, args = gg_theme_args) + + if (!is.null(coord_fix_ratio)) { + pl <- pl + ggplot2::coord_fixed(ratio = coord_fix_ratio) + } + + savelist[[feat]] <- pl + } + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + + + ## print plot + if (show_plot == TRUE) { + print(combo_plot) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = combo_plot, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(combo_plot) + } +} + + +#' @title Plot data in physical space 2D +#' @name spatFeatPlot2D +#' @description Visualize cells and feature expression according to +#' spatial coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_image_params +#' @inheritParams plot_params +#' @inheritParams plot_spatnet_params +#' @param largeImage_name deprecated +#' @param spat_loc_name name of spatial locations +#' @param sdimx x-axis dimension name (default = 'sdimx') +#' @param sdimy y-axis dimension name (default = 'sdimy') +#' @param expression_values gene expression values to use +#' @param feats features to show +#' @param order order points according to feature expression +#' @param show_network show underlying spatial network +#' @param network_color color of spatial network +#' @param edge_alpha alpha of spatial network +#' @param show_grid show spatial grid +#' @param grid_color color of spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param midpoint expression midpoint +#' @param scale_alpha_with_expression scale expression with ggplot alpha parameter +#' @param coord_fix_ratio fix ratio between x and y-axis (default = 1) +#' @param background_color color of plot background +#' @param vor_border_color border colorr for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparency of voronoi 'cells' +#' @param axis_text size of axis text +#' @param axis_title size of axis title +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @details Description of parameters. +#' @family spatial feature expression visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatFeatPlot2D(g, feats = "Gna12") +#' +#' @export +#' @seealso \code{\link{spatFeatPlot3D}} +spatFeatPlot2D <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + spat_loc_name = NULL, + group_by = NULL, + group_by_subset = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + expression_values = c("normalized", "scaled", "custom"), + feats, + order = TRUE, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + show_network = FALSE, + network_color = NULL, + edge_alpha = NULL, + spatial_network_name = "Delaunay_network", + show_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + midpoint = 0, + scale_alpha_with_expression = FALSE, + point_shape = c("border", "no_border", "voronoi"), + point_size = 1, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + coord_fix_ratio = 1, + show_legend = TRUE, + legend_text = 8, + background_color = "white", + vor_border_color = "white", + vor_alpha = 1, + vor_max_radius = 200, + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatFeatPlot2D") { + # deprecation message + if (!is.null(largeImage_name)) { + deprecate_warn( + when = "0.2.0", + what = "spatFeatPlot2D(largeImage_name)", + details = c( + "Use `image_name` argument instead for all images to plot." + ) + ) + image_name <- c(image_name, largeImage_name) + } + + # create args list needed for each call to spatFeatPlot2D_single() + # 1. - grab all params available + # 2. - subset to those needed + sfp_params <- get_args_list() + sfp_params <- sfp_params[c( + # [gobject params] + "gobject", "feat_type", "spat_unit", + # [image params] + "show_image", "gimage", "image_name", + # [spatlocs params] + "spat_loc_name", "sdimx", "sdimy", + # [expression params] + "expression_values", "feats", "order", + # [point aes] + "cell_color_gradient", "gradient_midpoint", "gradient_style", + "gradient_limits", "midpoint", "scale_alpha_with_expression", + "point_shape", + "point_size", "point_alpha", "point_border_col", "point_border_stroke", + # [voronoi-point params] + "vor_border_color", "vor_alpha", "vor_max_radius", + # [network aes] + "show_network", "network_color", "edge_alpha", "spatial_network_name", + # [grid aes] + "show_grid", "grid_color", "spatial_grid_name", + # [figure params] + "coord_fix_ratio", "show_legend", "legend_text", "background_color", + "axis_text", "axis_title", + "cow_n_col", "cow_rel_h", "cow_rel_w", "cow_align", + # [return params] + "show_plot", "return_plot", "save_plot", "save_param", + "default_save_name", + # [theme params] + "theme_param" + )] + + ## check group_by + if (is.null(group_by)) { # ----------------------------------------------- # + + do.call(spatFeatPlot2D_single, args = sfp_params) + } else { # -------------------------------------------------------------- # + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit + ) + # ! update spat_unit & feat_type in static params ! # + + ## check metadata for valid group_by information + comb_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + spat_loc_name = spat_loc_name, + feat_type = feat_type + ) + possible_meta_groups <- colnames(comb_metadata) + + ## error if group_by col is not found + if (!group_by %in% possible_meta_groups) { + stop("group_by ", group_by, " was not found in pDataDT()") + } + + unique_groups <- unique(comb_metadata[[group_by]]) + + # subset unique_groups + # These unique_groups will be used to iterate through subsetting then + # plotting the giotto object multiple times. + if (!is.null(group_by_subset)) { + not_found <- group_by_subset[!group_by_subset %in% unique_groups] + if (length(not_found) > 0) { + message("the following subset was not found: ", not_found) + } + unique_groups <- unique_groups[unique_groups %in% group_by_subset] + } + + + # group_by static settings # + # update these params + sfp_params$spat_unit <- spat_unit + sfp_params$feat_type <- feat_type + # apply group_by specific defaults + sfp_params$cow_n_col <- 1 + sfp_params$show_plot <- FALSE + sfp_params$return_plot <- TRUE + sfp_params$save_plot <- FALSE + sfp_params$default_save_name <- "spatFeatPlot2D" + + + ## plotting ## + savelist <- list() + + for (group_id in seq_along(unique_groups)) { + group <- unique_groups[group_id] + + subset_cell_IDs <- comb_metadata[ + get(group_by) == group + ][["cell_ID"]] + sfp_params$gobject <- subsetGiotto( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + cell_ids = subset_cell_IDs, + verbose = FALSE + ) + + # use a different image per group if there are the same number of + # names provided as there are groups + # Otherwise, use the same image (or NULL) for all groups (default) + if (length(unique_groups) == length(image_name)) { + sfp_params$image_name <- image_name[group_id] + } + + + pl <- do.call(spatFeatPlot2D_single, args = sfp_params) + + savelist[[group_id]] <- pl + } + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + + # output + return( + plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + return_plot = return_plot, + show_plot = show_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + ) + ) + } # --------------------------------------------------------------------- # +} + + + + + + + + +## ** dim reduction feature plotting #### + +#' @title dimFeatPlot2D +#' @name dimFeatPlot2D +#' @description Visualize gene expression according to dimension reduction +#' coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_nn_net_params +#' @inheritParams plot_dimred_params +#' @inheritParams plot_params +#' @param expression_values gene expression values to use +#' @param feats features to show +#' @param order order points according to feature expression +#' @param scale_alpha_with_expression scale expression with ggplot alpha +#' parameter +#' @details Description of parameters. +#' @family dimension reduction feature expression visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' dimFeatPlot2D(g, feats = c("Gna12", "Ccnd2", "Btbd17")) +#' +#' @export +dimFeatPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats = NULL, + order = TRUE, + dim_reduction_to_use = "umap", + dim_reduction_name = NULL, + dim1_to_use = 1, + dim2_to_use = 2, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + network_color = "lightgray", + edge_alpha = NULL, + scale_alpha_with_expression = FALSE, + point_shape = c("border", "no_border"), + point_size = 1, + point_alpha = 1, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + point_border_col = "black", + point_border_stroke = 0.1, + show_legend = TRUE, + legend_text = 10, + background_color = "white", + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dimFeatPlot2D") { + # print, return and save parameters + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + # point shape + point_shape <- match.arg(point_shape, choices = c("border", "no_border")) + + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # specify dim_reduction_name according to provided feat_type + if (!is.null(dim_reduction_to_use)) { + if (is.null(dim_reduction_name)) { + if (feat_type == "rna") { + dim_reduction_name <- dim_reduction_to_use + } else { + dim_reduction_name <- paste0( + feat_type, ".", + dim_reduction_to_use + ) + } + } + } + + + # expression values + values <- match.arg( + expression_values, + unique(c( + "normalized", "scaled", "custom", + expression_values + )) + ) + expr_values <- getExpression( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + values = values, + output = "matrix" + ) + + # only keep feats that are in the dataset + selected_feats <- feats + selected_feats <- selected_feats[selected_feats %in% rownames(expr_values)] + + # + if (length(selected_feats) == 1) { + subset_expr_data <- expr_values[ + rownames(expr_values) %in% selected_feats, + ] + t_sub_expr_data_DT <- data.table::data.table( + "selected_feat" = subset_expr_data, + "cell_ID" = colnames(expr_values) + ) + data.table::setnames( + t_sub_expr_data_DT, "selected_feat", + selected_feats + ) + } else { + subset_expr_data <- expr_values[rownames(expr_values) %in% + selected_feats, ] + t_sub_expr_data <- t_flex(subset_expr_data) + t_sub_expr_data_DT <- data.table::as.data.table( + as.matrix(t_sub_expr_data) + ) + + # data.table variables + cell_ID <- NULL + + t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] + } + + + ## dimension reduction ## + dim_dfr <- getDimReduction( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "data.table" + ) + + dim_names <- colnames(dim_dfr) + dim_DT <- data.table::as.data.table(dim_dfr) + dim_DT[, cell_ID := rownames(dim_dfr)] + + ## annotated cell metadata + cell_metadata <- pDataDT( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + annotated_DT <- data.table::merge.data.table(cell_metadata, + dim_DT, + by = "cell_ID" + ) + + ## merge feat info + annotated_feat_DT <- data.table::merge.data.table(annotated_DT, + t_sub_expr_data_DT, + by = "cell_ID" + ) + + # create input for network + if (show_NN_network == TRUE) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + + network_DT <- data.table::as.data.table( + igraph::as_data_frame(selected_nn_network, what = "edges") + ) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- data.table::merge.data.table( + network_DT, dim_DT, + by.x = "from", by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = from_dim_names + ) + + annotated_network_DT <- data.table::merge.data.table( + annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = to_dim_names + ) + } + + ## visualize multiple plots ## + ## 2D plots ## + savelist <- list() + + + for (feat in selected_feats) { + # order spatial units (e.g. cell IDs) based on expression of feature + if (isTRUE(order)) { + annotated_feat_DT <- annotated_feat_DT[order(get(feat))] + } + + + ## OLD need to be combined ## + pl <- ggplot2::ggplot() + pl <- pl + ggplot2::theme_classic() + + # network layer + if (show_NN_network == TRUE) { + if (is.null(edge_alpha)) { + edge_alpha <- 0.5 + pl <- pl + ggplot2::geom_segment( + data = annotated_network_DT, + aes_string( + x = from_dim_names[1], y = from_dim_names[2], + xend = to_dim_names[1], yend = to_dim_names[2] + ), + alpha = edge_alpha, color = network_color, size = 0.1, + show.legend = FALSE + ) + } else if (is.numeric(edge_alpha)) { + pl <- pl + ggplot2::geom_segment( + data = annotated_network_DT, + aes_string( + x = from_dim_names[1], y = from_dim_names[2], + xend = to_dim_names[1], yend = to_dim_names[2] + ), + alpha = edge_alpha, color = network_color, size = 0.1, + show.legend = FALSE + ) + } else if (is.character(edge_alpha)) { + if (edge_alpha %in% colnames(annotated_network_DT)) { + pl <- pl + ggplot2::geom_segment( + data = annotated_network_DT, + aes_string( + x = from_dim_names[1], y = from_dim_names[2], + xend = to_dim_names[1], + yend = to_dim_names[2], alpha = edge_alpha + ), + color = network_color, + show.legend = FALSE + ) + } + } + } + + + ## point layer ## + if (is.null(feats)) { + cell_color <- "lightblue" + message("no feats selected") + pl <- pl + ggplot2::geom_point( + data = annotated_feat_DT, + aes_string(x = dim_names[1], dim_names[2]), + fill = cell_color, show.legend = show_legend, + size = point_size, alpha = point_alpha + ) + } else { + ## set gradient limits if needed ## + if (!is.null(gradient_limits) & is.vector(gradient_limits) & + length(gradient_limits) == 2) { + lower_lim <- gradient_limits[[1]] + upper_lim <- gradient_limits[[2]] + numeric_data <- annotated_feat_DT[[feat]] + limit_numeric_data <- ifelse(numeric_data > upper_lim, + upper_lim, + ifelse(numeric_data < lower_lim, lower_lim, numeric_data) + ) + annotated_feat_DT[[feat]] <- limit_numeric_data + } + + if (is.null(gradient_midpoint)) { + gradient_midpoint <- stats::median(annotated_feat_DT[[feat]]) + } + + + + ## with border ## + if (point_shape == "border") { + if (scale_alpha_with_expression == TRUE) { + pl <- pl + ggplot2::geom_point( + data = annotated_feat_DT, aes_string2( + x = dim_names[1], + y = dim_names[2], + fill = feat, alpha = feat + ), + show.legend = show_legend, shape = 21, + size = point_size, + color = point_border_col, stroke = point_border_stroke + ) + } else { + pl <- pl + ggplot2::geom_point( + data = annotated_feat_DT, aes_string2( + x = dim_names[1], + y = dim_names[2], + fill = feat + ), + show.legend = show_legend, shape = 21, + size = point_size, + color = point_border_col, stroke = point_border_stroke, + alpha = point_alpha + ) + } + + ## scale and labs ## + pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") + pl <- pl + set_default_color_continuous_cell( + colors = cell_color_gradient, + instrs = instructions(gobject), + midpoint = gradient_midpoint, + style = gradient_style, + guide = guide_colorbar(title = ""), + type = "fill" + ) + } + + + ## without border ## + if (point_shape == "no_border") { + if (scale_alpha_with_expression == TRUE) { + pl <- pl + ggplot2::geom_point( + data = annotated_feat_DT, aes_string2( + x = dim_names[1], + y = dim_names[2], + color = feat, alpha = feat + ), + show.legend = show_legend, shape = 19, size = point_size + ) + } else { + pl <- pl + ggplot2::geom_point( + data = annotated_feat_DT, aes_string2( + x = dim_names[1], + y = dim_names[2], + color = feat + ), + show.legend = show_legend, shape = 19, + size = point_size, + alpha = point_alpha + ) + } + + ## scale and labs ## + pl <- pl + ggplot2::scale_alpha_continuous(guide = "none") + pl <- pl + set_default_color_continuous_cell( + colors = cell_color_gradient, + instrs = instructions(gobject), + midpoint = gradient_midpoint, + style = gradient_style, + guide = guide_colorbar(title = ""), + type = "color" + ) + } + } + + ## add title + pl <- pl + ggplot2::labs(x = "coord x", y = "coord y", title = feat) + + ## aesthetics + pl <- pl + ggplot2::theme( + plot.title = element_text(hjust = 0.5), + legend.title = element_blank(), + legend.text = element_text(size = legend_text), + axis.title = element_text(size = axis_title), + axis.text = element_text(size = axis_text), + panel.grid = element_blank(), + panel.background = element_rect(fill = background_color) + ) + + savelist[[feat]] <- pl + } + + + + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, rel_widths = cow_rel_w, + align = cow_align + ) + + + ## print plot + if (show_plot == TRUE) { + print(combo_plot) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = combo_plot, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(combo_plot) + } +} + + + + + + +## ** spatial and dim reduction feature plotting #### + + +#' @title spatDimFeatPlot2D +#' @name spatDimFeatPlot2D +#' @description Visualize cells according to spatial AND dimension reduction +#' coordinates in ggplot mode +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_image_params +#' @inheritParams plot_params +#' @inheritParams plot_dimred_params +#' @inheritParams plot_spatnet_params +#' @inheritParams plot_nn_net_params +#' @param expression_values feat expression values to use +#' @param plot_alignment direction to align plot +#' @param feats features to show +#' @param order order points according to feature expression +#' @param network_name name of NN network to use, if show_NN_network = TRUE +#' @param dim_network_color color of NN network +#' @param dim_edge_alpha dim reduction plot: column to use for alpha of the +#' edges +#' @param scale_alpha_with_expression scale expression with ggplot alpha +#' parameter +#' @param sdimx spatial x-axis dimension name (default = 'sdimx') +#' @param sdimy spatial y-axis dimension name (default = 'sdimy') +#' @param show_spatial_grid show spatial grid +#' @param grid_color color of spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param spat_point_shape spatial points with border or +#' not (border or no_border) +#' @param spat_point_size spatial plot: point size +#' @param spat_point_alpha transparency of spatial points +#' @param spat_point_border_col color of border around points +#' @param spat_point_border_stroke stroke size of border around points +#' @param spat_edge_alpha edge alpha +#' @param dim_background_color color of plot background for dimension plot +#' @param spat_background_color color of plot background for spatial plot +#' @param vor_border_color border colorr for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparancy of voronoi 'cells' +#' @details Description of parameters. +#' @family spatial and dimension reduction feature expression visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatDimFeatPlot2D(g, feats = c("Gna12", "Ccnd2", "Btbd17")) +#' +#' @export +spatDimFeatPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + expression_values = c("normalized", "scaled", "custom"), + plot_alignment = c("vertical", "horizontal"), + feats, + order = TRUE, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + dim_point_shape = c("border", "no_border"), + dim_point_size = 1, + dim_point_alpha = 1, + dim_point_border_col = "black", + dim_point_border_stroke = 0.1, + show_NN_network = FALSE, + show_spatial_network = FALSE, + dim_network_color = "gray", + nn_network_to_use = "sNN", + network_name = "sNN.pca", + dim_edge_alpha = NULL, + scale_alpha_with_expression = FALSE, + sdimx = "sdimx", + sdimy = "sdimy", + spatial_network_name = "Delaunay_network", + spatial_network_color = NULL, + show_spatial_grid = FALSE, + grid_color = NULL, + spatial_grid_name = "spatial_grid", + spat_point_shape = c("border", "no_border", "voronoi"), + spat_point_size = 1, + spat_point_alpha = 1, + spat_point_border_col = "black", + spat_point_border_stroke = 0.1, + spat_edge_alpha = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_legend = TRUE, + legend_text = 10, + dim_background_color = "white", + spat_background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + axis_text = 8, + axis_title = 8, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatDimFeatPlot2D") { + plot_alignment <- match.arg(plot_alignment, + choices = c("vertical", "horizontal") + ) + + # dimension reduction plot + dmpl <- dimFeatPlot2D( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + expression_values = expression_values, + feats = feats, + order = order, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + network_color = dim_network_color, + edge_alpha = dim_edge_alpha, + scale_alpha_with_expression = scale_alpha_with_expression, + point_shape = dim_point_shape, + point_size = dim_point_size, + point_alpha = dim_point_alpha, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + point_border_col = dim_point_border_col, + point_border_stroke = dim_point_border_stroke, + show_legend = show_legend, + legend_text = legend_text, + background_color = dim_background_color, + axis_text = axis_text, + axis_title = axis_title, + cow_n_col = cow_n_col, + cow_rel_h = cow_rel_h, + cow_rel_w = cow_rel_w, + cow_align = cow_align, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE + ) + + # spatial plot + spl <- spatFeatPlot2D( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + show_image = show_image, + gimage = gimage, + image_name = image_name, + largeImage_name = largeImage_name, + sdimx = sdimx, + sdimy = sdimy, + expression_values = expression_values, + feats = feats, + order = order, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + show_network = show_spatial_network, + network_color = spatial_network_color, + spatial_network_name = spatial_network_name, + edge_alpha = spat_edge_alpha, + show_grid = show_spatial_grid, + grid_color = grid_color, + spatial_grid_name = spatial_grid_name, + scale_alpha_with_expression = scale_alpha_with_expression, + point_shape = spat_point_shape, + point_size = spat_point_size, + point_alpha = spat_point_alpha, + point_border_col = spat_point_border_col, + point_border_stroke = spat_point_border_stroke, + show_legend = show_legend, + legend_text = legend_text, + background_color = spat_background_color, + vor_border_color = vor_border_color, + vor_max_radius = vor_max_radius, + vor_alpha = vor_alpha, + axis_text = axis_text, + axis_title = axis_title, + cow_n_col = cow_n_col, + cow_rel_h = cow_rel_h, + cow_rel_w = cow_rel_w, + cow_align = cow_align, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE + ) + + + if (plot_alignment == "vertical") { + ncol <- 1 + nrow <- 2 + combo_plot <- cowplot::plot_grid( + dmpl, spl, + ncol = ncol, nrow = nrow, rel_heights = c(1), + rel_widths = c(1), align = "v" + ) + } else { + ncol <- 2 + nrow <- 1 + combo_plot <- cowplot::plot_grid( + dmpl, spl, + ncol = ncol, nrow = nrow, rel_heights = c(1), + rel_widths = c(1), align = "h" + ) + } + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + show_plot = show_plot, + save_plot = save_plot, + return_plot = return_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + + + + + + + + + + + + + +#' @title spatCellPlot +#' @name spatCellPlot +#' @description Visualize cells according to spatial coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_params +#' @inheritParams plot_spatenr_params +#' @inheritParams plot_image_params +#' @inheritParams plot_spatnet_params +#' @param sdimx x-axis dimension name (default = 'sdimx') +#' @param sdimy y-axis dimension name (default = 'sdimy') +#' @param cell_annotation_values numeric cell annotation columns +#' @param show_network show underlying spatial network +#' @param network_color color of spatial network +#' @param network_alpha alpha of spatial network +#' @param show_grid show spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param grid_color color of spatial grid +#' @param coord_fix_ratio fix ratio between x and y-axis +#' @param vor_border_color border colorr for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparency of voronoi 'cells' +#' @param theme_param list of additional params passed to `ggplot2::theme()` +#' @details Description of parameters. +#' @family spatial cell annotation visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatCellPlot2D(g, cell_annotation_values = "leiden_clus") +#' +#' @export +spatCellPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + spat_enr_names = NULL, + cell_annotation_values = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + point_shape = c("border", "no_border", "voronoi"), + point_size = 3, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + show_cluster_center = FALSE, + show_center_label = FALSE, + center_point_size = 4, + center_point_border_col = "black", + center_point_border_stroke = 0.1, + label_size = 4, + label_fontface = "bold", + show_network = FALSE, + spatial_network_name = "Delaunay_network", + network_color = NULL, + network_alpha = 1, + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + grid_color = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + other_cells_alpha = 0.1, + coord_fix_ratio = 1, + show_legend = TRUE, + legend_text = 8, + legend_symbol_size = 1, + background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatCellPlot2D") { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + comb_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_enr_names = spat_enr_names + ) + + # keep only available columns + possible_value_cols <- colnames(comb_metadata) + if (is.null(cell_annotation_values)) { + stop("you need to choose which continuous/numerical cell + annotations or enrichments you want to visualize") + } + cell_annotation_values <- as.character(cell_annotation_values) + cell_annotation_values <- cell_annotation_values[ + cell_annotation_values %in% possible_value_cols + ] + + ## plotting ## + savelist <- list() + + for (annot in cell_annotation_values) { + pl <- spatPlot2D( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + show_image = show_image, + gimage = gimage, + image_name = image_name, + largeImage_name = largeImage_name, + group_by = NULL, + group_by_subset = NULL, + sdimx = sdimx, + sdimy = sdimy, + spat_enr_names = spat_enr_names, + cell_color = annot, + color_as_factor = FALSE, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + point_shape = point_shape, + point_size = point_size, + point_alpha = point_alpha, + point_border_col = point_border_col, + point_border_stroke = point_border_stroke, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + center_point_border_col = center_point_border_col, + center_point_border_stroke = center_point_border_stroke, + label_size = label_size, + label_fontface = label_fontface, + show_network = show_network, + spatial_network_name = spatial_network_name, + network_color = network_color, + network_alpha = network_alpha, + show_grid = show_grid, + spatial_grid_name = spatial_grid_name, + grid_color = grid_color, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + other_cells_alpha = other_cells_alpha, + coord_fix_ratio = coord_fix_ratio, + title = annot, + show_legend = show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = background_color, + vor_border_color = vor_border_color, + vor_max_radius = vor_max_radius, + vor_alpha = vor_alpha, + axis_text = axis_text, + axis_title = axis_title, + theme_param = theme_param, + # hardcoded on purpose below + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE, + save_param = list(), + default_save_name = "spatPlot2D" + ) + + + savelist[[annot]] <- pl + } + + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + show_plot = show_plot, + return_plot = return_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + +#' @rdname spatCellPlot +#' @param \dots spatCellPlot(...) passes to spatCellPlot2D() +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatCellPlot(g, cell_annotation_values = "leiden_clus") +#' +#' @export +spatCellPlot <- function(...) { + spatCellPlot2D(...) +} + + + + + +#' @title dimCellPlot +#' @name dimCellPlot +#' @description Visualize cells according to dimension reduction coordinates. +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_dimred_params +#' @inheritParams plot_nn_net_params +#' @inheritParams plot_spatenr_params +#' @inheritParams plot_params +#' @param cell_annotation_values numeric cell annotation columns +#' @details Description of parameters. For 3D plots see \code{\link{dimPlot3D}} +#' @family dimension reduction cell annotation visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' dimCellPlot2D( +#' g, +#' spat_enr_names = "cluster_metagene", +#' cell_annotation_values = as.character(seq(4)) +#' ) +#' +#' @export +dimCellPlot2D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + spat_enr_names = NULL, + cell_annotation_values = NULL, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + center_point_border_col = "black", + center_point_border_stroke = 0.1, + label_size = 4, + label_fontface = "bold", + edge_alpha = NULL, + point_shape = c("border", "no_border"), + point_size = 1, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + show_legend = TRUE, + legend_text = 8, + legend_symbol_size = 1, + background_color = "white", + axis_text = 8, + axis_title = 8, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dimCellPlot2D") { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + comb_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_enr_names = spat_enr_names + ) + + # keep only available columns + possible_value_cols <- colnames(comb_metadata) + if (is.null(cell_annotation_values)) { + stop("you need to choose which continuous/numerical cell annotations + or enrichments you want to visualize") + } + cell_annotation_values <- cell_annotation_values[ + cell_annotation_values %in% possible_value_cols + ] + + ## plotting ## + savelist <- list() + + for (annot in cell_annotation_values) { + pl <- dimPlot2D( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + group_by = NULL, + group_by_subset = NULL, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + spat_enr_names = spat_enr_names, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + cell_color = annot, + color_as_factor = FALSE, + cell_color_code = cell_color_code, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + center_point_border_col = center_point_border_col, + center_point_border_stroke = center_point_border_stroke, + label_size = label_size, + label_fontface = label_fontface, + edge_alpha = edge_alpha, + point_shape = point_shape, + point_size = point_size, + point_alpha = point_alpha, + point_border_col = point_border_col, + point_border_stroke = point_border_stroke, + title = annot, + show_legend = show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = background_color, + axis_text = axis_text, + axis_title = axis_title, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE, + save_param = list(), + default_save_name = "dimPlot2D" + ) + + + savelist[[annot]] <- pl + } + + + # combine plots with cowplot + combo_plot <- cowplot::plot_grid( + plotlist = savelist, + ncol = set_default_cow_n_col( + cow_n_col = cow_n_col, + nr_plots = length(savelist) + ), + rel_heights = cow_rel_h, + rel_widths = cow_rel_w, + align = cow_align + ) + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + show_plot = show_plot, + return_plot = return_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + + + +#' @rdname dimCellPlot +#' @param ... dimCellPlot(...) passes to dimCellPlot2D() +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' dimCellPlot(g, cell_annotation_values = "leiden_clus") +#' +#' @export +dimCellPlot <- function(gobject, ...) { + dimCellPlot2D(gobject = gobject, ...) +} + + + + +#' @title spatDimCellPlot2D +#' @name spatDimCellPlot2D +#' @description Visualize numerical features of cells according to spatial +#' AND dimension reduction coordinates in 2D +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @inheritParams plot_cow_params +#' @inheritParams plot_image_params +#' @inheritParams plot_spatenr_params +#' @inheritParams plot_dimred_params +#' @inheritParams plot_nn_net_params +#' @inheritParams plot_params +#' @param plot_alignment direction to align plot +#' @param cell_annotation_values numeric cell annotation columns +#' @param sdimx = spatial dimension to use on x-axis +#' @param sdimy = spatial dimension to use on y-axis +#' @param spat_point_shape shape of points (border, no_border or voronoi) +#' @param spat_point_size size of spatial points +#' @param spat_point_alpha transparency of spatial points +#' @param spat_point_border_col border color of spatial points +#' @param spat_point_border_stroke border stroke of spatial points +#' @param dim_show_cluster_center show the center of each cluster +#' @param dim_show_center_label provide a label for each cluster +#' @param dim_center_point_size size of the center point +#' @param dim_center_point_border_col border color of center point +#' @param dim_center_point_border_stroke stroke size of center point +#' @param dim_label_size size of the center label +#' @param dim_label_fontface font of the center label +#' @param spat_show_cluster_center show the center of each cluster +#' @param spat_show_center_label provide a label for each cluster +#' @param spat_center_point_size size of the spatial center points +#' @param spat_center_point_border_col border color of the spatial center points +#' @param spat_center_point_border_stroke stroke size of the spatial center +#' points +#' @param spat_label_size size of the center label +#' @param spat_label_fontface font of the center label +#' @param dim_edge_alpha column to use for alpha of the edges +#' @param spat_show_network show spatial network +#' @param spatial_network_name name of spatial network to use +#' @param spat_network_color color of spatial network +#' @param spat_network_alpha alpha of spatial network +#' @param spat_show_grid show spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param spat_grid_color color of spatial grid +#' @param dim_other_point_size size of not selected dim cells +#' @param spat_other_point_size size of not selected spat cells +#' @param spat_other_cells_alpha alpha of not selected spat cells +#' @param coord_fix_ratio ratio for coordinates +#' @param dim_background_color background color of points in dim. reduction +#' space +#' @param spat_background_color background color of spatial points +#' @param vor_border_color border colorr for voronoi plot +#' @param vor_max_radius maximum radius for voronoi 'cells' +#' @param vor_alpha transparancy of voronoi 'cells' +#' @details Description of parameters. +#' @family spatial and dimension reduction cell annotation visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatDimCellPlot2D(g, cell_annotation_values = "leiden_clus") +#' +#' @export +spatDimCellPlot2D <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + plot_alignment = c("vertical", "horizontal"), + spat_enr_names = NULL, + cell_annotation_values = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + sdimx = "sdimx", + sdimy = "sdimy", + cell_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + dim_point_shape = c("border", "no_border"), + dim_point_size = 1, + dim_point_alpha = 1, + dim_point_border_col = "black", + dim_point_border_stroke = 0.1, + spat_point_shape = c("border", "no_border", "voronoi"), + spat_point_size = 1, + spat_point_alpha = 1, + spat_point_border_col = "black", + spat_point_border_stroke = 0.1, + dim_show_cluster_center = FALSE, + dim_show_center_label = TRUE, + dim_center_point_size = 4, + dim_center_point_border_col = "black", + dim_center_point_border_stroke = 0.1, + dim_label_size = 4, + dim_label_fontface = "bold", + spat_show_cluster_center = FALSE, + spat_show_center_label = FALSE, + spat_center_point_size = 4, + spat_center_point_border_col = "black", + spat_center_point_border_stroke = 0.1, + spat_label_size = 4, + spat_label_fontface = "bold", + show_NN_network = FALSE, + nn_network_to_use = "sNN", + nn_network_name = "sNN.pca", + dim_edge_alpha = 0.5, + spat_show_network = FALSE, + spatial_network_name = "Delaunay_network", + spat_network_color = "red", + spat_network_alpha = 0.5, + spat_show_grid = FALSE, + spatial_grid_name = "spatial_grid", + spat_grid_color = "green", + show_other_cells = TRUE, + other_cell_color = "grey", + dim_other_point_size = 0.5, + spat_other_point_size = 0.5, + spat_other_cells_alpha = 0.5, + show_legend = TRUE, + legend_text = 8, + legend_symbol_size = 1, + dim_background_color = "white", + spat_background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + axis_text = 8, + axis_title = 8, + coord_fix_ratio = 1, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatDimCellPlot2D") { + plot_alignment <- match.arg(plot_alignment, + choices = c("vertical", "horizontal") + ) + + # dimension reduction plot + dmpl <- dimCellPlot2D( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + spat_enr_names = spat_enr_names, + cell_annotation_values = cell_annotation_values, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + point_shape = dim_point_shape, + point_size = dim_point_size, + point_alpha = dim_point_alpha, + point_border_col = dim_point_border_col, + point_border_stroke = dim_point_border_stroke, + show_cluster_center = dim_show_cluster_center, + show_center_label = dim_show_center_label, + center_point_size = dim_center_point_size, + center_point_border_col = dim_center_point_border_col, + center_point_border_stroke = dim_center_point_border_stroke, + label_size = dim_label_size, + label_fontface = dim_label_fontface, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = nn_network_name, + edge_alpha = dim_edge_alpha, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = dim_other_point_size, + show_legend = show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = dim_background_color, + axis_text = axis_text, + axis_title = axis_title, + cow_n_col = cow_n_col, + cow_rel_h = cow_rel_h, + cow_rel_w = cow_rel_w, + cow_align = cow_align, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE + ) + + # spatial plot + spl <- spatCellPlot2D( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + show_image = show_image, + gimage = gimage, + image_name = image_name, + largeImage_name = largeImage_name, + sdimx = sdimx, + sdimy = sdimy, + spat_enr_names = spat_enr_names, + cell_annotation_values = cell_annotation_values, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + point_shape = spat_point_shape, + point_size = spat_point_size, + point_alpha = spat_point_alpha, + point_border_col = spat_point_border_col, + point_border_stroke = spat_point_border_stroke, + show_cluster_center = spat_show_cluster_center, + show_center_label = spat_show_center_label, + center_point_size = spat_center_point_size, + center_point_border_col = spat_center_point_border_col, + center_point_border_stroke = spat_center_point_border_stroke, + label_size = spat_label_size, + label_fontface = spat_label_fontface, + show_network = spat_show_network, + spatial_network_name = spatial_network_name, + network_color = spat_network_color, + network_alpha = spat_network_alpha, + show_grid = spat_show_grid, + spatial_grid_name = spatial_grid_name, + grid_color = spat_grid_color, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = spat_other_point_size, + other_cells_alpha = spat_other_cells_alpha, + coord_fix_ratio = coord_fix_ratio, + show_legend = show_legend, + legend_text = legend_text, + legend_symbol_size = legend_symbol_size, + background_color = spat_background_color, + vor_border_color = vor_border_color, + vor_max_radius = vor_max_radius, + vor_alpha = vor_alpha, + axis_text = axis_text, + axis_title = axis_title, + cow_n_col = cow_n_col, + cow_rel_h = cow_rel_h, + cow_rel_w = cow_rel_w, + cow_align = cow_align, + show_plot = FALSE, + return_plot = TRUE, + save_plot = FALSE + ) + + + if (plot_alignment == "vertical") { + ncol <- 1 + nrow <- 2 + combo_plot <- cowplot::plot_grid(dmpl, spl, + ncol = ncol, nrow = nrow, + rel_heights = c(1), rel_widths = c(1), + align = "v" + ) + } else { + ncol <- 2 + nrow <- 1 + combo_plot <- cowplot::plot_grid(dmpl, spl, + ncol = ncol, nrow = nrow, + rel_heights = c(1), rel_widths = c(1), + align = "h" + ) + } + + return(plot_output_handler( + gobject = gobject, + plot_object = combo_plot, + save_plot = save_plot, + show_plot = show_plot, + return_plot = return_plot, + default_save_name = default_save_name, + save_param = save_param, + else_return = NULL + )) +} + + + + +#' @title spatDimCellPlot +#' @name spatDimCellPlot +#' @description Visualize numerical features of cells according to spatial +#' AND dimension reduction coordinates in 2D +#' @inheritDotParams spatDimCellPlot2D +#' @details Description of parameters. +#' @family spatial and dimension reduction cell annotation visualizations +#' @returns ggplot +#' @examples +#' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) +#' spatDimCellPlot(g, cell_annotation_values = "leiden_clus") +#' +#' @export +spatDimCellPlot <- function(...) { + spatDimCellPlot2D(...) +} diff --git a/R/vis_spatial_in_situ.R b/R/vis_spatial_in_situ.R index 640e9b8..fa78988 100644 --- a/R/vis_spatial_in_situ.R +++ b/R/vis_spatial_in_situ.R @@ -18,7 +18,7 @@ #' @param feat_type feature types of the feats #' @param sdimx spatial dimension x #' @param sdimy spatial dimension y -#' @param xlim limits of x-scale (min/max vector) +#' @param xlim limits of x-scale (min/max vector) #' @param ylim limits of y-scale (min/max vector) #' @param point_size size of the points #' @param stroke stroke to apply to feature points @@ -109,7 +109,7 @@ spatInSituPlotPoints <- function(gobject, show_polygon = TRUE, use_overlap = TRUE, polygon_feat_type = "cell", - polygon_color = "black", + polygon_color = "grey", polygon_bg_color = "black", polygon_fill = NULL, polygon_fill_gradient = NULL, @@ -425,13 +425,13 @@ spatInSituPlotPoints <- function(gobject, if(!is.null(ylim)) { plot <- plot + ggplot2::ylim(ylim) } - + # fix coordinates if(!is.null(coord_fix_ratio)) { plot = plot + ggplot2::coord_fixed(ratio = coord_fix_ratio) } - + return(plot_output_handler( gobject = gobject, plot_object = plot, @@ -502,19 +502,11 @@ spatInSituPlotPoints <- function(gobject, polygon_feat_type <- gobject@expression_feat[[1]] } - - # polygon_dt = combineSpatialCellMetadataInfo(gobject, - # feat_type = polygon_feat_type) - # polygon_dt = polygon_dt[[polygon_feat_type]] - - polygon_info <- get_polygon_info( + polygon_dt <- getPolygonInfo( gobject = gobject, polygon_name = polygon_feat_type - ) - polygon_dt <- data.table::as.data.table( - polygon_info, - geom = "XY" - ) + ) %>% + data.table::as.data.table(geom = "XY") plot <- plot_cell_polygon_layer( ggobject = plot, @@ -541,9 +533,6 @@ spatInSituPlotPoints <- function(gobject, poly_info = polygon_feat_type ) - # spatial_feat_info = combineSpatialCellFeatureInfo(gobject = gobject, - # feat_type = feat_type, - # selected_features = feat) spatial_feat_info <- do.call("rbind", spatial_feat_info) plot <- plot_feature_hexbin_layer( @@ -794,18 +783,11 @@ spatInSituPlotHex <- function( } - polygon_info <- get_polygon_info( + polygon_dt <- getPolygonInfo( gobject = gobject, polygon_name = polygon_feat_type - ) - polygon_dt <- data.table::as.data.table( - polygon_info, - geom = "XY" - ) - - # polygon_dt = combineSpatialCellMetadataInfo(gobject, - # feat_type = polygon_feat_type) - # polygon_dt = polygon_dt[[polygon_feat_type]] + ) %>% + data.table::as.data.table(geom = "XY") plot <- plot_cell_polygon_layer( ggobject = plot, @@ -831,9 +813,6 @@ spatInSituPlotHex <- function( poly_info = polygon_feat_type ) - # spatial_feat_info = combineSpatialCellFeatureInfo(gobject = gobject, - # feat_type = feat_type, - # selected_features = feat) spatial_feat_info <- do.call("rbind", spatial_feat_info) plot <- plot_feature_raster_density_layer( diff --git a/R/vis_spatial_plotly.R b/R/vis_spatial_plotly.R new file mode 100644 index 0000000..4525600 --- /dev/null +++ b/R/vis_spatial_plotly.R @@ -0,0 +1,4392 @@ +# * #### +## 3-D plotly #### +## ----------- ## + +# ** dimension plot #### + + +#' @title .dimPlot_2d_plotly +#' @name .dimPlot_2d_plotly +#' @description Visualize cells at their 2D dimension reduction coordinates +#' with plotly +#' @returns plotly object +#' @keywords internal +.dimPlot_2d_plotly <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + spat_enr_names = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + color_as_factor = TRUE, + cell_color = NULL, + cell_color_code = NULL, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 4, + edge_alpha = NULL, + point_size = 5) { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # data.table variables + cell_ID <- NULL + + ## dimension reduction ## + dim_dfr <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "data.table" + ) + + dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use)] + dim_names <- colnames(dim_dfr) + dim_DT <- data.table::as.data.table(dim_dfr) + dim_DT[, "cell_ID" := rownames(dim_dfr)] + + + ## annotated cell metadata + cell_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_enr_names = spat_enr_names + ) + annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") + + + # create input for network + if (show_NN_network == TRUE) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + network_DT <- data.table::as.data.table(igraph::as_data_frame( + selected_nn_network, + what = "edges" + )) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- merge(network_DT, dim_DT, + by.x = "from", + by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = from_dim_names + ) + + annotated_network_DT <- merge(annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = to_dim_names + ) + } + + + if (dim_reduction_to_use == "pca") { + pca_object <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "dimObj" + ) + eigenvalues <- slot(pca_object, "misc")$eigenvalues + + if (!is.null(eigenvalues)) { + total <- sum(eigenvalues) + var_expl_vec <- (eigenvalues / total) * 100 + dim1_x_variance <- var_expl_vec[dim1_to_use] + dim2_y_variance <- var_expl_vec[dim2_to_use] + } + } + + + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + if (is.null(cell_color)) { + stop("\n selection of cells is based on cell_color paramter, + which is a metadata column \n") + } + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + + if (!is.null(select_cells)) { + annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% + select_cells] + annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% + select_cells] + + if (show_NN_network == TRUE) { + annotated_network_DT <- annotated_network_DT[ + annotated_network_DT$to %in% select_cells & + annotated_network_DT$from %in% select_cells + ] + } + + # if specific cells are selected + # annotated_DT = annotated_DT_selected + } + + + ## if no subsets are required + if (is.null(select_cells) & is.null(select_cell_groups)) { + annotated_DT_selected <- annotated_DT + annotated_DT_other <- NULL + } + + + ## annotated_DT_selected = all selected cells or all cells if no selection + ## annotated_DT_other = all not selected cells or NULL if no selection + + + pl <- plotly::plot_ly() + if (show_NN_network == TRUE) { + if (is.null(edge_alpha)) { + edge_alpha <- 0.5 + } else if (is.character(edge_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + edge_alpha <- 0.5 + } + + pl <- pl %>% plotly::add_segments( + name = network_name, + type = "scatter", + x = annotated_network_DT[[from_dim_names[1]]], + y = annotated_network_DT[[from_dim_names[2]]], + xend = annotated_network_DT[[to_dim_names[1]]], + yend = annotated_network_DT[[to_dim_names[2]]], + line = list( + color = "lightgray", + width = 0.5 + ), + opacity = edge_alpha + ) + } + + if (is.null(cell_color)) { + cell_color <- "lightblue" + pl <- pl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + color = cell_color, + colors = cell_color, + marker = list(size = point_size) + ) + } else if (cell_color %in% colnames(annotated_DT_selected)) { + if (is.null(cell_color_code)) { + number_colors <- length(unique(annotated_DT[[cell_color]])) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + } + if (color_as_factor) { + annotated_DT_selected[[cell_color]] <- as.factor( + annotated_DT_selected[[cell_color]] + ) + } + + + pl <- pl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + color = annotated_DT_selected[[cell_color]], + colors = cell_color_code, + legendgroup = annotated_DT_selected[[cell_color]], + marker = list(size = point_size) + ) + + if (!is.null(select_cells) & show_other_cells) { + pl <- pl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + # legendgroup = annotated_DT[[cell_color]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + if (show_cluster_center == TRUE | show_center_label == TRUE) { + annotated_DT_centers <- annotated_DT_selected[, .( + center_1 = stats::median(get(dim_names[1])), + center_2 = stats::median(get(dim_names[2])) + ), + by = cell_color + ] + annotated_DT_centers[[cell_color]] <- as.factor( + annotated_DT_centers[[cell_color]] + ) + if (show_cluster_center == TRUE) { + pl <- pl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_centers[["center_1"]], + y = annotated_DT_centers[["center_2"]], + color = annotated_DT_centers[[cell_color]], + colors = cell_color_code, + legendgroup = annotated_DT_centers[[cell_color]], + marker = list( + size = center_point_size, symbol = "x", + symbols = "x" + ), + showlegend = FALSE + ) + } + + if (show_center_label == TRUE) { + pl <- pl %>% + plotly::add_text( + x = annotated_DT_centers[["center_1"]], + y = annotated_DT_centers[["center_2"]], + type = "scatter", mode = "text", + text = annotated_DT_centers[[cell_color]], + textposition = "middle right", + textfont = list(color = "#000000", size = 16), + showlegend = FALSE + ) + } + } + } else { + stop("cell_color does not exist!\n") + } + + + + if (dim_reduction_to_use == "pca") { + if (!is.null(eigenvalues)) { + x_name <- paste0("pca", "-", dim_names[1]) + y_name <- paste0("pca", "-", dim_names[2]) + x_title <- sprintf( + "%s explains %.02f%% of variance", + x_name, var_expl_vec[1] + ) + y_title <- sprintf( + "%s explains %.02f%% of variance", y_name, + var_expl_vec[2] + ) + } + } else { + x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + } + pl <- pl %>% plotly::layout( + xaxis = list(title = x_title), + yaxis = list(title = y_title), + legend = list(x = 100, y = 0.5, font = list( + family = "sans-serif", + size = 12 + )) + ) + + return(pl) +} + + +#' @title .dimPlot_3d_plotly +#' @name .dimPlot_3d_plotly +#' @description Visualize cells at their 3D dimension reduction coordinates +#' with plotly +#' @returns plotly object +#' @keywords internal +.dimPlot_3d_plotly <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + dim3_to_use = 3, + spat_enr_names = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + color_as_factor = TRUE, + cell_color = NULL, + cell_color_code = NULL, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 4, + edge_alpha = NULL, + point_size = 1) { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # data.table variables + cell_ID <- NULL + + ## dimension reduction ## + dim_mat <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "matrix" + ) + dim_mat <- dim_mat[, c(dim1_to_use, dim2_to_use, dim3_to_use)] + dim_names <- colnames(dim_mat) + dim_DT <- data.table::as.data.table(dim_mat, keep.rownames = TRUE) + data.table::setnames(dim_DT, old = "rn", new = "cell_ID") + + + ## annotated cell metadata + cell_metadata <- combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_enr_names = spat_enr_names + ) + annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") + + + # create input for network + if (show_NN_network == TRUE) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + network_DT <- data.table::as.data.table(igraph::as_data_frame( + selected_nn_network, + what = "edges" + )) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- merge(network_DT, dim_DT, + by.x = "from", + by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = from_dim_names + ) + + annotated_network_DT <- merge(annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = to_dim_names + ) + } + + if (dim_reduction_to_use == "pca") { + pca_object <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "dimObj" + ) + + eigenvalues <- slot(pca_object, "misc")$eigenvalues + if (!is.null(eigenvalues)) { + total <- sum(eigenvalues) + var_expl_vec <- (eigenvalues / total) * 100 + dim1_x_variance <- var_expl_vec[dim1_to_use] + dim2_y_variance <- var_expl_vec[dim2_to_use] + } + } + + ## create subsets if needed + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + if (is.null(cell_color)) { + stop("\n selection of cells is based on cell_color parameter, + which is a metadata column \n") + } + message("You have selected both individual cell IDs and a group of + cells") + group_cell_IDs <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% + select_cells] + annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% + select_cells] + + if (show_NN_network == TRUE) { + annotated_network_DT <- annotated_network_DT[ + annotated_network_DT$to %in% select_cells & + annotated_network_DT$from %in% select_cells + ] + } + + # if specific cells are selected + annotated_DT <- annotated_DT_selected + } + + ## if no subsets are required + if (is.null(select_cells) & is.null(select_cell_groups)) { + annotated_DT_selected <- annotated_DT + annotated_DT_other <- NULL + } + + ## annotated_DT_selected = all selected cells or all cells if no selection + ## annotated_DT_other = all not selected cells or NULL if no selection + + + pl <- plotly::plot_ly() + if (is.null(cell_color)) { + cell_color <- "lightblue" + pl <- pl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + z = annotated_DT_selected[[dim_names[3]]], + color = cell_color, + colors = cell_color, + marker = list(size = 2), + legendgroup = annotated_DT_selected[[cell_color]] + ) + } else { + if (cell_color %in% colnames(annotated_DT_selected)) { + if (is.null(cell_color_code)) { + number_colors <- length( + unique(annotated_DT_selected[[cell_color]]) + ) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + } + if (color_as_factor) { + annotated_DT_selected[[cell_color]] <- as.factor( + annotated_DT_selected[[cell_color]] + ) + } + + pl <- pl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + z = annotated_DT_selected[[dim_names[3]]], + color = annotated_DT_selected[[cell_color]], + colors = cell_color_code, + marker = list(size = point_size), + legendgroup = annotated_DT_selected[[cell_color]] + ) + + if (!is.null(select_cells) & show_other_cells) { + pl <- pl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + z = annotated_DT_other[[dim_names[3]]], + # colors = other_cell_color, + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + + if (show_cluster_center == TRUE | show_center_label == TRUE) { + annotated_DT_centers <- annotated_DT_selected[, .( + center_1 = stats::median(get(dim_names[1])), + center_2 = stats::median(get(dim_names[2])), + center_3 = stats::median(get(dim_names[3])) + ), + by = cell_color + ] + annotated_DT_centers[[cell_color]] <- as.factor( + annotated_DT_centers[[cell_color]] + ) + if (show_cluster_center == TRUE) { + pl <- pl %>% plotly::add_trace( + mode = "markers", + type = "scatter3d", + data = annotated_DT_centers, + x = ~center_1, + y = ~center_2, + z = ~center_3, + color = annotated_DT_centers[[cell_color]], + colors = cell_color_code, + inherit = FALSE, + marker = list(size = 2, symbol = "x", symbols = "x"), + legendgroup = annotated_DT_centers[[cell_color]], + showlegend = FALSE + ) + } + if (show_center_label == TRUE) { + message(" center label is not clear to see in 3D plot\n You + can shut it down with show_center_label = FALSE") + pl <- pl %>% plotly::add_trace( + mode = "text", + type = "scatter3d", + data = annotated_DT_centers, + x = ~center_1, + y = ~center_2, + z = ~center_3, + text = annotated_DT_centers[[cell_color]], + legendgroup = annotated_DT_centers[[cell_color]], + inherit = FALSE, + showlegend = FALSE + ) + } + } + } else { + stop("cell_color does not exist!\n") + } + } + + if (show_NN_network) { + edges <- plotly_network( + annotated_network_DT, + "from_Dim.1", "from_Dim.2", "from_Dim.3", + "to_Dim.1", "to_Dim.2", "to_Dim.3" + ) + if (is.null(edge_alpha)) { + edge_alpha <- 0.5 + } else if (is.character(edge_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + edge_alpha <- 0.5 + } + + pl <- pl %>% plotly::add_trace( + name = network_name, + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, y = ~y, z = ~z, + inherit = FALSE, + line = list(color = "lightgray", width = 0.5), + opacity = edge_alpha + ) + } + + if (dim_reduction_to_use == "pca") { + if (!is.null(eigenvalues)) { + x_name <- paste0("pca", "-", dim_names[1]) + y_name <- paste0("pca", "-", dim_names[2]) + z_name <- paste0("pca", "-", dim_names[3]) + x_title <- sprintf( + "%s explains %.02f%% of variance", + x_name, var_expl_vec[1] + ) + y_title <- sprintf( + "%s explains %.02f%% of variance", + y_name, var_expl_vec[2] + ) + z_title <- sprintf( + "%s explains %.02f%% of variance", + z_name, var_expl_vec[3] + ) + } + } else { + x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + z_title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") + } + pl <- pl %>% plotly::layout( + scene = list( + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + ), + legend = list( + x = 100, y = 0.5, + font = list(family = "sans-serif", size = 12) + ) + ) + return(pl) +} + + + + + + + +#' @rdname dimPlot +#' @returns plotly (dimplot3D only) +#' @export +dimPlot3D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + dim3_to_use = 3, + spat_enr_names = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 2, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + color_as_factor = TRUE, + cell_color = NULL, + cell_color_code = NULL, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 4, + edge_alpha = NULL, + point_size = 3, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dim3D") { + if (is.null(dim3_to_use)) { + message("create 2D plot") + + pl <- .dimPlot_2d_plotly( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + spat_enr_names = spat_enr_names, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + color_as_factor = color_as_factor, + cell_color = cell_color, + cell_color_code = cell_color_code, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + label_size = label_size, + edge_alpha = edge_alpha, + point_size = point_size + ) + } else { + message("create 3D plot") + pl <- .dimPlot_3d_plotly( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + dim_reduction_to_use = dim_reduction_to_use, + dim_reduction_name = dim_reduction_name, + dim1_to_use = dim1_to_use, + dim2_to_use = dim2_to_use, + dim3_to_use = dim3_to_use, + spat_enr_names = spat_enr_names, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_NN_network = show_NN_network, + nn_network_to_use = nn_network_to_use, + network_name = network_name, + color_as_factor = color_as_factor, + cell_color = cell_color, + cell_color_code = cell_color_code, + show_cluster_center = show_cluster_center, + show_center_label = show_center_label, + center_point_size = center_point_size, + label_size = label_size, + edge_alpha = edge_alpha, + point_size = point_size + ) + } + + + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + ## print plot + if (show_plot == TRUE) { + print(pl) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = pl, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(pl) + } +} + + +#' @title plotUMAP_3D +#' @name plotUMAP_3D +#' @description Visualize cells according to dimension reduction coordinates +#' @param gobject giotto object +#' @param dim_reduction_name name of UMAP +#' @param default_save_name default save name of UMAP plot +#' @inheritDotParams dimPlot3D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters. +#' @family reduced dimension visualizations +#' @returns plotly +#' @examples +#' g <- GiottoData::loadGiottoMini("starmap") +#' plotUMAP_3D(g, dim_reduction_name = "3D_umap") +#' +#' @export +plotUMAP_3D <- function(gobject, + dim_reduction_name = "umap", + default_save_name = "UMAP_3D", + ...) { + dimPlot3D( + gobject = gobject, + dim_reduction_to_use = "umap", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + +#' @title plotTSNE_3D +#' @name plotTSNE_3D +#' @description Visualize cells according to dimension reduction coordinates +#' @param gobject giotto object +#' @param dim_reduction_name name of TSNE +#' @param default_save_name default save name of TSNE plot +#' @inheritDotParams dimPlot3D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters. +#' @family reduced dimension visualizations +#' @returns plotly +#' @examples +#' g <- GiottoData::loadGiottoMini("starmap") +#' plotTSNE_3D(g) +#' +#' @export +plotTSNE_3D <- function(gobject, + dim_reduction_name = "tsne", + default_save_name = "TSNE_3D", + ...) { + dimPlot3D( + gobject = gobject, + dim_reduction_to_use = "tsne", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + +#' @title plotPCA_3D +#' @name plotPCA_3D +#' @description Visualize cells according to 3D PCA dimension reduction +#' @param gobject giotto object +#' @param dim_reduction_name name of PCA +#' @param default_save_name default save name of PCA plot +#' @inheritDotParams dimPlot3D -gobject -dim_reduction_to_use +#' -dim_reduction_name -default_save_name +#' @details Description of parameters. +#' @family reduced dimension visualizations +#' @returns plotly +#' @examples +#' g <- GiottoData::loadGiottoMini("starmap") +#' plotPCA_3D(g) +#' +#' @export +plotPCA_3D <- function(gobject, + dim_reduction_name = "pca", + default_save_name = "PCA_3D", + ...) { + dimPlot3D( + gobject = gobject, + dim_reduction_to_use = "pca", + dim_reduction_name = dim_reduction_name, + default_save_name = default_save_name, + ... + ) +} + + + + + + +# ** #### +# ** spatial 3D plot #### + +#' @title .spatPlot_2d_plotly +#' @name .spatPlot_2d_plotly +#' @description Visualize cells at their 2D spatial locations with plotly +#' @returns plotly object +#' @keywords internal +.spatPlot_2d_plotly <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + sdimx = NULL, + sdimy = NULL, + spat_enr_names = NULL, + point_size = 3, + cell_color = NULL, + cell_color_code = NULL, + color_as_factor = TRUE, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_network = FALSE, + spatial_network_name = "spatial_network", + network_color = "lightgray", + network_alpha = 1, + other_cell_alpha = 0.5, + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + grid_color = NULL, + grid_alpha = 1, + show_legend = TRUE, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + show_plot = FALSE) { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + ## get spatial cell locations + cell_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table" + ) + if (is.null(cell_locations)) { + return(NULL) + } + + + ## extract spatial network + if (show_network) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT" + ) + } else { + spatial_network <- NULL + } + + ## extract spatial grid + if (show_grid == TRUE) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name + ) + } else { + spatial_grid <- NULL + } + + ## get cell metadata + cell_metadata <- try( + expr = combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + spat_enr_names = spat_enr_names + ), + silent = TRUE + ) + + + if (inherits(cell_metadata, "try-error")) { + cell_locations_metadata <- cell_locations + } else if (nrow(cell_metadata) == 0) { + cell_locations_metadata <- cell_locations + } else { + cell_locations_metadata <- cell_metadata + } + + ## create subsets if needed + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- cell_locations_metadata[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- cell_locations_metadata[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + + if (!is.null(select_cells)) { + cell_locations_metadata_other <- cell_locations_metadata[ + !cell_locations_metadata$cell_ID %in% select_cells + ] + cell_locations_metadata_selected <- cell_locations_metadata[ + cell_locations_metadata$cell_ID %in% select_cells + ] + spatial_network <- spatial_network[spatial_network$to %in% + select_cells & spatial_network$from %in% + select_cells] + + # if specific cells are selected + # cell_locations_metadata = cell_locations_metadata_selected + } else if (is.null(select_cells)) { + cell_locations_metadata_selected <- cell_locations_metadata + cell_locations_metadata_other <- NULL + } + + + + ### set scale + axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) + + ### set ratio + ratio <- plotly_axis_scale_2D(cell_locations, + sdimx = sdimx, + sdimy = sdimy, + mode = axis_scale, + custom_ratio = custom_ratio + ) + + + + pl <- plotly::plot_ly() + + ## create network + if (show_network == TRUE) { + if (is.null(spatial_network)) { + stop("No usable spatial network specified! Please choose a + network with spatial_network_name=xxx") + } else { + if (is.null(network_alpha)) { + network_alpha <- 0.5 + } else if (is.character(network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + network_alpha <- 0.5 + } + pl <- pl %>% plotly::add_segments( + name = spatial_network_name, + type = "scatter", + x = spatial_network[["sdimx_begin"]], + y = spatial_network[["sdimy_begin"]], + xend = spatial_network[["sdimx_end"]], + yend = spatial_network[["sdimy_end"]], + line = list( + color = network_color, + width = 0.5 + ), + opacity = network_alpha + ) + } + } + + ## create grid + if (show_grid == TRUE) { + if (is.null(spatial_grid)) { + stop("No usable spatial grid specified! Please choose a + network with spatial_grid_name=xxx") + } else { + if (is.null(grid_color)) { + grid_color <- "black" + } + edges <- plotly_grid(spatial_grid) + pl <- pl %>% plotly::add_segments( + name = "spatial_grid", + type = "scatter", + data = edges, + x = ~x, + y = ~y, + xend = ~x_end, + yend = ~y_end, + line = list( + color = grid_color, + width = 1 + ), + opacity = grid_alpha + ) + } + } + + + + if (!is.null(cell_color)) { + if (cell_color %in% colnames(cell_locations_metadata_selected)) { + if (is.null(cell_color_code)) { + number_colors <- length(unique( + cell_locations_metadata_selected[[cell_color]] + )) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + } + cell_locations_metadata_selected[[cell_color]] <- as.factor( + cell_locations_metadata_selected[[cell_color]] + ) + pl <- pl %>% plotly::add_trace( + type = "scatter", + mode = "markers", + x = cell_locations_metadata_selected[[sdimx]], + y = cell_locations_metadata_selected[[sdimy]], + color = cell_locations_metadata_selected[[cell_color]], + colors = cell_color_code, + marker = list(size = point_size) + ) + + + if (!is.null(select_cells) & show_other_cells) { + pl <- pl %>% plotly::add_trace( + type = "scatter", + mode = "markers", + data = cell_locations_metadata_other, + name = "unselected cells", + x = ~sdimx, + y = ~sdimy, + marker = list( + size = other_point_size, + color = other_cell_color + ), + opacity = other_cell_alpha + ) + } + } else { + message("cell_color does not exist!") + } + } else { + pl <- pl %>% plotly::add_trace( + type = "scatter", + mode = "markers", + name = "selected cells", + x = cell_locations_metadata_selected[[sdimx]], + y = cell_locations_metadata_selected[[sdimy]], + colors = "lightblue", + marker = list(size = point_size) + ) + + if (!is.null(select_cells) & show_other_cells) { + pl <- pl %>% plotly::add_trace( + type = "scatter", + mode = "markers", + data = cell_locations_metadata_other, + name = "unselected cells", + x = ~sdimx, + y = ~sdimy, + marker = list( + size = other_point_size, + color = other_cell_color + ), + opacity = other_cell_alpha + ) + } + } + + + pl <- pl %>% + plotly::layout( + list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks) + ), + legend = list( + x = 100, y = 0.5, + font = list( + family = "sans-serif", + size = 12 + ) + ) + ) + + + return((pl)) +} + + + +#' @title .spatPlot_3d_plotly +#' @name .spatPlot_3d_plotly +#' @description Visualize cells at their 3D spatial locations with plotly +#' @returns plotly object +#' @keywords internal +.spatPlot_3d_plotly <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + sdimx = NULL, + sdimy = NULL, + sdimz = NULL, + spat_enr_names = NULL, + point_size = 3, + cell_color = NULL, + cell_color_code = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_network = FALSE, + spatial_network_name = "spatial_network", + network_color = NULL, + network_alpha = 1, + other_cell_alpha = 0.5, + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + title = "", + show_legend = TRUE, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + show_plot = FALSE) { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + ## get spatial cell locations + cell_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table" + ) + if (is.null(cell_locations)) { + return(NULL) + } + + ## extract spatial network + if (show_network) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT" + ) + } else { + spatial_network <- NULL + } + + ## extract spatial grid + if (show_grid) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name + ) + } else { + spatial_grid <- NULL + } + + ## get cell metadata + cell_metadata <- try( + expr = combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + spat_enr_names = spat_enr_names + ), + silent = TRUE + ) + + + if (inherits(cell_metadata, "try-error")) { + cell_locations_metadata <- cell_locations + } else if (nrow(cell_metadata) == 0) { + cell_locations_metadata <- cell_locations + } else { + cell_locations_metadata <- cell_metadata + } + + + ## create subsets if needed + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + message("You have selected both individual cell IDs and a group of + cells") + group_cell_IDs <- cell_locations_metadata[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- cell_locations_metadata[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + cell_locations_metadata_other <- cell_locations_metadata[ + !cell_locations_metadata$cell_ID %in% select_cells + ] + cell_locations_metadata_selected <- cell_locations_metadata[ + cell_locations_metadata$cell_ID %in% select_cells + ] + spatial_network <- spatial_network[spatial_network$to %in% + select_cells & spatial_network$from %in% select_cells] + + # if specific cells are selected + # cell_locations_metadata = cell_locations_metadata_selected + } else if (is.null(select_cells)) { + cell_locations_metadata_selected <- cell_locations_metadata + cell_locations_metadata_other <- NULL + } + + + + ### set scale + axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) + + ### set ratio + ratio <- plotly_axis_scale_3D(cell_locations, + sdimx = sdimx, + sdimy = sdimy, + sdimz = sdimz, + mode = axis_scale, + custom_ratio = custom_ratio + ) + + + + pl <- plotly::plot_ly() + if (!is.null(cell_color)) { + if (cell_color %in% colnames(cell_locations_metadata_selected)) { + if (is.null(cell_color_code)) { + number_colors <- length(unique( + cell_locations_metadata_selected[[cell_color]] + )) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + } + cell_locations_metadata_selected[[cell_color]] <- as.factor( + cell_locations_metadata_selected[[cell_color]] + ) + pl <- pl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + data = cell_locations_metadata_selected, + x = ~sdimx, y = ~sdimy, z = ~sdimz, + color = cell_locations_metadata_selected[[cell_color]], + colors = cell_color_code, + marker = list(size = point_size) + ) + + + if (!is.null(select_cells) & show_other_cells) { + pl <- pl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + data = cell_locations_metadata_other, + name = "unselected cells", + x = ~sdimx, + y = ~sdimy, + z = ~sdimz, + marker = list( + size = other_point_size, + color = other_cell_color + ), + opacity = other_cell_alpha + ) + } + } else { + message("cell_color does not exist!") + } + } else { + pl <- pl %>% plotly::add_trace( + type = "scatter3d", + data = cell_locations_metadata_selected, + x = ~sdimx, + y = ~sdimy, + z = ~sdimz, + mode = "markers", + marker = list(size = point_size), + colors = "lightblue", name = "selected cells" + ) + + if (!is.null(select_cells) & show_other_cells) { + pl <- pl %>% plotly::add_trace( + type = "scatter3d", + mode = "markers", + data = cell_locations_metadata_other, + name = "unselected cells", + x = ~sdimx, y = ~sdimy, z = ~sdimz, + marker = list( + size = other_point_size, + color = other_cell_color + ), + opacity = other_cell_alpha + ) + } + } + + + ## plot spatial network + if (!is.null(spatial_network) & show_network == TRUE) { + if (is.null(network_color)) { + network_color <- "red" + } + edges <- plotly_network(spatial_network) + + pl <- pl %>% plotly::add_trace( + name = "sptial network", + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, + y = ~y, + z = ~z, + line = list(color = network_color, width = 0.5), + opacity = network_alpha + ) + } + + ## plot spatial grid + # 3D grid is not clear to view + + + pl <- pl %>% + plotly::layout( + scene = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + legend = list( + x = 100, y = 0.5, + font = list(family = "sans-serif", size = 12) + ) + ) + + + return(pl) +} + + + + + +#' @rdname spatPlot +#' @param sdimz z-axis dimension name (default = 'sdimy') +#' @param grid_alpha opacity of spatial grid +#' @param axis_scale the way to scale the axis +#' @param custom_ratio customize the scale of the plot +#' @param x_ticks set the number of ticks on the x-axis +#' @param y_ticks set the number of ticks on the y-axis +#' @param z_ticks set the number of ticks on the z-axis +#' @export +spatPlot3D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + spat_enr_names = NULL, + point_size = 3, + cell_color = NULL, + cell_color_code = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + other_cell_alpha = 0.5, + show_network = FALSE, + spatial_network_name = "Delaunay_network", + network_color = NULL, + network_alpha = 1, + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + grid_color = NULL, + grid_alpha = 1, + title = "", + show_legend = TRUE, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spat3D") { + if (is.null(sdimz)) { + message("create 2D plot") + + pl <- .spatPlot_2d_plotly( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + sdimx = sdimx, + sdimy = sdimy, + point_size = point_size, + cell_color = cell_color, + cell_color_code = cell_color_code, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_network = show_network, + network_color = network_color, + network_alpha = network_alpha, + other_cell_alpha = other_cell_alpha, + spatial_network_name = spatial_network_name, + show_grid = show_grid, + grid_color = grid_color, + grid_alpha = grid_alpha, + spatial_grid_name = spatial_grid_name, + show_legend = show_legend, + axis_scale = axis_scale, + custom_ratio = custom_ratio, + x_ticks = x_ticks, + y_ticks = y_ticks, + show_plot = FALSE + ) + } else { + message("create 3D plot") + pl <- .spatPlot_3d_plotly( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + sdimx = sdimx, + sdimy = sdimy, + sdimz = sdimz, + point_size = point_size, + cell_color = cell_color, + cell_color_code = cell_color_code, + select_cell_groups = select_cell_groups, + select_cells = select_cells, + show_other_cells = show_other_cells, + other_cell_color = other_cell_color, + other_point_size = other_point_size, + show_network = show_network, + network_color = network_color, + network_alpha = network_alpha, + other_cell_alpha = other_cell_alpha, + spatial_network_name = spatial_network_name, + spatial_grid_name = spatial_grid_name, + show_legend = show_legend, + axis_scale = axis_scale, + custom_ratio = custom_ratio, + x_ticks = x_ticks, + y_ticks = y_ticks, + z_ticks = z_ticks, + show_plot = FALSE + ) + } + + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + ## print plot + if (show_plot == TRUE) { + print(pl) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = pl, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(pl) + } +} + + + + + + + + + +# ** #### +# ** spatial & dimension 3D plot #### + +#' @title spatDimPlot3D +#' @name spatDimPlot3D +#' @description Visualize cells according to spatial AND dimension +#' reduction coordinates in plotly mode +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @inheritParams plot_cell_params +#' @param plot_alignment direction to align plot +#' @param dim_reduction_to_use dimension reduction to use +#' @param dim_reduction_name dimension reduction name +#' @param dim1_to_use dimension to use on x-axis +#' @param dim2_to_use dimension to use on y-axis +#' @param dim3_to_use dimension to use on z-axis +#' +#' @param spat_loc_name name for spatial locations +#' @param sdimx = spatial dimension to use on x-axis +#' @param sdimy = spatial dimension to use on y-axis +#' @param sdimz = spatial dimension to use on z-axis +#' +#' @param spat_enr_names names of spatial enrichment results to include +#' @param show_NN_network show underlying NN network +#' @param nn_network_to_use type of NN network to use (kNN vs sNN) +#' @param network_name name of NN network to use, if show_NN_network = TRUE +#' @param show_cluster_center show the center of each cluster +#' @param show_center_label provide a label for each cluster +#' @param center_point_size size of the center point +#' @param label_size size of the center label +#' +#' @param select_cell_groups select subset of cells/clusters based on +#' cell_color parameter +#' @param select_cells select subset of cells based on cell IDs +#' @param show_other_cells display not selected cells +#' @param other_cell_color color of not selected cells +#' @param other_point_size size of not selected cells +#' +#' @param dim_point_size size of points in dim. reduction space +#' @param nn_network_color color of nn network +#' @param nn_network_alpha column to use for alpha of the edges +#' @param show_spatial_network show spatial network +#' @param spatial_network_name name of spatial network to use +#' @param spatial_network_color color of spatial network +#' +#' @param show_spatial_grid show spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' @param spatial_grid_color color of spatial grid +#' @param spatial_grid_alpha alpha of spatial grid +#' @param spatial_point_size size of spatial points +#' @param spatial_network_color color of spatial network +#' @param spatial_network_alpha alpha of spatial network +#' +#' @param axis_scale the way to scale the axis +#' @param custom_ratio customize the scale of the plot +#' @param x_ticks set the number of ticks on the x-axis +#' @param y_ticks set the number of ticks on the y-axis +#' @param z_ticks set the number of ticks on the z-axis +#' @param legend_text_size size of legend +#' @returns plotly +#' @details Description of parameters. +#' @family spatial and dimension reduction visualizations +#' @export +spatDimPlot3D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + plot_alignment = c("horizontal", "vertical"), + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + dim3_to_use = 3, + spat_loc_name = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + spat_enr_names = NULL, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + nn_network_color = "lightgray", + nn_network_alpha = 0.5, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 16, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1.5, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + dim_point_size = 3, + show_spatial_network = FALSE, + spatial_network_name = "Delaunay_network", + spatial_network_color = "lightgray", + spatial_network_alpha = 0.5, + show_spatial_grid = FALSE, + spatial_grid_name = "spatial_grid", + spatial_grid_color = NULL, + spatial_grid_alpha = 0.5, + spatial_point_size = 3, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + legend_text_size = 12, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatDimPlot3D") { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # data.table variables + cell_ID <- NULL + + plot_alignment <- match.arg(plot_alignment, + choices = c("horizontal", "vertical") + ) + + # ********data prepare********# + ## dimension reduction ## + dim_dfr <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "matrix" + ) + dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] + dim_names <- colnames(dim_dfr) + dim_DT <- data.table::as.data.table(dim_dfr) + dim_DT[, cell_ID := rownames(dim_dfr)] + + + ## annotated cell metadata + cell_metadata <- combineMetadata( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + spat_enr_names = spat_enr_names + ) + annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") + spatial_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table" + ) + if (is.null(spatial_locations)) { + return(NULL) + } + + annotated_DT <- merge(annotated_DT, spatial_locations, by = "cell_ID") + + + if (dim_reduction_to_use == "pca") { + pca_object <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "dimObj" + ) + eigenvalues <- slot(pca_object, "misc")$eigenvalues + + if (!is.null(eigenvalues)) { + total <- sum(eigenvalues) + var_expl_vec <- (eigenvalues / total) * 100 + dim1_x_variance <- var_expl_vec[dim1_to_use] + dim2_y_variance <- var_expl_vec[dim2_to_use] + if (!is.null(dim3_to_use)) { + dim3_z_variance <- var_expl_vec[3] + } + } + } + + + + ## nn network + if (show_NN_network) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + network_DT <- data.table::as.data.table(igraph::as_data_frame( + selected_nn_network, + what = "edges" + )) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- merge(network_DT, dim_DT, + by.x = "from", + by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = from_dim_names + ) + + annotated_network_DT <- merge(annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = to_dim_names + ) + } + + + + + ## extract spatial network + if (show_spatial_network) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT" + ) + } else { + spatial_network <- NULL + } + + + ## extract spatial grid + if (show_spatial_grid == TRUE) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name + ) + } else { + spatial_grid <- NULL + } + + + # create matching cell_color_code + if (is.null(cell_color_code)) { + if (is.character(cell_color)) { + cell_metadata <- pDataDT(gobject, + feat_type = feat_type, + spat_unit = spat_unit + ) + if (cell_color %in% colnames(cell_metadata)) { + if (color_as_factor == TRUE) { + number_colors <- length(unique(cell_metadata[[cell_color]])) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + names(cell_color_code) <- unique( + cell_metadata[[cell_color]] + ) + } + } + } + } + + + ## subset cell selection ## + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + if (is.null(cell_color)) { + stop("\n selection of cells is based on cell_color paramter, + which is a metadata column \n") + } + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- annotated_DT[get(cell_color) %in% + select_cell_groups][["cell_ID"]] + } + + + if (!is.null(select_cells)) { + annotated_DT_other <- annotated_DT[!annotated_DT$cell_ID %in% + select_cells] + annotated_DT_selected <- annotated_DT[annotated_DT$cell_ID %in% + select_cells] + + if (show_NN_network == TRUE) { + annotated_network_DT <- annotated_network_DT[ + annotated_network_DT$to %in% select_cells & + annotated_network_DT$from %in% select_cells + ] + } + if (show_spatial_network == TRUE) { + spatial_network <- spatial_network[spatial_network$to %in% + select_cells & + spatial_network$from %in% + select_cells] + } + + # if specific cells are selected + # annotated_DT = annotated_DT_selected + } + + + ## if no subsets are required + if (is.null(select_cells) & is.null(select_cell_groups)) { + annotated_DT_selected <- annotated_DT + annotated_DT_other <- NULL + } + + ## annotated_DT_selected = all selected cells or all cells if no selection + ## annotated_DT_other = all not selected cells or NULL if no selection + + + + ########### dim plot ########### + # 2D plot + if (is.null(dim3_to_use)) { + dpl <- plotly::plot_ly() + if (show_NN_network == TRUE) { + if (is.null(nn_network_alpha)) { + nn_network_alpha <- 0.5 + } else if (is.character(nn_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + nn_network_alpha <- 0.5 + } + dpl <- dpl %>% plotly::add_segments( + name = network_name, + type = "scatter", + x = annotated_network_DT[[from_dim_names[1]]], + y = annotated_network_DT[[from_dim_names[2]]], + xend = annotated_network_DT[[to_dim_names[1]]], + yend = annotated_network_DT[[to_dim_names[2]]], + line = list( + color = nn_network_color, + width = 0.5 + ), + opacity = nn_network_alpha + ) + } + + if (is.null(cell_color)) { + # cell_color = "lightblue" + dpl <- dpl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + # color = "lightblue", + # colors ="lightblue", + marker = list( + size = dim_point_size, + color = "lightblue" + ), + showlegend = FALSE + ) + } else if (cell_color %in% colnames(annotated_DT_selected)) { + if (color_as_factor) { + annotated_DT_selected[[cell_color]] <- as.factor( + annotated_DT_selected[[cell_color]] + ) + } + + + dpl <- dpl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + color = annotated_DT_selected[[cell_color]], + colors = cell_color_code, + legendgroup = annotated_DT_selected[[cell_color]], + marker = list(size = dim_point_size) + ) + } else { + stop("cell_color does not exist!\n") + } + + + if ((show_cluster_center == TRUE | show_center_label == TRUE) & + !is.null(cell_color)) { + annotated_DT_centers <- annotated_DT_selected[, .( + center_1 = stats::median(get(dim_names[1])), + center_2 = stats::median(get(dim_names[2])) + ), + by = cell_color + ] + annotated_DT_centers[[cell_color]] <- as.factor( + annotated_DT_centers[[cell_color]] + ) + if (show_cluster_center == TRUE) { + dpl <- dpl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_centers[["center_1"]], + y = annotated_DT_centers[["center_2"]], + color = annotated_DT_centers[[cell_color]], + colors = cell_color_code, + legendgroup = annotated_DT_centers[[cell_color]], + marker = list( + size = center_point_size, symbol = "x", + symbols = "x" + ), + showlegend = FALSE + ) + } + + if (show_center_label == TRUE) { + dpl <- dpl %>% plotly::add_text( + x = annotated_DT_centers[["center_1"]], + y = annotated_DT_centers[["center_2"]], + type = "scatter", mode = "text", + text = annotated_DT_centers[[cell_color]], + textposition = "middle right", + textfont = list( + color = "#000000", + size = label_size + ), + showlegend = FALSE + ) + } + } + if (show_other_cells == TRUE) { + dpl <- dpl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + if (dim_reduction_to_use == "pca") { + if (!is.null(eigenvalues)) { + x_name <- paste0("pca", "-", dim_names[1]) + y_name <- paste0("pca", "-", dim_names[2]) + x_title <- sprintf( + "%s explains %.02f%% of variance", + x_name, var_expl_vec[1] + ) + y_title <- sprintf( + "%s explains %.02f%% of variance", + y_name, var_expl_vec[2] + ) + } + } else { + x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + } + dpl <- dpl %>% plotly::layout( + xaxis = list(title = x_title), + yaxis = list(title = y_title), + legend = list( + x = 100, y = 0.5, + font = list( + family = "sans-serif", + size = legend_text_size + ) + ) + ) + } + # 3D plot + else if (!is.null(dim3_to_use)) { + dpl <- plotly::plot_ly(scene = "scene1") + if (is.null(cell_color)) { + # cell_color = "lightblue" + dpl <- dpl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + z = annotated_DT_selected[[dim_names[3]]], + color = "lightblue", + colors = "lightblue", + marker = list(size = dim_point_size), + showlegend = FALSE + ) + # legendgroup = annotated_DT_selected[[cell_color]]) + } else { + if (cell_color %in% colnames(annotated_DT_selected)) { + if (is.null(cell_color_code)) { + number_colors <- length(unique( + annotated_DT_selected[[cell_color]] + )) + cell_color_code <- set_default_color_discrete_cell( + instrs = instructions(gobject) + )(n = number_colors) + } + if (color_as_factor) { + annotated_DT_selected[[cell_color]] <- as.factor( + annotated_DT_selected[[cell_color]] + ) + } + dpl <- dpl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_selected[[dim_names[1]]], + y = annotated_DT_selected[[dim_names[2]]], + z = annotated_DT_selected[[dim_names[3]]], + color = annotated_DT_selected[[cell_color]], + colors = cell_color_code, + marker = list(size = dim_point_size), + legendgroup = annotated_DT_selected[[cell_color]] + ) + } else { + stop("cell_color does not exist!\n") + } + } + if (show_other_cells == TRUE) { + dpl <- dpl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + z = annotated_DT_other[[dim_names[3]]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + if (show_NN_network) { + edges <- plotly_network( + annotated_network_DT, + "from_Dim.1", "from_Dim.2", "from_Dim.3", + "to_Dim.1", "to_Dim.2", "to_Dim.3" + ) + if (is.null(nn_network_alpha)) { + nn_network_alpha <- 0.5 + } else if (is.character(nn_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + nn_network_alpha <- 0.5 + } + + dpl <- dpl %>% plotly::add_trace( + name = network_name, + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, y = ~y, z = ~z, + line = list(color = nn_network_color), + opacity = nn_network_alpha + ) + } + if ((show_cluster_center == TRUE | show_center_label == TRUE) & + !is.null(cell_color)) { + annotated_DT_centers <- annotated_DT_selected[, .( + center_1 = stats::median(get(dim_names[1])), + center_2 = stats::median(get(dim_names[2])), + center_3 = stats::median(get(dim_names[3])) + ), + by = cell_color + ] + annotated_DT_centers[[cell_color]] <- as.factor( + annotated_DT_centers[[cell_color]] + ) + if (show_cluster_center == TRUE) { + dpl <- dpl %>% + plotly::add_trace( + mode = "markers", + type = "scatter3d", + data = annotated_DT_centers, + x = ~center_1, + y = ~center_2, + z = ~center_3, + color = annotated_DT_centers[[cell_color]], + colors = cell_color_code, + marker = list(size = 2, symbol = "x", symbols = "x"), + legendgroup = annotated_DT_centers[[cell_color]], + showlegend = FALSE + ) + } + if (show_center_label == TRUE) { + message(" center label is not clear to see in 3D plot. + You can shut it down with show_center_label = FALSE") + dpl <- dpl %>% + plotly::add_trace( + mode = "text", + type = "scatter3d", + data = annotated_DT_centers, + x = ~center_1, + y = ~center_2, + z = ~center_3, + text = annotated_DT_centers[[cell_color]], + legendgroup = annotated_DT_centers[[cell_color]], + showlegend = FALSE + ) + } + } + if (dim_reduction_to_use == "pca") { + x_name <- paste0("pca", "-", dim_names[1]) + y_name <- paste0("pca", "-", dim_names[2]) + z_name <- paste0("pca", "-", dim_names[3]) + x_title <- sprintf( + "%s explains %.02f%% of variance", + x_name, var_expl_vec[1] + ) + y_title <- sprintf( + "%s explains %.02f%% of variance", + y_name, var_expl_vec[2] + ) + z_title <- sprintf( + "%s explains %.02f%% of variance", + z_name, var_expl_vec[3] + ) + } else { + x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + z_title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") + } + } + + + + ############ spatial plot ########## + if (is.null(sdimx) | is.null(sdimy)) { + # cat('first and second dimension need to be defined, default is + # first 2 \n') + sdimx <- "sdimx" + sdimy <- "sdimy" + } + + ## 2D plot ## + if (is.null(sdimz)) { + spl <- plotly::plot_ly() + + if (show_spatial_network == TRUE) { + if (is.null(spatial_network)) { + stop("No usable spatial network specified! Please choose + a network with spatial_network_name=xxx") + } else { + if (is.null(spatial_network_alpha)) { + spatial_network_alpha <- 0.5 + } else if (is.character(spatial_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + spatial_network_alpha <- 0.5 + } + spl <- spl %>% plotly::add_segments( + name = spatial_network_name, + type = "scatter", + x = spatial_network[["sdimx_begin"]], + y = spatial_network[["sdimy_begin"]], + xend = spatial_network[["sdimx_end"]], + yend = spatial_network[["sdimy_end"]], + line = list( + color = spatial_network_color, + width = 0.5 + ), + opacity = spatial_network_alpha + ) + } + } + + + if (show_spatial_grid == TRUE) { + if (is.null(spatial_grid)) { + stop("No usable spatial grid specified! Please choose a + network with spatial_grid_name=xxx") + } else { + if (is.null(spatial_grid_color)) { + spatial_grid_color <- "black" + } + edges <- plotly_grid(spatial_grid) + spl <- spl %>% plotly::add_segments( + name = "spatial_grid", + type = "scatter", + data = edges, + x = ~x, + y = ~y, + xend = ~x_end, + yend = ~y_end, + line = list( + color = spatial_grid_color, + width = 1 + ), + opacity = spatial_grid_alpha + ) + } + } + if (is.null(cell_color)) { + # cell_color = "lightblue" + spl <- spl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_selected[[sdimx]], + y = annotated_DT_selected[[sdimy]], + # color = "lightblue", + # colors = "lightblue", + marker = list( + size = spatial_point_size, + color = "lightblue" + ), + showlegend = FALSE + ) + } else if (cell_color %in% colnames(annotated_DT_selected)) { + if (color_as_factor) { + annotated_DT_selected[[cell_color]] <- as.factor( + annotated_DT_selected[[cell_color]] + ) + } + + + spl <- spl %>% + plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_selected[[sdimx]], + y = annotated_DT_selected[[sdimy]], + color = annotated_DT_selected[[cell_color]], + colors = cell_color_code, + legendgroup = annotated_DT_selected[[cell_color]], + marker = list(size = spatial_point_size), + showlegend = FALSE + ) + } else { + stop("cell_color doesn't exist!\n") + } + if (show_other_cells == TRUE) { + spl <- spl %>% plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_other[[sdimx]], + y = annotated_DT_other[[sdimy]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + spl <- spl %>% plotly::layout( + xaxis = list(title = "X"), + yaxis = list(title = "Y"), + legend = list( + x = 100, y = 0.5, + font = list( + family = "sans-serif", + size = legend_text_size + ) + ) + ) + } + + + ## 3D plot ## + else { + axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) + + ratio <- plotly_axis_scale_3D(annotated_DT_selected, + sdimx = sdimx, sdimy = sdimy, sdimz = sdimz, + mode = axis_scale, custom_ratio = custom_ratio + ) + spl <- plotly::plot_ly(scene = "scene2") + if (!is.null(cell_color)) { + if (cell_color %in% colnames(annotated_DT_selected)) { + annotated_DT_selected[[cell_color]] <- as.factor( + annotated_DT_selected[[cell_color]] + ) + spl <- spl %>% + plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_selected[[sdimx]], + y = annotated_DT_selected[[sdimy]], + z = annotated_DT_selected[[sdimz]], + color = annotated_DT_selected[[cell_color]], + colors = cell_color_code, + legendgroup = annotated_DT_selected[[cell_color]], + marker = list(size = spatial_point_size), + showlegend = FALSE + ) + } else { + stop("cell_color doesn't exist!\n") + } + } else { + spl <- spl %>% + plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_selected$sdimx, + y = annotated_DT_selected$sdimy, + z = annotated_DT_selected$sdimz, + color = "lightblue", + colors = "lightblue", + # legendgroup = annotated_DT_selected[[cell_color]], + marker = list(size = spatial_point_size), + showlegend = FALSE + ) + } + if (show_other_cells == TRUE) { + spl <- spl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_other[[sdimx]], + y = annotated_DT_other[[sdimy]], + z = annotated_DT_other[[sdimz]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + if (show_spatial_network == TRUE) { + if (is.null(spatial_network)) { + stop("No usable spatial network specified! Please choose a + network with spatial_network_name=xxx") + } else { + if (is.null(spatial_network_alpha)) { + spatial_network_alpha <- 0.5 + } else if (is.character(spatial_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + spatial_network_alpha <- 0.5 + } + edges <- plotly_network(spatial_network) + + spl <- spl %>% plotly::add_trace( + name = "sptial network", + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, y = ~y, z = ~z, + line = list(color = spatial_network_color), + opacity = spatial_network_alpha + ) + } + } + + if (show_spatial_grid == TRUE) { + message("3D grid is not clear to view\n") + } + } + + + + + if (is.null(dim3_to_use) & is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot(dpl, spl, + nrows = 2, + titleX = TRUE, titleY = TRUE + ) + } else { + combo_plot <- plotly::subplot(dpl, spl, + titleX = TRUE, + titleY = TRUE + ) + } + } else if (!is.null(dim3_to_use) & is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot(dpl, spl, + nrows = 2, titleX = TRUE, + titleY = TRUE + ) %>% + plotly::layout(scene = list( + domain = list(x = c(0, 1), y = c(0, 0.5)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + )) + } else { + combo_plot <- plotly::subplot(dpl, spl, + titleX = TRUE, + titleY = TRUE + ) %>% + plotly::layout(scene = list( + domain = list(x = c(0, 0.5), y = c(0, 1)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + )) + } + } else if (is.null(dim3_to_use) & !is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot(dpl, spl, + nrows = 2, titleX = TRUE, + titleY = TRUE + ) %>% + plotly::layout(scene2 = list( + domain = list(x = c(0, 1), y = c(0.5, 1)), + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + )) + } else { + combo_plot <- plotly::subplot(dpl, spl, + titleX = TRUE, + titleY = TRUE + ) %>% + plotly::layout(scene2 = list( + domain = list(x = c(0.5, 1), y = c(0, 1)), + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + )) + } + } else if (!is.null(dim3_to_use) & !is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot(dpl, spl, + nrows = 2, titleX = TRUE, + titleY = TRUE + ) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 1), y = c(0, 0.5)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + ), + scene2 = list( + domain = list(x = c(0, 1), y = c(0.5, 1)), + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ) + ) + } else { + combo_plot <- plotly::subplot(dpl, spl, + titleX = TRUE, + titleY = TRUE + ) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 0.5), y = c(0, 1)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + ), + scene2 = list( + domain = list(x = c(0.5, 1), y = c(0, 1)), + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ) + ) + } + } + + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + ## print plot + if (show_plot == TRUE) { + print(combo_plot) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = combo_plot, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(combo_plot) + } +} + + + + +# ** #### +# ** feature 3D plot #### + +#' @title spatFeatPlot3D +#' @name spatFeatPlot3D +#' @description Visualize cells and gene expression according to spatial +#' coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @param spat_loc_name name of spatial locations to use +#' @param expression_values gene expression values to use +#' @param feats feats to show +#' @param spat_enr_names names of spatial enrichment results to include +#' +#' @param cluster_column cluster column to select groups +#' @param select_cell_groups select subset of cells/clusters based on +#' cell_color parameter +#' @param select_cells select subset of cells based on cell IDs +#' @param show_other_cells display not selected cells +#' @param other_cell_color color of not selected cells +#' @param other_point_size size of not selected cells +#' +#' @param genes_high_color color represents high gene expression +#' @param genes_mid_color color represents middle gene expression +#' @param genes_low_color color represents low gene expression +#' @param show_network show underlying spatial network +#' @param network_color color of spatial network +#' @param spatial_network_name name of spatial network to use +#' @param edge_alpha alpha of edges +#' @param show_grid show spatial grid +#' @param spatial_grid_name name of spatial grid to use +#' +#' @param point_size size of point (cell) +#' @param show_legend show legend +#' +#' @param axis_scale the way to scale the axis +#' @param custom_ratio customize the scale of the plot +#' @param x_ticks set the number of ticks on the x-axis +#' @param y_ticks set the number of ticks on the y-axis +#' @param z_ticks set the number of ticks on the z-axis +#' @param ... additional params to pass +#' @family spatial gene expression visualizations +#' @returns plotly +#' @examples +#' g <- GiottoData::loadGiottoMini("starmap") +#' spatFeatPlot3D(g, feats = "Slc17a7") +#' +#' @export +spatFeatPlot3D <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = "raw", + expression_values = c("normalized", "scaled", "custom"), + feats, + spat_enr_names = NULL, + show_network = FALSE, + network_color = NULL, + spatial_network_name = "Delaunay_network", + edge_alpha = NULL, + cluster_column = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = FALSE, + other_cell_color = "lightgrey", + other_point_size = 1, + genes_high_color = NULL, + genes_mid_color = "white", + genes_low_color = "blue", + show_grid = FALSE, + spatial_grid_name = "spatial_grid", + point_size = 2, + show_legend = TRUE, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatFeatPlot3D", + ...) { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # data.table variables + cell_ID <- NULL + + selected_genes <- feats + + values <- match.arg(expression_values, c("normalized", "scaled", "custom")) + expr_values <- getExpression( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + values = values, + output = "matrix" + ) + + # only keep genes that are in the dataset + selected_genes <- selected_genes[selected_genes %in% rownames(expr_values)] + + # get selected feature expression values in data.table format + if (length(selected_genes) == 1) { + subset_expr_data <- expr_values[rownames(expr_values) %in% + selected_genes, ] + t_sub_expr_data_DT <- data.table::data.table( + "selected_gene" = subset_expr_data, + "cell_ID" = colnames(expr_values) + ) + data.table::setnames( + t_sub_expr_data_DT, + "selected_gene", selected_genes + ) + } else { + subset_expr_data <- expr_values[rownames(expr_values) %in% + selected_genes, ] + t_sub_expr_data <- t_flex(subset_expr_data) + t_sub_expr_data_DT <- data.table::as.data.table( + as.matrix(t_sub_expr_data) + ) + t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] + } + + + ## extract cell locations + cell_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table" + ) + if (is.null(cell_locations)) { + return(NULL) + } + + + ## extract spatial network + if (show_network) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT" + ) + } else { + spatial_network <- NULL + } + + ## extract spatial grid + if (show_grid) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name + ) + } else { + spatial_grid <- NULL + } + + ## extract cell metadata + cell_metadata <- try( + expr = combineMetadata( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + spat_loc_name = spat_loc_name, + spat_enr_names = spat_enr_names + ), + silent = TRUE + ) + + + if (inherits(cell_metadata, "try-error")) { + cell_locations_metadata <- cell_locations + } else if (nrow(cell_metadata) == 0) { + cell_locations_metadata <- cell_locations + } else { + cell_locations_metadata <- cell_metadata + } + + + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- cell_locations_metadata[get(cluster_column) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- cell_locations_metadata[get(cluster_column) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + cell_locations_metadata_other <- cell_locations_metadata[ + !cell_locations_metadata$cell_ID %in% select_cells + ] + cell_locations_metadata_selected <- cell_locations_metadata[ + cell_locations_metadata$cell_ID %in% select_cells + ] + spatial_network <- spatial_network[spatial_network$to %in% + select_cells & spatial_network$from %in% select_cells] + + # if specific cells are selected + cell_locations_metadata <- cell_locations_metadata_selected + } + + cell_locations_metadata_genes <- merge(cell_locations_metadata, + t_sub_expr_data_DT, + by = "cell_ID" + ) + + + + ## plotting ## + axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) + + ratio <- plotly_axis_scale_3D(cell_locations_metadata_genes, + sdimx = "sdimx", sdimy = "sdimy", sdimz = "sdimz", + mode = axis_scale, custom_ratio = custom_ratio + ) + + + ## spatial network data + if (!is.null(spatial_network) & show_network == TRUE) { + edges <- plotly_network(spatial_network) + } + + ## Point layer + if (length(selected_genes) > 4) { + stop("\n The max number of genes showed together is 4.Otherwise + it will be too small to see\n + \n If you have more genes to show, please divide them + into groups\n") + } + savelist <- list() + for (i in seq_len(length(selected_genes))) { + gene <- selected_genes[i] + if (!is.null(genes_high_color)) { + if (length(genes_high_color) != length(selected_genes) & + length(genes_high_color) != 1) { + stop("\n The number of genes and their corresbonding do + not match\n") + } else if (length(genes_high_color) == 1) { + genes_high_color <- rep( + genes_high_color, + length(selected_genes) + ) + } + } else { + genes_high_color <- rep("red", length(selected_genes)) + } + pl <- plotly::plot_ly( + name = gene, + scene = paste("scene", i, sep = "") + ) %>% + plotly::add_trace( + data = cell_locations_metadata_genes, + type = "scatter3d", mode = "markers", + x = ~sdimx, y = ~sdimy, z = ~sdimz, + marker = list(size = point_size), + color = cell_locations_metadata_genes[[gene]], + colors = c( + genes_low_color, genes_mid_color, + genes_high_color[i] + ) + ) + + if (show_other_cells == TRUE) { + pl <- pl %>% plotly::add_trace( + name = "unselected cells", + data = cell_locations_metadata_other, + type = "scatter3d", mode = "markers", + x = ~sdimx, y = ~sdimy, z = ~sdimz, + marker = list(size = other_point_size, color = other_cell_color) + ) + } + + + ## plot spatial network + if (show_network == TRUE) { + if (is.null(network_color)) { + network_color <- "lightblue" + } + if (is.null(edge_alpha)) { + edge_alpha <- 0.5 + } else if (is.character(edge_alpha)) { + edge_alpha <- 0.5 + message("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set") + } + pl <- pl %>% plotly::add_trace( + name = "sptial network", + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, y = ~y, z = ~z, + line = list(color = network_color, width = 0.5), + opacity = edge_alpha, + showlegend = FALSE + ) + } + + + ## plot spatial grid + if (!is.null(spatial_grid) & show_grid == TRUE) { + message("spatial grid is not clear in 3D plot") + } + + pl <- pl %>% plotly::colorbar(title = gene) + savelist[[gene]] <- pl + } + + + if (length(savelist) == 1) { + cowplot <- savelist[[1]] %>% plotly::layout(scene = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + )) + } else if (length(savelist) == 2) { + cowplot <- plotly::subplot(savelist) %>% + plotly::layout( + scene = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + # annotations = annotations, + legend = list(x = 100, y = 0) + ) + } else if (length(savelist) == 3) { + cowplot <- plotly::subplot(savelist) %>% + plotly::layout( + scene = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + scene3 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + legend = list(x = 100, y = 0) + ) + } else if (length(savelist) == 4) { + cowplot <- plotly::subplot(savelist) %>% + plotly::layout( + scene = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + scene3 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + scene4 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ), + legend = list(x = 100, y = 0) + ) + } + + + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + ## print plot + if (show_plot == TRUE) { + print(cowplot) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = cowplot, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(cowplot) + } +} + +#' @describeIn spatFeatPlot3D deprecated +#' @export +spatGenePlot3D <- function(...) { + deprecate_warn( + when = "0.2.0", + what = "spatGenePlot3D()", + with = "spatFeatPlot3D()" + ) + spatFeatPlot3D(...) +} + + +#' @title dimFeatPlot3D +#' @name dimFeatPlot3D +#' @description Visualize cells and gene expression according to +#' dimension reduction coordinates +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @param expression_values gene expression values to use +#' @param genes genes to show +#' @param dim_reduction_to_use dimension reduction to use +#' @param dim_reduction_name dimension reduction name +#' @param dim1_to_use dimension to use on x-axis +#' @param dim2_to_use dimension to use on y-axis +#' @param dim3_to_use dimension to use on z-axis +#' +#' @param show_NN_network show underlying NN network +#' @param nn_network_to_use type of NN network to use (kNN vs sNN) +#' @param network_name name of NN network to use, if show_NN_network = TRUE +#' @param network_color color of NN network +#' +#' @param cluster_column cluster column to select groups +#' @param select_cell_groups select subset of cells/clusters based on +#' cell_color parameter +#' @param select_cells select subset of cells based on cell IDs +#' @param show_other_cells display not selected cells +#' @param other_cell_color color of not selected cells +#' @param other_point_size size of not selected cells +#' +#' @param edge_alpha column to use for alpha of the edges +#' @param point_size size of point (cell) +#' +#' @param genes_high_color color for high expression levels +#' @param genes_mid_color color for medium expression levels +#' @param genes_low_color color for low expression levels +#' +#' @param show_legend show legend +#' @details Description of parameters. +#' @family dimension reduction gene expression visualizations +#' @returns plotly +#' @examples +#' g <- GiottoData::loadGiottoMini("starmap") +#' +#' dimFeatPlot3D(g, genes = "Slc17a7", dim_reduction_name = "3D_umap") +#' @export +dimFeatPlot3D <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + expression_values = c("normalized", "scaled", "custom"), + genes = NULL, + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + dim3_to_use = 3, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + network_name = "sNN.pca", + network_color = "lightgray", + cluster_column = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + edge_alpha = NULL, + point_size = 2, + genes_high_color = NULL, + genes_mid_color = "white", + genes_low_color = "blue", + show_legend = TRUE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dimFeatPlot3D") { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + ## select genes ## + selected_genes <- genes + values <- match.arg(expression_values, c("normalized", "scaled", "custom")) + expr_values <- getExpression( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + values = values, + output = "matrix" + ) + + # only keep genes that are in the dataset + selected_genes <- selected_genes[selected_genes %in% rownames(expr_values)] + + # + if (length(selected_genes) == 1) { + subset_expr_data <- expr_values[ + rownames(expr_values) %in% selected_genes, + ] + t_sub_expr_data_DT <- data.table::data.table( + "selected_gene" = subset_expr_data, + "cell_ID" = colnames(expr_values) + ) + data.table::setnames( + t_sub_expr_data_DT, "selected_gene", selected_genes + ) + } else { + subset_expr_data <- expr_values[ + rownames(expr_values) %in% selected_genes, + ] + t_sub_expr_data <- t_flex(subset_expr_data) + t_sub_expr_data_DT <- data.table::as.data.table( + as.matrix(t_sub_expr_data) + ) + + # data.table variables + cell_ID <- NULL + + t_sub_expr_data_DT[, cell_ID := rownames(t_sub_expr_data)] + } + + + ## dimension reduction ## + dim_dfr <- getDimReduction(gobject, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "data.table" + ) + dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] + dim_names <- colnames(dim_dfr) + dim_DT <- data.table::as.data.table(dim_dfr) + dim_DT[, cell_ID := rownames(dim_dfr)] + + ## annotated cell metadata + cell_metadata <- pDataDT(gobject, + feat_type = feat_type, + spat_unit = spat_unit + ) + annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") + + + + # create input for network + if (show_NN_network == TRUE) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + network_DT <- data.table::as.data.table(igraph::as_data_frame( + selected_nn_network, + what = "edges" + )) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- merge( + network_DT, dim_DT, + by.x = "from", by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = from_dim_names + ) + + annotated_network_DT <- merge( + annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames(annotated_network_DT, + old = old_dim_names, + new = to_dim_names + ) + } + + + ## create subsets if needed + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + if (is.null(cluster_column)) { + stop("\n selection of cells is based on cell_color paramter, + which is a metadata column \n") + } + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- annotated_DT[get(cluster_column) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- annotated_DT[get(cluster_column) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + annotated_DT_other <- annotated_DT[ + !annotated_DT$cell_ID %in% select_cells + ] + annotated_DT_selected <- annotated_DT[ + annotated_DT$cell_ID %in% select_cells + ] + + if (show_NN_network == TRUE) { + annotated_network_DT <- annotated_network_DT[ + annotated_network_DT$to %in% select_cells & + annotated_network_DT$from %in% select_cells + ] + } + + # if specific cells are selected + annotated_DT <- annotated_DT_selected + } + + ## if no subsets are required + if (is.null(select_cells) & is.null(select_cell_groups)) { + annotated_DT_selected <- annotated_DT + annotated_DT_other <- NULL + } + + ## merge gene info + annotated_gene_DT <- merge(annotated_DT, t_sub_expr_data_DT, by = "cell_ID") + + + + ## visualize multipe plots ## + ## 3D plots ## + + + if (show_NN_network == TRUE) { + edges <- plotly_network( + annotated_network_DT, + "from_Dim.1", "from_Dim.2", "from_Dim.3", + "to_Dim.1", "to_Dim.2", "to_Dim.3" + ) + } + ## Point layer + if (length(selected_genes) > 4) { + stop("\n The max number of genes showed together is 4.Otherwise + it will be too small to see\n + \n If you have more genes to show, please divide them into + groups\n") + } + if (!is.null(genes_high_color)) { + if (length(genes_high_color) != length(selected_genes) & + length(genes_high_color) != 1) { + stop("\n The number of genes and their corresbonding do not + match\n") + } + } else if (is.null(genes_high_color)) { + genes_high_color <- rep("red", length(selected_genes)) + } else { + genes_high_color <- rep(genes_high_color, length(selected_genes)) + } + + titleX <- title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + titleY <- title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + titleZ <- title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") + savelist <- list() + for (i in seq_len(length(selected_genes))) { + gene <- selected_genes[i] + + pl <- plotly::plot_ly(name = gene, scene = paste("scene", i, sep = "")) + pl <- pl %>% plotly::add_trace( + data = annotated_gene_DT, type = "scatter3d", mode = "markers", + x = annotated_gene_DT[[dim_names[1]]], + y = annotated_gene_DT[[dim_names[2]]], + z = annotated_gene_DT[[dim_names[3]]], + color = annotated_gene_DT[[gene]], + colors = c(genes_low_color, genes_mid_color, genes_high_color[i]), + marker = list(size = point_size) + ) + if (show_other_cells == TRUE) { + pl <- pl %>% plotly::add_trace( + name = "unselected cells", + data = annotated_DT_other, + type = "scatter3d", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + z = annotated_DT_other[[dim_names[3]]], + marker = list(size = other_point_size, color = other_cell_color) + ) + } + + ## plot spatial network + if (show_NN_network == TRUE) { + pl <- pl %>% plotly::add_trace( + name = "sptial network", mode = "lines", + type = "scatter3d", opacity = edge_alpha, + showlegend = FALSE, + data = edges, + x = ~x, y = ~y, z = ~z, + line = list( + color = network_color, + width = 0.5 + ) + ) + } + pl <- pl %>% plotly::colorbar(title = gene) + savelist[[gene]] <- pl + } + + if (length(savelist) == 1) { + cowplot <- savelist[[1]] %>% plotly::layout(scene = list( + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + )) + } else if (length(savelist) == 2) { + cowplot <- plotly::subplot( + savelist, + titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 0.5), y = c(0, 1)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + scene2 = list( + domain = list(x = c(0.5, 1), y = c(0, 1)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + legend = list(x = 100, y = 0) + ) + } else if (length(savelist) == 3) { + cowplot <- plotly::subplot( + savelist, + titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 0.5), y = c(0, 0.5)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + scene2 = list( + domain = list(x = c(0.5, 1), y = c(0, 0.5)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + scene3 = list( + domain = list(x = c(0, 0.5), y = c(0.5, 1)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + legend = list(x = 100, y = 0) + ) + } else if (length(savelist) == 4) { + cowplot <- plotly::subplot(savelist) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 0.5), y = c(0, 0.5)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + scene2 = list( + domain = list(x = c(0.5, 1), y = c(0, 0.5)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + scene3 = list( + domain = list(x = c(0, 0.5), y = c(0.5, 1)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + scene4 = list( + domain = list(x = c(0.5, 1), y = c(0.5, 1)), + xaxis = list(title = titleX), + yaxis = list(title = titleY), + zaxis = list(title = titleZ) + ), + legend = list(x = 100, y = 0) + ) + } + + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + ## print plot + if (show_plot == TRUE) { + print(cowplot) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = cowplot, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(cowplot) + } +} + +#' @describeIn dimFeatPlot3D deprecated +#' @param ... additional params to pass +#' @export +dimGenePlot3D <- function(...) { + deprecate_warn( + when = "0.2.0", + what = "dimGenePlot3D()", + with = "dimFeatPlot3D()" + ) + dimFeatPlot3D(...) +} + + + +#' @title spatDimFeatPlot3D +#' @name spatDimFeatPlot3D +#' @description Visualize cells according to spatial AND dimension +#' reduction coordinates in ggplot mode +#' @inheritParams data_access_params +#' @inheritParams plot_output_params +#' @param spat_loc_name name of spatial locations to use +#' @param expression_values gene expression values to use +#' @param plot_alignment direction to align plot +#' @param dim_reduction_to_use dimension reduction to use +#' @param dim_reduction_name dimension reduction name +#' @param dim1_to_use dimension to use on x-axis +#' @param dim2_to_use dimension to use on y-axis +#' @param dim3_to_use dimension to use on z-axis +#' @param sdimx spatial dimension to use on x-axis +#' @param sdimy spatial dimension to use on y-axis +#' @param sdimz spatial dimension to use on z-axis +#' @param genes genes to show +#' +#' @param cluster_column cluster column to select groups +#' @param select_cell_groups select subset of cells/clusters based on +#' cell_color parameter +#' @param select_cells select subset of cells based on cell IDs +#' @param show_other_cells display not selected cells +#' @param other_cell_color color of not selected cells +#' @param other_point_size size of not selected cells +#' +#' @param dim_point_size dim reduction plot: point size +#' @param show_NN_network show underlying NN network +#' @param nn_network_to_use type of NN network to use (kNN vs sNN) +#' @param nn_network_color color of NN network +#' @param nn_network_alpha alpha of NN network +#' @param network_name name of NN network to use, if show_NN_network = TRUE +#' +#' @param label_size size of labels +#' @param genes_high_color color for high expression levels +#' @param genes_mid_color color for medium expression levels +#' @param genes_low_color color for low expression levels +#' +#' @param show_spatial_network show spatial network (boolean) +#' @param spatial_network_name name of spatial network to use +#' @param spatial_network_color color of spatial network +#' @param spatial_network_alpha alpha of spatial network +#' +#' @param show_spatial_grid show spatial grid (boolean) +#' @param spatial_grid_name name of spatial grid to use +#' @param spatial_grid_color color of spatial grid +#' @param spatial_grid_alpha alpha of spatial grid +#' +#' @param spatial_point_size spatial plot: point size +#' @param legend_text_size size of legend +#' +#' @param axis_scale the way to scale the axis +#' @param custom_ratio customize the scale of the plot +#' @param x_ticks set the number of ticks on the x-axis +#' @param y_ticks set the number of ticks on the y-axis +#' @param z_ticks set the number of ticks on the z-axis +#' @details Description of parameters. +#' @family spatial and dimension reduction gene expression visualizations +#' @returns plotly +#' @examples +#' g <- GiottoData::loadGiottoMini("starmap") +#' spatDimFeatPlot3D(g, genes = "Slc17a7") +#' +#' @export +spatDimFeatPlot3D <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + spat_loc_name = NULL, + expression_values = c("normalized", "scaled", "custom"), + plot_alignment = c("horizontal", "vertical"), + dim_reduction_to_use = "umap", + dim_reduction_name = "umap", + dim1_to_use = 1, + dim2_to_use = 2, + dim3_to_use = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + genes, + cluster_column = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1.5, + show_NN_network = FALSE, + nn_network_to_use = "sNN", + nn_network_color = "lightgrey", + nn_network_alpha = 0.5, + network_name = "sNN.pca", + label_size = 16, + genes_low_color = "blue", + genes_mid_color = "white", + genes_high_color = "red", + dim_point_size = 3, + show_spatial_network = FALSE, + spatial_network_name = "Delaunay_network", + spatial_network_color = "lightgray", + spatial_network_alpha = 0.5, + show_spatial_grid = FALSE, + spatial_grid_name = "spatial_grid", + spatial_grid_color = NULL, + spatial_grid_alpha = 0.5, + spatial_point_size = 3, + legend_text_size = 12, + axis_scale = c("cube", "real", "custom"), + custom_ratio = NULL, + x_ticks = NULL, + y_ticks = NULL, + z_ticks = NULL, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatDimFeatPlot3D") { + # Set feat_type and spat_unit + spat_unit <- set_default_spat_unit( + gobject = gobject, + spat_unit = spat_unit + ) + feat_type <- set_default_feat_type( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type + ) + + # data.table variables + cell_ID <- NULL + + plot_alignment <- match.arg(plot_alignment, + choices = c("horizontal", "vertical") + ) + + ########### data prepare ########### + ## select genes ## + if (length(genes) > 1) { + warning("\n Now 3D mode can just accept one gene, only the first + gene will be plot\n") + genes <- genes[1] + } + selected_genes <- genes + values <- match.arg(expression_values, c("normalized", "scaled", "custom")) + expr_values <- getExpression( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + values = values, + output = "matrix" + ) + + # only keep genes that are in the dataset + selected_genes <- selected_genes[selected_genes %in% rownames(expr_values)] + subset_expr_data <- expr_values[rownames(expr_values) %in% selected_genes, ] + t_sub_expr_data_DT <- data.table::data.table( + "selected_gene" = subset_expr_data, "cell_ID" = colnames(expr_values) + ) + data.table::setnames(t_sub_expr_data_DT, "selected_gene", selected_genes) + + + ## dimension reduction ## + dim_dfr <- getDimReduction( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + reduction = "cells", + reduction_method = dim_reduction_to_use, + name = dim_reduction_name, + output = "matrix" + ) + dim_dfr <- dim_dfr[, c(dim1_to_use, dim2_to_use, dim3_to_use)] + dim_names <- colnames(dim_dfr) + dim_DT <- data.table::as.data.table(dim_dfr) + dim_DT[, cell_ID := rownames(dim_dfr)] + + + ## annotated cell metadata + cell_metadata <- pDataDT(gobject, + feat_type = feat_type, + spat_unit = spat_unit + ) + cell_locations <- getSpatialLocations( + gobject = gobject, + spat_unit = spat_unit, + name = spat_loc_name, + output = "data.table" + ) + if (is.null(cell_locations)) { + return(NULL) + } + + annotated_DT <- merge(cell_metadata, dim_DT, by = "cell_ID") + annotated_DT <- merge(annotated_DT, cell_locations, by = "cell_ID") + annotated_DT <- merge(annotated_DT, t_sub_expr_data_DT, by = "cell_ID") + + + ## nn network + if (show_NN_network) { + # nn_network + selected_nn_network <- getNearestNetwork( + gobject = gobject, + feat_type = feat_type, + spat_unit = spat_unit, + nn_type = nn_network_to_use, + name = network_name, + output = "igraph" + ) + network_DT <- data.table::as.data.table(igraph::as_data_frame( + selected_nn_network, + what = "edges" + )) + + # annotated network + old_dim_names <- dim_names + + annotated_network_DT <- merge( + network_DT, dim_DT, + by.x = "from", by.y = "cell_ID" + ) + from_dim_names <- paste0("from_", old_dim_names) + data.table::setnames( + annotated_network_DT, + old = old_dim_names, new = from_dim_names + ) + + annotated_network_DT <- merge(annotated_network_DT, dim_DT, + by.x = "to", by.y = "cell_ID" + ) + to_dim_names <- paste0("to_", old_dim_names) + data.table::setnames( + annotated_network_DT, + old = old_dim_names, new = to_dim_names + ) + } + + + ## extract spatial network + if (show_spatial_network == TRUE) { + spatial_network <- getSpatialNetwork( + gobject = gobject, + spat_unit = spat_unit, + name = spatial_network_name, + output = "networkDT" + ) + } else { + spatial_network <- NULL + } + + ## extract spatial grid + if (show_spatial_grid == TRUE) { + spatial_grid <- getSpatialGrid( + gobject = gobject, + spat_unit = spat_unit, + feat_type = feat_type, + name = spatial_grid_name + ) + } else { + spatial_grid <- NULL + } + + + ## select subset of cells ## + if (!is.null(select_cells) & !is.null(select_cell_groups)) { + if (is.null(cluster_column)) { + stop("\n selection of cells is based on cell_color paramter, + which is a metadata column \n") + } + message("You have selected both individual cell IDs and a group + of cells") + group_cell_IDs <- annotated_DT[get(cluster_column) %in% + select_cell_groups][["cell_ID"]] + select_cells <- unique(c(select_cells, group_cell_IDs)) + } else if (!is.null(select_cell_groups)) { + select_cells <- annotated_DT[get(cluster_column) %in% + select_cell_groups][["cell_ID"]] + } + + if (!is.null(select_cells)) { + annotated_DT_other <- annotated_DT[ + !annotated_DT$cell_ID %in% select_cells + ] + annotated_DT_selected <- annotated_DT[ + annotated_DT$cell_ID %in% select_cells + ] + + if (show_NN_network == TRUE) { + annotated_network_DT <- annotated_network_DT[ + annotated_network_DT$to %in% select_cells & + annotated_network_DT$from %in% select_cells + ] + } + if (show_spatial_network == TRUE) { + spatial_network <- spatial_network[ + spatial_network$to %in% select_cells & + spatial_network$from %in% select_cells + ] + } + + # if specific cells are selected + annotated_DT <- annotated_DT_selected + } + + ## if no subsets are required + if (is.null(select_cells) & is.null(select_cell_groups)) { + annotated_DT_selected <- annotated_DT + annotated_DT_other <- NULL + } + + + + + ########### dim plot ########### + # 2D plot + if (is.null(dim3_to_use)) { + dpl <- plotly::plot_ly() + if (show_NN_network == TRUE) { + if (is.null(nn_network_alpha)) { + nn_network_alpha <- 0.5 + } else if (is.character(nn_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + nn_network_alpha <- 0.5 + } + dpl <- dpl %>% plotly::add_segments( + name = network_name, + type = "scatter", + x = annotated_network_DT[[from_dim_names[1]]], + y = annotated_network_DT[[from_dim_names[2]]], + xend = annotated_network_DT[[to_dim_names[1]]], + yend = annotated_network_DT[[to_dim_names[2]]], + line = list( + color = nn_network_color, + width = 0.5 + ), + opacity = nn_network_alpha + ) + } + + dpl <- dpl %>% + plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT[[dim_names[1]]], + y = annotated_DT[[dim_names[2]]], + color = annotated_DT[[selected_genes]], + colors = c( + genes_low_color, genes_mid_color, + genes_high_color + ), + marker = list(size = dim_point_size), + showlegend = FALSE + ) + + if (show_other_cells == TRUE) { + dpl <- dpl %>% + plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + + dpl <- dpl %>% plotly::layout( + xaxis = list(title = x_title), + yaxis = list(title = y_title), + legend = list( + x = 100, y = 0.5, + font = list( + family = "sans-serif", + size = legend_text_size + ) + ) + ) + } + # 3D plot + else if (!is.null(dim3_to_use)) { + dpl <- plotly::plot_ly(scene = "scene1") + + dpl <- dpl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT[[dim_names[1]]], + y = annotated_DT[[dim_names[2]]], + z = annotated_DT[[dim_names[3]]], + color = annotated_DT[[selected_genes]], + colors = c(genes_low_color, genes_mid_color, genes_high_color), + marker = list(size = dim_point_size), + showlegend = FALSE + ) + # legendgroup = annotated_DT[[cell_color]]) + if (show_other_cells == TRUE) { + dpl <- dpl %>% plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_other[[dim_names[1]]], + y = annotated_DT_other[[dim_names[2]]], + z = annotated_DT_other[[dim_names[3]]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + if (show_NN_network) { + edges <- plotly_network( + annotated_network_DT, + "from_Dim.1", "from_Dim.2", "from_Dim.3", + "to_Dim.1", "to_Dim.2", "to_Dim.3" + ) + if (is.null(nn_network_alpha)) { + nn_network_alpha <- 0.5 + } else if (is.character(nn_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + nn_network_alpha <- 0.5 + } + + dpl <- dpl %>% plotly::add_trace( + name = network_name, + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, y = ~y, z = ~z, + line = list(color = nn_network_color), + opacity = nn_network_alpha + ) + } + + + x_title <- paste(dim_reduction_to_use, dim_names[1], sep = " ") + y_title <- paste(dim_reduction_to_use, dim_names[2], sep = " ") + z_title <- paste(dim_reduction_to_use, dim_names[3], sep = " ") + } + dpl <- dpl %>% plotly::colorbar(title = selected_genes) + + + ########### spatial plot ########### + if (is.null(sdimx) | is.null(sdimy)) { + # cat('first and second dimenion need to be defined, + # default is first 2 \n') + sdimx <- "sdimx" + sdimy <- "sdimy" + } + + # 2D plot + if (is.null(sdimz)) { + spl <- plotly::plot_ly() + + if (show_spatial_network == TRUE) { + if (is.null(spatial_network)) { + stop("No usable spatial network specified! Please choose a + network with spatial_network_name=xxx") + } else { + if (is.null(spatial_network_alpha)) { + spatial_network_alpha <- 0.5 + } else if (is.character(spatial_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + spatial_network_alpha <- 0.5 + } + spl <- spl %>% plotly::add_segments( + name = spatial_network_name, + type = "scatter", + x = spatial_network[["sdimx_begin"]], + y = spatial_network[["sdimy_begin"]], + xend = spatial_network[["sdimx_end"]], + yend = spatial_network[["sdimy_end"]], + line = list( + color = spatial_network_color, + width = 0.5 + ), + opacity = spatial_network_alpha + ) + } + } + if (show_spatial_grid == TRUE) { + if (is.null(spatial_grid)) { + stop("No usable spatial grid specified! Please choose a + network with spatial_grid_name=xxx") + } else { + if (is.null(spatial_grid_color)) { + spatial_grid_color <- "black" + } + edges <- plotly_grid(spatial_grid) + spl <- spl %>% plotly::add_segments( + name = "spatial_grid", + type = "scatter", + data = edges, + x = ~x, + y = ~y, + xend = ~x_end, + yend = ~y_end, + line = list( + color = spatial_grid_color, + width = 1 + ), + opacity = spatial_grid_alpha + ) + } + } + + spl <- spl %>% + plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT[[sdimx]], + y = annotated_DT[[sdimy]], + color = annotated_DT[[selected_genes]], + colors = c( + genes_low_color, genes_mid_color, + genes_high_color + ), + marker = list(size = spatial_point_size), + showlegend = FALSE + ) + if (show_other_cells == TRUE) { + spl <- spl %>% + plotly::add_trace( + type = "scatter", mode = "markers", + x = annotated_DT_other[[sdimx]], + y = annotated_DT_other[[sdimy]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + spl <- spl %>% plotly::layout( + xaxis = list(title = "X"), + yaxis = list(title = "Y"), + legend = list( + x = 100, y = 0.5, + font = list( + family = "sans-serif", + size = legend_text_size + ) + ) + ) + } + + + # 3D plot + else { + axis_scale <- match.arg(axis_scale, c("cube", "real", "custom")) + ratio <- plotly_axis_scale_3D(annotated_DT, + sdimx = sdimx, sdimy = sdimy, sdimz = sdimz, + mode = axis_scale, custom_ratio = custom_ratio + ) + + + spl <- plotly::plot_ly(scene = "scene2") + + spl <- spl %>% + plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT[[sdimx]], + y = annotated_DT[[sdimy]], + z = annotated_DT[[sdimz]], + color = annotated_DT[[selected_genes]], + colors = c( + genes_low_color, genes_mid_color, + genes_high_color + ), + # legendgroup = annotated_DT[[cell_color]], + marker = list(size = spatial_point_size), + showlegend = FALSE + ) + if (show_other_cells == TRUE) { + spl <- spl %>% + plotly::add_trace( + type = "scatter3d", mode = "markers", + x = annotated_DT_other[[sdimx]], + y = annotated_DT_other[[sdimy]], + z = annotated_DT_other[[sdimz]], + marker = list( + size = other_point_size, + color = other_cell_color + ), + showlegend = FALSE + ) + } + + if (show_spatial_network == TRUE) { + if (is.null(spatial_network)) { + stop("No usable spatial network specified! Please choose a + network with spatial_network_name=xxx") + } else { + if (is.null(spatial_network_alpha)) { + spatial_network_alpha <- 0.5 + } else if (is.character(spatial_network_alpha)) { + warning("Edge_alpha for plotly mode is not adjustable yet. + Default 0.5 will be set\n") + spatial_network_alpha <- 0.5 + } + edges <- plotly_network(spatial_network) + + spl <- spl %>% plotly::add_trace( + name = "sptial network", + mode = "lines", + type = "scatter3d", + data = edges, + x = ~x, y = ~y, z = ~z, + line = list(color = spatial_network_color), + opacity = spatial_network_alpha + ) + } + } + + if (show_spatial_grid == TRUE) { + message("3D grid is not clear to view") + } + } + + + + spl <- plotly::hide_colorbar(spl) + if (is.null(dim3_to_use) & is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot( + dpl, spl, + nrows = 2, titleX = TRUE, titleY = TRUE + ) + } else { + combo_plot <- plotly::subplot( + dpl, spl, + titleX = TRUE, titleY = TRUE + ) + } + } else if (!is.null(dim3_to_use) & is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot( + dpl, spl, + nrows = 2, titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout(scene = list( + domain = list(x = c(0, 1), y = c(0, 0.5)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + )) + } else { + combo_plot <- plotly::subplot( + dpl, spl, + titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout(scene = list( + domain = list(x = c(0, 0.5), y = c(0, 1)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + )) + } + } else if (is.null(dim3_to_use) & !is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot( + dpl, spl, + nrows = 2, titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout(scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + )) + } else { + combo_plot <- plotly::subplot( + dpl, spl, + titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout(scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + )) + } + } else if (!is.null(dim3_to_use) & !is.null(sdimz)) { + if (plot_alignment == "vertical") { + combo_plot <- plotly::subplot( + dpl, spl, + nrows = 2, titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 1), y = c(0, 0.5)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + ), + scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ) + ) + } else { + combo_plot <- plotly::subplot( + dpl, spl, + titleX = TRUE, titleY = TRUE + ) %>% + plotly::layout( + scene = list( + domain = list(x = c(0, 0.5), y = c(0, 1)), + xaxis = list(title = x_title), + yaxis = list(title = y_title), + zaxis = list(title = z_title) + ), + scene2 = list( + xaxis = list(title = "X", nticks = x_ticks), + yaxis = list(title = "Y", nticks = y_ticks), + zaxis = list(title = "Z", nticks = z_ticks), + aspectmode = "manual", + aspectratio = list( + x = ratio[[1]], + y = ratio[[2]], + z = ratio[[3]] + ) + ) + ) + } + } + + show_plot <- ifelse(is.null(show_plot), + readGiottoInstructions(gobject, param = "show_plot"), + show_plot + ) + save_plot <- ifelse(is.null(save_plot), + readGiottoInstructions(gobject, param = "save_plot"), + save_plot + ) + return_plot <- ifelse(is.null(return_plot), + readGiottoInstructions(gobject, param = "return_plot"), + return_plot + ) + + ## print plot + if (show_plot == TRUE) { + print(combo_plot) + } + + ## save plot + if (save_plot == TRUE) { + do.call( + "all_plots_save_function", + c(list( + gobject = gobject, plot_object = combo_plot, + default_save_name = default_save_name + ), save_param) + ) + } + + ## return plot + if (return_plot == TRUE) { + return(combo_plot) + } +} + +#' @describeIn spatDimFeatPlot3D deprecated +#' @param ... additional params to pass +#' @export +spatDimGenePlot3D <- function(...) { + deprecate_warn( + when = "0.2.0", + what = "spatDimGenePlot3D()", + with = "spatDimFeatPlot3D()" + ) + spatDimFeatPlot3D(...) +} diff --git a/R/viz_spatial_network.R b/R/viz_spatial_network.R index acf7530..4a9c8b3 100644 --- a/R/viz_spatial_network.R +++ b/R/viz_spatial_network.R @@ -33,7 +33,8 @@ spatNetwDistributionsDistance <- function( distance <- rank_int <- status <- label <- keep <- NULL ## spatial network - spatial_network <- get_spatialNetwork(gobject, + spatial_network <- getSpatialNetwork( + gobject = gobject, spat_unit = spat_unit, name = spatial_network_name, output = "networkDT" @@ -146,7 +147,8 @@ spatNetwDistributionsKneighbors <- function( ## spatial network # spatial_network = gobject@spatial_network[[spatial_network_name]] - spatial_network <- get_spatialNetwork(gobject, + spatial_network <- getSpatialNetwork( + gobject = gobject, spat_unit = spat_unit, name = spatial_network_name, output = "networkDT" @@ -236,7 +238,8 @@ spatNetwDistributions <- function( ) ## spatial network - spatial_network <- get_spatialNetwork(gobject, + spatial_network <- getSpatialNetwork( + gobject = gobject, spat_unit = spat_unit, name = spatial_network_name, output = "networkDT" diff --git a/man/combine_aes.Rd b/man/combine_aes.Rd new file mode 100644 index 0000000..1669267 --- /dev/null +++ b/man/combine_aes.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_param.R +\name{combine_aes} +\alias{combine_aes} +\title{Combine ggplot2 aesthetics} +\usage{ +combine_aes(..., warn_duplicates = TRUE) +} +\arguments{ +\item{...}{one or more objects of class \code{uneval} +(output from \code{\link[ggplot2:aes]{ggplot2::aes()}})} + +\item{warn_duplicates}{logical. Warn when aes names overlap} +} +\description{ +Utility for combining ggplot2 \code{aes} lists. Uses the last +provided value when aes names overlap. +} +\examples{ +a <- ggplot2::aes(a = a1, b = b1, c = c1) +b <- ggplot2::aes(x = x1, y = y1, a = a2, c = c2) + +# warnings turned off +combine_aes(a, b, warn_duplicates = FALSE) # b values used for a,c +combine_aes(b, a, warn_duplicates = FALSE) # a values used for a,c +} +\seealso{ +Other ggplot2 plotting wrangling functions: +\code{\link{gg_param}()} +} +\concept{ggplot2 plotting wrangling functions} diff --git a/man/create_cluster_dendrogram.Rd b/man/create_cluster_dendrogram.Rd index a44539f..ea4b008 100644 --- a/man/create_cluster_dendrogram.Rd +++ b/man/create_cluster_dendrogram.Rd @@ -65,11 +65,11 @@ g_expression <- head(GiottoClass::getExpression(g, output = "matrix")) g_expression_df <- as.data.frame(as.matrix(g_expression)) g_expression_df$feat_ID <- rownames(g_expression) -g_expression_melt <- reshape2::melt(g_expression_df, id.vars = "feat_ID", -measure.vars = colnames(g_expression), variable.name = "cell_ID", +g_expression_melt <- data.table::melt(g_expression_df, id.vars = "feat_ID", +measure.vars = colnames(g_expression), variable.name = "cell_ID", value.name = "raw_expression") -create_cluster_dendrogram(data.table::as.data.table(g_expression_melt), +create_cluster_dendrogram(data.table::as.data.table(g_expression_melt), var_col = "cell_ID", clus_col = "feat_ID", "raw_expression") } diff --git a/man/dimCellPlot.Rd b/man/dimCellPlot.Rd index f317fa8..3f92616 100644 --- a/man/dimCellPlot.Rd +++ b/man/dimCellPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{dimCellPlot} \alias{dimCellPlot} \alias{dimCellPlot2D} @@ -185,7 +185,8 @@ Description of parameters. For 3D plots see \code{\link{dimPlot3D}} \examples{ g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) dimCellPlot2D( - g, spat_enr_names = "cluster_metagene", + g, + spat_enr_names = "cluster_metagene", cell_annotation_values = as.character(seq(4)) ) diff --git a/man/dimFeatPlot2D.Rd b/man/dimFeatPlot2D.Rd index 935e4d0..f689358 100644 --- a/man/dimFeatPlot2D.Rd +++ b/man/dimFeatPlot2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{dimFeatPlot2D} \alias{dimFeatPlot2D} \title{dimFeatPlot2D} diff --git a/man/dimFeatPlot3D.Rd b/man/dimFeatPlot3D.Rd index e55ee71..22d5cca 100644 --- a/man/dimFeatPlot3D.Rd +++ b/man/dimFeatPlot3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{dimFeatPlot3D} \alias{dimFeatPlot3D} \alias{dimGenePlot3D} diff --git a/man/dimPlot.Rd b/man/dimPlot.Rd index 033cd18..e951b26 100644 --- a/man/dimPlot.Rd +++ b/man/dimPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R, R/vis_spatial_plotly.R \name{dimPlot2D} \alias{dimPlot2D} \alias{dimPlot} diff --git a/man/dot-dimPlot_2d_plotly.Rd b/man/dot-dimPlot_2d_plotly.Rd index 347e3f5..ac40672 100644 --- a/man/dot-dimPlot_2d_plotly.Rd +++ b/man/dot-dimPlot_2d_plotly.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{.dimPlot_2d_plotly} \alias{.dimPlot_2d_plotly} \title{.dimPlot_2d_plotly} diff --git a/man/dot-dimPlot_3d_plotly.Rd b/man/dot-dimPlot_3d_plotly.Rd index 6e28c53..1e1500d 100644 --- a/man/dot-dimPlot_3d_plotly.Rd +++ b/man/dot-dimPlot_3d_plotly.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{.dimPlot_3d_plotly} \alias{.dimPlot_3d_plotly} \title{.dimPlot_3d_plotly} diff --git a/man/dot-spatPlot2D_single.Rd b/man/dot-spatPlot2D_single.Rd index 67cce0c..8381d91 100644 --- a/man/dot-spatPlot2D_single.Rd +++ b/man/dot-spatPlot2D_single.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{.spatPlot2D_single} \alias{.spatPlot2D_single} \title{.spatPlot2D_single} diff --git a/man/dot-spatPlot_2d_plotly.Rd b/man/dot-spatPlot_2d_plotly.Rd index 388a416..2972df5 100644 --- a/man/dot-spatPlot_2d_plotly.Rd +++ b/man/dot-spatPlot_2d_plotly.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{.spatPlot_2d_plotly} \alias{.spatPlot_2d_plotly} \title{.spatPlot_2d_plotly} diff --git a/man/dot-spatPlot_3d_plotly.Rd b/man/dot-spatPlot_3d_plotly.Rd index 43a0ea3..8b366ea 100644 --- a/man/dot-spatPlot_3d_plotly.Rd +++ b/man/dot-spatPlot_3d_plotly.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{.spatPlot_3d_plotly} \alias{.spatPlot_3d_plotly} \title{.spatPlot_3d_plotly} diff --git a/man/dotPlot.Rd b/man/dotPlot.Rd new file mode 100644 index 0000000..6e7989b --- /dev/null +++ b/man/dotPlot.Rd @@ -0,0 +1,173 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/plot_dotplot.R +\name{dotPlot} +\alias{dotPlot} +\title{Create a dotplot} +\usage{ +dotPlot( + gobject, + feats, + cluster_column, + cluster_custom_order = NULL, + dot_size = function(x) mean(x != 0) * 100, + dot_size_threshold = 0, + dot_scale = 6, + dot_color = mean, + dot_color_gradient = NULL, + gradient_midpoint = NULL, + gradient_style = "sequential", + gradient_limits = NULL, + group_by = NULL, + group_by_subset = NULL, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + title = NULL, + show_legend = TRUE, + legend_text = 10, + legend_symbol_size = 2, + background_color = "white", + axis_text = 10, + axis_title = 9, + cow_n_col = NULL, + cow_rel_h = 1, + cow_rel_w = 1, + cow_align = "h", + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "dotPlot" +) +} +\arguments{ +\item{gobject}{giotto object} + +\item{feats}{character vector or named list. Features to use or named lists +of features to use.} + +\item{cluster_column}{character. Clusterings column to use (usually in cell +metadata)} + +\item{cluster_custom_order}{character vector. Specific cluster order to use} + +\item{dot_size, dot_color}{summary function e.g. \code{sum}, \code{mean}, \code{var}, or +other custom function. The default for \code{dot_size} finds the percentage of +cells of a particular cluster that do not have an expression level of 0.} + +\item{dot_size_threshold}{numeric. The minimal value at which a dot is no +longer drawn.} + +\item{dot_scale}{numeric. Controls size of dots} + +\item{dot_color_gradient}{hex codes or palette name. Color gradient to use.} + +\item{gradient_midpoint}{numeric. midpoint for color gradient} + +\item{gradient_style}{either 'divergent' (midpoint is used in color scaling) +or 'sequential' (scaled based on data range)} + +\item{gradient_limits}{numeric vector of length 2. Set minmax value mappings +for color gradient} + +\item{group_by}{character. Create multiple plots based on cell +annotation column} + +\item{group_by_subset}{character. subset the group_by factor column} + +\item{spat_unit}{spatial unit (e.g. "cell")} + +\item{feat_type}{feature type (e.g. "rna", "dna", "protein")} + +\item{expression_values}{character. Expression values to use.} + +\item{title}{character. title for plot} + +\item{show_legend}{logical. show legend} + +\item{legend_text}{size of legend text} + +\item{legend_symbol_size}{size of legend symbols} + +\item{background_color}{color of plot background} + +\item{axis_text}{size of axis text} + +\item{axis_title}{size of axis title} + +\item{cow_n_col}{cowplot param: how many columns} + +\item{cow_rel_h}{cowplot param: relative heights of rows (e.g. c(1,2))} + +\item{cow_rel_w}{cowplot param: relative widths of columns (e.g. c(1,2))} + +\item{cow_align}{cowplot param: how to align} + +\item{theme_param}{list of additional params passed to \code{ggplot2::theme()}} + +\item{show_plot}{logical. show plot} + +\item{return_plot}{logical. return ggplot object} + +\item{save_plot}{logical. save the plot} + +\item{save_param}{list of saving parameters, +see \code{\link{showSaveParameters}}} + +\item{default_save_name}{default save name for saving, don't change, +change save_name in save_param} +} +\description{ +Visualize feature expression statistics applied across +clusters/groupings of cells. The default behavior is dot size scaled by +what percentage of cells within a particular cluster express the feature, +and dot color scaled by mean expression of that feature within the cluster. +} +\examples{ +g <- GiottoData::loadGiottoMini("visium") +library(GiottoClass) +f1 <- head(featIDs(g), 20) +f2 <- tail(featIDs(g), 20) + +dotPlot(g, cluster_column = "leiden_clus", feats = f1) + +# make two plots from two named sets of features +dotPlot(g, + cluster_column = "leiden_clus", + feats = list(set1 = f1, set2 = f2) +) + +# add new cell metadata col that classifies by total expression into +# - 0 (< 900) +# - 1 (> 900 and < 1200) +# - 2 (> 1200) +total_expr <- g$total_expr +g$expr_class <- findInterval(total_expr, c(900, 1200)) + +# Create a dotplot while splitting the values based on the above total +# expression classifications. +dotPlot(g, + cluster_column = "leiden_clus", + feats = list(set1 = f1, set2 = f2), + group_by = "expr_class" +) + +# Same as before, but focusing on classifications 0 and 2 +dotPlot(g, + cluster_column = "leiden_clus", + feats = list(set1 = f1, set2 = f2), + group_by = "expr_class", + group_by_subset = c(0, 2) +) + +# example with an alternate function used for `dot_color` and a different +# color gradient +dotPlot(g, + cluster_column = "leiden_clus", + feats = f1, + dot_size = mean, + dot_color = var, + dot_color_gradient = c("#EEEEFF", "#333377") +) +} diff --git a/man/gg_annotation_raster.Rd b/man/gg_annotation_raster.Rd index fdff3c4..d0cf44e 100644 --- a/man/gg_annotation_raster.Rd +++ b/man/gg_annotation_raster.Rd @@ -44,3 +44,9 @@ No ... params are implemented for \code{giottoImage}. \cr ... params for \code{giottoLargeImage} passes to automated resampling params see \code{?auto_image_resample} for details } +\examples{ +gimg <- GiottoData::loadSubObjectMini("giottoLargeImage") +gg <- ggplot2::ggplot() +out <- GiottoVisuals::gg_annotation_raster(gg, gimg) +print(out) +} diff --git a/man/gg_param.Rd b/man/gg_param.Rd new file mode 100644 index 0000000..53805e1 --- /dev/null +++ b/man/gg_param.Rd @@ -0,0 +1,90 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_param.R +\name{gg_param} +\alias{gg_param} +\title{Generate ggplot params} +\usage{ +gg_param(..., data = NULL, warn_duplicates = TRUE) +} +\arguments{ +\item{...}{One or more named plotting params. Entries should either be +individually named params or lists of named parameters / \code{aes()} generated +aesthetic lists.} + +\item{data}{data to plot} + +\item{warn_duplicates}{logical. Warn when aes names provided through ... +overlap.} +} +\description{ +Based on a set of named inputs, organize them into either +ggplot2 aesthetic mappings or toplevel params based on whether they are or +are not of the classes \code{quosure}, \code{name}, or a language object. The \code{data} +param may be applied here or added afterwards\cr + +This is mainly a convenience for developers. Users should still use \code{aes()} +and \code{quo()} for their environment-enclosing characteristics. Inside of +packages however, the proper environments for code to run is already +available, or can be already processed before passing to plotting. +} +\examples{ +# data to use +library(ggplot2) +d <- data.frame( + xvals = seq(10), + yvals = seq(10), + values = seq(0.1, 1, by = 0.1), + size_col = seq(5, 1, length.out = 10) +) + +# ----- single step ----- # +p_single <- gg_param( + data = d, + x = as.name("xvals"), # aes + fill = "green", # toplevel + aes( + size = size_col, # aes + y = yvals # aes + ), + show.legend = TRUE, # toplevel + list( + shape = 21, # toplevel + alpha = as.name("values") # aes + ) +) + +ggplot() + do.call(geom_point, p_single) + +# ----- multistep appending ----- # + +p0 <- list() + +# add aesthetics directly through assignment +p0$x <- as.name("xvals") +p0$show.legend <- TRUE + +# add aesthetics through `c()` list concatenation +# list objects are unnamed and thus are best added this way +p0 <- c(p0, list(fill = "green")) +p0 <- c(p0, aes(size = size_col, y = yvals)) +p0 <- c(p0, list(shape = 21, alpha = as.name("values"))) + +# add data +p0$data <- d + +# `quote = TRUE` must be used when using `do.call()` for this +p_multi <- do.call(gg_param, p0, quote = TRUE) +ggplot() + do.call(geom_point, p_multi) + +# ----- nested appending ----- # +p_nest <- gg_param(p_single, p_multi) +p_nest_sub <- gg_param(p_single, p_multi, data = d[1:5,]) # change the data to use + +ggplot() + do.call(geom_point, p_nest) +ggplot() + do.call(geom_point, p_nest_sub) +} +\seealso{ +Other ggplot2 plotting wrangling functions: +\code{\link{combine_aes}()} +} +\concept{ggplot2 plotting wrangling functions} diff --git a/man/ggplot_themes.Rd b/man/ggplot_themes.Rd new file mode 100644 index 0000000..bcd80bc --- /dev/null +++ b/man/ggplot_themes.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/gg_settings.R +\docType{data} +\name{ggplot_themes} +\alias{ggplot_themes} +\alias{theme_dark2} +\title{ggplot2 plotting themes} +\format{ +An object of class \code{theme} (inherits from \code{gg}) of length 10. +} +\usage{ +theme_dark2 +} +\description{ +ggplot2 themes. It can be applied through the \code{theme_param} arg. +} +\keyword{datasets} diff --git a/man/plotPCA.Rd b/man/plotPCA.Rd index 0d54342..9830761 100644 --- a/man/plotPCA.Rd +++ b/man/plotPCA.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{plotPCA} \alias{plotPCA} \title{plotPCA} diff --git a/man/plotPCA_2D.Rd b/man/plotPCA_2D.Rd index ef0a6f2..82c89ca 100644 --- a/man/plotPCA_2D.Rd +++ b/man/plotPCA_2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{plotPCA_2D} \alias{plotPCA_2D} \title{plotPCA_2D} diff --git a/man/plotPCA_3D.Rd b/man/plotPCA_3D.Rd index 37c481f..03274cd 100644 --- a/man/plotPCA_3D.Rd +++ b/man/plotPCA_3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{plotPCA_3D} \alias{plotPCA_3D} \title{plotPCA_3D} diff --git a/man/plotTSNE.Rd b/man/plotTSNE.Rd index ea5ec02..6b8c5ab 100644 --- a/man/plotTSNE.Rd +++ b/man/plotTSNE.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{plotTSNE} \alias{plotTSNE} \title{plotTSNE} diff --git a/man/plotTSNE_2D.Rd b/man/plotTSNE_2D.Rd index 58ca03e..69f36e6 100644 --- a/man/plotTSNE_2D.Rd +++ b/man/plotTSNE_2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{plotTSNE_2D} \alias{plotTSNE_2D} \title{plotTSNE_2D} diff --git a/man/plotTSNE_3D.Rd b/man/plotTSNE_3D.Rd index 7dd9c2c..99a3f47 100644 --- a/man/plotTSNE_3D.Rd +++ b/man/plotTSNE_3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{plotTSNE_3D} \alias{plotTSNE_3D} \title{plotTSNE_3D} diff --git a/man/plotUMAP.Rd b/man/plotUMAP.Rd index 50a4fb8..728160f 100644 --- a/man/plotUMAP.Rd +++ b/man/plotUMAP.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{plotUMAP} \alias{plotUMAP} \title{plotUMAP} diff --git a/man/plotUMAP_2D.Rd b/man/plotUMAP_2D.Rd index e1150c3..ae1f4a1 100644 --- a/man/plotUMAP_2D.Rd +++ b/man/plotUMAP_2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{plotUMAP_2D} \alias{plotUMAP_2D} \title{plotUMAP_2D} diff --git a/man/plotUMAP_3D.Rd b/man/plotUMAP_3D.Rd index 9d93fca..bffacec 100644 --- a/man/plotUMAP_3D.Rd +++ b/man/plotUMAP_3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{plotUMAP_3D} \alias{plotUMAP_3D} \title{plotUMAP_3D} diff --git a/man/plot_image_params.Rd b/man/plot_image_params.Rd index 9cd04c2..50bd710 100644 --- a/man/plot_image_params.Rd +++ b/man/plot_image_params.Rd @@ -10,8 +10,7 @@ \item{image_name}{name of a giotto image or multiple images with group_by} -\item{largeImage_name}{name of a giottoLargeImage or multiple images -with group_by} +\item{largeImage_name}{deprecated. Use \code{image_name}} } \value{ ggplot diff --git a/man/plot_save.Rd b/man/plot_save.Rd index 625c128..7203787 100644 --- a/man/plot_save.Rd +++ b/man/plot_save.Rd @@ -2,12 +2,11 @@ % Please edit documentation in R/aux_save.R \name{plot_save} \alias{plot_save} -\alias{.ggplot_save_function} -\alias{.general_save_function} \alias{all_plots_save_function} +\alias{gpsparam} \title{Plot saving} \usage{ -.ggplot_save_function( +all_plots_save_function( gobject, plot_object, save_dir = NULL, @@ -26,45 +25,23 @@ dpi = NULL, limitsize = TRUE, plot_count = NULL, + GPSPARAM = NULL, ... ) -.general_save_function( - gobject, - plot_object, - save_dir = NULL, - save_folder = NULL, - save_name = NULL, - default_save_name = "giotto_plot", - save_format = c("png", "tiff", "pdf", "svg"), - show_saved_plot = FALSE, - base_width = NULL, - base_height = NULL, - base_aspect_ratio = NULL, - units = NULL, - dpi = NULL, - plot_count = NULL, - ... -) - -all_plots_save_function( - gobject, - plot_object, +gpsparam( + instructions, + type = c("gg", "plotly", "general"), save_dir = NULL, save_folder = NULL, save_name = NULL, default_save_name = "giotto_plot", save_format = NULL, - show_saved_plot = FALSE, - ncol = 1, - nrow = 1, - scale = 1, + dpi = NULL, base_width = NULL, base_height = NULL, base_aspect_ratio = NULL, units = NULL, - dpi = NULL, - limitsize = TRUE, plot_count = NULL, ... ) @@ -109,25 +86,33 @@ pixels.} \item{plot_count}{manually set the plot count that is appended to a default_save_name} -\item{\dots}{additional parameters to pass downstream save functions} +\item{GPSPARAM}{\code{giotto_plot_save_param} object. If provided, will be +used instead of most other general save params. (save_dir, save_folder, +save_name, default_save_name, save_format, base_width, base_height, +base_aspect_ratio, units, dpi, plot_count)} + +\item{\dots}{additional parameters to pass downstream save functions. +\code{\link[cowplot:save_plot]{cowplot::save_plot()}} is used for \code{ggplot2} plots. grDevices png, tiff +svg, pdf is used for base and general saving} + +\item{instructions}{\code{giotto} or \code{giottoInstructions} object} + +\item{type}{\code{character}. One of \verb{"gg"', '"plotly"', '"general"} to designate +which type of plot to save. This affects which types of outputs are +possible.} } \value{ -a plot file +\code{all_plots_save_function} returns a plot file. \code{gpsparam} returns +a \code{giotto_plot_save_param} object } \description{ -Functions to automatically save plots to directory of interest +Functions to save plots to directory of interest. +\code{all_plots_save_function()} is used for plot saving operations. \code{gpsparam()} +is used to generate a set of save parameters and filepath based on available +parameter and \code{giottoInstructions} values. } -\section{Functions}{ -\itemize{ -\item \code{.ggplot_save_function()}: (internal) ggplot saving. ... -passes to cowplot::save_plot - -\item \code{.general_save_function()}: (internal) base and general saving. -... passes to grDevices png, tiff, pdf, svg - -}} \examples{ -g <- GiottoClass::createGiottoInstructions(save_plot = TRUE) +g <- GiottoData::loadGiottoMini("vis") df <- data.frame(x = rnorm(5), y = rnorm(5)) g_plot <- ggplot2::ggplot(df, ggplot2::aes(x,y)) + ggplot2::geom_point() all_plots_save_function(g, g_plot) @@ -140,4 +125,3 @@ all_plots_save_function(g, g_plot) \code{\link[grDevices]{pdf}} \code{\link[grDevices]{svg}} } -\keyword{internal} diff --git a/man/plotly_axis_scale_3D.Rd b/man/plotly_axis_scale_3D.Rd index a4eb77d..7edfd1e 100644 --- a/man/plotly_axis_scale_3D.Rd +++ b/man/plotly_axis_scale_3D.Rd @@ -33,7 +33,7 @@ edges in spatial grid as data.table() adjust the axis scale in 3D plotly plot } \examples{ -my_cell_locations <- data.frame(x = sample(10), y = sample(10), +my_cell_locations <- data.frame(x = sample(10), y = sample(10), z = sample(10)) plotly_axis_scale_3D(my_cell_locations) diff --git a/man/reexports.Rd b/man/reexports.Rd index 1096a60..9136421 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -8,6 +8,7 @@ \alias{getDistinctColors} \alias{geom_text_repel} \alias{geom_label_repel} +\alias{plot_grid} \title{Objects exported from other packages} \value{ a function to create continous colors @@ -24,6 +25,8 @@ below to see their documentation. \describe{ \item{colorRamp2}{\code{\link[colorRamp2]{colorRamp2}}} + \item{cowplot}{\code{\link[cowplot]{plot_grid}}} + \item{ggrepel}{\code{\link[ggrepel:geom_text_repel]{geom_label_repel}}, \code{\link[ggrepel]{geom_text_repel}}} \item{GiottoUtils}{\code{\link[GiottoUtils]{getDistinctColors}}, \code{\link[GiottoUtils]{getRainbowColors}}} diff --git a/man/spatCellPlot.Rd b/man/spatCellPlot.Rd index 1808ef3..9b4cb49 100644 --- a/man/spatCellPlot.Rd +++ b/man/spatCellPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatCellPlot} \alias{spatCellPlot} \alias{spatCellPlot2D} @@ -83,8 +83,7 @@ spatCellPlot(...) \item{image_name}{name of a giotto image or multiple images with group_by} -\item{largeImage_name}{name of a giottoLargeImage or multiple images -with group_by} +\item{largeImage_name}{deprecated. Use \code{image_name}} \item{sdimx}{x-axis dimension name (default = 'sdimx')} diff --git a/man/spatDeconvPlot.Rd b/man/spatDeconvPlot.Rd index 118084b..54762c3 100644 --- a/man/spatDeconvPlot.Rd +++ b/man/spatDeconvPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatDeconvPlot} \alias{spatDeconvPlot} \title{spatDeconvPlot} diff --git a/man/spatDimCellPlot.Rd b/man/spatDimCellPlot.Rd index ac56647..24d9359 100644 --- a/man/spatDimCellPlot.Rd +++ b/man/spatDimCellPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatDimCellPlot} \alias{spatDimCellPlot} \title{spatDimCellPlot} @@ -71,8 +71,7 @@ use or vector of colors to use (minimum of 2).} \item{\code{show_image}}{show a tissue background image} \item{\code{gimage}}{a giotto image} \item{\code{image_name}}{name of a giotto image or multiple images with group_by} - \item{\code{largeImage_name}}{name of a giottoLargeImage or multiple images -with group_by} + \item{\code{largeImage_name}}{deprecated. Use \code{image_name}} \item{\code{spat_enr_names}}{character. names of spatial enrichment results to include} \item{\code{dim_reduction_to_use}}{character. dimension reduction to use} diff --git a/man/spatDimCellPlot2D.Rd b/man/spatDimCellPlot2D.Rd index 4ed5957..c529578 100644 --- a/man/spatDimCellPlot2D.Rd +++ b/man/spatDimCellPlot2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatDimCellPlot2D} \alias{spatDimCellPlot2D} \title{spatDimCellPlot2D} @@ -102,8 +102,7 @@ spatDimCellPlot2D( \item{image_name}{name of a giotto image or multiple images with group_by} -\item{largeImage_name}{name of a giottoLargeImage or multiple images -with group_by} +\item{largeImage_name}{deprecated. Use \code{image_name}} \item{plot_alignment}{direction to align plot} diff --git a/man/spatDimFeatPlot2D.Rd b/man/spatDimFeatPlot2D.Rd index a4f4288..116df28 100644 --- a/man/spatDimFeatPlot2D.Rd +++ b/man/spatDimFeatPlot2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatDimFeatPlot2D} \alias{spatDimFeatPlot2D} \title{spatDimFeatPlot2D} @@ -82,8 +82,7 @@ spatDimFeatPlot2D( \item{image_name}{name of a giotto image or multiple images with group_by} -\item{largeImage_name}{name of a giottoLargeImage or multiple images -with group_by} +\item{largeImage_name}{deprecated. Use \code{image_name}} \item{expression_values}{feat expression values to use} diff --git a/man/spatDimFeatPlot3D.Rd b/man/spatDimFeatPlot3D.Rd index 47d157a..edbe1a7 100644 --- a/man/spatDimFeatPlot3D.Rd +++ b/man/spatDimFeatPlot3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{spatDimFeatPlot3D} \alias{spatDimFeatPlot3D} \alias{spatDimGenePlot3D} diff --git a/man/spatDimPlot.Rd b/man/spatDimPlot.Rd index 5079ceb..405d5aa 100644 --- a/man/spatDimPlot.Rd +++ b/man/spatDimPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatDimPlot} \alias{spatDimPlot} \alias{spatDimPlot2D} diff --git a/man/spatDimPlot3D.Rd b/man/spatDimPlot3D.Rd index f7cc371..6382052 100644 --- a/man/spatDimPlot3D.Rd +++ b/man/spatDimPlot3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{spatDimPlot3D} \alias{spatDimPlot3D} \title{spatDimPlot3D} diff --git a/man/spatFeatPlot2D.Rd b/man/spatFeatPlot2D.Rd index 44f132a..e76337c 100644 --- a/man/spatFeatPlot2D.Rd +++ b/man/spatFeatPlot2D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatFeatPlot2D} \alias{spatFeatPlot2D} \title{Plot data in physical space 2D} diff --git a/man/spatFeatPlot2D_single.Rd b/man/spatFeatPlot2D_single.Rd index 328c1c5..f0a4416 100644 --- a/man/spatFeatPlot2D_single.Rd +++ b/man/spatFeatPlot2D_single.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R \name{spatFeatPlot2D_single} \alias{spatFeatPlot2D_single} \title{spatFeatPlot2D_single} diff --git a/man/spatFeatPlot3D.Rd b/man/spatFeatPlot3D.Rd index f20f1da..90f9091 100644 --- a/man/spatFeatPlot3D.Rd +++ b/man/spatFeatPlot3D.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_plotly.R \name{spatFeatPlot3D} \alias{spatFeatPlot3D} \alias{spatGenePlot3D} diff --git a/man/spatInSituPlotPoints.Rd b/man/spatInSituPlotPoints.Rd index 0fcd97e..3fd8c8a 100644 --- a/man/spatInSituPlotPoints.Rd +++ b/man/spatInSituPlotPoints.Rd @@ -29,7 +29,7 @@ spatInSituPlotPoints( show_polygon = TRUE, use_overlap = TRUE, polygon_feat_type = "cell", - polygon_color = "black", + polygon_color = "grey", polygon_bg_color = "black", polygon_fill = NULL, polygon_fill_gradient = NULL, diff --git a/man/spatPlot.Rd b/man/spatPlot.Rd index a165bc2..2f80719 100644 --- a/man/spatPlot.Rd +++ b/man/spatPlot.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/vis_spatial.R +% Please edit documentation in R/vis_spatial_gg.R, R/vis_spatial_plotly.R \name{spatPlot2D} \alias{spatPlot2D} \alias{spatPlot} @@ -129,8 +129,7 @@ spatPlot3D( \item{image_name}{name of a giotto image or multiple images with group_by} -\item{largeImage_name}{name of a giottoLargeImage or multiple images -with group_by} +\item{largeImage_name}{deprecated. Use \code{image_name}} \item{group_by}{character. Create multiple plots based on cell annotation column} diff --git a/tests/testthat/test_save.R b/tests/testthat/test_save.R index a974ba1..8d6a7be 100644 --- a/tests/testthat/test_save.R +++ b/tests/testthat/test_save.R @@ -1,3 +1,109 @@ + +# showSaveParameters #### + test_that("No errors when running showSaveParameters", { expect_no_error(showSaveParameters()) }) + +# plot saving and formats #### + +# dummy save directory +results_folder <- file.path( + getwd(), "testout", format(Sys.Date(), "%y%m%d") +) + +# load in dummy gobject +g <- GiottoData::loadGiottoMini("vis", verbose = FALSE) +instructions(g, "save_dir") <- results_folder + +# create dummy plot +df <- data.frame(x = rnorm(5), y = rnorm(5), z = rnorm(5)) +g_plot <- ggplot2::ggplot(df, ggplot2::aes(x,y)) + ggplot2::geom_point() +b_plot <- plot(df$x, df$y) +p_plot <- plotly::plot_ly(df, x = ~x, y = ~y, z = ~z) + + +test_that("gg save works - png", { + all_plots_save_function(g, g_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "png")) + ) +}) + +test_that("gg save works - tiff", { + instructions(g, "plot_format") <- "tiff" + all_plots_save_function(g, g_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "tiff")) + ) +}) + +test_that("gg save works - pdf", { + instructions(g, "plot_format") <- "pdf" + all_plots_save_function(g, g_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "pdf")) + ) +}) + +test_that("gg save works - jpg", { + instructions(g, "plot_format") <- "jpg" + all_plots_save_function(g, g_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "jpg")) + ) +}) + +test_that("gg save works - svg", { + instructions(g, "plot_format") <- "svg" + all_plots_save_function(g, g_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "svg")) + ) +}) + + +test_that("plotly save works - html", { + # should find html default by itself + all_plots_save_function(g, p_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "html")) + ) +}) + + +# plot saving and dpi #### +test_that("gg save works - dpi 10", { + instructions(g, "dpi") <- 10 + all_plots_save_function(g, g_plot) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "png")) + ) +}) + +test_that("gg save works - dpi 300 override", { + instructions(g, "dpi") <- 10 + all_plots_save_function(g, g_plot, dpi = 300) + img_id <- getOption("giotto.plot_count") - 1L + checkmate::expect_file_exists( + file.path(results_folder, + sprintf("%d-giotto_plot.%s", img_id, "png")) + ) +}) + + +