From b3b6a9814269b8bf3017c458491e397d9761d29a Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Thu, 14 Nov 2024 17:27:02 -0500 Subject: [PATCH 01/11] Revert "chore: return remotes for push" This reverts commit f4f594238c3ada614813fdacf1bc3f2618b88cf1. --- DESCRIPTION | 3 --- 1 file changed, 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index b9410c9..a9bfec6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -66,9 +66,6 @@ Suggests: testthat (>= 3.0.0), knitr, rmarkdown -Remotes: - drieslab/GiottoUtils, - drieslab/GiottoClass Config/testthat/edition: 3 Collate: 'aux_defaults.R' From a40f3dc7a83623e5fdfd25acda9787ddd7c493f5 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 15 Nov 2024 15:46:10 -0500 Subject: [PATCH 02/11] fix list indexing for naming --- R/vis_spatial_gg.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/vis_spatial_gg.R b/R/vis_spatial_gg.R index 0570805..342fe9b 100644 --- a/R/vis_spatial_gg.R +++ b/R/vis_spatial_gg.R @@ -3168,6 +3168,12 @@ spatFeatPlot2D <- function(gobject, ## ** dim reduction feature plotting #### +.dimFeatPlot2D_single <- function() { + +} + + + #' @title dimFeatPlot2D #' @name dimFeatPlot2D #' @description Visualize gene expression according to dimension reduction From 87540e059a4934d886eefaeab3b8fd3c1e4886fa Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 15 Nov 2024 21:36:17 -0500 Subject: [PATCH 03/11] enh: group_by for dimFeatPlot2D() --- NEWS.md | 7 + R/aux_visuals.R | 29 +++ R/vis_spatial_gg.R | 456 ++++++++++++++++++++++++++----------------- man/dimFeatPlot2D.Rd | 19 ++ 4 files changed, 333 insertions(+), 178 deletions(-) diff --git a/NEWS.md b/NEWS.md index 4fc761e..ecc8e6b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,10 @@ + +# GiottoVisuals 0.2.9 + +## enhancements +- `group_by` and `group_by_subset` for `dimFeatPlot2D()` [#1069](https://github.com/drieslab/Giotto/issues/1069) by xhNorthwestern + + # GiottoVisuals 0.2.8 (2024/11/14) ## enhancements diff --git a/R/aux_visuals.R b/R/aux_visuals.R index 9a9cc0a..9aea2f5 100644 --- a/R/aux_visuals.R +++ b/R/aux_visuals.R @@ -2,6 +2,35 @@ NULL +# groupby #### + +# split apart a table of data based on a group by column +.groupby <- function(data, group_by, group_by_subset = NULL) { + + possible_groups <- colnames(data) + + ## error if group_by col is not found + if (!group_by %in% possible_groups) { + stop("group_by ", group_by, " was not found in pDataDT()") + } + + # subset unique_groups if needed + if (!is.null(group_by_subset)) { + unique_groups <- unique(data[[group_by]]) + 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 data to only group_by_subset + data <- data[get(group_by) %in% unique_groups] + } + + datalist <- split(data, data[[group_by]]) +} + + # clusters #### #' @title Decide cluster order diff --git a/R/vis_spatial_gg.R b/R/vis_spatial_gg.R index 342fe9b..d515617 100644 --- a/R/vis_spatial_gg.R +++ b/R/vis_spatial_gg.R @@ -3168,8 +3168,218 @@ spatFeatPlot2D <- function(gobject, ## ** dim reduction feature plotting #### -.dimFeatPlot2D_single <- function() { +.dimFeatPlot2D_single <- function(selected_feats, ...) { + lapply(selected_feats, function(feat) { + .dimFeatPlot_single_feat(feat, ...) + }) +} + +.dimFeatPlot_single_feat <- function(data, + feat, + feats, + dim_names, + order = TRUE, + group_id = NULL, + show_NN_network = FALSE, + network_color = NULL, + from_dim_names = NULL, + to_dim_names = NULL, + annotated_network_DT = NULL, + edge_alpha = NULL, + scale_alpha_with_expression = FALSE, + point_shape, + 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, + instrs +) { + # order spatial units (e.g. cell IDs) based on expression of feature + if (isTRUE(order)) { + data <- data[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 = data, + 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 <- data[[feat]] + limit_numeric_data <- ifelse( + numeric_data > upper_lim, + upper_lim, + ifelse(numeric_data < lower_lim, lower_lim, numeric_data) + ) + data[[feat]] <- limit_numeric_data + } + + if (is.null(gradient_midpoint)) { + gradient_midpoint <- stats::median(data[[feat]]) + } + + + + ## with border ## + if (point_shape == "border") { + if (scale_alpha_with_expression == TRUE) { + pl <- pl + ggplot2::geom_point( + data = data, 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 = data, 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 = instrs, + 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 = data, 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 = data, 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 = instrs, + 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 = paste(group_id, feat, sep = "-") + ) + + ## 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) + ) + return(pl) } @@ -3197,6 +3407,18 @@ spatFeatPlot2D <- function(gobject, #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' dimFeatPlot2D(g, feats = c("Gna12", "Ccnd2", "Btbd17")) #' +#' # with group_by +#' dimFeatPlot2D(g, +#' feats = c("Gna12"), +#' group_by = "leiden_clus", +#' gradient_midpoint = 3 # setting a specific midpoint can be helpful +#' ) +#' # with group_by and group_by_subset +#' dimFeatPlot2D(g, +#' feats = c("Gna12", "Ccnd2", "Btbd17"), +#' group_by = "leiden_clus", +#' group_by_subset = c(2, 5) +#' ) #' @export dimFeatPlot2D <- function(gobject, spat_unit = NULL, @@ -3204,6 +3426,8 @@ dimFeatPlot2D <- function(gobject, expression_values = c("normalized", "scaled", "custom"), feats = NULL, order = TRUE, + group_by = NULL, + group_by_subset = NULL, dim_reduction_to_use = "umap", dim_reduction_name = NULL, dim1_to_use = 1, @@ -3297,8 +3521,15 @@ dimFeatPlot2D <- function(gobject, ) # only keep feats that are in the dataset + if (length(feats) == 0) { + stop("No `feats` selected to plot.", call. = FALSE) + } selected_feats <- feats selected_feats <- selected_feats[selected_feats %in% rownames(expr_values)] + if (length(selected_feats) == 0) { + stop("Selected `feats` not found in expression information", + call. = FALSE) + } # if (length(selected_feats) == 1) { @@ -3401,189 +3632,58 @@ dimFeatPlot2D <- function(gobject, ) } - ## 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 - ) - } + # params list for plotting + a <- list( + feats = feats, + selected_feats = selected_feats, + order = order, + dim_names = dim_names, + show_NN_network = show_NN_network, + edge_alpha = edge_alpha, + scale_alpha_with_expression = scale_alpha_with_expression, + point_shape = point_shape, + point_size = point_size, + point_alpha = point_alpha, + cell_color_gradient = cell_color_gradient, + gradient_midpoint = gradient_midpoint, + gradient_style = gradient_style, + gradient_limits = gradient_limits, + point_border_col = point_border_col, + point_border_stroke = point_border_stroke, + show_legend = show_legend, + legend_text = legend_text, + background_color = background_color, + axis_text = axis_text, + axis_title = axis_title, + instrs = instructions(gobject) + ) - ## 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" - ) - } - } + if (isTRUE(show_NN_network)) { + a$network_color <- network_color + a$from_dim_names <- from_dim_names + a$to_dim_names <- to_dim_names + a$annotated_network_DT <- annotated_network_DT + } - ## 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) + ## generate plot(s) ## + if (is.null(group_by)) { + a$data <- annotated_feat_DT + savelist <- do.call(.dimFeatPlot2D_single, a) + } else { + datalist <- .groupby(annotated_feat_DT, + group_by = group_by, + group_by_subset = group_by_subset ) - - savelist[[feat]] <- pl + gp_savelist <- lapply(datalist, function(data) { + a$data <- data + group_id <- data[[group_by]][[1]] + a$group_id <- group_id + do.call(.dimFeatPlot2D_single, a) + }) + savelist <- do.call(c, gp_savelist) } - - # combine plots with cowplot combo_plot <- cowplot::plot_grid( plotlist = savelist, diff --git a/man/dimFeatPlot2D.Rd b/man/dimFeatPlot2D.Rd index f689358..6090b90 100644 --- a/man/dimFeatPlot2D.Rd +++ b/man/dimFeatPlot2D.Rd @@ -11,6 +11,8 @@ dimFeatPlot2D( expression_values = c("normalized", "scaled", "custom"), feats = NULL, order = TRUE, + group_by = NULL, + group_by_subset = NULL, dim_reduction_to_use = "umap", dim_reduction_name = NULL, dim1_to_use = 1, @@ -59,6 +61,11 @@ dimFeatPlot2D( \item{order}{order points according to feature expression} +\item{group_by}{character. Create multiple plots based on cell +annotation column} + +\item{group_by_subset}{character. subset the group_by factor column} + \item{dim_reduction_to_use}{character. dimension reduction to use} \item{dim_reduction_name}{character. dimension reduction name} @@ -145,5 +152,17 @@ Description of parameters. g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) dimFeatPlot2D(g, feats = c("Gna12", "Ccnd2", "Btbd17")) +# with group_by +dimFeatPlot2D(g, + feats = c("Gna12"), + group_by = "leiden_clus", + gradient_midpoint = 3 # setting a specific midpoint can be helpful +) +# with group_by and group_by_subset +dimFeatPlot2D(g, + feats = c("Gna12", "Ccnd2", "Btbd17"), + group_by = "leiden_clus", + group_by_subset = c(2, 5) +) } \concept{dimension reduction feature expression visualizations} From 827e633b1622c369e8d88d1b88967421f47d8af7 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Fri, 15 Nov 2024 21:44:37 -0500 Subject: [PATCH 04/11] fix: fix network behavior when using group_by --- R/vis_spatial_gg.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/vis_spatial_gg.R b/R/vis_spatial_gg.R index d515617..74c3e45 100644 --- a/R/vis_spatial_gg.R +++ b/R/vis_spatial_gg.R @@ -3208,13 +3208,18 @@ spatFeatPlot2D <- function(gobject, data <- data[order(get(feat))] } - ## OLD need to be combined ## pl <- ggplot2::ggplot() pl <- pl + ggplot2::theme_classic() # network layer if (show_NN_network == TRUE) { + + annotated_network_DT <- annotated_network_DT[ + to %in% data$cell_ID & from %in% data$cell_ID + ] + + if (is.null(edge_alpha)) { edge_alpha <- 0.5 pl <- pl + ggplot2::geom_segment( From 01138e687b77cfbfa9681cc3b33c5b0b4f765dea Mon Sep 17 00:00:00 2001 From: josschavezf Date: Fri, 15 Nov 2024 22:00:36 -0500 Subject: [PATCH 05/11] add biocstyle --- R/aux_defaults.R | 137 +-- R/aux_output.R | 17 +- R/aux_save.R | 121 ++- R/aux_visuals.R | 141 ++-- R/colorRamp2.R | 2 +- R/color_palettes.R | 11 +- R/gg_annotation_raster.R | 75 +- R/gg_info_layers.R | 602 +++++++------- R/gg_param.R | 35 +- R/gg_settings.R | 18 +- R/gstop.R | 17 +- R/mixcolor.R | 5 +- R/plot_dendrogram.R | 65 +- R/plot_dotplot.R | 114 ++- R/plot_heatmap.R | 306 +++---- R/plot_sankey.R | 104 ++- R/plot_scatter.R | 5 +- R/plot_violin.R | 43 +- R/spatialDE_visuals.R | 20 +- R/vis_spatial_gg.R | 1611 ++++++++++++++++++------------------ R/vis_spatial_in_situ.R | 365 ++++---- R/vis_spatial_plotly.R | 761 ++++++++--------- R/viz_spatial_network.R | 108 ++- R/zzz.R | 3 - tests/testthat/test_save.R | 55 +- 25 files changed, 2421 insertions(+), 2320 deletions(-) diff --git a/R/aux_defaults.R b/R/aux_defaults.R index 62c480a..f34e236 100644 --- a/R/aux_defaults.R +++ b/R/aux_defaults.R @@ -12,8 +12,9 @@ #' set_default_cow_n_col(nr_plots = 4) #' #' @export -set_default_cow_n_col <- function(cow_n_col = NULL, - nr_plots) { +set_default_cow_n_col <- function( + cow_n_col = NULL, + nr_plots) { if (is.null(cow_n_col)) { cow_n_col <- ceiling(sqrt(nr_plots)) } else { @@ -76,8 +77,10 @@ set_default_cow_n_col <- function(cow_n_col = NULL, #' @param \dots additional params to pass #' @returns a palette function #' @examples -#' set_default_color_discrete(colors = "#eb4034", -#' instr_rev = NULL, instr_strategy = NULL) +#' set_default_color_discrete( +#' colors = "#eb4034", +#' instr_rev = NULL, instr_strategy = NULL +#' ) NULL @@ -91,11 +94,12 @@ NULL #' pass specific `giottoInstructions` params #' #' @export -set_default_color_discrete <- function(colors = NULL, - ..., - instr_pal, - instr_rev, - instr_strategy) { +set_default_color_discrete <- function( + colors = NULL, + ..., + instr_pal, + instr_rev, + instr_strategy) { # global giotto options opt_pal <- getOption("giotto.color_d_pal", "distinct") opt_rev <- getOption("giotto.color_d_rev", FALSE) @@ -138,9 +142,10 @@ set_default_color_discrete <- function(colors = NULL, #' @rdname set_default_color_discrete #' @returns vector of color ids #' @export -set_default_color_discrete_cell <- function(colors = NULL, - instrs, - ...) { +set_default_color_discrete_cell <- function( + colors = NULL, + instrs, + ...) { # read instructions instr_pal <- readGiottoInstructions(instrs, "cell_color_d_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "cell_color_d_rev", NULL) @@ -160,9 +165,10 @@ set_default_color_discrete_cell <- function(colors = NULL, #' @rdname set_default_color_discrete #' @export -set_default_color_discrete_poly <- function(colors = NULL, - instrs, - ...) { +set_default_color_discrete_poly <- function( + colors = NULL, + instrs, + ...) { # read instructions instr_pal <- readGiottoInstructions(instrs, "poly_color_d_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "poly_color_d_rev", NULL) @@ -182,9 +188,10 @@ set_default_color_discrete_poly <- function(colors = NULL, #' @rdname set_default_color_discrete #' @export -set_default_color_discrete_feat <- function(colors = NULL, - instrs, - ...) { +set_default_color_discrete_feat <- function( + colors = NULL, + instrs, + ...) { # read instructions instr_pal <- readGiottoInstructions(instrs, "feat_color_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "feat_color_rev", NULL) @@ -204,9 +211,10 @@ set_default_color_discrete_feat <- function(colors = NULL, #' @rdname set_default_color_discrete #' @export -set_default_color_discrete_heatmap_clus <- function(colors = NULL, - instrs, - ...) { +set_default_color_discrete_heatmap_clus <- function( + colors = NULL, + instrs, + ...) { # read instructions instr_pal <- readGiottoInstructions( instrs, "heatmap_clus_color_pal", @@ -340,14 +348,14 @@ NULL #' `giottoInstructions` params #' @export set_default_color_continuous <- function( - colors = NULL, # used for function inputs - midpoint = NULL, - style = c("divergent", "sequential"), - ..., - instr_pal, - instr_rev, - data_default = NULL, - type = c("fill", "color")) { + colors = NULL, # used for function inputs + midpoint = NULL, + style = c("divergent", "sequential"), + ..., + instr_pal, + instr_rev, + data_default = NULL, + type = c("fill", "color")) { if (!is.null(midpoint)) checkmate::assert_numeric(midpoint) if (!is.null(instr_pal)) checkmate::assert_character(instr_pal) if (!is.null(instr_rev)) checkmate::assert_logical(instr_rev) @@ -418,8 +426,7 @@ set_default_color_continuous <- function( } -.evaluate_color_gradient_divergent <- function( - colors, reverse, midpoint, ..., grad2, grad, gradn) { +.evaluate_color_gradient_divergent <- function(colors, reverse, midpoint, ..., grad2, grad, gradn) { if (is.null(midpoint)) midpoint <- 0 if (inherits(colors, "character")) { @@ -465,8 +472,7 @@ set_default_color_continuous <- function( gradient } -.evaluate_color_gradient_sequential <- function( - colors, reverse, ..., gradn, grad) { +.evaluate_color_gradient_sequential <- function(colors, reverse, ..., gradn, grad) { if (inherits(colors, "character")) { if (length(colors) == 3L) { # assume simple palette if 3 entries in vector @@ -501,13 +507,12 @@ set_default_color_continuous <- function( #' @rdname set_default_color_continuous #' @export -set_default_color_continuous_cell <- function( - colors = NULL, - instrs, - midpoint = NULL, - style = "divergent", - ..., - data_default = NULL) { +set_default_color_continuous_cell <- function(colors = NULL, + instrs, + midpoint = NULL, + style = "divergent", + ..., + data_default = NULL) { # read instructions instr_pal <- readGiottoInstructions(instrs, "cell_color_c_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "cell_color_c_rev", NULL) @@ -525,12 +530,11 @@ set_default_color_continuous_cell <- function( #' @rdname set_default_color_continuous #' @export -set_default_color_continuous_poly <- function( - colors = NULL, - instrs, - midpoint = NULL, - style = "divergent", - ...) { +set_default_color_continuous_poly <- function(colors = NULL, + instrs, + midpoint = NULL, + style = "divergent", + ...) { # read instructions instr_pal <- readGiottoInstructions(instrs, "poly_color_c_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "poly_color_c_rev", NULL) @@ -548,12 +552,11 @@ set_default_color_continuous_poly <- function( #' @rdname set_default_color_continuous #' @export -set_default_color_continuous_heatmap <- function( - colors = NULL, - instrs, - midpoint = NULL, - style = "divergent", - ...) { +set_default_color_continuous_heatmap <- function(colors = NULL, + instrs, + midpoint = NULL, + style = "divergent", + ...) { # read instructions instr_pal <- readGiottoInstructions(instrs, "heatmap_color_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "heatmap_color_rev", NULL) @@ -570,12 +573,11 @@ set_default_color_continuous_heatmap <- function( #' @rdname set_default_color_continuous #' @export -set_default_color_continuous_CCcom_heatmap <- function( - colors = NULL, - instrs, - midpoint = NULL, - style = "divergent", - ...) { +set_default_color_continuous_CCcom_heatmap <- function(colors = NULL, + instrs, + midpoint = NULL, + style = "divergent", + ...) { # read instructions instr_pal <- readGiottoInstructions(instrs, "CCcom_heatmap_color_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "CCcom_heatmap_color_rev", NULL) @@ -595,16 +597,15 @@ set_default_color_continuous_CCcom_heatmap <- function( #' @rdname set_default_color_continuous #' @export -set_default_color_continuous_CCcom_dotplot <- function( - colors = NULL, - instrs, - midpoint = NULL, - style = "divergent", - ..., - type = c("fill", "color"), - data_default = list( - pal = c("darkblue", "blue", "white", "red", "darkred") - )) { +set_default_color_continuous_CCcom_dotplot <- function(colors = NULL, + instrs, + midpoint = NULL, + style = "divergent", + ..., + type = c("fill", "color"), + data_default = list( + pal = c("darkblue", "blue", "white", "red", "darkred") + )) { # read instructions instr_pal <- readGiottoInstructions(instrs, "CCcom_dotplot_color_pal", NULL) instr_rev <- readGiottoInstructions(instrs, "CCcom_dotplot_color_rev", NULL) diff --git a/R/aux_output.R b/R/aux_output.R index b87a36e..eba2a39 100644 --- a/R/aux_output.R +++ b/R/aux_output.R @@ -29,15 +29,14 @@ #' plot_output_handler(g, plot_object = g_spatplot, save_plot = FALSE) #' #' @export -plot_output_handler <- function( - gobject, - plot_object, - save_plot = NULL, - return_plot = NULL, - show_plot = NULL, - default_save_name = NULL, - save_param = list(), - else_return = NULL) { +plot_output_handler <- function(gobject, + plot_object, + save_plot = NULL, + return_plot = NULL, + show_plot = NULL, + default_save_name = NULL, + save_param = list(), + else_return = NULL) { checkmate::assert_class(gobject, "giotto") ## output settings detection ## diff --git a/R/aux_save.R b/R/aux_save.R index 4017ef9..4e51f9e 100644 --- a/R/aux_save.R +++ b/R/aux_save.R @@ -50,35 +50,36 @@ NULL #' @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() +#' 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, - GPSPARAM = NULL, - ...) { - +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, + GPSPARAM = NULL, + ...) { # get save params if (is.null(GPSPARAM)) { type <- "general" - if(any("ggplot" %in% class(plot_object))) type <- "gg" + if (any("ggplot" %in% class(plot_object))) type <- "gg" if (any("plotly" %in% class(plot_object))) type <- "plotly" a <- .grab_gpsparam_args() @@ -125,25 +126,26 @@ all_plots_save_function <- function(gobject, #' 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 = NULL, - dpi = NULL, - base_width = NULL, - base_height = NULL, - base_aspect_ratio = NULL, - units = NULL, - plot_count = NULL, - ... # ignored +gpsparam <- function(instructions, + type = c("gg", "plotly", "general"), + save_dir = NULL, + save_folder = NULL, + save_name = NULL, + default_save_name = "giotto_plot", + save_format = NULL, + dpi = NULL, + base_width = NULL, + base_height = NULL, + base_aspect_ratio = NULL, + units = NULL, + plot_count = NULL, + ... # ignored ) { if (!inherits(instructions, c("giotto", "giottoInstructions"))) { - stop("`instructions` must be either a `giotto` or", - "`giottoInstructions` object.") + stop( + "`instructions` must be either a `giotto` or", + "`giottoInstructions` object." + ) } instrs <- instructions # shortname checkmate::assert_character(type) @@ -186,7 +188,8 @@ gpsparam <- function( save_name <- paste0(plot_count, "-", save_name) if (custom_plot_count) { on.exit(options("giotto.plot_count" = plot_count + 1L), # increment - add = TRUE) + add = TRUE + ) } } @@ -272,17 +275,15 @@ showSaveParameters <- function() { # 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, - ... -) { +.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") } @@ -341,13 +342,11 @@ showSaveParameters <- function() { # 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, - ... -) { +.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") } @@ -374,7 +373,6 @@ showSaveParameters <- function() { file = fullpath ) } else { - switch(save_format, "png" = { grDevices::png( @@ -452,7 +450,6 @@ print.giotto_plot_save_param <- function(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, @@ -462,5 +459,3 @@ print.giotto_plot_save_param <- function(x, ...) { ) round(prod(pxdims)) } - - diff --git a/R/aux_visuals.R b/R/aux_visuals.R index 9aea2f5..13c7011 100644 --- a/R/aux_visuals.R +++ b/R/aux_visuals.R @@ -6,7 +6,6 @@ NULL # split apart a table of data based on a group by column .groupby <- function(data, group_by, group_by_subset = NULL) { - possible_groups <- colnames(data) ## error if group_by col is not found @@ -50,17 +49,16 @@ NULL #' @return custom #' @details Calculates order for clusters. #' @keywords internal -.decide_cluster_order <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats, - cluster_column = NULL, - cluster_order = c("size", "correlation", "custom"), - cluster_custom_order = NULL, - cor_method = "pearson", - hclust_method = "ward.D") { +.decide_cluster_order <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats, + cluster_column = NULL, + cluster_order = c("size", "correlation", "custom"), + cluster_custom_order = NULL, + cor_method = "pearson", + hclust_method = "ward.D") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -206,13 +204,12 @@ gg_input <- function(ggobject) { #' @keywords internal #' @noRd #' @returns ggplot2::geom_point layer -giotto_point <- function( - plot_method = c("ggplot", "scattermore", "scattermost"), - size = 1, - ext, - scattermost_xy = NULL, - scattermost_color = NULL, - ...) { +giotto_point <- function(plot_method = c("ggplot", "scattermore", "scattermost"), + size = 1, + ext, + scattermost_xy = NULL, + scattermost_color = NULL, + ...) { plot_method <- match.arg( arg = plot_method, choices = c("ggplot", "scattermore", "scattermost") @@ -281,24 +278,23 @@ giotto_point <- function( #' @keywords internal #' @noRd giotto_point_3d <- function(pl, - data, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_limits = NULL, - gradient_style = "divergent", - gradient_midpoint = NULL, - point_size = 3, - point_alpha = 1, - data_other = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - other_cell_alpha = 3, - instrs -) { + data, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_limits = NULL, + gradient_style = "divergent", + gradient_midpoint = NULL, + point_size = 3, + point_alpha = 1, + data_other = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + other_cell_alpha = 3, + instrs) { # plotly params list init & static params # ** toplevel ** # trace_params <- trace_params_other <- list( @@ -355,7 +351,7 @@ giotto_point_3d <- function(pl, lower_lim <- gradient_limits[[1L]] upper_lim <- gradient_limits[[2L]] data[, (cell_color) := - scales::oob_squish(get(cell_color), gradient_limits)] + scales::oob_squish(get(cell_color), gradient_limits)] } } # apply non-default color settings @@ -373,7 +369,8 @@ giotto_point_3d <- function(pl, trace_params_other$data <- data_other trace_params_other$marker <- marker_params_other pl <- do.call( - plotly::add_trace, args = c(list(p = pl), trace_params_other) + plotly::add_trace, + args = c(list(p = pl), trace_params_other) ) } @@ -415,13 +412,14 @@ mid_rescaler <- function(mid) { #' @returns edges in network as data.table #' #' @export -plotly_network <- function(network, - x = "sdimx_begin", - y = "sdimy_begin", - z = "sdimz_begin", - x_end = "sdimx_end", - y_end = "sdimy_end", - z_end = "sdimz_end") { +plotly_network <- function( + network, + x = "sdimx_begin", + y = "sdimy_begin", + z = "sdimz_begin", + x_end = "sdimx_end", + y_end = "sdimy_end", + z_end = "sdimz_end") { edges <- data.table::data.table( edge_id = seq_len(3 * dim(network)[1]), x = 0, @@ -460,22 +458,23 @@ plotly_network <- function(network, #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' #' library(GiottoClass) -#' g <- createSpatialGrid(gobject = g, -#' sdimx_stepsize = 400, -#' sdimy_stepsize = 400, -#' minimum_padding = 0) +#' 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, - x_start = "x_start", - y_start = "y_start", - x_end = "x_end", - y_end = "y_end") { +plotly_grid <- function(spatial_grid, + x_start = "x_start", + y_start = "y_start", + x_end = "x_end", + y_end = "y_end") { edge_num <- length(unique(spatial_grid[[x_start]])) + length(unique(spatial_grid[[y_start]])) + 2 x_line <- unique(as.numeric(unlist(spatial_grid[, c(x_start, x_end)]))) @@ -517,18 +516,19 @@ 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), -#' z = 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, - sdimx = NULL, - sdimy = NULL, - sdimz = NULL, - mode = c("cube", "real", "custom"), - custom_ratio = NULL) { +plotly_axis_scale_3D <- function(cell_locations, + sdimx = NULL, + sdimy = NULL, + sdimz = NULL, + mode = c("cube", "real", "custom"), + custom_ratio = NULL) { mode <- match.arg(mode, c("cube", "real", "custom")) if (mode == "real") { x_ratio <- max(cell_locations[[sdimx]]) - min(cell_locations[[sdimx]]) @@ -572,12 +572,11 @@ plotly_axis_scale_3D <- function( #' plotly_axis_scale_2D(my_cell_locations) #' #' @export -plotly_axis_scale_2D <- function( - cell_locations, - sdimx = NULL, - sdimy = NULL, - mode = c("cube", "real", "custom"), - custom_ratio = NULL) { +plotly_axis_scale_2D <- function(cell_locations, + sdimx = NULL, + sdimy = NULL, + mode = c("cube", "real", "custom"), + custom_ratio = NULL) { mode <- match.arg(mode, c("cube", "real", "custom")) if (mode == "real") { x_ratio <- max(cell_locations[[sdimx]]) - min(cell_locations[[sdimx]]) diff --git a/R/colorRamp2.R b/R/colorRamp2.R index 4c854c3..86db923 100644 --- a/R/colorRamp2.R +++ b/R/colorRamp2.R @@ -4,7 +4,7 @@ #' @returns a function to create continous colors #' @examples #' colorRamp2::colorRamp2(breaks = seq_len(2), colors = c("blue", "red")) -#' +#' #' @export colorRamp2::colorRamp2 # nocov end diff --git a/R/color_palettes.R b/R/color_palettes.R index ba9e6be..581b83d 100644 --- a/R/color_palettes.R +++ b/R/color_palettes.R @@ -23,12 +23,11 @@ #' r <- terra::rast(f) #' terra::plot(r, col = getColors(pal = "Spectral", n = 100)) #' @export -getColors <- function( - pal = "viridis", - n = 100, - rev = FALSE, - src = NULL, - strategy = c("interpolate")) { +getColors <- function(pal = "viridis", + n = 100, + rev = FALSE, + src = NULL, + strategy = c("interpolate")) { checkmate::assert_numeric(n, len = 1L) checkmate::assert_character(pal, len = 1L) checkmate::assert_logical(rev, len = 1L) diff --git a/R/gg_annotation_raster.R b/R/gg_annotation_raster.R index 4887bc6..ffe1d6c 100644 --- a/R/gg_annotation_raster.R +++ b/R/gg_annotation_raster.R @@ -33,7 +33,6 @@ setMethod( "gg_annotation_raster", signature(ggobj = "gg", gimage = "list"), function(ggobj, gimage, ext = NULL, geom_blank = TRUE, ...) { - # apply geom_blank ext <- ext %null% ext(gimage[[1L]]) if (geom_blank) ggobj <- .gg_geom_blank(ggobj, ext) @@ -58,7 +57,6 @@ setMethod( "gg_annotation_raster", signature(ggobj = "gg", gimage = "giottoImage"), function(ggobj, gimage, ext = NULL, geom_blank = TRUE, ...) { - # apply geom_blank ext <- ext %null% ext(gimage) if (geom_blank) ggobj <- .gg_geom_blank(ggobj, ext) @@ -81,7 +79,6 @@ setMethod( "gg_annotation_raster", signature(ggobj = "gg", gimage = "giottoLargeImage"), function(ggobj, gimage, ext = NULL, geom_blank = TRUE, ...) { - # geom_blank ext <- ext %null% ext(gimage) if (geom_blank) ggobj <- .gg_geom_blank(ggobj, ext) @@ -109,7 +106,6 @@ setMethod( "gg_annotation_raster", signature(ggobj = "gg", gimage = "giottoAffineImage"), function(ggobj, gimage, ext = NULL, geom_blank = TRUE, ...) { - # geom_blank ext <- ext %null% ext(gimage) if (geom_blank) ggobj <- .gg_geom_blank(ggobj, ext) @@ -137,13 +133,12 @@ setMethod( # returns the spatial extent needed for the plot # ... passes to ext() `giotto` method -.guess_plot_extent <- function( - gobject, spat_unit = NULL, spat_loc_name = NULL, ext = NULL, ... - ) { - +.guess_plot_extent <- function(gobject, spat_unit = NULL, spat_loc_name = NULL, ext = NULL, ...) { if (!is.null(ext)) ext <- ext(ext) # normalize to `SpatExtent` class # if ext already given, directly return - if (inherits(ext, "SpatExtent")) return(ext) + if (inherits(ext, "SpatExtent")) { + return(ext) + } # find extent from one of poly, spatlocs, points, in that order of pref e <- ext( @@ -255,23 +250,24 @@ setMethod( #' } #' @seealso \code{\link[terra]{spatSample}} #' @keywords internal -.auto_resample_gimage <- function( - 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), - max_resample_scale = getOption( - "giotto.plot_img_max_resample_scale", 100 - ) -) { - +.auto_resample_gimage <- function(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), + max_resample_scale = getOption( + "giotto.plot_img_max_resample_scale", 100 + )) { # 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) + 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) # 1.1. override max_crop if needed @@ -280,7 +276,6 @@ setMethod( # 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 %>% rescale(1 + img_border) %>% ext() @@ -307,9 +302,13 @@ setMethod( ) } - vmsg(.is_debug = TRUE, - sprintf("img auto_res: [A] | area: %f | max: %f", - crop_area_px, max_crop)) + vmsg( + .is_debug = TRUE, + sprintf( + "img auto_res: [A] | area: %f | max: %f", + crop_area_px, max_crop + ) + ) crop_img <- terra::crop(img, crop_ext) res <- sample_fun(crop_img, size = max_sample) @@ -320,13 +319,17 @@ setMethod( # Sample n values where max_sample is scaled by a value >1 # Scale factor is fullsize image dim/crop dim. Larger of the two # ratios is chosen - scalef <- max(1/ratios) + scalef <- max(1 / ratios) # This scaling is ALSO capped by max_resample_scale if (scalef > max_resample_scale) scalef <- max_resample_scale - vmsg(.is_debug = TRUE, - sprintf("img auto_res: [B] | scalef: %f | max_scale: %f", - scalef, max_resample_scale)) + vmsg( + .is_debug = TRUE, + sprintf( + "img auto_res: [B] | scalef: %f | max_scale: %f", + scalef, max_resample_scale + ) + ) oversample_img <- sample_fun(img, size = round(max_sample * scalef)) res <- terra::crop(oversample_img, crop_ext) @@ -439,9 +442,9 @@ setMethod( # `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 + 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 <- (x - r[1]) / (r[2] - r[1]) x <- round(x * (length(col) - 1) + 1) x[] <- col[x] terra::as.raster(x) @@ -470,5 +473,3 @@ setMethod( ggobj <- .gg_append_imagearray(ggobj, a, ext(gimage)) return(ggobj) } - - diff --git a/R/gg_info_layers.R b/R/gg_info_layers.R index 925ca76..d1f5b6b 100644 --- a/R/gg_info_layers.R +++ b/R/gg_info_layers.R @@ -25,38 +25,39 @@ #' @details Description of parameters. #' @keywords internal #' @noRd -plot_spat_point_layer_ggplot <- function(ggobject, - instrs = NULL, - sdimx = NULL, - sdimy = NULL, - plot_method = c("ggplot", "scattermore"), # does not actually work for fill types - cell_locations_metadata_selected, - cell_locations_metadata_other, - 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_size = 2, - point_alpha = 1, - point_border_col = "lightgrey", - point_border_stroke = 0.1, - 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", - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - show_legend = TRUE, - ...) { +plot_spat_point_layer_ggplot <- function( + ggobject, + instrs = NULL, + sdimx = NULL, + sdimy = NULL, + plot_method = c("ggplot", "scattermore"), # does not actually work for fill types + cell_locations_metadata_selected, + cell_locations_metadata_other, + 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_size = 2, + point_alpha = 1, + point_border_col = "lightgrey", + point_border_stroke = 0.1, + 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", + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + show_legend = TRUE, + ...) { ## specify spatial dimensions first if (is.null(sdimx) || is.null(sdimy)) { warning(wrap_txt("plot_method = ggplot, @@ -110,7 +111,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, # cell color default if (is.null(cell_color)) { cell_color <- "lightblue" - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string(x = sdimx, y = sdimy), show.legend = show_legend, @@ -130,7 +132,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, } cell_locations_metadata_selected[["temp_color"]] <- cell_color - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy, fill = "temp_color"), show.legend = show_legend, @@ -146,7 +149,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, a factor or vector of colors \n") } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy), show.legend = show_legend, @@ -163,7 +167,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, if (!cell_color %in% grDevices::colors()) { stop(cell_color, " is not a color or a column name \n") } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy), show.legend = show_legend, @@ -199,7 +204,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, limit_numeric_data } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy, fill = cell_color), show.legend = show_legend, @@ -230,7 +236,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, annotated_DT_centers[[cell_color]] <- factor_center_data } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy, fill = cell_color), show.legend = show_legend, @@ -246,7 +253,8 @@ plot_spat_point_layer_ggplot <- function(ggobject, if (isTRUE(show_cluster_center) && (isTRUE(color_as_factor) || class_cell_color %in% c("character", "factor"))) { - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_centers, mapping = aes_string2( x = "center_1", y = "center_2", @@ -280,13 +288,15 @@ plot_spat_point_layer_ggplot <- function(ggobject, } else if (isTRUE(color_as_factor)) { number_colors <- length(unique(factor_data)) cell_color_code <- set_default_color_discrete_cell( - instrs = instrs)(n = number_colors) + instrs = instrs + )(n = number_colors) names(cell_color_code) <- unique(factor_data) pl <- pl + ggplot2::scale_fill_manual(values = cell_color_code) } else if (!isTRUE(color_as_factor)) { if (is.null(gradient_midpoint)) { gradient_midpoint <- stats::median( - cell_locations_metadata_selected[[cell_color]]) + cell_locations_metadata_selected[[cell_color]] + ) } pl <- pl + set_default_color_continuous_cell( @@ -319,34 +329,35 @@ plot_spat_point_layer_ggplot <- function(ggobject, #' @details Description of parameters. #' @keywords internal #' @noRd -plot_spat_point_layer_ggplot_noFILL <- function(ggobject, - instrs = NULL, - sdimx = NULL, - sdimy = NULL, - plot_method = c("ggplot", "scattermore"), - cell_locations_metadata_selected, - cell_locations_metadata_other, - 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_size = 2, - point_alpha = 1, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 4, - label_fontface = "bold", - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - show_legend = TRUE, - ...) { +plot_spat_point_layer_ggplot_noFILL <- function( + ggobject, + instrs = NULL, + sdimx = NULL, + sdimy = NULL, + plot_method = c("ggplot", "scattermore"), + cell_locations_metadata_selected, + cell_locations_metadata_other, + 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_size = 2, + point_alpha = 1, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 4, + label_fontface = "bold", + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + show_legend = TRUE, + ...) { ## specify spatial dimensions first if (is.null(sdimx) || is.null(sdimy)) { warning(wrap_txt("plot_method = ggplot, but spatial dimensions @@ -395,7 +406,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, # cell color default if (is.null(cell_color)) { cell_color <- "lightblue" - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string(x = sdimx, y = sdimy), show.legend = show_legend, @@ -413,7 +425,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, } cell_locations_metadata_selected[["temp_color"]] <- cell_color - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy, color = "temp_color"), show.legend = show_legend, @@ -428,7 +441,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, colors \n") } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy), show.legend = show_legend, shape = 19, @@ -442,7 +456,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, if (!cell_color %in% grDevices::colors()) { stop(cell_color, " is not a color or a column name \n") } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy), show.legend = show_legend, @@ -454,7 +469,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, ) } else { class_cell_color <- class( - cell_locations_metadata_selected[[cell_color]]) + cell_locations_metadata_selected[[cell_color]] + ) if (class_cell_color %in% c("integer", "numeric") && !isTRUE(color_as_factor)) { @@ -469,15 +485,16 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, cell_locations_metadata_selected[[cell_color]] limit_numeric_data <- ifelse( numeric_data > upper_lim, upper_lim, - ifelse(numeric_data < lower_lim, lower_lim, - numeric_data - ) + ifelse(numeric_data < lower_lim, lower_lim, + numeric_data ) + ) cell_locations_metadata_selected[[cell_color]] <- limit_numeric_data } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy, color = cell_color), show.legend = show_legend, @@ -490,7 +507,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, # convert character or numeric to factor if (isTRUE(color_as_factor)) { factor_data <- factor( - cell_locations_metadata_selected[[cell_color]]) + cell_locations_metadata_selected[[cell_color]] + ) cell_locations_metadata_selected[[cell_color]] <- factor_data } @@ -507,7 +525,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, annotated_DT_centers[[cell_color]] <- factor_center_data } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = cell_locations_metadata_selected, mapping = aes_string2(x = sdimx, y = sdimy, color = cell_color), show.legend = show_legend, @@ -522,7 +541,8 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, if (isTRUE(show_cluster_center) && (isTRUE(color_as_factor) || class_cell_color %in% c("character", "factor"))) { - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_centers, mapping = aes_string2( x = "center_1", y = "center_2", @@ -556,13 +576,15 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, } else if (isTRUE(color_as_factor)) { number_colors <- length(unique(factor_data)) cell_color_code <- set_default_color_discrete_cell( - instrs = instrs)(n = number_colors) + instrs = instrs + )(n = number_colors) names(cell_color_code) <- unique(factor_data) pl <- pl + ggplot2::scale_color_manual(values = cell_color_code) } else if (!isTRUE(color_as_factor)) { if (is.null(gradient_midpoint)) { gradient_midpoint <- stats::median( - cell_locations_metadata_selected[[cell_color]]) + cell_locations_metadata_selected[[cell_color]] + ) } pl <- pl + set_default_color_continuous_cell( @@ -598,37 +620,38 @@ plot_spat_point_layer_ggplot_noFILL <- function(ggobject, #' @details Description of parameters. #' @keywords internal #' @noRd -plot_spat_voronoi_layer_ggplot <- function(ggobject, - instrs = NULL, - sdimx = NULL, - sdimy = NULL, - cell_locations_metadata_selected, - cell_locations_metadata_other, - 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_size = 2, - point_alpha = 1, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 4, - label_fontface = "bold", - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 1, - background_color = "white", - vor_border_color = "white", - vor_max_radius = 200, - vor_alpha = 1, - show_legend = TRUE, - ...) { +plot_spat_voronoi_layer_ggplot <- function( + ggobject, + instrs = NULL, + sdimx = NULL, + sdimy = NULL, + cell_locations_metadata_selected, + cell_locations_metadata_other, + 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_size = 2, + point_alpha = 1, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 4, + label_fontface = "bold", + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 1, + background_color = "white", + vor_border_color = "white", + vor_max_radius = 200, + vor_alpha = 1, + show_legend = TRUE, + ...) { ## specify spatial dimensions first if (is.null(sdimx) | is.null(sdimy)) { warning("plot_method = ggplot, but spatial dimensions for sdimx @@ -729,7 +752,8 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, if (is.null(gradient_midpoint)) { gradient_midpoint <- stats::median( - cell_locations_metadata_selected[["temp_color"]]) + cell_locations_metadata_selected[["temp_color"]] + ) } mybg_color <- ifelse(show_other_cells == TRUE, other_cell_color, @@ -824,7 +848,8 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, ) my_color_code <- unique( - combn_cell_locations_metadata[["temp_color"]]) + combn_cell_locations_metadata[["temp_color"]] + ) names(my_color_code) <- my_color_code pl <- pl + ggplot2::scale_fill_manual(values = c( @@ -888,7 +913,8 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, if (is.null(gradient_midpoint)) { gradient_midpoint <- stats::median( - cell_locations_metadata_selected[["temp_color"]]) + cell_locations_metadata_selected[["temp_color"]] + ) } pl <- pl + set_default_color_continuous_cell( @@ -905,7 +931,8 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, # convert character or numeric to factor if (color_as_factor == TRUE) { factor_data <- factor( - cell_locations_metadata_selected[[cell_color]]) + cell_locations_metadata_selected[[cell_color]] + ) cell_locations_metadata_selected[[cell_color]] <- factor_data } @@ -918,7 +945,8 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, center_2 = stats::median(get("sdimy")) ), by = cell_color] factor_center_data <- factor( - annotated_DT_centers[[cell_color]]) + annotated_DT_centers[[cell_color]] + ) annotated_DT_centers[[cell_color]] <- factor_center_data } @@ -928,9 +956,9 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, cell_locations_metadata_other[["temp_color"]] <- "other" } combn_cell_locations_metadata <- rbind( - cell_locations_metadata_selected, - cell_locations_metadata_other - ) + cell_locations_metadata_selected, + cell_locations_metadata_other + ) pl <- pl + ggforce::geom_voronoi_tile( data = combn_cell_locations_metadata, @@ -956,7 +984,8 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, } else if (isTRUE(color_as_factor)) { number_colors <- length(unique(factor_data)) cell_color_code <- set_default_color_discrete_cell( - instrs = instrs)(n = number_colors) + instrs = instrs + )(n = number_colors) names(cell_color_code) <- unique(factor_data) cell_color_code[["other"]] <- other_cell_color @@ -1047,21 +1076,20 @@ plot_spat_voronoi_layer_ggplot <- function(ggobject, #' This is most likely a polygon that corresponds to the cell shape. #' @keywords internal #' @noRd -plot_cell_polygon_layer <- function( - ggobject = NULL, - instrs = NULL, - polygon_dt, - polygon_grouping = "poly_ID", - fill = NULL, - poly_fill_gradient = NULL, - fill_gradient_midpoint = NULL, - fill_gradient_style = "divergent", - fill_as_factor = TRUE, - fill_code = NULL, - bg_color = "black", - color = "black", - alpha = 0.5, - size = 2) { +plot_cell_polygon_layer <- function(ggobject = NULL, + instrs = NULL, + polygon_dt, + polygon_grouping = "poly_ID", + fill = NULL, + poly_fill_gradient = NULL, + fill_gradient_midpoint = NULL, + fill_gradient_style = "divergent", + fill_as_factor = TRUE, + fill_code = NULL, + bg_color = "black", + color = "black", + alpha = 0.5, + size = 2) { # check fill column if (!is.null(fill)) { if (isTRUE(fill_as_factor)) { @@ -1102,7 +1130,8 @@ plot_cell_polygon_layer <- function( } else { fill_values_names <- unique(polygon_dt[["final_fill"]]) fill_code <- set_default_color_discrete_poly( - instrs = instrs)(length(fill_values_names)) + instrs = instrs + )(length(fill_values_names)) names(fill_code) <- fill_values_names pl <- pl + ggplot2::scale_fill_manual(values = fill_code) } @@ -1158,26 +1187,25 @@ plot_cell_polygon_layer <- function( #' These plots can get very big very fast. #' @keywords internal #' @noRd -plot_feature_points_layer <- function( - ggobject, - instrs = NULL, - ext, - spatial_feat_info, - feats, - feats_color_code = NULL, - feat_shape_code = NULL, - sdimx = "x", - sdimy = "y", - color = "feat_ID", - shape = "feat", - point_size = 1.5, - stroke = NULL, - show_legend = TRUE, - plot_method = c("ggplot", "scattermore", "scattermost"), - expand_counts = FALSE, - count_info_column = "count", - jitter = c(0, 0), - verbose = TRUE) { +plot_feature_points_layer <- function(ggobject, + instrs = NULL, + ext, + spatial_feat_info, + feats, + feats_color_code = NULL, + feat_shape_code = NULL, + sdimx = "x", + sdimy = "y", + color = "feat_ID", + shape = "feat", + point_size = 1.5, + stroke = NULL, + show_legend = TRUE, + plot_method = c("ggplot", "scattermore", "scattermost"), + expand_counts = FALSE, + count_info_column = "count", + jitter = c(0, 0), + verbose = TRUE) { # define plotting method plot_method <- match.arg( arg = plot_method, @@ -1220,7 +1248,8 @@ plot_feature_points_layer <- function( } else { feats_names <- unique(spatial_feat_info_subset[[color]]) feats_color_code <- set_default_color_discrete_feat( - instrs = instrs)(length(feats_names)) + instrs = instrs + )(length(feats_names)) names(feats_color_code) <- feats_names scattermost_color <- feats_color_code[spatial_feat_info_subset[["feat_ID"]]] @@ -1254,7 +1283,8 @@ plot_feature_points_layer <- function( } else { feats_names <- unique(spatial_feat_info_subset[[color]]) feats_color_code <- set_default_color_discrete_feat( - instrs = instrs)(length(feats_names)) + instrs = instrs + )(length(feats_names)) names(feats_color_code) <- feats_names pl <- pl + ggplot2::scale_color_manual(values = feats_color_code) } @@ -1282,13 +1312,14 @@ plot_feature_points_layer <- function( #' @details This function can plot one feature for one modality. #' @keywords internal #' @noRd -plot_feature_raster_density_layer <- function(ggobject = NULL, - instrs = NULL, - spatial_feat_info, - sel_feat, - sdimx = "x", - sdimy = "y", - alpha = 0.5) { +plot_feature_raster_density_layer <- function( + ggobject = NULL, + instrs = NULL, + spatial_feat_info, + sel_feat, + sdimx = "x", + sdimy = "y", + alpha = 0.5) { # data.table variable feat_ID <- NULL @@ -1330,16 +1361,15 @@ plot_feature_raster_density_layer <- function(ggobject = NULL, #' @details This function can plot one feature for one modality. #' @keywords internal #' @noRd -plot_feature_hexbin_layer <- function( - ggobject = NULL, - instrs = NULL, - spatial_feat_info, - sel_feat, - sdimx = "x", - sdimy = "y", - binwidth = NULL, - min_axis_bins = 10L, - alpha = 0.5) { +plot_feature_hexbin_layer <- function(ggobject = NULL, + instrs = NULL, + spatial_feat_info, + sel_feat, + sdimx = "x", + sdimy = "y", + binwidth = NULL, + min_axis_bins = 10L, + alpha = 0.5) { # data.table variables feat_ID <- NULL @@ -1348,8 +1378,8 @@ plot_feature_hexbin_layer <- function( # set default binwidth to 1/10 of minor axis if (is.null(binwidth)) { minorRange <- spatial_feat_info_subset[, - min(diff(vapply(.SD, range, FUN.VALUE = numeric(2)))), - .SDcols = c("x", "y") + min(diff(vapply(.SD, range, FUN.VALUE = numeric(2)))), + .SDcols = c("x", "y") ] binwidth <- as.integer(minorRange / min_axis_bins) } @@ -1401,15 +1431,14 @@ plot_feature_hexbin_layer <- function( #' @return ggplot #' @keywords internal #' @noRd -plot_spat_image_layer_ggplot <- function( - gg_obj, - gobject, - gimage, - spat_unit = NULL, - feat_type = NULL, - spat_loc_name = NULL, - polygon_feat_type = NULL, - ...) { +plot_spat_image_layer_ggplot <- function(gg_obj, + gobject, + gimage, + spat_unit = NULL, + feat_type = NULL, + spat_loc_name = NULL, + polygon_feat_type = NULL, + ...) { if (is.null(gobject) || is.null(gimage)) { stop("A giotto object and a giotto image need to be provided") } @@ -1457,17 +1486,16 @@ plot_spat_image_layer_ggplot <- function( #' @return ggplot #' @keywords internal #' @noRd -plot_spat_scatterpie_layer_ggplot <- function( - ggobject, - instrs = NULL, - sdimx = "sdimx", - sdimy = "sdimy", - spatial_locations = NULL, - spatial_enrichment = NULL, - radius = 10, - color = NA, - alpha = 1, - cell_color_code = NULL) { +plot_spat_scatterpie_layer_ggplot <- function(ggobject, + instrs = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + spatial_locations = NULL, + spatial_enrichment = NULL, + radius = 10, + color = NA, + alpha = 1, + cell_color_code = NULL) { # get cell names cell_names <- colnames(spatial_enrichment)[-1] @@ -1494,7 +1522,8 @@ plot_spat_scatterpie_layer_ggplot <- function( } else { number_colors <- length(unique(cell_names)) cell_color_code <- set_default_color_discrete_cell( - instrs = instrs)(n = number_colors) + instrs = instrs + )(n = number_colors) names(cell_color_code) <- unique(cell_names) pl <- pl + ggplot2::scale_fill_manual(values = cell_color_code) } @@ -1519,11 +1548,12 @@ plot_spat_scatterpie_layer_ggplot <- function( #' @details Description of parameters. #' @keywords internal #' @noRd -plot_network_layer_ggplot <- function(ggobject, - instrs = NULL, - annotated_network_DT, - edge_alpha = NULL, - show_legend = TRUE) { +plot_network_layer_ggplot <- function( + ggobject, + instrs = NULL, + annotated_network_DT, + edge_alpha = NULL, + show_legend = TRUE) { from_dims <- grep("from_Dim", colnames(annotated_network_DT), value = TRUE) to_dims <- grep("to_Dim", colnames(annotated_network_DT), value = TRUE) @@ -1577,35 +1607,36 @@ plot_network_layer_ggplot <- function(ggobject, #' @details Description of parameters. #' @keywords internal #' @noRd -plot_point_layer_ggplot <- function(ggobject, - instrs = NULL, - annotated_DT_selected, - annotated_DT_other, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = 0, - gradient_style = "divergent", - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - point_size = 1, - point_alpha = 1, - point_border_col = "black", - point_border_stroke = 0.1, - 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, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_legend = TRUE) { +plot_point_layer_ggplot <- function( + ggobject, + instrs = NULL, + annotated_DT_selected, + annotated_DT_other, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = 0, + gradient_style = "divergent", + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + point_size = 1, + point_alpha = 1, + point_border_col = "black", + point_border_stroke = 0.1, + 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, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_legend = TRUE) { pl <- ggobject @@ -1648,7 +1679,7 @@ plot_point_layer_ggplot <- function(ggobject, size = point_size, alpha = point_alpha ) - # map color for each cell + # 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)) { @@ -1740,7 +1771,8 @@ plot_point_layer_ggplot <- function(ggobject, center_2 = stats::median(get(dims[2])) ), by = cell_color] factor_center_data <- factor( - annotated_DT_centers[[cell_color]]) + annotated_DT_centers[[cell_color]] + ) annotated_DT_centers[[cell_color]] <- factor_center_data } @@ -1795,7 +1827,8 @@ plot_point_layer_ggplot <- function(ggobject, } else if (isTRUE(color_as_factor)) { number_colors <- length(unique(factor_data)) cell_color_code <- set_default_color_discrete_cell( - instrs = instrs)(n = number_colors) + instrs = instrs + )(n = number_colors) names(cell_color_code) <- unique(factor_data) pl <- pl + ggplot2::scale_fill_manual(values = cell_color_code) } else if (!isTRUE(color_as_factor)) { @@ -1829,34 +1862,33 @@ plot_point_layer_ggplot <- function(ggobject, #' @details Description of parameters. #' @keywords internal #' @noRd -plot_point_layer_ggplot_noFILL <- function( - ggobject, - plot_method = "ggplot", - instrs = NULL, - annotated_DT_selected, - annotated_DT_other, - cell_color = NULL, - color_as_factor = TRUE, - cell_color_code = NULL, - cell_color_gradient = NULL, - gradient_midpoint = 0, - gradient_style = "divergent", - gradient_limits = NULL, - select_cell_groups = NULL, - select_cells = NULL, - point_size = 1, - point_alpha = 1, - show_cluster_center = FALSE, - show_center_label = TRUE, - center_point_size = 4, - label_size = 4, - label_fontface = "bold", - edge_alpha = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 0.5, - show_legend = TRUE, - ...) { +plot_point_layer_ggplot_noFILL <- function(ggobject, + plot_method = "ggplot", + instrs = NULL, + annotated_DT_selected, + annotated_DT_other, + cell_color = NULL, + color_as_factor = TRUE, + cell_color_code = NULL, + cell_color_gradient = NULL, + gradient_midpoint = 0, + gradient_style = "divergent", + gradient_limits = NULL, + select_cell_groups = NULL, + select_cells = NULL, + point_size = 1, + point_alpha = 1, + show_cluster_center = FALSE, + show_center_label = TRUE, + center_point_size = 4, + label_size = 4, + label_fontface = "bold", + edge_alpha = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 0.5, + show_legend = TRUE, + ...) { pl <- ggobject plot_method <- match.arg(plot_method, c("ggplot", "scattermore")) @@ -1890,7 +1922,8 @@ plot_point_layer_ggplot_noFILL <- function( if (is.null(cell_color)) { cell_color <- "lightblue" - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_selected, mapping = aes_string(x = dims[1], dims[2]), color = cell_color, show.legend = show_legend, size = point_size, @@ -1916,7 +1949,8 @@ plot_point_layer_ggplot_noFILL <- function( stop("cell_color is not numeric, a factor or vector of colors \n") } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_selected, mapping = aes_string2(x = dims[1], y = dims[2]), show.legend = show_legend, shape = 19, @@ -1930,7 +1964,8 @@ plot_point_layer_ggplot_noFILL <- function( if (!cell_color %in% grDevices::colors()) { stop(cell_color, " is not a color or a column name \n") } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_selected, mapping = aes_string(x = dims[1], y = dims[2]), show.legend = show_legend, shape = 19, @@ -1959,7 +1994,8 @@ plot_point_layer_ggplot_noFILL <- function( annotated_DT_selected[[cell_color]] <- limit_numeric_data } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_selected, mapping = aes_string2(x = dims[1], y = dims[2], color = cell_color), show.legend = show_legend, shape = 19, size = point_size, @@ -1984,7 +2020,8 @@ plot_point_layer_ggplot_noFILL <- function( annotated_DT_centers[[cell_color]] <- factor_center_data } - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_selected, mapping = aes_string2(x = dims[1], y = dims[2], color = cell_color), show.legend = show_legend, shape = 19, size = point_size, @@ -1997,7 +2034,8 @@ plot_point_layer_ggplot_noFILL <- function( if (show_cluster_center == TRUE & (color_as_factor == TRUE | class_cell_color %in% c("character", "factor"))) { - pl <- pl + giotto_point(plot_method = plot_method, + pl <- pl + giotto_point( + plot_method = plot_method, data = annotated_DT_centers, mapping = aes_string2( x = "center_1", y = "center_2", @@ -2030,13 +2068,15 @@ plot_point_layer_ggplot_noFILL <- function( } else if (color_as_factor == TRUE) { number_colors <- length(unique(factor_data)) cell_color_code <- set_default_color_discrete_cell( - instrs = instrs)(n = number_colors) + instrs = instrs + )(n = number_colors) names(cell_color_code) <- unique(factor_data) pl <- pl + ggplot2::scale_color_manual(values = cell_color_code) } else if (color_as_factor == FALSE) { if (is.null(gradient_midpoint)) { gradient_midpoint <- stats::median( - annotated_DT_selected[[cell_color]]) + annotated_DT_selected[[cell_color]] + ) } pl <- pl + set_default_color_continuous_cell( colors = cell_color_gradient, @@ -2076,19 +2116,19 @@ plot_point_layer_ggplot_noFILL <- function( #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' #' my_giottoimage <- GiottoClass::createGiottoImage(g, -#' mg_object = system.file("image.png", package = "GiottoVisuals"), -#' name = 'image') +#' mg_object = system.file("image.png", package = "GiottoVisuals"), +#' name = "image" +#' ) #' #' my_spatplot <- spatPlot2D(g, return_plot = TRUE) #' #' addGiottoImageToSpatPlot(spatpl = my_spatplot, gimage = my_giottoimage) #' #' @export -addGiottoImageToSpatPlot <- function( - spatpl = NULL, - gimage = NULL, - layer = c("bg", "overlay"), - alpha = NULL) { +addGiottoImageToSpatPlot <- function(spatpl = NULL, + gimage = NULL, + layer = c("bg", "overlay"), + alpha = NULL) { layer <- match.arg(arg = layer, choices = c("bg", "overlay")) if (is.null(spatpl) | is.null(gimage)) { diff --git a/R/gg_param.R b/R/gg_param.R index f324c03..d1933fd 100644 --- a/R/gg_param.R +++ b/R/gg_param.R @@ -1,4 +1,3 @@ - .handle_param_dups <- function(x, warn = TRUE, what = "aes") { ns <- names(x) dups <- duplicated(ns, fromLast = TRUE) @@ -76,20 +75,21 @@ combine_aes <- function(..., warn_duplicates = TRUE) { #' # ----- single step ----- # #' p_single <- gg_param( #' data = d, -#' x = as.name("xvals"), # aes -#' fill = "green", # toplevel +#' x = as.name("xvals"), # aes +#' fill = "green", # toplevel #' aes( -#' size = size_col, # aes -#' y = yvals # aes +#' size = size_col, # aes +#' y = yvals # aes #' ), -#' show.legend = TRUE, # toplevel +#' show.legend = TRUE, # toplevel #' list( -#' shape = 21, # toplevel -#' alpha = as.name("values") # aes +#' shape = 21, # toplevel +#' alpha = as.name("values") # aes #' ) #' ) #' -#' ggplot() + do.call(geom_point, p_single) +#' ggplot() + +#' do.call(geom_point, p_single) #' #' # ----- multistep appending ----- # #' @@ -110,14 +110,17 @@ combine_aes <- function(..., warn_duplicates = TRUE) { #' #' # `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) +#' 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 +#' 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) +#' 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) { @@ -171,7 +174,8 @@ gg_param <- function(..., data = NULL, warn_duplicates = TRUE) { 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, + warn = warn_duplicates, what = "toplevel" ) p_items$mapping <- a_items @@ -179,6 +183,3 @@ gg_param <- function(..., data = NULL, warn_duplicates = TRUE) { class(p_items) <- "gplot_param" return(p_items) } - - - diff --git a/R/gg_settings.R b/R/gg_settings.R index 20eba2d..dfd623d 100644 --- a/R/gg_settings.R +++ b/R/gg_settings.R @@ -1,16 +1,12 @@ - - # wrapper for ggplot2 with some adapters for Giotto settings # ggplot2-native arg inputs are preferred # -.gg_theme <- function( - legend_text = 8, - axis_title = 8, - axis_text = 8, - axis_text_y_angle = 90, - background_color = "white", - ... -) { +.gg_theme <- function(legend_text = 8, + axis_title = 8, + axis_text = 8, + axis_text_y_angle = 90, + background_color = "white", + ...) { a <- list(...) # giotto masked args @@ -48,5 +44,3 @@ theme_dark2 <- theme( legend.text = element_text(color = "white"), legend.title = element_text(color = "white") ) - - diff --git a/R/gstop.R b/R/gstop.R index aad8e5d..afd71e5 100644 --- a/R/gstop.R +++ b/R/gstop.R @@ -2,14 +2,15 @@ # .n should be increased when called from a nested location if capturing the # original call is desired. # .n should be increased to 2L when within a generic method -.gstop <- function(..., - sep = " ", - strWidth = 100, - errWidth = FALSE, - .prefix = " ", - .initial = "", - .n = 1L, - .call = TRUE) { +.gstop <- function( + ..., + sep = " ", + strWidth = 100, + errWidth = FALSE, + .prefix = " ", + .initial = "", + .n = 1L, + .call = TRUE) { GiottoUtils::gstop( ..., sep = sep, diff --git a/R/mixcolor.R b/R/mixcolor.R index c3b117d..d0ef215 100644 --- a/R/mixcolor.R +++ b/R/mixcolor.R @@ -178,8 +178,9 @@ hex2hsv <- function(x) { #' @rdname mixHSV #' @export -mixHSV <- function(c1, c2, base_color = c("white", "black"), - output = c("hex", "hsv")) { +mixHSV <- function( + c1, c2, base_color = c("white", "black"), + output = c("hex", "hsv")) { base_color <- match.arg(base_color, choices = c("white", "black")) output <- match.arg(output, c("hex", "hsv")) diff --git a/R/plot_dendrogram.R b/R/plot_dendrogram.R index 5a9ab09..4783f47 100644 --- a/R/plot_dendrogram.R +++ b/R/plot_dendrogram.R @@ -22,23 +22,22 @@ #' showClusterDendrogram(g, cluster_column = "leiden_clus") #' #' @export -showClusterDendrogram <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - cluster_column, - cor = c("pearson", "spearman"), - distance = "ward.D", - h = NULL, - h_color = "red", - rotate = FALSE, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "showClusterDendrogram", - ...) { +showClusterDendrogram <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + cluster_column, + cor = c("pearson", "spearman"), + distance = "ward.D", + h = NULL, + h_color = "red", + rotate = FALSE, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "showClusterDendrogram", + ...) { # verify if optional package is installed package_check(pkg_name = "ggdendro", repository = "CRAN") @@ -122,24 +121,28 @@ showClusterDendrogram <- function( #' g_expression_df <- as.data.frame(as.matrix(g_expression)) #' g_expression_df$feat_ID <- rownames(g_expression) #' -#' 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") +#' 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), -#' var_col = "cell_ID", clus_col = "feat_ID", "raw_expression") +#' var_col = "cell_ID", clus_col = "feat_ID", "raw_expression" +#' ) #' #' @export -create_cluster_dendrogram <- function(data, - clus_col = names(data)[[1]], - var_col = names(data)[[2]], - val_col = names(data)[[3]], - cor = c("pearson", "spearman"), - distance = "ward.D", - h = NULL, - h_color = "red", - rotate = FALSE, - ...) { +create_cluster_dendrogram <- function( + data, + clus_col = names(data)[[1]], + var_col = names(data)[[2]], + val_col = names(data)[[3]], + cor = c("pearson", "spearman"), + distance = "ward.D", + h = NULL, + h_color = "red", + rotate = FALSE, + ...) { checkmate::assert_data_table(data) checkmate::assert_character(clus_col) checkmate::assert_character(var_col) diff --git a/R/plot_dotplot.R b/R/plot_dotplot.R index 384d253..7dbf9e1 100644 --- a/R/plot_dotplot.R +++ b/R/plot_dotplot.R @@ -1,8 +1,3 @@ - - - - - #' @name dotPlot #' @title Create a dotplot #' @description Visualize feature expression statistics applied across @@ -77,46 +72,44 @@ #' 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" -) { +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)) { @@ -136,12 +129,16 @@ dotPlot <- function( 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) + 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"] @@ -253,12 +250,10 @@ dotPlot <- function( # 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 -) { +.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 @@ -281,7 +276,7 @@ dotPlot <- function( data.table::setnames(plot_dt, old = cluster_column, new = "cluster") ## dot size cutoff ## - plot_dt <- plot_dt[size > dot_size_threshold,] + plot_dt <- plot_dt[size > dot_size_threshold, ] ## set cluster order ## if (is.null(cluster_custom_order)) { @@ -333,6 +328,3 @@ dotPlot <- function( return(pl) } - - - diff --git a/R/plot_heatmap.R b/R/plot_heatmap.R index 7aac3e2..7e54802 100644 --- a/R/plot_heatmap.R +++ b/R/plot_heatmap.R @@ -20,21 +20,20 @@ #' showClusterHeatmap(g, cluster_column = "leiden_clus") #' #' @export -showClusterHeatmap <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats = "all", - cluster_column, - cor = c("pearson", "spearman"), - distance = "ward.D", - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "showClusterHeatmap", - ...) { +showClusterHeatmap <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats = "all", + cluster_column, + cor = c("pearson", "spearman"), + distance = "ward.D", + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "showClusterHeatmap", + ...) { # package Check package_check(pkg_name = "ComplexHeatmap", repository = "Bioc") @@ -148,39 +147,40 @@ showClusterHeatmap <- function( #' } #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotHeatmap(g, feats = c("Gm19935", "Gna12", "Ccnd2", "Btbd17"), -#' cluster_column = "leiden_clus") +#' plotHeatmap(g, +#' feats = c("Gm19935", "Gna12", "Ccnd2", "Btbd17"), +#' cluster_column = "leiden_clus" +#' ) #' #' @export -plotHeatmap <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats, - cluster_column = NULL, - cluster_order = c("size", "correlation", "custom"), - cluster_custom_order = NULL, - cluster_color_code = NULL, - cluster_cor_method = "pearson", - cluster_hclust_method = "ward.D", - feat_order = c("correlation", "custom"), - feat_custom_order = NULL, - feat_cor_method = "pearson", - feat_hclust_method = "complete", - show_values = c("rescaled", "z-scaled", "original"), - size_vertical_lines = 1.1, - gradient_colors = deprecated(), - gradient_color = NULL, - gradient_style = c("divergent", "sequential"), - feat_label_selection = NULL, - axis_text_y_size = NULL, - legend_nrows = 1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotHeatmap") { +plotHeatmap <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats, + cluster_column = NULL, + cluster_order = c("size", "correlation", "custom"), + cluster_custom_order = NULL, + cluster_color_code = NULL, + cluster_cor_method = "pearson", + cluster_hclust_method = "ward.D", + feat_order = c("correlation", "custom"), + feat_custom_order = NULL, + feat_cor_method = "pearson", + feat_hclust_method = "complete", + show_values = c("rescaled", "z-scaled", "original"), + size_vertical_lines = 1.1, + gradient_colors = deprecated(), + gradient_color = NULL, + gradient_style = c("divergent", "sequential"), + feat_label_selection = NULL, + axis_text_y_size = NULL, + legend_nrows = 1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotHeatmap") { # deprecate if (GiottoUtils::is_present(gradient_colors)) { deprecate_warn( @@ -443,40 +443,43 @@ plotHeatmap <- function( #' @returns ggplot or data.table #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' plotMetaDataHeatmap(g, metadata_cols = "leiden_clus", -#' selected_feats = c("Gna12", "Ccnd2", "Btbd17", "Gm19935")) +#' plotMetaDataHeatmap(g, +#' metadata_cols = "leiden_clus", +#' selected_feats = c("Gna12", "Ccnd2", "Btbd17", "Gm19935") +#' ) #' #' @export -plotMetaDataHeatmap <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - metadata_cols = NULL, - selected_feats = NULL, - first_meta_col = NULL, - second_meta_col = NULL, - show_values = c("zscores", "original", "zscores_rescaled"), - custom_cluster_order = NULL, - clus_cor_method = "pearson", - clus_cluster_method = "complete", - custom_feat_order = NULL, - feat_cor_method = "pearson", - feat_cluster_method = "complete", - gradient_color = NULL, - gradient_midpoint = 0, - gradient_style = c("divergent", "sequential"), - gradient_limits = NULL, - x_text_size = 10, - x_text_angle = 45, - y_text_size = 10, - strip_text_size = 8, - title = NULL, - plot_title = deprecated(), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotMetaDataHeatmap") { +plotMetaDataHeatmap <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + metadata_cols = NULL, + selected_feats = NULL, + first_meta_col = NULL, + second_meta_col = NULL, + show_values = c("zscores", "original", "zscores_rescaled"), + custom_cluster_order = NULL, + clus_cor_method = "pearson", + clus_cluster_method = "complete", + custom_feat_order = NULL, + feat_cor_method = "pearson", + feat_cluster_method = "complete", + gradient_color = NULL, + gradient_midpoint = 0, + gradient_style = c("divergent", "sequential"), + gradient_limits = NULL, + x_text_size = 10, + x_text_angle = 45, + y_text_size = 10, + strip_text_size = 8, + title = NULL, + plot_title = deprecated(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotMetaDataHeatmap") { # deprecate if (GiottoUtils::is_present(plot_title)) { deprecate_warn( @@ -568,7 +571,8 @@ plotMetaDataHeatmap <- function(gobject, method = feat_cor_method ) feat_cordist <- stats::as.dist(1 - feat_cormatrix, - diag = TRUE, upper = TRUE) + diag = TRUE, upper = TRUE + ) feat_corclus <- stats::hclust( d = feat_cordist, method = feat_cluster_method @@ -830,35 +834,34 @@ plotMetaDataHeatmap <- function(gobject, #' @returns ggplot or data.table #' #' @export -plotMetaDataCellsHeatmap <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - metadata_cols = NULL, - spat_enr_names = NULL, - value_cols = NULL, - first_meta_col = NULL, - second_meta_col = NULL, - show_values = c("zscores", "original", "zscores_rescaled"), - custom_cluster_order = NULL, - clus_cor_method = "pearson", - clus_cluster_method = "complete", - custom_values_order = NULL, - values_cor_method = "pearson", - values_cluster_method = "complete", - gradient_color = NULL, - gradient_midpoint = 0, - gradient_style = c("divergent", "sequential"), - midpoint = deprecated(), - x_text_size = 8, - x_text_angle = 45, - y_text_size = 8, - strip_text_size = 8, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotMetaDataCellsHeatmap") { +plotMetaDataCellsHeatmap <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + metadata_cols = NULL, + spat_enr_names = NULL, + value_cols = NULL, + first_meta_col = NULL, + second_meta_col = NULL, + show_values = c("zscores", "original", "zscores_rescaled"), + custom_cluster_order = NULL, + clus_cor_method = "pearson", + clus_cluster_method = "complete", + custom_values_order = NULL, + values_cor_method = "pearson", + values_cluster_method = "complete", + gradient_color = NULL, + gradient_midpoint = 0, + gradient_style = c("divergent", "sequential"), + midpoint = deprecated(), + x_text_size = 8, + x_text_angle = 45, + y_text_size = 8, + strip_text_size = 8, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotMetaDataCellsHeatmap") { # deprecate if (GiottoUtils::is_present(midpoint)) { deprecate_warn( @@ -921,7 +924,8 @@ plotMetaDataCellsHeatmap <- function( if (is.null(custom_cluster_order)) { cormatrix <- cor_flex(x = testmain_mat, method = clus_cor_method) cordist <- stats::as.dist(1 - cormatrix, - diag = TRUE, upper = TRUE) + diag = TRUE, upper = TRUE + ) corclus <- stats::hclust(d = cordist, method = clus_cluster_method) clus_names <- rownames(cormatrix) names(clus_names) <- seq_len(length(clus_names)) @@ -942,8 +946,8 @@ plotMetaDataCellsHeatmap <- function( method = values_cor_method ) values_cordist <- stats::as.dist(1 - values_cormatrix, - diag = TRUE, - upper = TRUE + diag = TRUE, + upper = TRUE ) values_corclus <- stats::hclust( d = values_cordist, @@ -965,9 +969,11 @@ plotMetaDataCellsHeatmap <- function( factor_column <- variable <- NULL metaDT[, factor_column := factor(get(metadata_cols), - levels = clus_sort_names)] + levels = clus_sort_names + )] metaDT[, variable := factor(get("variable"), - levels = values_sort_names)] + levels = values_sort_names + )] pl <- ggplot2::ggplot() pl <- pl + @@ -1009,10 +1015,12 @@ plotMetaDataCellsHeatmap <- function( metaDT[, factor_1_column := factor( get(first_meta_col), - clus_sort_names)] + clus_sort_names + )] metaDT[, factor_2_column := as.factor(get(second_meta_col))] metaDT[, variable := factor(get("variable"), - levels = values_sort_names)] + levels = values_sort_names + )] pl <- ggplot2::ggplot() pl <- pl + @@ -1021,7 +1029,8 @@ plotMetaDataCellsHeatmap <- function( ggplot2::aes_string( x = "factor_1_column", y = "variable", - fill = show_values), + fill = show_values + ), color = "black" ) pl <- pl + set_default_color_continuous_heatmap( @@ -1029,7 +1038,8 @@ plotMetaDataCellsHeatmap <- function( instrs = instructions(gobject), midpoint = gradient_midpoint, style = gradient_style, - type = "fill") + type = "fill" + ) pl <- pl + ggplot2::facet_grid(stats::reformulate("factor_2_column")) pl <- pl + ggplot2::theme_classic() @@ -1037,10 +1047,12 @@ plotMetaDataCellsHeatmap <- function( axis.text.x = ggplot2::element_text( size = x_text_size, angle = x_text_angle, - hjust = 1, vjust = 1), + hjust = 1, vjust = 1 + ), axis.text.y = ggplot2::element_text(size = y_text_size), strip.text = ggplot2::element_text(size = strip_text_size), - legend.title = ggplot2::element_blank()) + legend.title = ggplot2::element_blank() + ) pl <- pl + ggplot2::labs( x = first_meta_col, y = "genes", title = second_meta_col @@ -1092,20 +1104,21 @@ plotMetaDataCellsHeatmap <- function( #' @return list #' @details Creates input data.tables for plotHeatmap function. #' @keywords internal -.create_heatmap_dt <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats, - cluster_column = NULL, - cluster_order = c("size", "correlation", "custom"), - cluster_custom_order = NULL, - cluster_cor_method = "pearson", - cluster_hclust_method = "ward.D", - feat_order = c("correlation", "custom"), - feat_custom_order = NULL, - feat_cor_method = "pearson", - feat_hclust_method = "complete") { +.create_heatmap_dt <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats, + cluster_column = NULL, + cluster_order = c("size", "correlation", "custom"), + cluster_custom_order = NULL, + cluster_cor_method = "pearson", + cluster_hclust_method = "ward.D", + feat_order = c("correlation", "custom"), + feat_custom_order = NULL, + feat_cor_method = "pearson", + feat_hclust_method = "complete") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -1182,14 +1195,18 @@ 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)), - by = feats] + subset_values_DT[, scale_scores := scales::rescale( + x = expression, + to = c(0, 1) + ), + by = feats + ] ## order cells by mean expression ## cell_order_DT <- subset_values_DT[, mean(expression), - by = c("cells", cluster_column)] + by = c("cells", cluster_column) + ] cell_order_DT <- cell_order_DT[order(get(cluster_column), V1)] subset_values_DT[, cells := factor(cells, cell_order_DT$cells)] @@ -1199,18 +1216,21 @@ plotMetaDataCellsHeatmap <- function( ## order feats ## if (feat_order == "correlation") { featsum_per_clus <- subset_values_DT[, sum(expression), - by = c("feats", cluster_column)] + by = c("feats", cluster_column) + ] my_formula <- paste0("feats~", cluster_column) test_mat <- data.table::dcast.data.table( data = featsum_per_clus, formula = my_formula, - value.var = "V1") + value.var = "V1" + ) test_matrix <- as.matrix(test_mat[, -1]) rownames(test_matrix) <- test_mat$feats feat_dist <- stats::as.dist(1 - cor_flex(t_flex(test_matrix), - method = feat_cor_method)) + method = feat_cor_method + )) feat_clus <- stats::hclust(feat_dist, method = feat_hclust_method) feat_labels <- rownames(test_matrix) @@ -1219,7 +1239,8 @@ plotMetaDataCellsHeatmap <- function( final_feat_order <- names(feat_index[match( feat_clus$order, - feat_index)]) + feat_index + )]) subset_values_DT[, "feats" := factor(feats, final_feat_order)] } else if (feat_order == "custom") { if (is.null(feat_custom_order)) { @@ -1230,7 +1251,8 @@ plotMetaDataCellsHeatmap <- function( } cell_order_DT[["cells"]] <- factor(cell_order_DT[["cells"]], - levels = as.character(cell_order_DT[["cells"]])) + levels = as.character(cell_order_DT[["cells"]]) + ) return( list( diff --git a/R/plot_sankey.R b/R/plot_sankey.R index 98e158d..fbcfc22 100644 --- a/R/plot_sankey.R +++ b/R/plot_sankey.R @@ -201,11 +201,13 @@ setMethod( # remove all #' @param x giottoSankeyPlan #' @returns character #' @examples -#' my_sankeyplan <- sankeySet(spat_unit = "cell", -#' feat_type = "rna", col = "leiden_clus") +#' my_sankeyplan <- sankeySet( +#' spat_unit = "cell", +#' feat_type = "rna", col = "leiden_clus" +#' ) #' my_sankeyplan <- `sankeyLabel<-`(my_sankeyplan, value = "my_label") #' sankeyLabel(my_sankeyplan) -#' +#' #' @export sankeyLabel <- function(x) { return(x@set_label) @@ -215,8 +217,10 @@ sankeyLabel <- function(x) { #' @param value values to set #' @returns a `giottoSankeyPlan` #' @examples -#' my_sankeyplan <- sankeySet(spat_unit = "cell", -#' feat_type = "rna", col = "leiden_clus") +#' my_sankeyplan <- sankeySet( +#' spat_unit = "cell", +#' feat_type = "rna", col = "leiden_clus" +#' ) #' my_sankeyplan <- `sankeyLabel<-`(my_sankeyplan, value = "my_label") #' @export `sankeyLabel<-` <- function(x, value) { @@ -242,9 +246,11 @@ setMethod( # update addresses e1@set_address <- rbind(e1@set_address, e2@set_address) if (any(duplicated( - e1@set_address[, c("spat_unit", "feat_type", "col")]))) { + e1@set_address[, c("spat_unit", "feat_type", "col")] + ))) { stop( - "Not possible to append more than one reference to the same node") + "Not possible to append more than one reference to the same node" + ) # TODO try to recover } @@ -286,15 +292,18 @@ setMethod( #' @param label (optional) character label for a set #' @returns a `giottoSankeyPlan` #' @examples -#' my_sankeyplan <- sankeySet(spat_unit = "cell", -#' feat_type = "rna", col = "leiden_clus") -#' +#' my_sankeyplan <- sankeySet( +#' spat_unit = "cell", +#' feat_type = "rna", col = "leiden_clus" +#' ) +#' #' @keywords plotting sankey #' @export -sankeySet <- function(spat_unit = NULL, - feat_type = NULL, - col, index = NULL, - label = NA_character_) { +sankeySet <- function( + spat_unit = NULL, + feat_type = NULL, + col, index = NULL, + label = NA_character_) { x <- giottoSankeyPlan( set_address = data.table::data.table( spat_unit = spat_unit, @@ -315,7 +324,7 @@ sankeySet <- function(spat_unit = NULL, #' @param index new index subset, provided in the same order as the set_id #' @returns a `giottoSankeyPlan` #' @keywords plotting sankey -#' +#' #' @export subsetSankeySet <- function(x, set_id, index = list()) { if (!is.list(index)) index <- list(index) @@ -339,10 +348,12 @@ subsetSankeySet <- function(x, set_id, index = list()) { #' @param x giottoSankeyPlan object #' @returns a `giottoSankeyPlan` #' @examples -#' my_sankeyplan <- sankeySet(spat_unit = "cell", -#' feat_type = "rna", col = "leiden_clus") +#' my_sankeyplan <- sankeySet( +#' spat_unit = "cell", +#' feat_type = "rna", col = "leiden_clus" +#' ) #' my_sankeyplan <- sankeySetAddresses(my_sankeyplan) -#' +#' #' @export #' @keywords plotting sankey sankeySetAddresses <- function(x) { @@ -581,12 +592,13 @@ setMethod( x = "giotto", y = "giottoSankeyPlan" ), - function(x, - y, - meta_type = c("cell", "feat"), - focus_names = NULL, - unfocused_color = FALSE, - ...) { + function( + x, + y, + meta_type = c("cell", "feat"), + focus_names = NULL, + unfocused_color = FALSE, + ...) { GiottoUtils::package_check("networkD3") meta_type <- match.arg(meta_type, choices = c("cell", "feat")) y@data_type <- meta_type @@ -642,16 +654,15 @@ setMethod( x = "giotto", y = "character" ), - function( - x, - y, - spat_unit = NULL, - feat_type = NULL, - meta_type = c("cell", "feat"), - idx = NULL, - focus_names = NULL, - unfocused_color = FALSE, - ...) { + function(x, + y, + spat_unit = NULL, + feat_type = NULL, + meta_type = c("cell", "feat"), + idx = NULL, + focus_names = NULL, + unfocused_color = FALSE, + ...) { GiottoUtils::package_check("networkD3") checkmate::assert_character(y, len = 2L) @@ -819,18 +830,19 @@ setMethod( #' additional params for controlling the plot. #' @returns networkd3 sankey #' @keywords internal -.sankey_networkd3 <- function(Links, - Nodes, - Source = "source", - Target = "target", - Value = "value", - NodeID = "name", - nodePadding = 1, - sinksRight = FALSE, - focus_names = NULL, - unfocused_replacer = "", - unfocused_color = FALSE, - ...) { +.sankey_networkd3 <- function( + Links, + Nodes, + Source = "source", + Target = "target", + Value = "value", + NodeID = "name", + nodePadding = 1, + sinksRight = FALSE, + focus_names = NULL, + unfocused_replacer = "", + unfocused_color = FALSE, + ...) { # NSE vars color <- NULL diff --git a/R/plot_scatter.R b/R/plot_scatter.R index badebd2..73edcb4 100644 --- a/R/plot_scatter.R +++ b/R/plot_scatter.R @@ -15,8 +15,9 @@ #' gg_simple_scatter(data = x, x = "x", y = "y") #' #' @export -gg_simple_scatter <- function(ggobject = NULL, data, x, y, - xlab = "x", ylab = "y", main = NULL, ...) { +gg_simple_scatter <- function( + ggobject = NULL, data, x, y, + xlab = "x", ylab = "y", main = NULL, ...) { pl <- gg_input(ggobject) pl <- pl + diff --git a/R/plot_violin.R b/R/plot_violin.R index f1ae2f9..ca9f22c 100644 --- a/R/plot_violin.R +++ b/R/plot_violin.R @@ -19,29 +19,30 @@ #' @returns ggplot #' @examples #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -#' violinPlot(g, feats = c("Gna12", "Ccnd2", "Btbd17"), -#' cluster_column = "leiden_clus") +#' violinPlot(g, +#' feats = c("Gna12", "Ccnd2", "Btbd17"), +#' cluster_column = "leiden_clus" +#' ) #' #' @export -violinPlot <- function( - gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats = NULL, - cluster_column, - cluster_custom_order = NULL, - color_violin = c("feats", "cluster"), - cluster_color_code = NULL, - strip_position = c("top", "right", "left", "bottom"), - strip_text = 7, - axis_text_x_size = 10, - axis_text_y_size = 6, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "violinPlot") { +violinPlot <- function(gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats = NULL, + cluster_column, + cluster_custom_order = NULL, + color_violin = c("feats", "cluster"), + cluster_color_code = NULL, + strip_position = c("top", "right", "left", "bottom"), + strip_text = 7, + axis_text_x_size = 10, + axis_text_y_size = 6, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "violinPlot") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, diff --git a/R/spatialDE_visuals.R b/R/spatialDE_visuals.R index f3c7468..6ec8891 100644 --- a/R/spatialDE_visuals.R +++ b/R/spatialDE_visuals.R @@ -10,18 +10,18 @@ #' @details Description of parameters. #' @keywords internal #' @returns ggplot object -#' +#' #' @export -FSV_show <- function( - results, - ms_results = NULL, - size = c(4, 2, 1), - color = c("blue", "green", "red"), - sig_alpha = 0.5, - unsig_alpha = 0.5) { +FSV_show <- function(results, + ms_results = NULL, + size = c(4, 2, 1), + color = c("blue", "green", "red"), + sig_alpha = 0.5, + unsig_alpha = 0.5) { results$FSV95conf <- 2 * sqrt(results$s2_FSV) - results$intervals <- cut(results$FSV95conf, c(0, 1e-1, 1e0, Inf), - label = FALSE) + results$intervals <- cut(results$FSV95conf, c(0, 1e-1, 1e0, Inf), + label = FALSE + ) results$log_pval <- log10(results$pval) if (is.null(ms_results)) { diff --git a/R/vis_spatial_gg.R b/R/vis_spatial_gg.R index d515617..6486205 100644 --- a/R/vis_spatial_gg.R +++ b/R/vis_spatial_gg.R @@ -42,67 +42,68 @@ #' @details Description of parameters. #' @keywords internal #' @seealso \code{\link{spatPlot3D}} -.spatPlot2D_single <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - plot_method = "ggplot", - 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") { +.spatPlot2D_single <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + plot_method = "ggplot", + 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") @@ -492,73 +493,74 @@ #' @details coord_fix_ratio: set to NULL to use default ggplot parameters #' @returns ggplot #' @export -spatPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - plot_method = "ggplot", - 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") { +spatPlot2D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + plot_method = "ggplot", + 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 @@ -870,33 +872,34 @@ spatPlot <- function(...) { #' @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") { +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") @@ -1055,54 +1058,55 @@ spatDeconvPlot <- function(gobject, # 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") { +.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 @@ -1452,60 +1456,61 @@ spatDeconvPlot <- function(gobject, #' 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") { +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") @@ -1745,10 +1750,11 @@ dimPlot <- function(...) { #' g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) #' plotUMAP_2D(g) #' @export -plotUMAP_2D <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "UMAP_2D", - ...) { +plotUMAP_2D <- function( + gobject, + dim_reduction_name = NULL, + default_save_name = "UMAP_2D", + ...) { checkmate::assert_class(gobject, "giotto") dimPlot2D( @@ -1776,10 +1782,11 @@ plotUMAP_2D <- function(gobject, #' plotUMAP(g) #' #' @export -plotUMAP <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "UMAP", - ...) { +plotUMAP <- function( + gobject, + dim_reduction_name = NULL, + default_save_name = "UMAP", + ...) { checkmate::assert_class(gobject, "giotto") dimPlot2D( @@ -1812,10 +1819,11 @@ plotUMAP <- function(gobject, #' plotTSNE_2D(g) #' #' @export -plotTSNE_2D <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "tSNE_2D", - ...) { +plotTSNE_2D <- function( + gobject, + dim_reduction_name = NULL, + default_save_name = "tSNE_2D", + ...) { checkmate::assert_class(gobject, "giotto") dimPlot2D( @@ -1844,10 +1852,11 @@ plotTSNE_2D <- function(gobject, #' plotTSNE(g) #' #' @export -plotTSNE <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "tSNE", - ...) { +plotTSNE <- function( + gobject, + dim_reduction_name = NULL, + default_save_name = "tSNE", + ...) { checkmate::assert_class(gobject, "giotto") dimPlot2D( @@ -1878,10 +1887,11 @@ plotTSNE <- function(gobject, #' plotPCA_2D(g) #' #' @export -plotPCA_2D <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "PCA_2D", - ...) { +plotPCA_2D <- function( + gobject, + dim_reduction_name = NULL, + default_save_name = "PCA_2D", + ...) { checkmate::assert_class(gobject, "giotto") dimPlot2D( @@ -1912,10 +1922,11 @@ plotPCA_2D <- function(gobject, #' plotPCA(g) #' #' @export -plotPCA <- function(gobject, - dim_reduction_name = NULL, - default_save_name = "PCA", - ...) { +plotPCA <- function( + gobject, + dim_reduction_name = NULL, + default_save_name = "PCA", + ...) { checkmate::assert_class(gobject, "giotto") dimPlot2D( @@ -2002,87 +2013,88 @@ plotPCA <- function(gobject, #' #' @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") { +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( @@ -2347,58 +2359,59 @@ spatDimPlot <- function(gobject, ...) { #' #' @export #' @seealso \code{\link{spatFeatPlot3D}} -spatFeatPlot2D_single <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - plot_method = "ggplot", - 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") { +spatFeatPlot2D_single <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + plot_method = "ggplot", + 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 @@ -2671,7 +2684,8 @@ spatFeatPlot2D_single <- function(gobject, length(gradient_limits) == 2) { cell_locations_metadata_feats[[feat]] <- scales::oob_squish(cell_locations_metadata_feats[[feat]], - range = gradient_limits) + range = gradient_limits + ) } if (is.null(gradient_midpoint)) { @@ -2682,7 +2696,6 @@ spatFeatPlot2D_single <- function(gobject, if (point_shape %in% c("border", "no_border")) { - # assemble points plotting params # * aes - dynamic values found in the `data` # * args - static values to set @@ -2739,7 +2752,8 @@ spatFeatPlot2D_single <- function(gobject, pl <- pl + ggplot2::labs( x = "coord x", y = "coord y", - title = feat) + title = feat + ) } @@ -2934,59 +2948,60 @@ spatFeatPlot2D_single <- function(gobject, #' #' @export #' @seealso \code{\link{spatFeatPlot3D}} -spatFeatPlot2D <- function(gobject, - feat_type = NULL, - spat_unit = NULL, - plot_method = "ggplot", - 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") { +spatFeatPlot2D <- function( + gobject, + feat_type = NULL, + spat_unit = NULL, + plot_method = "ggplot", + 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( @@ -3174,35 +3189,35 @@ spatFeatPlot2D <- function(gobject, }) } -.dimFeatPlot_single_feat <- function(data, - feat, - feats, - dim_names, - order = TRUE, - group_id = NULL, - show_NN_network = FALSE, - network_color = NULL, - from_dim_names = NULL, - to_dim_names = NULL, - annotated_network_DT = NULL, - edge_alpha = NULL, - scale_alpha_with_expression = FALSE, - point_shape, - 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, - instrs -) { +.dimFeatPlot_single_feat <- function( + data, + feat, + feats, + dim_names, + order = TRUE, + group_id = NULL, + show_NN_network = FALSE, + network_color = NULL, + from_dim_names = NULL, + to_dim_names = NULL, + annotated_network_DT = NULL, + edge_alpha = NULL, + scale_alpha_with_expression = FALSE, + point_shape, + 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, + instrs) { # order spatial units (e.g. cell IDs) based on expression of feature if (isTRUE(order)) { data <- data[order(get(feat))] @@ -3420,47 +3435,48 @@ spatFeatPlot2D <- function(gobject, #' group_by_subset = c(2, 5) #' ) #' @export -dimFeatPlot2D <- function(gobject, - spat_unit = NULL, - feat_type = NULL, - expression_values = c("normalized", "scaled", "custom"), - feats = NULL, - order = TRUE, - group_by = NULL, - group_by_subset = NULL, - 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") { +dimFeatPlot2D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + expression_values = c("normalized", "scaled", "custom"), + feats = NULL, + order = TRUE, + group_by = NULL, + group_by_subset = NULL, + 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"), @@ -3528,7 +3544,8 @@ dimFeatPlot2D <- function(gobject, selected_feats <- selected_feats[selected_feats %in% rownames(expr_values)] if (length(selected_feats) == 0) { stop("Selected `feats` not found in expression information", - call. = FALSE) + call. = FALSE + ) } # @@ -3774,68 +3791,69 @@ dimFeatPlot2D <- function(gobject, #' 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") { +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") ) @@ -4006,66 +4024,67 @@ spatDimFeatPlot2D <- function(gobject, #' 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") { +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, @@ -4233,56 +4252,57 @@ spatCellPlot <- function(...) { #' ) #' #' @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") { +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, @@ -4478,88 +4498,89 @@ dimCellPlot <- function(gobject, ...) { #' 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") { +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") ) diff --git a/R/vis_spatial_in_situ.R b/R/vis_spatial_in_situ.R index b5c26ad..e249293 100644 --- a/R/vis_spatial_in_situ.R +++ b/R/vis_spatial_in_situ.R @@ -85,55 +85,56 @@ #' #' @family In Situ visualizations #' @export -spatInSituPlotPoints <- function(gobject, - show_image = FALSE, - gimage = NULL, - image_name = NULL, - largeImage_name = NULL, - spat_unit = NULL, - spat_loc_name = NULL, - feats = NULL, - feat_type = "rna", - feats_color_code = NULL, - feat_shape_code = NULL, - sdimx = "x", - sdimy = "y", - xlim = NULL, - ylim = NULL, - spat_enr_names = NULL, - point_size = 1.5, - stroke = 0.5, - expand_counts = FALSE, - count_info_column = "count", - jitter = c(0, 0), - show_polygon = TRUE, - use_overlap = TRUE, - polygon_feat_type = "cell", - polygon_color = "grey", - polygon_bg_color = "black", - polygon_fill = NULL, - polygon_fill_gradient = NULL, - polygon_fill_gradient_midpoint = NULL, - polygon_fill_gradient_style = c("divergent", "sequential"), - polygon_fill_as_factor = NULL, - polygon_fill_code = NULL, - polygon_alpha = NULL, - polygon_line_size = 0.4, - axis_text = 8, - axis_title = 8, - legend_text = 6, - coord_fix_ratio = 1, - background_color = "black", - show_legend = TRUE, - plot_method = c("ggplot", "scattermore", "scattermost"), - plot_last = c("polygons", "points"), - theme_param = list(), - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatInSituPlotPoints", - verbose = TRUE) { +spatInSituPlotPoints <- function( + gobject, + show_image = FALSE, + gimage = NULL, + image_name = NULL, + largeImage_name = NULL, + spat_unit = NULL, + spat_loc_name = NULL, + feats = NULL, + feat_type = "rna", + feats_color_code = NULL, + feat_shape_code = NULL, + sdimx = "x", + sdimy = "y", + xlim = NULL, + ylim = NULL, + spat_enr_names = NULL, + point_size = 1.5, + stroke = 0.5, + expand_counts = FALSE, + count_info_column = "count", + jitter = c(0, 0), + show_polygon = TRUE, + use_overlap = TRUE, + polygon_feat_type = "cell", + polygon_color = "grey", + polygon_bg_color = "black", + polygon_fill = NULL, + polygon_fill_gradient = NULL, + polygon_fill_gradient_midpoint = NULL, + polygon_fill_gradient_style = c("divergent", "sequential"), + polygon_fill_as_factor = NULL, + polygon_fill_code = NULL, + polygon_alpha = NULL, + polygon_line_size = 0.4, + axis_text = 8, + axis_title = 8, + legend_text = 6, + coord_fix_ratio = 1, + background_color = "black", + show_legend = TRUE, + plot_method = c("ggplot", "scattermore", "scattermost"), + plot_last = c("polygons", "points"), + theme_param = list(), + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatInSituPlotPoints", + verbose = TRUE) { # set polygon_feat_type avail_poly_names <- list_spatial_info_names(gobject = gobject) if (polygon_feat_type == "cell" && @@ -141,7 +142,7 @@ spatInSituPlotPoints <- function(gobject, polygon_feat_type <- spat_unit if (verbose) { wrap_msg( - "[polygon_feat_type] 'cell' not discovered in polygon names. + "[polygon_feat_type] 'cell' not discovered in polygon names. Defaulting to spat_unit." ) } @@ -175,7 +176,6 @@ spatInSituPlotPoints <- function(gobject, ## giotto image ## if (isTRUE(show_image)) { - # get 1 or more images gimage <- getGiottoImage( gobject = gobject, @@ -256,7 +256,6 @@ spatInSituPlotPoints <- function(gobject, ## 2. plot polygons/morphology second/last if (isTRUE(show_polygon)) { - if (isTRUE(show_image)) { polygon_alpha <- polygon_alpha %null% 0.5 } else { @@ -419,31 +418,30 @@ spatInSituPlotPoints <- function(gobject, plot <- plot + do.call(.gg_theme, args = gg_theme_args) - # 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) - } + # 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 + )) } @@ -469,27 +467,26 @@ spatInSituPlotPoints <- function(gobject, #' @return ggplot #' @details This function can plot one feature for one modality. #' @keywords internal -.spatInSituPlotHex_single <- function( - gobject, - feat = NULL, - feat_type = "rna", - sdimx = "x", - sdimy = "y", - binwidth = NULL, - min_axis_bins = NULL, - alpha = 0.5, - show_polygon = TRUE, - polygon_feat_type = "cell", - polygon_color = "black", - polygon_fill = NULL, - polygon_fill_as_factor = NULL, - polygon_alpha = 0.5, - polygon_size = 0.5, - coord_fix_ratio = NULL, - axis_text = 8, - axis_title = 8, - legend_text = 6, - background_color = "black") { +.spatInSituPlotHex_single <- function(gobject, + feat = NULL, + feat_type = "rna", + sdimx = "x", + sdimy = "y", + binwidth = NULL, + min_axis_bins = NULL, + alpha = 0.5, + show_polygon = TRUE, + polygon_feat_type = "cell", + polygon_color = "black", + polygon_fill = NULL, + polygon_fill_as_factor = NULL, + polygon_alpha = 0.5, + polygon_size = 0.5, + coord_fix_ratio = NULL, + axis_text = 8, + axis_title = 8, + legend_text = 6, + background_color = "black") { if (is.null(feat)) { stop("You need to select a feature (feat) and modify feature types (feat_type) if needed \n") @@ -597,40 +594,41 @@ spatInSituPlotPoints <- function(gobject, #' @returns ggplot #' @examples #' g <- GiottoData::loadGiottoMini("vizgen") -#' spatInSituPlotHex(g, feats = c("Mlc1", "Gprc5b", "Gfap"), -#' polygon_feat_type = "z0") +#' spatInSituPlotHex(g, +#' feats = c("Mlc1", "Gprc5b", "Gfap"), +#' polygon_feat_type = "z0" +#' ) #' @export -spatInSituPlotHex <- function( - gobject, - feats = NULL, - feat_type = "rna", - sdimx = "x", - sdimy = "y", - binwidth = NULL, - min_axis_bins = 10, - alpha = 0.5, - show_polygon = TRUE, - polygon_feat_type = "cell", - polygon_color = "black", - polygon_fill = NULL, - polygon_fill_as_factor = NULL, - polygon_alpha = 0.5, - polygon_size = deprecated(), - polygon_line_size = 0.5, - coord_fix_ratio = 1, - axis_text = 8, - axis_title = 8, - legend_text = 6, - background_color = "white", - 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 = "spatInSituPlotHex") { +spatInSituPlotHex <- function(gobject, + feats = NULL, + feat_type = "rna", + sdimx = "x", + sdimy = "y", + binwidth = NULL, + min_axis_bins = 10, + alpha = 0.5, + show_polygon = TRUE, + polygon_feat_type = "cell", + polygon_color = "black", + polygon_fill = NULL, + polygon_fill_as_factor = NULL, + polygon_alpha = 0.5, + polygon_size = deprecated(), + polygon_line_size = 0.5, + coord_fix_ratio = 1, + axis_text = 8, + axis_title = 8, + legend_text = 6, + background_color = "white", + 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 = "spatInSituPlotHex") { # deprecate if (GiottoUtils::is_present(polygon_size)) { deprecate_warn( @@ -751,25 +749,24 @@ spatInSituPlotHex <- function( #' @return ggplot #' @details This function can plot one feature for one modality. #' @keywords internal -.spatInSituPlotDensity_single <- function( - gobject, - feat = NULL, - feat_type = "rna", - sdimx = "x", - sdimy = "y", - alpha = 0.95, - show_polygon = TRUE, - polygon_feat_type = "cell", - polygon_color = "black", - polygon_fill = NULL, - polygon_fill_as_factor = NULL, - polygon_alpha = 0.5, - polygon_size = 0.5, - coord_fix_ratio = NULL, - axis_text = 8, - axis_title = 8, - legend_text = 6, - background_color = "black") { +.spatInSituPlotDensity_single <- function(gobject, + feat = NULL, + feat_type = "rna", + sdimx = "x", + sdimy = "y", + alpha = 0.95, + show_polygon = TRUE, + polygon_feat_type = "cell", + polygon_color = "black", + polygon_fill = NULL, + polygon_fill_as_factor = NULL, + polygon_alpha = 0.5, + polygon_size = 0.5, + coord_fix_ratio = NULL, + axis_text = 8, + axis_title = 8, + legend_text = 6, + background_color = "black") { if (is.null(feat)) { stop("You need to select a feature (feat) and modify feature types (feat_type) if needed \n") @@ -872,39 +869,40 @@ spatInSituPlotHex <- function( #' @returns ggplot #' @examples #' g <- GiottoData::loadGiottoMini("vizgen") -#' spatInSituPlotDensity(g, feats = c("Mlc1", "Gprc5b", "Gfap"), -#' polygon_feat_type = "z0") +#' spatInSituPlotDensity(g, +#' feats = c("Mlc1", "Gprc5b", "Gfap"), +#' polygon_feat_type = "z0" +#' ) #' #' @export -spatInSituPlotDensity <- function( - gobject, - feats = NULL, - feat_type = "rna", - sdimx = "x", - sdimy = "y", - alpha = 0.95, - show_polygon = TRUE, - polygon_feat_type = "cell", - polygon_color = "black", - polygon_fill = NULL, - polygon_fill_as_factor = NULL, - polygon_alpha = 0.5, - polygon_size = deprecated(), - polygon_line_size = 0.5, - coord_fix_ratio = 1, - axis_text = 8, - axis_title = 8, - legend_text = 6, - background_color = "black", - 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 = "spatInSituPlotDensity") { +spatInSituPlotDensity <- function(gobject, + feats = NULL, + feat_type = "rna", + sdimx = "x", + sdimy = "y", + alpha = 0.95, + show_polygon = TRUE, + polygon_feat_type = "cell", + polygon_color = "black", + polygon_fill = NULL, + polygon_fill_as_factor = NULL, + polygon_alpha = 0.5, + polygon_size = deprecated(), + polygon_line_size = 0.5, + coord_fix_ratio = 1, + axis_text = 8, + axis_title = 8, + legend_text = 6, + background_color = "black", + 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 = "spatInSituPlotDensity") { # deprecate if (GiottoUtils::is_present(polygon_size)) { deprecate_warn( @@ -1039,12 +1037,11 @@ spatInSituPlotDensity <- function( #' #' @keywords internal #' @export -expand_feature_info <- function( - spatial_feat_info, - expand_counts = FALSE, - count_info_column = "count", - jitter = c(0, 0), - verbose = TRUE) { +expand_feature_info <- function(spatial_feat_info, + expand_counts = FALSE, + count_info_column = "count", + jitter = c(0, 0), + verbose = TRUE) { # data.table variables feat_ID <- x <- y <- feat <- spat_unit <- NULL diff --git a/R/vis_spatial_plotly.R b/R/vis_spatial_plotly.R index 90dc368..9447244 100644 --- a/R/vis_spatial_plotly.R +++ b/R/vis_spatial_plotly.R @@ -11,31 +11,32 @@ #' 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) { +.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, @@ -337,32 +338,33 @@ #' 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) { +.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, @@ -682,38 +684,39 @@ #' @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, - cell_color_gradient = 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") { +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, + cell_color_gradient = 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") @@ -829,10 +832,11 @@ dimPlot3D <- function(gobject, #' plotUMAP_3D(g, dim_reduction_name = "3D_umap") #' #' @export -plotUMAP_3D <- function(gobject, - dim_reduction_name = "umap", - default_save_name = "UMAP_3D", - ...) { +plotUMAP_3D <- function( + gobject, + dim_reduction_name = "umap", + default_save_name = "UMAP_3D", + ...) { dimPlot3D( gobject = gobject, dim_reduction_to_use = "umap", @@ -859,10 +863,11 @@ plotUMAP_3D <- function(gobject, #' plotTSNE_3D(g) #' #' @export -plotTSNE_3D <- function(gobject, - dim_reduction_name = "tsne", - default_save_name = "TSNE_3D", - ...) { +plotTSNE_3D <- function( + gobject, + dim_reduction_name = "tsne", + default_save_name = "TSNE_3D", + ...) { dimPlot3D( gobject = gobject, dim_reduction_to_use = "tsne", @@ -889,10 +894,11 @@ plotTSNE_3D <- function(gobject, #' plotPCA_3D(g) #' #' @export -plotPCA_3D <- function(gobject, - dim_reduction_name = "pca", - default_save_name = "PCA_3D", - ...) { +plotPCA_3D <- function( + gobject, + dim_reduction_name = "pca", + default_save_name = "PCA_3D", + ...) { dimPlot3D( gobject = gobject, dim_reduction_to_use = "pca", @@ -915,37 +921,38 @@ plotPCA_3D <- function(gobject, #' @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) { +.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, @@ -1217,43 +1224,44 @@ plotPCA_3D <- function(gobject, #' @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, - point_alpha = 1, - cell_color = NULL, - cell_color_code = NULL, - cell_color_gradient = NULL, - color_as_factor = TRUE, - gradient_limits = NULL, - gradient_style = "divergent", - gradient_midpoint = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 3, - 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) { +.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, + point_alpha = 1, + cell_color = NULL, + cell_color_code = NULL, + cell_color_gradient = NULL, + color_as_factor = TRUE, + gradient_limits = NULL, + gradient_style = "divergent", + gradient_midpoint = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 3, + 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, @@ -1451,48 +1459,49 @@ plotPCA_3D <- function(gobject, #' @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, - point_alpha = 1, - cell_color = NULL, - cell_color_code = NULL, - cell_color_gradient = NULL, - color_as_factor = TRUE, - gradient_limits = NULL, - gradient_style = "divergent", - gradient_midpoint = NULL, - select_cell_groups = NULL, - select_cells = NULL, - show_other_cells = TRUE, - other_cell_color = "lightgrey", - other_point_size = 3, - 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") { +spatPlot3D <- function( + gobject, + spat_unit = NULL, + feat_type = NULL, + sdimx = "sdimx", + sdimy = "sdimy", + sdimz = "sdimz", + spat_enr_names = NULL, + point_size = 3, + point_alpha = 1, + cell_color = NULL, + cell_color_code = NULL, + cell_color_gradient = NULL, + color_as_factor = TRUE, + gradient_limits = NULL, + gradient_style = "divergent", + gradient_midpoint = NULL, + select_cell_groups = NULL, + select_cells = NULL, + show_other_cells = TRUE, + other_cell_color = "lightgrey", + other_point_size = 3, + 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)) { vmsg(.is_debug = TRUE, "create 2D plot") @@ -1671,58 +1680,59 @@ spatPlot3D <- function(gobject, #' @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") { +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, @@ -2675,41 +2685,42 @@ spatDimPlot3D <- function(gobject, #' 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", - ...) { +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, @@ -3170,37 +3181,38 @@ spatGenePlot3D <- function(...) { #' #' 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, @@ -3635,57 +3647,58 @@ dimGenePlot3D <- function(...) { #' 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") { +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, diff --git a/R/viz_spatial_network.R b/R/viz_spatial_network.R index 4a9c8b3..5a56ee0 100644 --- a/R/viz_spatial_network.R +++ b/R/viz_spatial_network.R @@ -11,18 +11,17 @@ #' @param ncol number of columns to visualize the histograms in #' @return ggplot plot #' @export -spatNetwDistributionsDistance <- function( - gobject, - spat_unit = NULL, - spatial_network_name = "spatial_network", - hist_bins = 30, - test_distance_limit = NULL, - ncol = 1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatNetwDistributionsDistance") { +spatNetwDistributionsDistance <- function(gobject, + spat_unit = NULL, + spatial_network_name = "spatial_network", + hist_bins = 30, + test_distance_limit = NULL, + ncol = 1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatNetwDistributionsDistance") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -50,11 +49,13 @@ spatNetwDistributionsDistance <- function( if (!is.null(test_distance_limit)) { removed_neighbors <- spatial_network[distance > test_distance_limit, .N, - by = rank_int] + by = rank_int + ] removed_neighbors[, "status" := "remove"] keep_neighbors <- spatial_network[distance <= test_distance_limit, .N, - by = rank_int] + by = rank_int + ] keep_neighbors[, "status" := "keep"] dist_removal_dt <- rbind(removed_neighbors, keep_neighbors) @@ -126,16 +127,15 @@ spatNetwDistributionsDistance <- function( #' @param hist_bins number of binds to use for the histogram #' @return ggplot plot #' @export -spatNetwDistributionsKneighbors <- function( - gobject, - spat_unit = NULL, - spatial_network_name = "spatial_network", - hist_bins = 30, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatNetwDistributionsKneighbors") { +spatNetwDistributionsKneighbors <- function(gobject, + spat_unit = NULL, + spatial_network_name = "spatial_network", + hist_bins = 30, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatNetwDistributionsKneighbors") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -213,19 +213,18 @@ spatNetwDistributionsKneighbors <- function( #' over all cells. #' @return ggplot plot #' @export -spatNetwDistributions <- function( - gobject, - spat_unit = NULL, - spatial_network_name = "spatial_network", - distribution = c("distance", "k_neighbors"), - hist_bins = 30, - test_distance_limit = NULL, - ncol = 1, - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "spatNetwDistributions") { +spatNetwDistributions <- function(gobject, + spat_unit = NULL, + spatial_network_name = "spatial_network", + distribution = c("distance", "k_neighbors"), + hist_bins = 30, + test_distance_limit = NULL, + ncol = 1, + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "spatNetwDistributions") { # Set feat_type and spat_unit spat_unit <- set_default_spat_unit( gobject = gobject, @@ -306,24 +305,23 @@ spatNetwDistributions <- function( #' @param \dots Other parameters #' @return giotto object with updated spatial network slot #' @export -plotStatDelaunayNetwork <- function( - gobject, - feat_type = NULL, - spat_unit = NULL, - method = c("deldir", "delaunayn_geometry", "RTriangle"), - dimensions = "all", - maximum_distance = "auto", # all - minimum_k = 0, # all - options = "Pp", # geometry - Y = TRUE, # RTriange - j = TRUE, # RTriange - S = 0, # RTriange - show_plot = NULL, - return_plot = NULL, - save_plot = NULL, - save_param = list(), - default_save_name = "plotStatDelaunayNetwork", - ...) { +plotStatDelaunayNetwork <- function(gobject, + feat_type = NULL, + spat_unit = NULL, + method = c("deldir", "delaunayn_geometry", "RTriangle"), + dimensions = "all", + maximum_distance = "auto", # all + minimum_k = 0, # all + options = "Pp", # geometry + Y = TRUE, # RTriange + j = TRUE, # RTriange + S = 0, # RTriange + show_plot = NULL, + return_plot = NULL, + save_plot = NULL, + save_param = list(), + default_save_name = "plotStatDelaunayNetwork", + ...) { # data.table variables distance <- rank_int <- N <- NULL diff --git a/R/zzz.R b/R/zzz.R index cb197a6..02f15c7 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -31,6 +31,3 @@ # point rasterization init_option("giotto.plot_point_raster", 5e5) } - - - diff --git a/tests/testthat/test_save.R b/tests/testthat/test_save.R index 8d6a7be..a227bbb 100644 --- a/tests/testthat/test_save.R +++ b/tests/testthat/test_save.R @@ -1,4 +1,3 @@ - # showSaveParameters #### test_that("No errors when running showSaveParameters", { @@ -18,7 +17,8 @@ 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() +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) @@ -27,8 +27,10 @@ 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "png") + ) ) }) @@ -37,8 +39,10 @@ test_that("gg save works - 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "tiff") + ) ) }) @@ -47,8 +51,10 @@ test_that("gg save works - 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "pdf") + ) ) }) @@ -57,8 +63,10 @@ test_that("gg save works - 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "jpg") + ) ) }) @@ -67,8 +75,10 @@ test_that("gg save works - 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "svg") + ) ) }) @@ -78,8 +88,10 @@ test_that("plotly save works - html", { 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "html") + ) ) }) @@ -90,8 +102,10 @@ test_that("gg save works - 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "png") + ) ) }) @@ -100,10 +114,9 @@ test_that("gg save works - dpi 300 override", { 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")) + file.path( + results_folder, + sprintf("%d-giotto_plot.%s", img_id, "png") + ) ) }) - - - From d72e5fca06e14e77dcd777cefae1aa3465d96901 Mon Sep 17 00:00:00 2001 From: josschavezf Date: Fri, 15 Nov 2024 22:01:15 -0500 Subject: [PATCH 06/11] run devtools::document --- man/addGiottoImageToSpatPlot.Rd | 5 +++-- man/create_cluster_dendrogram.Rd | 11 +++++++---- man/gg_param.Rd | 28 ++++++++++++++++------------ man/plotHeatmap.Rd | 6 ++++-- man/plotMetaDataHeatmap.Rd | 6 ++++-- man/plot_save.Rd | 3 ++- man/plotly_axis_scale_3D.Rd | 6 ++++-- man/plotly_grid.Rd | 10 ++++++---- man/reexports.Rd | 2 +- man/sankeyLabel.Rd | 12 ++++++++---- man/sankeySet.Rd | 6 ++++-- man/sankeySetAddresses.Rd | 6 ++++-- man/set_default_color_discrete.Rd | 6 ++++-- man/spatInSituPlotDensity.Rd | 6 ++++-- man/spatInSituPlotHex.Rd | 6 ++++-- man/violinPlot.Rd | 6 ++++-- 16 files changed, 79 insertions(+), 46 deletions(-) diff --git a/man/addGiottoImageToSpatPlot.Rd b/man/addGiottoImageToSpatPlot.Rd index 1cbe545..5b769dd 100644 --- a/man/addGiottoImageToSpatPlot.Rd +++ b/man/addGiottoImageToSpatPlot.Rd @@ -33,8 +33,9 @@ Add a giotto image to a spatial ggplot object post creation g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) my_giottoimage <- GiottoClass::createGiottoImage(g, -mg_object = system.file("image.png", package = "GiottoVisuals"), -name = 'image') + mg_object = system.file("image.png", package = "GiottoVisuals"), + name = "image" +) my_spatplot <- spatPlot2D(g, return_plot = TRUE) diff --git a/man/create_cluster_dendrogram.Rd b/man/create_cluster_dendrogram.Rd index ea4b008..b3f5e6d 100644 --- a/man/create_cluster_dendrogram.Rd +++ b/man/create_cluster_dendrogram.Rd @@ -65,11 +65,14 @@ 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 <- data.table::melt(g_expression_df, id.vars = "feat_ID", -measure.vars = colnames(g_expression), variable.name = "cell_ID", -value.name = "raw_expression") +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), -var_col = "cell_ID", clus_col = "feat_ID", "raw_expression") + var_col = "cell_ID", clus_col = "feat_ID", "raw_expression" +) } diff --git a/man/gg_param.Rd b/man/gg_param.Rd index 53805e1..0267ab7 100644 --- a/man/gg_param.Rd +++ b/man/gg_param.Rd @@ -40,20 +40,21 @@ d <- data.frame( # ----- single step ----- # p_single <- gg_param( data = d, - x = as.name("xvals"), # aes - fill = "green", # toplevel + x = as.name("xvals"), # aes + fill = "green", # toplevel aes( - size = size_col, # aes - y = yvals # aes + size = size_col, # aes + y = yvals # aes ), - show.legend = TRUE, # toplevel + show.legend = TRUE, # toplevel list( - shape = 21, # toplevel - alpha = as.name("values") # aes + shape = 21, # toplevel + alpha = as.name("values") # aes ) ) -ggplot() + do.call(geom_point, p_single) +ggplot() + + do.call(geom_point, p_single) # ----- multistep appending ----- # @@ -74,14 +75,17 @@ 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) +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 +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) +ggplot() + + do.call(geom_point, p_nest) +ggplot() + + do.call(geom_point, p_nest_sub) } \seealso{ Other ggplot2 plotting wrangling functions: diff --git a/man/plotHeatmap.Rd b/man/plotHeatmap.Rd index 5868711..e59fa28 100644 --- a/man/plotHeatmap.Rd +++ b/man/plotHeatmap.Rd @@ -119,7 +119,9 @@ If you want to display many features there are 2 ways to proceed: } \examples{ g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -plotHeatmap(g, feats = c("Gm19935", "Gna12", "Ccnd2", "Btbd17"), -cluster_column = "leiden_clus") +plotHeatmap(g, + feats = c("Gm19935", "Gna12", "Ccnd2", "Btbd17"), + cluster_column = "leiden_clus" +) } diff --git a/man/plotMetaDataHeatmap.Rd b/man/plotMetaDataHeatmap.Rd index d595c67..b85354b 100644 --- a/man/plotMetaDataHeatmap.Rd +++ b/man/plotMetaDataHeatmap.Rd @@ -124,8 +124,10 @@ z-scores rescaled per feature (-1 to 1). } \examples{ g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -plotMetaDataHeatmap(g, metadata_cols = "leiden_clus", -selected_feats = c("Gna12", "Ccnd2", "Btbd17", "Gm19935")) +plotMetaDataHeatmap(g, + metadata_cols = "leiden_clus", + selected_feats = c("Gna12", "Ccnd2", "Btbd17", "Gm19935") +) } \seealso{ diff --git a/man/plot_save.Rd b/man/plot_save.Rd index 7203787..4ff52f4 100644 --- a/man/plot_save.Rd +++ b/man/plot_save.Rd @@ -114,7 +114,8 @@ parameter and \code{giottoInstructions} values. \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() +g_plot <- ggplot2::ggplot(df, ggplot2::aes(x, y)) + + ggplot2::geom_point() all_plots_save_function(g, g_plot) } diff --git a/man/plotly_axis_scale_3D.Rd b/man/plotly_axis_scale_3D.Rd index 7edfd1e..a675bb0 100644 --- a/man/plotly_axis_scale_3D.Rd +++ b/man/plotly_axis_scale_3D.Rd @@ -33,8 +33,10 @@ 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), -z = 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/plotly_grid.Rd b/man/plotly_grid.Rd index 1bf6328..c571a3e 100644 --- a/man/plotly_grid.Rd +++ b/man/plotly_grid.Rd @@ -33,10 +33,12 @@ provide grid segment to draw in plot_ly() g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) library(GiottoClass) -g <- createSpatialGrid(gobject = g, -sdimx_stepsize = 400, -sdimy_stepsize = 400, -minimum_padding = 0) +g <- createSpatialGrid( + gobject = g, + sdimx_stepsize = 400, + sdimy_stepsize = 400, + minimum_padding = 0 +) my_spatial_grid <- getSpatialGrid(g) diff --git a/man/reexports.Rd b/man/reexports.Rd index 9136421..7990b72 100644 --- a/man/reexports.Rd +++ b/man/reexports.Rd @@ -15,7 +15,7 @@ a function to create continous colors } \examples{ colorRamp2::colorRamp2(breaks = seq_len(2), colors = c("blue", "red")) - + } \keyword{internal} \description{ diff --git a/man/sankeyLabel.Rd b/man/sankeyLabel.Rd index ccbfc35..ebf5bd5 100644 --- a/man/sankeyLabel.Rd +++ b/man/sankeyLabel.Rd @@ -23,12 +23,16 @@ a \code{giottoSankeyPlan} Get and set the sankey labels information } \examples{ -my_sankeyplan <- sankeySet(spat_unit = "cell", -feat_type = "rna", col = "leiden_clus") +my_sankeyplan <- sankeySet( + spat_unit = "cell", + feat_type = "rna", col = "leiden_clus" +) my_sankeyplan <- `sankeyLabel<-`(my_sankeyplan, value = "my_label") sankeyLabel(my_sankeyplan) -my_sankeyplan <- sankeySet(spat_unit = "cell", -feat_type = "rna", col = "leiden_clus") +my_sankeyplan <- sankeySet( + spat_unit = "cell", + feat_type = "rna", col = "leiden_clus" +) my_sankeyplan <- `sankeyLabel<-`(my_sankeyplan, value = "my_label") } diff --git a/man/sankeySet.Rd b/man/sankeySet.Rd index ad080a5..370cbda 100644 --- a/man/sankeySet.Rd +++ b/man/sankeySet.Rd @@ -31,8 +31,10 @@ a \code{giottoSankeyPlan} Create a \code{giottoSankeyPlan} with one set of annotations } \examples{ -my_sankeyplan <- sankeySet(spat_unit = "cell", -feat_type = "rna", col = "leiden_clus") +my_sankeyplan <- sankeySet( + spat_unit = "cell", + feat_type = "rna", col = "leiden_clus" +) } \keyword{plotting} diff --git a/man/sankeySetAddresses.Rd b/man/sankeySetAddresses.Rd index f9e3e7e..1c1562d 100644 --- a/man/sankeySetAddresses.Rd +++ b/man/sankeySetAddresses.Rd @@ -17,8 +17,10 @@ Return a data.table containing where the sets of metadata to relate to each other exists inside the Giotto object. } \examples{ -my_sankeyplan <- sankeySet(spat_unit = "cell", -feat_type = "rna", col = "leiden_clus") +my_sankeyplan <- sankeySet( + spat_unit = "cell", + feat_type = "rna", col = "leiden_clus" +) my_sankeyplan <- sankeySetAddresses(my_sankeyplan) } diff --git a/man/set_default_color_discrete.Rd b/man/set_default_color_discrete.Rd index 382d0e0..2185e24 100644 --- a/man/set_default_color_discrete.Rd +++ b/man/set_default_color_discrete.Rd @@ -83,6 +83,8 @@ defaults setting. }} \examples{ -set_default_color_discrete(colors = "#eb4034", -instr_rev = NULL, instr_strategy = NULL) +set_default_color_discrete( + colors = "#eb4034", + instr_rev = NULL, instr_strategy = NULL +) } diff --git a/man/spatInSituPlotDensity.Rd b/man/spatInSituPlotDensity.Rd index 197ccc1..a63a137 100644 --- a/man/spatInSituPlotDensity.Rd +++ b/man/spatInSituPlotDensity.Rd @@ -107,8 +107,10 @@ TODO } \examples{ g <- GiottoData::loadGiottoMini("vizgen") -spatInSituPlotDensity(g, feats = c("Mlc1", "Gprc5b", "Gfap"), -polygon_feat_type = "z0") +spatInSituPlotDensity(g, + feats = c("Mlc1", "Gprc5b", "Gfap"), + polygon_feat_type = "z0" +) } \seealso{ diff --git a/man/spatInSituPlotHex.Rd b/man/spatInSituPlotHex.Rd index 1a2c91a..752da58 100644 --- a/man/spatInSituPlotHex.Rd +++ b/man/spatInSituPlotHex.Rd @@ -115,8 +115,10 @@ TODO } \examples{ g <- GiottoData::loadGiottoMini("vizgen") -spatInSituPlotHex(g, feats = c("Mlc1", "Gprc5b", "Gfap"), -polygon_feat_type = "z0") +spatInSituPlotHex(g, + feats = c("Mlc1", "Gprc5b", "Gfap"), + polygon_feat_type = "z0" +) } \seealso{ Other In Situ visualizations: diff --git a/man/violinPlot.Rd b/man/violinPlot.Rd index 292d1fd..28dc7ec 100644 --- a/man/violinPlot.Rd +++ b/man/violinPlot.Rd @@ -75,7 +75,9 @@ Creates violinplot for selected clusters } \examples{ g <- GiottoData::loadGiottoMini("visium", verbose = FALSE) -violinPlot(g, feats = c("Gna12", "Ccnd2", "Btbd17"), -cluster_column = "leiden_clus") +violinPlot(g, + feats = c("Gna12", "Ccnd2", "Btbd17"), + cluster_column = "leiden_clus" +) } From e8452cca85b1d6defa73cdc5053b0a1301bb5129 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 18 Nov 2024 10:40:01 -0500 Subject: [PATCH 07/11] enh: pass xlim ylim setting to image --- R/vis_spatial_in_situ.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/vis_spatial_in_situ.R b/R/vis_spatial_in_situ.R index e249293..ae429e4 100644 --- a/R/vis_spatial_in_situ.R +++ b/R/vis_spatial_in_situ.R @@ -189,6 +189,11 @@ spatInSituPlotPoints <- function( ## 0. plot image ## if (isTRUE(show_image) && !is.null(gimage)) { + + if (!is.null(xlim) && !is.null(ylim)) { + e <- ext(c(xlim, ylim)) + } + plot <- plot_spat_image_layer_ggplot( gg_obj = plot, gobject = gobject, @@ -196,7 +201,8 @@ spatInSituPlotPoints <- function( feat_type = feat_type, spat_loc_name = spat_loc_name, polygon_feat_type = polygon_feat_type, - gimage = gimage + gimage = gimage, + ext = e ) if (isTRUE(verbose)) wrap_msg("plot image layer done") From 4851a58cc522183063b3626b980cc460e69193de Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 18 Nov 2024 11:39:09 -0500 Subject: [PATCH 08/11] fix: if no max_window, set a default max - use quantile 0.99 value of the image raster --- R/gg_annotation_raster.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/gg_annotation_raster.R b/R/gg_annotation_raster.R index ffe1d6c..ff58aba 100644 --- a/R/gg_annotation_raster.R +++ b/R/gg_annotation_raster.R @@ -420,6 +420,7 @@ setMethod( if (nlyr == 1L) { # SINGLE CHANNEL # # max window cutoff + maxval <- maxval %na% quantile(x, 0.99) if (!is.null(maxval)) x[x > maxval] <- maxval # colorize if (is.null(col)) { From 3d2d2be2f2db5a5bba98844da57afbd84af50468 Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 18 Nov 2024 15:28:00 -0500 Subject: [PATCH 09/11] chore: update news --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index ecc8e6b..fbde7ec 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,8 @@ ## enhancements - `group_by` and `group_by_subset` for `dimFeatPlot2D()` [#1069](https://github.com/drieslab/Giotto/issues/1069) by xhNorthwestern - +- `spatInSituPlotPoints()` `xlim` and `ylim` params now also affect image resampling +- image plotting will now scale values to the 99th percentile when a specific max intensity is not set. # GiottoVisuals 0.2.8 (2024/11/14) From 388843d39c916d3d0366b780572c7e7d42dcab8a Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 18 Nov 2024 15:30:35 -0500 Subject: [PATCH 10/11] chore update news --- DESCRIPTION | 2 +- NEWS.md | 6 ++++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index a9bfec6..ecabd02 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: GiottoVisuals Title: Visuals for the Giotto spatial biology analysis ecosystem -Version: 0.2.8 +Version: 0.2.9 Authors@R: c( person("Ruben", "Dries", email = "rubendries@gmail.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0001-7650-7754")), diff --git a/NEWS.md b/NEWS.md index fbde7ec..2a34d65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,9 +1,11 @@ -# GiottoVisuals 0.2.9 +# GiottoVisuals 0.2.9 (2024/11/18) + +## bug fixes +- `spatInSituPlotPoints()` `xlim` and `ylim` params now also affect image resampling ## enhancements - `group_by` and `group_by_subset` for `dimFeatPlot2D()` [#1069](https://github.com/drieslab/Giotto/issues/1069) by xhNorthwestern -- `spatInSituPlotPoints()` `xlim` and `ylim` params now also affect image resampling - image plotting will now scale values to the 99th percentile when a specific max intensity is not set. # GiottoVisuals 0.2.8 (2024/11/14) From cbde7bba3cd8e7a0f4e7ec7e0fe8998532a97bea Mon Sep 17 00:00:00 2001 From: George Chen <72078254+jiajic@users.noreply.github.com> Date: Mon, 18 Nov 2024 15:31:55 -0500 Subject: [PATCH 11/11] chore: add back remotes for push --- DESCRIPTION | 3 +++ 1 file changed, 3 insertions(+) diff --git a/DESCRIPTION b/DESCRIPTION index ecabd02..2557187 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -66,6 +66,9 @@ Suggests: testthat (>= 3.0.0), knitr, rmarkdown +Remotes: + drieslab/GiottoUtils, + drieslab/GiottoClass Config/testthat/edition: 3 Collate: 'aux_defaults.R'