diff --git a/NAMESPACE b/NAMESPACE index 13d0472..ddbbf63 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,6 +15,8 @@ export(dimPlot) export(dimPlot2D) export(dimPlot3D) export(expand_feature_info) +export(geom_label_repel) +export(geom_text_repel) export(getColors) export(getDistinctColors) export(getRainbowColors) @@ -107,6 +109,8 @@ importFrom(GiottoUtils,getRainbowColors) importFrom(colorRamp2,colorRamp2) importFrom(data.table,dcast) importFrom(data.table,dcast.data.table) +importFrom(ggrepel,geom_label_repel) +importFrom(ggrepel,geom_text_repel) importFrom(igraph,as_data_frame) importFrom(methods,new) importFrom(methods,setGeneric) diff --git a/NEWS.md b/NEWS.md index 87e8b87..d1076ef 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,12 @@ # GiottoVisuals 0.2.4 +## enhancements +- `giottoLargeImage` `max_window` and `colors` slot info is now followed during ggplot plotting +- `giottoAffineImage` compatibility for giotto ggplot2 plotting functions + +## new +- `geom_text_repel()` and `geom_label_repel()` from `ggplot2` are now re-exported # GiottoVisuals 0.2.3 (2024/05/28) diff --git a/R/gg_annotation_raster.R b/R/gg_annotation_raster.R index 0e0d318..6766327 100644 --- a/R/gg_annotation_raster.R +++ b/R/gg_annotation_raster.R @@ -62,68 +62,39 @@ setMethod( "gg_annotation_raster", signature(ggobj = "gg", gimage = "giottoLargeImage"), function(ggobj, gimage, ext = NULL, ...) { + # resample from extent + if (is.null(ext)) ext <- ext(gimage) + gimage <- .auto_resample_gimage( + img = gimage, + plot_ext = ext, + crop_ratio_fun = .img_to_crop_ratio_gimage, + sample_fun = .sample_gimage, + ... + ) - # apply plot ext - if (!is.null(ext)) { - gimage <- .auto_resample_gimage( - img = gimage, - plot_ext = ext, - ... - ) - } - - # get plotting minmax - extent <- terra::ext(gimage@raster_object)[seq_len(4)] - xmin <- extent[["xmin"]] - xmax <- extent[["xmax"]] - ymin <- extent[["ymin"]] - ymax <- extent[["ymax"]] - - # convert raster object into array with 3 channels - img_array <- terra::as.array(gimage@raster_object) - - # TODO: check if required, fixes NaN values - # replacing NA's by zero or another value directly in raster object? - # raster[is.na(raster[])] <- 0 - if (is.nan(max(img_array[, , 1]))) { - img_array[, , 1][is.nan(img_array[, , 1])] <- max(img_array[, , 1], - na.rm = TRUE - ) - } - - if (dim(img_array)[3] > 1) { - if (is.nan(max(img_array[, , 2]))) { - img_array[, , 2][is.nan(img_array[, , 2])] <- - max(img_array[, , 2], na.rm = TRUE) - } - } - - if (dim(img_array)[3] > 2) { - if (is.nan(max(img_array[, , 3]))) { - img_array[, , 3][is.nan(img_array[, , 3])] <- - max(img_array[, , 3], na.rm = TRUE) - } - } - - img_array <- img_array / max(img_array, na.rm = TRUE) - if (dim(img_array)[3] == 1) { - img_array_RGB <- array(NA, dim = c(dim(img_array)[seq_len(2)], 3)) - img_array_RGB[, , seq_len(3)] <- img_array - } else { - img_array_RGB <- img_array - } + ggobj <- .gg_append_image(ggobj = ggobj, gimage = gimage) - # handle NA values - img_array_RGB[is.na(img_array_RGB)] <- 0 + return(ggobj) + } +) - # append to ggobj - ggobj <- ggobj + annotation_raster( - img_array_RGB, - xmin = xmin, xmax = xmax, - ymin = ymin, ymax = ymax +#' @rdname gg_annotation_raster +setMethod( + "gg_annotation_raster", + signature(ggobj = "gg", gimage = "giottoAffineImage"), + function(ggobj, gimage, ext, ...) { + # resample from extent + if (is.null(ext)) ext <- ext(gimage) + gimage <- .auto_resample_gimage( + img = gimage, + plot_ext = ext, + crop_ratio_fun = .img_to_crop_ratio_gaffimage, + sample_fun = .sample_gaffimage, + ... ) - # TODO geom_raster to accommodate single-channel + ggobj <- .gg_append_image(ggobj = ggobj, gimage = gimage) + return(ggobj) } ) @@ -131,8 +102,6 @@ setMethod( - - # Internals #### # returns the spatial extent needed for the plot @@ -202,7 +171,7 @@ setMethod( #' determines if this switching behavior happens. #' When set to \code{FALSE}, only method A is used. #' @param img giotto image to plot -#' @param plot_ext extent of plot (required) +#' @param plot_ext extent of plot (defaults to the image extent) #' @param img_border if not 0 or FALSE, expand plot_ext by this percentage on #' each side before applying crop on image. See details #' @param flex_resample logical. Default = TRUE. Forces usage of method A when @@ -236,6 +205,8 @@ setMethod( img, plot_ext = NULL, img_border = 0.125, + crop_ratio_fun = .img_to_crop_ratio_gimage, + sample_fun = .sample_gimage, flex_resample = TRUE, max_sample = getOption("giotto.plot_img_max_sample", 5e5), max_crop = getOption("giotto.plot_img_max_crop", 1e8), @@ -244,16 +215,16 @@ setMethod( ) ) { - img_ext <- terra::ext(img) - if (is.null(plot_ext)) crop_ext <- img_ext # default + # 1. determine source image and cropping extents + if (is.null(plot_ext)) crop_ext <- ext(img) # default to img extent else crop_ext <- ext(plot_ext) bound_poly <- as.polygons(crop_ext) - # override max_crop if needed + # 1.1. override max_crop if needed if (max_sample > max_crop) max_crop <- max_sample - # apply img border - # - cropping with extent larger than the image extent works + # 1.2. apply img border expansion + # - note: cropping with extent larger than the image extent is supported if (img_border > 0) { crop_ext <- bound_poly %>% @@ -264,35 +235,30 @@ setMethod( crop_ext <- ext(crop(bound_poly, crop_ext)) } - # determine ratio of crop vs original + # 2. determine cropping area original_dims <- dim(img)[c(2L, 1L)] # x, y ordering - ratios <- range(crop_ext) / range(img_ext) # x, y ordering + ratios <- crop_ratio_fun(img = img, crop_ext = crop_ext) # x, y ordering crop_dims <- original_dims * ratios crop_area_px <- prod(crop_dims) + # 3. perform flexible resample/crop based on cropping area if (!isTRUE(flex_resample) || crop_area_px <= max_crop) { # [METHOD A]: # 1. Crop if needed # 2. resample to final image if (!isTRUE(flex_resample) && crop_area_px > max_crop) { - warning("Plotting large regions with flex_resample == FALSE will - increase time and may require scratch space.") + warning( + "Plotting large regions with flex_resample == FALSE will\n ", + "increase time and may require scratch space." + ) } vmsg(.is_debug = TRUE, sprintf("img auto_res: [A] | area: %f | max: %f", crop_area_px, max_crop)) - crop_img <- terra::crop( - x = img@raster_object, - y = crop_ext - ) - img@raster_object <- terra::spatSample( - crop_img, - size = max_sample, - method = "regular", - as.raster = TRUE - ) + crop_img <- terra::crop(img, crop_ext) + res <- sample_fun(crop_img, size = max_sample) } else { # [METHOD B]: # 1. Oversample @@ -308,18 +274,141 @@ setMethod( sprintf("img auto_res: [B] | scalef: %f | max_scale: %f", scalef, max_resample_scale)) - oversample_img <- terra::spatSample( - img@raster_object, - size = round(max_sample * scalef), - method = "regular", - as.raster = TRUE - ) - img@raster_object <- terra::crop( - x = oversample_img, - y = crop_ext - ) + oversample_img <- sample_fun(img, size = round(max_sample * scalef)) + res <- terra::crop(oversample_img, crop_ext) + } + return(res) +} + + + + +# determine ratio of crop vs full image extent +.img_to_crop_ratio_gimage <- function(img, crop_ext) { + img_ext <- ext(img) + ratio <- range(crop_ext) / range(img_ext) + # crops larger than the image are possible, but meaningless for this + # calculate. so the ratios are capped at 1. + ratio[ratio > 1] <- 1 + return(ratio) +} + +.img_to_crop_ratio_gaffimage <- function(img, crop_ext) { + # Do not use the ext() method for giottoAffineImage + # Instead use the mapping applied to the underlying SpatRaster. + # For giottoAffineImage, these two values are usually different. + img_ext <- ext(img@raster_object) + # find the extent needed in the source (untransformed) image + crop_bound <- terra::as.polygons(crop_ext) + crop_bound$id <- "bound" # affine() requires ID values + crop_ext <- ext(affine(crop_bound, img@affine, inv = TRUE)) + ratio <- range(crop_ext) / range(img_ext) + # crops larger than the image are possible, but meaningless for this + # calculate. so the ratios are capped at 1. + ratio[ratio > 1] <- 1 + return(ratio) +} + + + + +# pull sampled values from original image into target spatial mapping +# should return a giottoLargeImage +.sample_gimage <- function(x, size) { + x@raster_object <- terra::spatSample( + x = x@raster_object, + size = size, + method = "regular", + as.raster = TRUE + ) + return(x) +} + +.sample_gaffimage <- function(x, size) { + res <- x@funs$realize_magick(size = size) + return(res) +} + + + + +# make an image array compatible with ggplot::annotation_raster() +# maxval is the cutoff after which everything is max intensity +# returns: raster +.gg_imgarray_2_raster <- function(x, maxval = NULL, col = NULL) { + nlyr <- dim(x)[3L] # number of channels/layers + if (is.na(nlyr)) nlyr <- 1L + # NOTE: 4 layers allowed (rgba), but may conflict with actual 4 info + # layer cases which SHOULD be converted to 3 layer + # + # more than 4 layers -> directly ignore layers past the 3rd + if (nlyr > 4L) { + nlyr <- 3L + x <- x[, , seq_len(3)] + } + + # handle NaN values -- set as max value of that layer + # these may arise due to save artefacting when values are larger than + # expected + for (lyr in seq_len(nlyr)) { + if (is.nan(max(x[, , lyr]))) { + x[, , lyr][is.nan(x[, , lyr])] <- + max(x[, , lyr], na.rm = TRUE) + } } - return(img) + + # handle NA values -- set as 0 + x[is.na(x)] <- 0 + + if (nlyr == 1L) { + # SINGLE CHANNEL # + # max window cutoff + if (!is.null(maxval)) x[x > maxval] <- maxval + # colorize + if (is.null(col)) { + col <- getMonochromeColors("white", n = 256) + } + r <- .colorize_single_channel_raster(x, col = col) + } else { + # RGB EXPECTED # + # convert to range 0:1 (needed for as.raster()) + x <- scales::rescale(x, to = c(0, 1)) + r <- as.raster(x) + } + + return(r) } + + +# `x` is array to use +# `col` is character vector of colors to use +.colorize_single_channel_raster <- function(x, col) { + if (!is.na(dim(x)[3L]))x <- x[,, 1L] # convert to matrix + r <- range(x, na.rm = TRUE) + x <- (x - r[1])/(r[2] - r[1]) + x <- round(x * (length(col) - 1) + 1) + x[] <- col[x] + as.raster(x) +} + +# append a giotto image object containing a SpatRaster that has already been +# resampled/pulled into memory. Output is a `gg` object +.gg_append_image <- function(ggobj, gimage) { + # convert gimage to a raster + r <- terra::as.array(gimage@raster_object) %>% + .gg_imgarray_2_raster( + maxval = gimage@max_window, + col = gimage@colors + ) + + # append to ggobj + extent <- ext(gimage)[seq_len(4L)] + ggobj <- ggobj + annotation_raster(r, + xmin = extent[["xmin"]], xmax = extent[["xmax"]], + ymin = extent[["ymin"]], ymax = extent[["ymax"]] + ) + + return(ggobj) +} diff --git a/R/gg_info_layers.R b/R/gg_info_layers.R index 63ae4c7..b7f1b0e 100644 --- a/R/gg_info_layers.R +++ b/R/gg_info_layers.R @@ -1412,10 +1412,7 @@ plot_spat_image_layer_ggplot <- function( ... ) - bounds_dt <- data.table::data.table( - sdimx = e[][c(1, 2)], - sdimy = e[][c(3, 4)] - ) + bounds_dt <- .ext_to_dummy_df(e) # Assign region to plot gg_obj <- gg_obj + geom_blank(data = bounds_dt, aes(sdimx, sdimy)) @@ -1436,7 +1433,15 @@ plot_spat_image_layer_ggplot <- function( return(gg_obj) } - +# internal to convert a SpatExtent into a data.frame with x and y values that +# ggplot2 can use to determine bounds of placement +.ext_to_dummy_df <- function(x) { + data.frame( + sdimx = x[][c(1, 2)], + sdimy = x[][c(3, 4)], + row.names = NULL + ) +} diff --git a/R/suite_reexports.R b/R/suite_reexports.R index 92d685d..b8cef91 100644 --- a/R/suite_reexports.R +++ b/R/suite_reexports.R @@ -2,3 +2,8 @@ GiottoUtils::getRainbowColors #' @export GiottoUtils::getDistinctColors + +#' @export +ggrepel::geom_text_repel +#' @export +ggrepel::geom_label_repel diff --git a/R/vis_spatial.R b/R/vis_spatial.R index c2c1a78..4df1d1a 100644 --- a/R/vis_spatial.R +++ b/R/vis_spatial.R @@ -774,7 +774,7 @@ spatPlot2D <- function( #' #' #' # load another dataset with 3D data -#' starmap <- GiottoData::loadGiottoData("starmap", verbose = FALSE) +#' starmap <- GiottoData::loadGiottoMini("starmap", verbose = FALSE) #' #' # default is to rescale plot as a 3D cube #' spatPlot3D(starmap, cell_color = "leiden_clus") @@ -7514,40 +7514,41 @@ spatGenePlot3D <- function(...) { #' @returns plotly #' @examples #' g <- GiottoData::loadGiottoMini("starmap") -#' dimFeatPlot3D(g, genes = "Slc17a7") -#' +#' +#' 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") { +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, @@ -7562,7 +7563,7 @@ dimFeatPlot3D <- function(gobject, ## select genes ## selected_genes <- genes values <- match.arg(expression_values, c("normalized", "scaled", "custom")) - expr_values <- get_expression_values( + expr_values <- getExpression( gobject = gobject, spat_unit = spat_unit, feat_type = feat_type, @@ -7597,11 +7598,11 @@ dimFeatPlot3D <- function(gobject, ## dimension reduction ## - dim_dfr <- get_dimReduction(gobject, - reduction = "cells", - reduction_method = dim_reduction_to_use, - name = dim_reduction_name, - output = "data.table" + 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) @@ -7620,12 +7621,12 @@ dimFeatPlot3D <- function(gobject, # create input for network if (show_NN_network == TRUE) { # nn_network - selected_nn_network <- get_NearestNetwork( + selected_nn_network <- getNearestNetwork( gobject = gobject, feat_type = feat_type, spat_unit = spat_unit, - nn_network_to_use = nn_network_to_use, - network_name = network_name, + nn_type = nn_network_to_use, + name = network_name, output = "igraph" ) network_DT <- data.table::as.data.table(igraph::as_data_frame( diff --git a/R/vis_spatial_in_situ.R b/R/vis_spatial_in_situ.R index 8187a52..640e9b8 100644 --- a/R/vis_spatial_in_situ.R +++ b/R/vis_spatial_in_situ.R @@ -18,6 +18,8 @@ #' @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 ylim limits of y-scale (min/max vector) #' @param point_size size of the points #' @param stroke stroke to apply to feature points #' @param expand_counts expand feature coordinate counts (see details) @@ -96,6 +98,8 @@ spatInSituPlotPoints <- function(gobject, feat_shape_code = NULL, sdimx = "x", sdimy = "y", + xlim = NULL, + ylim = NULL, spat_enr_names = NULL, point_size = 1.5, stroke = 0.5, @@ -414,20 +418,31 @@ spatInSituPlotPoints <- function(gobject, plot <- plot + do.call(.gg_theme, args = gg_theme_args) - if (!is.null(coord_fix_ratio)) { - plot <- plot + ggplot2::coord_fixed(ratio = coord_fix_ratio) - } + # subset data based on x and y limits + if(!is.null(xlim)) { + plot <- plot + ggplot2::xlim(xlim) + } + 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, + 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 + )) - return(plot_output_handler( - gobject = gobject, - plot_object = 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 - )) } diff --git a/man/auto_image_resample.Rd b/man/auto_image_resample.Rd index f77e13f..bb49060 100644 --- a/man/auto_image_resample.Rd +++ b/man/auto_image_resample.Rd @@ -9,6 +9,8 @@ img, plot_ext = NULL, img_border = 0.125, + crop_ratio_fun = .img_to_crop_ratio_gimage, + sample_fun = .sample_gimage, flex_resample = TRUE, max_sample = getOption("giotto.plot_img_max_sample", 5e+05), max_crop = getOption("giotto.plot_img_max_crop", 1e+08), @@ -18,7 +20,7 @@ \arguments{ \item{img}{giotto image to plot} -\item{plot_ext}{extent of plot (required)} +\item{plot_ext}{extent of plot (defaults to the image extent)} \item{img_border}{if not 0 or FALSE, expand plot_ext by this percentage on each side before applying crop on image. See details} diff --git a/man/dimFeatPlot3D.Rd b/man/dimFeatPlot3D.Rd index 5e7fc73..e55ee71 100644 --- a/man/dimFeatPlot3D.Rd +++ b/man/dimFeatPlot3D.Rd @@ -126,7 +126,7 @@ Description of parameters. }} \examples{ g <- GiottoData::loadGiottoMini("starmap") -dimFeatPlot3D(g, genes = "Slc17a7") +dimFeatPlot3D(g, genes = "Slc17a7", dim_reduction_name = "3D_umap") } \concept{dimension reduction gene expression visualizations} diff --git a/man/gg_annotation_raster.Rd b/man/gg_annotation_raster.Rd index 2b81d22..18e4bc3 100644 --- a/man/gg_annotation_raster.Rd +++ b/man/gg_annotation_raster.Rd @@ -5,6 +5,7 @@ \alias{gg_annotation_raster,gg,list-method} \alias{gg_annotation_raster,gg,giottoImage-method} \alias{gg_annotation_raster,gg,giottoLargeImage-method} +\alias{gg_annotation_raster,gg,giottoAffineImage-method} \title{Append image to ggplot as annotation_raster} \usage{ \S4method{gg_annotation_raster}{gg,list}(ggobj, gimage, ...) @@ -12,6 +13,8 @@ \S4method{gg_annotation_raster}{gg,giottoImage}(ggobj, gimage, ...) \S4method{gg_annotation_raster}{gg,giottoLargeImage}(ggobj, gimage, ext = NULL, ...) + +\S4method{gg_annotation_raster}{gg,giottoAffineImage}(ggobj, gimage, ext, ...) } \arguments{ \item{ggobj}{ggplot2 \code{gg} object} diff --git a/man/reexports.Rd b/man/reexports.Rd index 6259261..1096a60 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -6,6 +6,8 @@ \alias{colorRamp2} \alias{getRainbowColors} \alias{getDistinctColors} +\alias{geom_text_repel} +\alias{geom_label_repel} \title{Objects exported from other packages} \value{ a function to create continous colors @@ -22,6 +24,8 @@ below to see their documentation. \describe{ \item{colorRamp2}{\code{\link[colorRamp2]{colorRamp2}}} + \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/spatInSituPlotPoints.Rd b/man/spatInSituPlotPoints.Rd index aa05353..0fcd97e 100644 --- a/man/spatInSituPlotPoints.Rd +++ b/man/spatInSituPlotPoints.Rd @@ -18,6 +18,8 @@ spatInSituPlotPoints( feat_shape_code = NULL, sdimx = "x", sdimy = "y", + xlim = NULL, + ylim = NULL, spat_enr_names = NULL, point_size = 1.5, stroke = 0.5, @@ -81,6 +83,10 @@ spatInSituPlotPoints( \item{sdimy}{spatial dimension y} +\item{xlim}{limits of x-scale (min/max vector)} + +\item{ylim}{limits of y-scale (min/max vector)} + \item{spat_enr_names}{character. names of spatial enrichment results to include} diff --git a/man/spatPlot.Rd b/man/spatPlot.Rd index f453ba0..a165bc2 100644 --- a/man/spatPlot.Rd +++ b/man/spatPlot.Rd @@ -309,7 +309,7 @@ spatPlot2D(g, # load another dataset with 3D data -starmap <- GiottoData::loadGiottoData("starmap", verbose = FALSE) +starmap <- GiottoData::loadGiottoMini("starmap", verbose = FALSE) # default is to rescale plot as a 3D cube spatPlot3D(starmap, cell_color = "leiden_clus")