From ca85a642c1bfe9f0e5c1111ed5910f27b65c5e0f Mon Sep 17 00:00:00 2001 From: enblacar Date: Fri, 15 Dec 2023 17:58:54 +0100 Subject: [PATCH] Added dev version of 2.0.2. --- CRAN-SUBMISSION | 6 +- DESCRIPTION | 7 +- NAMESPACE | 8 + NEWS.md | 13 + R/do_AffinityAnalysisPlot.R | 546 +++++++++++++++ R/do_DiffusionMapPlot.R | 422 ++++++++++++ R/do_DimPlot.R | 3 +- R/do_EnrichmentHeatmap.R | 17 +- R/do_LigandReceptorPlot.R | 588 ++++++++++++++++ R/do_LoadingsPlot.R | 467 +++++++++++++ R/do_MetadataPlot.R | 345 ++++++++++ R/do_SCEnrichmentHeatmap.R | 644 ++++++++++++++++++ R/do_SCExpressionHeatmap.R | 563 +++++++++++++++ R/save_Plot.R | 203 ++++++ R/utils.R | 79 ++- man/do_AffinityAnalysisPlot.Rd | 195 ++++++ man/do_DiffusionMapPlot.Rd | 208 ++++++ man/do_EnrichmentHeatmap.Rd | 2 +- man/do_LigandReceptorPlot.Rd | 189 +++++ man/do_LoadingsPlot.Rd | 165 +++++ man/do_MetadataPlot.Rd | 137 ++++ man/do_SCEnrichmentHeatmap.Rd | 230 +++++++ man/do_SCExpressionHeatmap.Rd | 204 ++++++ .../examples_do_AffinityAnalysisPlot.R | 30 + man/examples/examples_do_DiffusionMapPlot.R | 37 + man/examples/examples_do_LigandReceptorPlot.R | 16 + man/examples/examples_do_LoadingsPlot.R | 19 + man/examples/examples_do_MetadataPlot.R | 22 + .../examples_do_SCEnrichmentHeatmap.R | 28 + .../examples_do_SCExpressionHeatmap.R | 20 + man/examples/examples_save_Plot.R | 47 ++ man/save_Plot.Rd | 96 +++ tests/testthat/setup.R | 40 +- tests/testthat/test-do_AffinityAnalysisPlot.R | 365 ++++++++++ tests/testthat/test-do_DiffusionMapPlot.R | 157 +++++ tests/testthat/test-do_LigandReceptorPlot.R | 415 +++++++++++ tests/testthat/test-do_LoadingsPlot.R | 69 ++ tests/testthat/test-do_MetadataPlot.R | 47 ++ tests/testthat/test-do_SCEnrichmentHeatmap.R | 254 +++++++ tests/testthat/test-do_SCExpressionHeatmap.R | 107 +++ tests/testthat/test-save_Plot.R | 222 ++++++ 41 files changed, 7163 insertions(+), 69 deletions(-) create mode 100644 R/do_AffinityAnalysisPlot.R create mode 100644 R/do_DiffusionMapPlot.R create mode 100644 R/do_LigandReceptorPlot.R create mode 100644 R/do_LoadingsPlot.R create mode 100644 R/do_MetadataPlot.R create mode 100644 R/do_SCEnrichmentHeatmap.R create mode 100644 R/do_SCExpressionHeatmap.R create mode 100644 R/save_Plot.R create mode 100644 man/do_AffinityAnalysisPlot.Rd create mode 100644 man/do_DiffusionMapPlot.Rd create mode 100644 man/do_LigandReceptorPlot.Rd create mode 100644 man/do_LoadingsPlot.Rd create mode 100644 man/do_MetadataPlot.Rd create mode 100644 man/do_SCEnrichmentHeatmap.Rd create mode 100644 man/do_SCExpressionHeatmap.Rd create mode 100644 man/examples/examples_do_AffinityAnalysisPlot.R create mode 100644 man/examples/examples_do_DiffusionMapPlot.R create mode 100644 man/examples/examples_do_LigandReceptorPlot.R create mode 100644 man/examples/examples_do_LoadingsPlot.R create mode 100644 man/examples/examples_do_MetadataPlot.R create mode 100644 man/examples/examples_do_SCEnrichmentHeatmap.R create mode 100644 man/examples/examples_do_SCExpressionHeatmap.R create mode 100644 man/examples/examples_save_Plot.R create mode 100644 man/save_Plot.Rd create mode 100644 tests/testthat/test-do_AffinityAnalysisPlot.R create mode 100644 tests/testthat/test-do_DiffusionMapPlot.R create mode 100644 tests/testthat/test-do_LigandReceptorPlot.R create mode 100644 tests/testthat/test-do_LoadingsPlot.R create mode 100644 tests/testthat/test-do_MetadataPlot.R create mode 100644 tests/testthat/test-do_SCEnrichmentHeatmap.R create mode 100644 tests/testthat/test-do_SCExpressionHeatmap.R create mode 100644 tests/testthat/test-save_Plot.R diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 192c50d..895d2f7 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 2.0.1 -Date: 2023-08-13 10:28:15 UTC -SHA: f88f6e19ce2d121e82869c4418d26fe9ff7b1db9 +Version: 2.0.2 +Date: 2023-10-11 09:31:25 UTC +SHA: f61490235898a929cb27e7cedbe73b22ab99f66e diff --git a/DESCRIPTION b/DESCRIPTION index 94f5b14..8803797 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -2,7 +2,7 @@ Type: Package Package: SCpubr Title: Generate Publication Ready Visualizations of Single Cell Transcriptomics Data -Version: 2.0.2 +Version: 2.0.2.9000 Authors@R: person("Enrique", "Blanco-Carmona", , "scpubr@gmail.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-1208-1691")) @@ -75,7 +75,10 @@ Suggests: tidyr, UCell, viridis, - withr + withr, + liana (>= 0.1.6) +Remotes: + saezlab/liana VignetteBuilder: knitr biocViews: Software, SingleCell, Visualization diff --git a/NAMESPACE b/NAMESPACE index 01c5a5f..64258ca 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +export(do_AffinityAnalysisPlot) export(do_AlluvialPlot) export(do_BarPlot) export(do_BeeSwarmPlot) @@ -9,6 +10,7 @@ export(do_ChordDiagramPlot) export(do_ColorPalette) export(do_CopyNumberVariantPlot) export(do_CorrelationPlot) +export(do_DiffusionMapPlot) export(do_DimPlot) export(do_DotPlot) export(do_EnrichmentHeatmap) @@ -18,11 +20,17 @@ export(do_FunctionalAnnotationPlot) export(do_GeyserPlot) export(do_GroupedGOTermPlot) export(do_GroupwiseDEPlot) +export(do_LigandReceptorPlot) +export(do_LoadingsPlot) +export(do_MetadataPlot) export(do_NebulosaPlot) export(do_PathwayActivityPlot) export(do_RidgePlot) +export(do_SCEnrichmentHeatmap) +export(do_SCExpressionHeatmap) export(do_TFActivityPlot) export(do_TermEnrichmentPlot) export(do_ViolinPlot) export(do_VolcanoPlot) export(package_report) +export(save_Plot) diff --git a/NEWS.md b/NEWS.md index 1c3988f..5115635 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,16 @@ +# SCpbur v2.0.3 (In Development) + +## do_DimPlot() +- Fixed a bug caused by using `cells.highlight` with only one cell. + +## do_EnrichmentHeatmap() +- Changed default value of `scale_scores` to `FALSE`. +- Fixed a bug in which scores were not actually being scaled when `scale_scores = TRUE`. +- Fixed a bug in which setting `scale_scores = TRUE` and `features.order` would trigger an error since the output had the suffix `_scaled` on it. This has been patched. + +## do_LigandReceptorPlot() +- Added a new parameter `top_interactions_by_group` which when set to `TRUE` + # SCpbur v2.0.2 ## General. diff --git a/R/do_AffinityAnalysisPlot.R b/R/do_AffinityAnalysisPlot.R new file mode 100644 index 0000000..c2bef41 --- /dev/null +++ b/R/do_AffinityAnalysisPlot.R @@ -0,0 +1,546 @@ +#' Compute affinity of gene sets to cell populations using decoupleR. +#' +#' Major contributions to this function: +#' - \href{https://github.com/MarcElosua}{Marc Elosua Bayés} for the core concept code and idea. +#' - \href{https://github.com/paubadiam}{Pau Badia i Mompel} for the network generation. +#' +#' @inheritParams doc_function +#' @param statistic \strong{\code{\link[base]{character}}} | DecoupleR statistic to use for the analysis. +#' values in the Idents of the Seurat object are reported, assessing how specific a given gene set is for a given cell population compared to other gene sets of equal expression. +#' +#' @return A list containing different plots. +#' @export +#' +#' @example /man/examples/examples_do_AffinityAnalysisPlot.R + +do_AffinityAnalysisPlot <- function(sample, + input_gene_list, + subsample = 2500, + group.by = NULL, + assay = NULL, + slot = NULL, + statistic = "ulm", + number.breaks = 5, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + diverging.palette = "RdBu", + diverging.direction = -1, + enforce_symmetry = TRUE, + legend.position = "bottom", + legend.width = 1, + legend.length = 20, + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.type = "colorbar", + na.value = "grey75", + font.size = 14, + font.type = "sans", + axis.text.x.angle = 45, + flip = FALSE, + colors.use = NULL, + min.cutoff = NA, + max.cutoff = NA, + verbose = TRUE, + return_object = FALSE, + grid.color = "white", + border.color = "black", + flavor = "Seurat", + nbin = 24, + ctrl = 100, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain"){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests("do_AffinityAnalysisPlot") + + check_Seurat(sample) + + if (is.null(assay)){assay <- check_and_set_assay(sample)$assay} + if (is.null(slot)){slot <- check_and_set_slot(slot)} + + # Check logical parameters. + logical_list <- list("verbose" = verbose, + "flip" = flip, + "enforce_symmetry" = enforce_symmetry, + "use_viridis" = use_viridis) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("font.size" = font.size, + "legend.length" = legend.length, + "legend.width" = legend.width, + "legend.framewidth" = legend.framewidth, + "legend.tickwidth" = legend.tickwidth, + "subsample" = subsample, + "viridis.direction" = viridis.direction, + "axis.text.x.angle" = axis.text.x.angle, + "min.cutoff" = min.cutoff, + "max.cutoff" = max.cutoff, + "number.breaks" = number.breaks, + "sequential.direction" = sequential.direction, + "nbin" = nbin, + "ctrl" = ctrl, + "diverging.direction" = diverging.direction) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + character_list <- list("group.by" = group.by, + "assay" = assay, + "slot" = slot, + "statistic" = statistic, + "legend.type" = legend.type, + "legend.position" = legend.position, + "legend.framecolor" = legend.framecolor, + "legend.tickcolor" = legend.tickcolor, + "font.type" = font.type, + "viridis.palette" = viridis.palette, + "diverging.palette" = diverging.palette, + "sequential.palette" = sequential.palette, + "grid.color" = grid.color, + "border.color" = border.color, + "flavor" = flavor, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face, + "na.value" = na.value) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + `%>%` <- magrittr::`%>%` + + check_colors(grid.color, parameter_name = "grid.color") + check_colors(na.value, parameter_name = "na.value") + check_colors(border.color, parameter_name = "border.color") + check_colors(legend.tickcolor, parameter_name = "legend.tickcolor") + check_colors(legend.framecolor, parameter_name = "legend.framecolor") + + check_parameters(parameter = font.type, parameter_name = "font.type") + check_parameters(parameter = legend.position, parameter_name = "legend.position") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + check_parameters(viridis.direction, parameter_name = "viridis.direction") + check_parameters(sequential.direction, parameter_name = "sequential.direction") + check_parameters(diverging.direction, parameter_name = "diverging.direction") + + # Assign a group.by if this is null. + out <- check_group_by(sample = sample, + group.by = group.by, + is.heatmap = TRUE) + sample <- out[["sample"]] + group.by <- out[["group.by"]] + + if (!is.na(subsample)){ + sample <- sample[, sample(colnames(sample), subsample)] + } + + # Generate the continuous color palette. + if (isTRUE(enforce_symmetry)){ + colors.gradient <- compute_continuous_palette(name = diverging.palette, + use_viridis = FALSE, + direction = diverging.direction, + enforce_symmetry = enforce_symmetry) + } else { + colors.gradient <- compute_continuous_palette(name = ifelse(isTRUE(use_viridis), viridis.palette, sequential.palette), + use_viridis = use_viridis, + direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction), + enforce_symmetry = enforce_symmetry) + } + + + # Generate a network with the names of the list of genes as source and the gene sets as targets with 1 of mode of regulation. + # Step 1: Check for underscores in the names of the gene sets. + if (length(unlist(stringr::str_match_all(names(input_gene_list), "_"))) > 0){ + warning(paste0(add_warning(), crayon_body("Found "), + crayon_key("underscores (_)"), + crayon_body(" in the name of the gene sets provided. Replacing them with "), + crayon_key("dots (.)"), + crayon_body(" to avoid conflicts when generating the Seurat assay.")), call. = FALSE) + names.use <- stringr::str_replace_all(names(input_gene_list), "_", ".") + names(input_gene_list) <- names.use + } + + # Step 2: make the lists of equal length. + max_value <- max(unname(unlist(lapply(input_gene_list, length)))) + min_value <- min(unname(unlist(lapply(input_gene_list, length)))) + + assertthat::assert_that(length(input_gene_list) >= 2, + msg = paste0(add_cross, + crayon_body("Please make sure that the gene list you provide to "), + crayon_key("input_gene_list"), + crayon_body(" have at least "), + crayon_key("two different"), + crayon_body(" gene sets."))) + + assertthat::assert_that(min_value >= 5, + msg = paste0(add_cross, + crayon_body("Please make sure that the gene list you provide to "), + crayon_key("input_gene_list"), + crayon_body(" have at least "), + crayon_key("five genes"), + crayon_body(" each."))) + + # Add fake genes until all lists have the same length so that it can be converted into a tibble. + gene_list <- lapply(input_gene_list, function(x){ + if (length(x) != max_value){ + remaining <- max_value - length(x) + x <- append(x, rep("deleteme", remaining)) + x + } else{ + x + } + }) + + # Generate the network as a tibble and filter out fake genes. + network <- gene_list %>% + tibble::as_tibble() %>% + tidyr::pivot_longer(cols = dplyr::everything(), + names_to = "source", + values_to = "target") %>% + dplyr::mutate("mor" = 1) %>% + dplyr::filter(.data$target != "deleteme") + + # Get expression data. + suppressWarnings({ + mat <- SeuratObject::GetAssayData(sample, + assay = assay, + slot = slot) + }) + # Compute activities. + if(isTRUE(verbose)){message(paste0(add_info(), crayon_body("Computing "), + crayon_key("activities"), + crayon_body("...")))} + + if (statistic == "ulm"){ + acts <- decoupleR::run_ulm(mat = mat, + network = network) + } else { + acts <- decoupleR::run_wmean(mat = mat, + network = network) + } + + + # Turn them into a matrix compatible to turn into a Seurat assay. + acts.matrix <- acts %>% + dplyr::filter(.data$statistic == .env$statistic) %>% + tidyr::pivot_wider(id_cols = dplyr::all_of("source"), + names_from = "condition", + values_from = "score") %>% + tibble::column_to_rownames('source') + + # Generate a Seurat assay. + assay.add <- Seurat::CreateAssayObject(acts.matrix) + + # Add the assay to the Seurat object. + sample@assays$affinity <- assay.add + sample@assays$affinity@key <- "affinity_" + + # Set it as default assay. + Seurat::DefaultAssay(sample) <- "affinity" + + # Scale and center the activity data. + sample <- Seurat::ScaleData(sample, verbose = FALSE, assay = "affinity") + + # Plotting. + # Get the data frames per group.by value for plotting. + list.data <- list() + counter <- 0 + for (group in group.by){ + counter <- counter + 1 + suppressWarnings({ + data.use <- SeuratObject::GetAssayData(sample, + assay = "affinity", + slot = "scale.data") %>% + t() %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::left_join(y = {sample@meta.data %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::select(dplyr::all_of(c("cell", group)))}, + by = "cell") %>% + tidyr::pivot_longer(cols = -dplyr::all_of(c("cell", group)), + names_to = "source", + values_to = "score") + }) + # Clustering based on the median across all cells. + data.cluster <- data.use %>% + tidyr::pivot_wider(id_cols = dplyr::all_of(c("cell", group)), + names_from = "source", + values_from = "score") %>% + dplyr::group_by(.data[[group]]) %>% + dplyr::summarise(dplyr::across(.cols = dplyr::all_of(c(names(input_gene_list))), + function(x){stats::median(x, na.rm = TRUE)})) %>% + as.data.frame() %>% + tibble::column_to_rownames(var = group) + + list.data[[group]][["data"]] <- data.use + list.data[[group]][["data.cluster"]] <- data.cluster + } + + # Plot individual heatmaps. + + list.heatmaps <- list() + counter <- 0 + row.order.list <- list() + for (group in group.by){ + counter <- counter + 1 + + data.use <- list.data[[group]][["data"]] + data.cluster <- list.data[[group]][["data.cluster"]] + + # nocov start + if (counter == 1){ + if (length(colnames(data.cluster)) == 1){ + col_order <- colnames(data.cluster)[1] + } else { + col_order <- colnames(data.cluster)[stats::hclust(stats::dist(t(data.cluster), method = "euclidean"), method = "ward.D")$order] + } + } + # nocov end + + if(length(rownames(data.cluster)) == 1){ + row_order <- rownames(data.cluster)[1] + } else { + row_order <- rownames(data.cluster)[stats::hclust(stats::dist(data.cluster, method = "euclidean"), method = "ward.D")$order] + } + row.order.list[[group]] <- row_order + + data.use <- data.use %>% + dplyr::group_by(.data[[group]], .data$source) %>% + dplyr::summarise("mean" = mean(.data$score, na.rm = TRUE)) + + list.data[[group]][["data.mean"]] <- data.use + + if (!is.na(min.cutoff)){ + data.use <- data.use %>% + dplyr::mutate("mean" = ifelse(.data$mean < min.cutoff, min.cutoff, .data$mean)) + } + + if (!is.na(max.cutoff)){ + data.use <- data.use %>% + dplyr::mutate("mean" = ifelse(.data$mean > max.cutoff, max.cutoff, .data$mean)) + } + p <- data.use %>% + dplyr::mutate("source" = factor(.data$source, levels = col_order), + "target" = factor(.data[[group]], levels = row_order)) %>% + # nocov start + ggplot2::ggplot(mapping = ggplot2::aes(x = if (isTRUE(flip)){.data$source} else {.data$target}, + y = if (isTRUE(flip)){.data$target} else {.data$source}, + fill = .data$mean)) + + # nocov end + ggplot2::geom_tile(color = grid.color, linewidth = 0.5, na.rm = TRUE) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::scale_x_discrete(expand = c(0, 0), + position = "top") + + # nocov start + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(if (isTRUE(flip)){.data$target} else {.data$source}))), + x.sec = guide_axis_label_trans(~paste0(levels(if (isTRUE(flip)){.data$source} else {.data$target})))) + + # nocov end + ggplot2::coord_equal() + list.heatmaps[[group]] <- p + } + + + # Compute limits. + min.vector <- NULL + max.vector <- NULL + + for (group in group.by){ + data.limits <- list.data[[group]][["data.mean"]] + + min.vector <- append(min.vector, min(data.limits$mean, na.rm = TRUE)) + max.vector <- append(max.vector, max(data.limits$mean, na.rm = TRUE)) + } + + # Get the absolute limits of the datasets. + limits <- c(min(min.vector, na.rm = TRUE), + max(max.vector, na.rm = TRUE)) + + # Compute overarching scales for all heatmaps. + scale.setup <- compute_scales(sample = sample, + feature = " ", + assay = assay, + reduction = NULL, + slot = slot, + number.breaks = number.breaks, + min.cutoff = min.cutoff, + max.cutoff = max.cutoff, + flavor = "Seurat", + enforce_symmetry = enforce_symmetry, + from_data = TRUE, + limits.use = limits) + + for (group in group.by){ + p <- list.heatmaps[[group]] + + p <- p + + ggplot2::scale_fill_gradientn(colors = colors.gradient, + na.value = na.value, + name = paste0(statistic, " | Scaled and Centered"), + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + + list.heatmaps[[group]] <- p + } + + # Modify legends. + for (group in group.by){ + p <- list.heatmaps[[group]] + + p <- modify_continuous_legend(p = p, + legend.aes = "fill", + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + list.heatmaps[[group]] <- p + } + + # Add theme + counter <- 0 + for (group in group.by){ + counter <- counter + 1 + + p <- list.heatmaps[[group]] + + # Set axis titles. + if (isTRUE(flip)){ + if (counter == 1){ + ylab <- group + xlab <- NULL + if (length(group.by) == counter){ + xlab <- "Gene set" + } + } else { + xlab <- "Gene set" + ylab <- group + } + } else { + if (counter == 1){ + ylab <- "Gene set" + xlab <- group + } else { + ylab <- NULL + xlab <- group + } + } + + + p <- list.heatmaps[[group]] + + axis.parameters <- handle_axis(flip = !flip, + group.by = rep("A", length(group.by)), + group = group, + counter = counter, + axis.text.x.angle = axis.text.x.angle, + plot.title.face = plot.title.face, + plot.subtitle.face = plot.subtitle.face, + plot.caption.face = plot.caption.face, + axis.title.face = axis.title.face, + axis.text.face = axis.text.face, + legend.title.face = legend.title.face, + legend.text.face = legend.text.face) + + p <- p + + ggplot2::xlab(xlab) + + ggplot2::ylab(ylab) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.ticks.x.bottom = axis.parameters$axis.ticks.x.bottom, + axis.ticks.x.top = axis.parameters$axis.ticks.x.top, + axis.ticks.y.left = axis.parameters$axis.ticks.y.left, + axis.ticks.y.right = axis.parameters$axis.ticks.y.right, + axis.text.y.left = axis.parameters$axis.text.y.left, + axis.text.y.right = axis.parameters$axis.text.y.right, + axis.text.x.top = axis.parameters$axis.text.x.top, + axis.text.x.bottom = axis.parameters$axis.text.x.bottom, + axis.title.x.bottom = axis.parameters$axis.title.x.bottom, + axis.title.x.top = axis.parameters$axis.title.x.top, + axis.title.y.right = axis.parameters$axis.title.y.right, + axis.title.y.left = axis.parameters$axis.title.y.left, + strip.background = axis.parameters$strip.background, + strip.clip = axis.parameters$strip.clip, + strip.text = axis.parameters$strip.text, + legend.position = legend.position, + axis.line = ggplot2::element_blank(), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white", linewidth = 1), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.text = ggplot2::element_text(face = legend.text.face), + legend.title = ggplot2::element_text(face = legend.title.face), + legend.justification = "center", + plot.margin = ggplot2::margin(t = 0, r = 0, b = 0, l = 0), + panel.border = ggplot2::element_rect(fill = NA, color = border.color, linewidth = 1), + panel.grid.major = ggplot2::element_blank(), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.spacing.x = ggplot2::unit(0, "cm")) + + list.heatmaps[[group]] <- p + } + + + if (isTRUE(flip)){ + list.heatmaps <- list.heatmaps[rev(group.by)] + } + p <- patchwork::wrap_plots(list.heatmaps, + ncol = if (base::isFALSE(flip)){NULL} else {1}, + nrow = if(base::isFALSE(flip)){1} else {NULL}, + guides = "collect") + p <- p + + patchwork::plot_annotation(theme = ggplot2::theme(legend.position = legend.position, + plot.title = ggplot2::element_text(family = font.type, + color = "black", + face = "bold", + hjust = 0), + plot.subtitle = ggplot2::element_text(family = font.type, + color = "black", + hjust = 0), + plot.caption = ggplot2::element_text(family = font.type, + color = "black", + hjust = 1), + plot.caption.position = "plot")) + + list.output <- list() + + list.output[["Heatmap"]] <- p + + + if (isTRUE(return_object)){ + list.output[["Object"]] <- sample + } + + if (isTRUE(return_object)){ + return_me <- list.output + } else { + return_me <- list.output$Heatmap + } + + return(return_me) +} diff --git a/R/do_DiffusionMapPlot.R b/R/do_DiffusionMapPlot.R new file mode 100644 index 0000000..8d1f63f --- /dev/null +++ b/R/do_DiffusionMapPlot.R @@ -0,0 +1,422 @@ +#' Compute a heatmap of enrichment of gene sets on the context of a diffusion component. +#' +#' @inheritParams doc_function +#' @param colors.use \strong{\code{\link[base]{list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the package but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column! +#' @param main.heatmap.size \strong{\code{\link[base]{numeric}}} | A number from 0 to 1 corresponding to how big the main heatmap plot should be with regards to the rest (corresponds to the proportion in size). +#' @param scale.enrichment \strong{\code{\link[base]{logical}}} | Should the enrichment scores be scaled for better comparison in between gene sets? Setting this to TRUE should make intra- gene set comparisons easier at the cost ot not being able to compare inter- gene sets in absolute values. +#' @return A list of ggplot2 objects and a Seurat object if desired. +#' @export +#' +#' @example /man/examples/examples_do_DiffusionMapPlot.R +do_DiffusionMapPlot <- function(sample, + input_gene_list, + assay = NULL, + slot = NULL, + scale.enrichment = TRUE, + dims = 1:5, + subsample = 2500, + reduction = "diffusion", + group.by = NULL, + colors.use = NULL, + interpolate = FALSE, + nbin = 24, + ctrl = 100, + flavor = "Seurat", + main.heatmap.size = 0.95, + enforce_symmetry = ifelse(isTRUE(scale.enrichment), TRUE, FALSE), + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + font.size = 14, + font.type = "sans", + na.value = "grey75", + legend.width = 1, + legend.length = 20, + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.type = "colorbar", + legend.position = "bottom", + legend.nrow = NULL, + legend.ncol = NULL, + legend.byrow = FALSE, + number.breaks = 5, + diverging.palette = "RdBu", + diverging.direction = -1, + axis.text.x.angle = 45, + border.color = "black", + return_object = FALSE, + verbose = TRUE, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain"){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests("do_DiffusionMapPlot") + check_Seurat(sample = sample) + + # Check logical parameters. + logical_list <- list("enforce_symmetry" = enforce_symmetry, + "legend.byrow" = legend.byrow, + "return_object" = return_object, + "scale.enrichment" = scale.enrichment, + "use_viridis" = use_viridis, + "verbose" = verbose, + "interpolate" = interpolate) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + + # Check numeric parameters. + numeric_list <- list("dims" = dims, + "subsample" = subsample, + "nbin" = nbin, + "ctrl" = ctrl, + "font.size" = font.size, + "legend.width" = legend.width, + "legend.length" = legend.length, + "legend.framewidth" = legend.framewidth, + "legend.tickwidth" = legend.tickwidth, + "number.breaks" = number.breaks, + "axis.text.x.angle" = axis.text.x.angle, + "legend.nrow" = legend.nrow, + "legend.ncol" = legend.ncol, + "main.heatmap.size" = main.heatmap.size, + "viridis.direction" = viridis.direction, + "sequential.direction" = sequential.direction, + "diverging.direction" = diverging.direction) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + + # Check character parameters. + character_list <- list("assay" = assay, + "reduction" = reduction, + "slot" = slot, + "group.by" = group.by, + "flavor" = flavor, + "font.type" = font.type, + "na.value" = na.value, + "legend.framecolor" = legend.framecolor, + "legend.tickcolor" = legend.tickcolor, + "legend.type" = legend.type, + "legend.position" = legend.position, + "viridis.palette" = viridis.palette, + "sequential.palette" = sequential.palette, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + check_colors(na.value, parameter_name = "na.value") + check_colors(legend.framecolor, parameter_name = "legend.framecolor") + check_colors(legend.tickcolor, parameter_name = "legend.tickcolor") + check_colors(border.color, parameter_name = "border.color") + + check_parameters(parameter = legend.position, parameter_name = "legend.position") + check_parameters(parameter = font.type, parameter_name = "font.type") + check_parameters(parameter = legend.type, parameter_name = "legend.type") + check_parameters(parameter = number.breaks, parameter_name = "number.breaks") + check_parameters(parameter = diverging.palette, parameter_name = "diverging.palette") + check_parameters(parameter = sequential.palette, parameter_name = "sequential.palette") + check_parameters(parameter = viridis.palette, parameter_name = "viridis.palette") + check_parameters(parameter = flavor, parameter_name = "flavor") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + check_parameters(viridis.direction, parameter_name = "viridis.direction") + check_parameters(sequential.direction, parameter_name = "sequential.direction") + check_parameters(diverging.direction, parameter_name = "diverging.direction") + + `%>%` <- magrittr::`%>%` + `:=` <- rlang::`:=` + + # nocov start + if (is.null(sample@reductions[[reduction]]@key) | is.na(sample@reductions[[reduction]]@key)){ + stop(paste0(add_cross(), + crayon_body("Assay "), + crayon_key("key"), + crayon_body(" not found for the provided"), + crayon_key(" assay"), + crayon_body(". Please set a key. \n\nYou can do it as: "), + cli::style_italic(paste0(crayon_key('sample@reductions[['), cli::col_yellow("reduction"), crayon_key(']]@key <- "DC_"')))), call. = FALSE) + } + # nocov end + key <- sample@reductions[[reduction]]@key + + if (!is.na(subsample)){ + sample <- sample[, sample(colnames(sample, subsample))] + } + + # Check group.by. + out <- check_group_by(sample = sample, + group.by = group.by, + is.heatmap = TRUE) + sample <- out[["sample"]] + group.by <- out[["group.by"]] + + if (isTRUE(enforce_symmetry)){ + colors.gradient <- compute_continuous_palette(name = diverging.palette, + use_viridis = FALSE, + direction = diverging.direction, + enforce_symmetry = enforce_symmetry) + } else { + colors.gradient <- compute_continuous_palette(name = ifelse(isTRUE(use_viridis), viridis.palette, sequential.palette), + use_viridis = use_viridis, + direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction), + enforce_symmetry = enforce_symmetry) + } + + genes.use <- unlist(input_gene_list) %>% unname() %>% unique() + genes.use <- genes.use[genes.use %in% rownames(sample)] + + if (isTRUE(verbose)){message(paste0(add_info(initial_newline = FALSE), crayon_body("Computing "), crayon_key("enrichment scores"), crayon_body("...")))} + + if (!(is.null(assay)) & flavor == "UCell"){ + warning(paste0(add_warning(), crayon_body("When using "), + crayon_key("flavor = UCell"), + crayon_body(" do not use the "), + crayon_key("assay"), + crayon_body(" parameter.\nInstead, make sure that the "), + crayon_key("assay"), + crayon_body(" you want to compute the scores with is set as the "), + crayon_key("default"), + crayon_body(" assay. Setting it to "), + crayon_key("NULL"), + crayon_body(".")), call. = FALSE) + } + + if (!(is.null(slot)) & flavor == "Seurat"){ + warning(paste0(add_warning(), crayon_body("When using "), + crayon_key("flavor = Seurat"), + crayon_body(" do not use the "), + crayon_key("slot"), + crayon_body(" parameter.\nThis is determiend by default in "), + crayon_key("Seurat"), + crayon_body(". Setting it to "), + crayon_key("NULL"), + crayon_body(".")), call. = FALSE) + } + + if (is.null(assay)){assay <- check_and_set_assay(sample)$assay} + if (is.null(slot)){slot <- check_and_set_slot(slot)} + + # nocov start + sample <- compute_enrichment_scores(sample, + input_gene_list = input_gene_list, + nbin = nbin, + ctrl = ctrl, + flavor = flavor, + assay = if (flavor == "UCell"){NULL} else {assay}, + slot = if (flavor == "Seurat"){NULL} else {slot}) + # nocov end + + if (isTRUE(verbose)){message(paste0(add_info(initial_newline = FALSE), crayon_body("Plotting "), crayon_key("heatmaps"), crayon_body("...")))} + key_col <- stringr::str_remove_all(key, "_") + # Obtain the DC embeddings, together with the enrichment scores. + data.use <- sample@reductions[[reduction]]@cell.embeddings %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "Cell") %>% + as.data.frame() %>% + tibble::as_tibble() %>% + tidyr::pivot_longer(cols = -dplyr::all_of("Cell"), + names_to = key_col, + values_to = "Score") %>% + dplyr::filter(.data[[key_col]] %in% vapply(dims, function(x){paste0(key, x)}, FUN.VALUE = character(1))) %>% + dplyr::group_by(.data[[key_col]]) %>% + dplyr::reframe("rank" = rank(.data$Score), + "Cell" = .data$Cell, + "Score" = .data$Score) %>% + dplyr::mutate("{key_col}" := factor(.data[[key_col]], levels = rev(vapply(dims, function(x){paste0(key, x)}, FUN.VALUE = character(1))))) %>% + dplyr::left_join(y = {sample@meta.data %>% + tibble::rownames_to_column(var = "Cell") %>% + tibble::as_tibble() %>% + dplyr::select(dplyr::all_of(c("Cell", group.by, names(input_gene_list))))}, + by = "Cell") + + if (isTRUE(scale.enrichment)){ + # Scale the enrichment scores as we are just interested in where they are enriched the most and not to compare across them. + for (name in names(input_gene_list)){ + data.use[, name] <- scale(data.use[, name])[, 1] + } + } + + + # Prepare the data to plot. + data.use <- data.use %>% + tidyr::pivot_longer(cols = dplyr::all_of(c(names(input_gene_list))), + names_to = "Gene_Set", + values_to = "Enrichment") + + + # Generate DC-based heatmaps. + list.out <- list() + + for (dc.use in vapply(dims, function(x){paste0(key, x)}, FUN.VALUE = character(1))){ + # Filter for the DC. + data.plot <- data.use %>% + dplyr::filter(.data[[key_col]] == dc.use) + + # Limit the scale to quantiles 0.1 and 0.9 to avoid extreme outliers. + limits <- c(stats::quantile(data.plot$Enrichment, 0.1, na.rm = TRUE), + stats::quantile(data.plot$Enrichment, 0.9, na.rm = TRUE)) + + # Bring extreme values to the cutoffs. + data.plot <- data.plot %>% + dplyr::mutate("Enrichment" = ifelse(.data$Enrichment <= limits[1], limits[1], .data$Enrichment)) %>% + dplyr::mutate("Enrichment" = ifelse(.data$Enrichment >= limits[2], limits[2], .data$Enrichment)) + + # Compute scale limits, breaks etc. + scale.setup <- compute_scales(sample = NULL, + feature = NULL, + assay = NULL, + reduction = NULL, + slot = NULL, + number.breaks = 5, + min.cutoff = NA, + max.cutoff = NA, + flavor = "Seurat", + enforce_symmetry = enforce_symmetry, + from_data = TRUE, + limits.use = limits) + + # Generate the plot. + p <- data.plot %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$rank, + y = .data$Gene_Set, + fill = .data$Enrichment)) + + ggplot2::geom_raster(interpolate = interpolate) + + legend.name <- if (flavor == "Seurat"){"Enrichment"} else if (flavor == "UCell"){"UCell score"} else if (flavor == "AUCell") {"AUC"} + legend.name.use <- ifelse(isTRUE(scale.enrichment), paste0("Scaled + centered | ", legend.name), legend.name) + + p <- p + + ggplot2::scale_fill_gradientn(colors = colors.gradient, + na.value = na.value, + name = legend.name.use, + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + + ggplot2::xlab(paste0("Ordering of cells along ", dc.use)) + + ggplot2::ylab("Gene sets") + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data$Gene_Set)))) + + # Modify the appearance of the plot. + p <- modify_continuous_legend(p = p, + legend.title = legend.name.use, + legend.aes = "fill", + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + + # Generate metadata plots to use on top of the main heatmap. + list.plots <- list() + list.plots[["main"]] <- p + for (name in group.by){ + + # Select color palette for metadata. + if (name %in% names(colors.use)){ + colors.use.iteration <- colors.use[[name]] + } else { + names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} + colors.use.iteration <- generate_color_scale(names_use = names.use) + } + + # Generate the metadata heatmap. + p <- data.use %>% + dplyr::filter(.data[[key_col]] == dc.use) %>% + dplyr::mutate("grouped.var" = .env$name) %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$rank, + y = .data$grouped.var, + fill = .data[[name]])) + + ggplot2::geom_raster(interpolate = interpolate) + + ggplot2::scale_fill_manual(values = colors.use.iteration) + + ggplot2::guides(fill = ggplot2::guide_legend(title = name, + title.position = "top", + title.hjust = 0.5, + ncol = legend.ncol, + nrow = legend.nrow, + byrow = legend.byrow)) + + ggplot2::xlab(NULL) + + ggplot2::ylab(NULL) + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data$grouped.var)))) + + list.plots[[name]] <- p + } + + # Add theme to all plots. + for (name in names(list.plots)){ + + list.plots[[name]] <- list.plots[[name]] + + ggplot2::scale_x_discrete(expand = c(0, 0)) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.text.x = ggplot2::element_blank(), + axis.text.y.right = ggplot2::element_text(face = axis.text.face, + color = "black"), + axis.text.y.left = ggplot2::element_blank(), + axis.ticks.y.right = ggplot2::element_line(color = "black"), + axis.ticks.y.left = ggplot2::element_blank(), + axis.ticks.x = ggplot2::element_blank(), + axis.line = ggplot2::element_blank(), + axis.title.y = ggplot2::element_text(face = axis.title.face, color = "black", angle = 0, hjust = 0.5, vjust = 0.5), + axis.title.x = ggplot2::element_text(face = axis.title.face, color = "black", angle = 0), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white"), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.text = ggplot2::element_text(face = legend.text.face), + legend.position = legend.position, + legend.title = ggplot2::element_text(face = legend.title.face), + legend.justification = "center", + plot.margin = ggplot2::margin(t = ifelse(name == "main", 15, 10), r = 10, b = 0, l = 10), + panel.border = ggplot2::element_rect(color = border.color, fill = NA), + panel.grid.major = ggplot2::element_blank(), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white")) + } + + # Reorder heatmaps for correct plotting. + list.plots <- list.plots[c(group.by, "main")] + height_unit <- c(rep((1 - main.heatmap.size) / length(group.by), length(group.by)), main.heatmap.size) + + + # Assemble the final heatmap. + p <- patchwork::wrap_plots(list.plots, + ncol = 1, + guides = "collect", + heights = height_unit) + + patchwork::plot_annotation(theme = ggplot2::theme(legend.position = legend.position)) + + list.out[[dc.use]] <- p + } + + # Return the object. + if (isTRUE(return_object)){ + list.out[["Object"]] <- sample + } + + return(list.out) +} diff --git a/R/do_DimPlot.R b/R/do_DimPlot.R index 97f9052..a5d112e 100644 --- a/R/do_DimPlot.R +++ b/R/do_DimPlot.R @@ -865,7 +865,8 @@ do_DimPlot <- function(sample, reduction = reduction, group.by = group.by, split.by = split.by, - n = 100) + n = 100, + skip.density = TRUE) base_layer_subset <- out$base_layer p$layers <- append(base_layer_subset, p$layers) p$layers <- append(na_layer, p$layers) diff --git a/R/do_EnrichmentHeatmap.R b/R/do_EnrichmentHeatmap.R index bc672c8..6e00be1 100644 --- a/R/do_EnrichmentHeatmap.R +++ b/R/do_EnrichmentHeatmap.R @@ -17,7 +17,7 @@ do_EnrichmentHeatmap <- function(sample, features.order = NULL, groups.order = NULL, cluster = TRUE, - scale_scores = TRUE, + scale_scores = FALSE, assay = NULL, slot = NULL, reduction = NULL, @@ -217,11 +217,11 @@ do_EnrichmentHeatmap <- function(sample, if (is.null(legend.title)){ if (flavor == "AUCell") { - legend.title <- "AUC" + legend.title <- ifelse(isTRUE(scale_scores), "AUC | Scaled", "AUC") } else if (flavor == "UCell"){ - legend.title <- "UCell score" + legend.title <- ifelse(isTRUE(scale_scores), "UCell score | Scaled", "UCell score") } else if (flavor == "Seurat"){ - legend.title <- "Enrichment" + legend.title <- ifelse(isTRUE(scale_scores), "Enrichment | Scaled", "Enrichment") } } @@ -277,7 +277,8 @@ do_EnrichmentHeatmap <- function(sample, storeRanks = storeRanks, # nocov start assay = if (flavor == "UCell"){NULL} else {assay}, - slot = if (flavor == "Seurat"){NULL} else {slot}) + slot = if (flavor == "Seurat"){NULL} else {slot}, + norm_data = scale_scores) # nocov end out.list <- list() @@ -290,12 +291,8 @@ do_EnrichmentHeatmap <- function(sample, group.by <- out[["group.by"]] matrix.list <- list() + names.use <- names(input_list) - if (base::isFALSE(scale_scores)){ - names.use <- names(input_list) - } else { - names.use <- unname(vapply(names(input_list), function(x){paste0(x, "_scaled")}, FUN.VALUE = character(1))) - } for (group in group.by){ suppressMessages({ sample$group.by <- sample@meta.data[, group] diff --git a/R/do_LigandReceptorPlot.R b/R/do_LigandReceptorPlot.R new file mode 100644 index 0000000..5efbb2f --- /dev/null +++ b/R/do_LigandReceptorPlot.R @@ -0,0 +1,588 @@ +#' Visualize Ligand-Receptor analysis output. +#' +#' This function makes use of [liana](https://github.com/saezlab/liana) package to run Ligand-Receptor analysis. Takes the output of liana and generates a dot-plot visualization according to the user's specifications. +#' +#' @inheritParams doc_function +#' @param liana_output \strong{\code{\link[tibble]{tibble}}} | Object resulting from running \link[liana]{liana_wrap} and \link[liana]{liana_aggregate}. +#' @param split.by \strong{\code{\link[base]{character}}} | Whether to further facet the plot on the y axis by common ligand.complex or receptor.complex. Values to provide: NULL, ligand.complex, receptor.complex. +#' @param keep_source,keep_target \strong{\code{\link[base]{character}}} | Identities to keep for the source/target of the interactions. NULL otherwise. +#' @param top_interactions \strong{\code{\link[base]{numeric}}} | Number of unique interactions to retrieve ordered by magnitude and specificity. It does not necessarily mean that the output will contain as many, but rather an approximate value. +#' @param top_interactions_by_group \strong{\code{\link[base]{logical}}} | Enforce the value on \strong{\code{top_interactions}} to be applied to each group in \strong{\code{source}} column. +#' @param dot_border \strong{\code{\link[base]{logical}}} | Whether to draw a black border in the dots. +#' @param dot.size \strong{\code{\link[base]{numeric}}} | Size aesthetic for the dots. +#' @param sort.by \strong{\code{\link[base]{character}}} | How to arrange the top interactions. Interactions are sorted and then the top N are retrieved and displayed. This takes place after subsetting for \strong{\code{keep_source}} and \strong{\code{keep_target}} One of: +#' \itemize{ +#' \item \emph{\code{A}}: Sorts by specificity. +#' \item \emph{\code{B}}: Sorts by magnitude. +#' \item \emph{\code{C}}: Sorts by specificity, then magnitude (gives extra weight to specificity). +#' \item \emph{\code{D}}: Sorts by magnitude, then specificity (gives extra weight to magnitude). Might lead to the display of non-significant results. +#' \item \emph{\code{E}}: Sorts by specificity and magnitude equally. +#' } +#' @param specificity,magnitude \strong{\code{\link[base]{character}}} | Which columns to use for \strong{\code{specificity}} and \strong{\code{magnitude}}. +#' @param invert_specificity,invert_magnitude \strong{\code{\link[base]{logical}}} | Whether to \strong{\code{-log10}} transform \strong{\code{specificity}} and \strong{\code{magnitude}} columns. +#' @param sorting.type.specificity,sorting.type.magnitude \strong{\code{\link[base]{character}}} | Whether the sorting of e \strong{\code{magnitude}} or \strong{\code{specificity}} columns is done in ascending or descending order. This synergises with the value of e \strong{\code{invert_specificity}} and e \strong{\code{invert_magnitude}} parameters. +#' @param compute_ChordDiagrams \strong{\code{\link[base]{logical}}} | Whether to also compute Chord Diagrams for both the number of interactions between source and target but also between ligand.complex and receptor.complex. +#' @param sort_interactions_alphabetically \strong{\code{\link[base]{logical}}} | Sort the interactions to be plotted alphabetically (\strong{\code{TRUE}}) or keep them in their original order in the matrix (\strong{\code{FALSE}}). +#' @param return_interactions \strong{\code{\link[base]{logical}}} | Whether to return the data.frames with the interactions so that they can be plotted as chord plots using other package functions. +#' +#' @return A ggplot2 plot with the results of the Ligand-Receptor analysis. +#' @export +#' +#' @example /man/examples/examples_do_LigandReceptorPlot.R + +do_LigandReceptorPlot <- function(liana_output, + split.by = NULL, + keep_source = NULL, + keep_target = NULL, + top_interactions = 25, + top_interactions_by_group = FALSE, + dot_border = TRUE, + magnitude = "sca.LRscore", + specificity = "aggregate_rank", + sort.by = "E", + sorting.type.specificity = "descending", + sorting.type.magnitude = "descending", + border.color = "black", + axis.text.x.angle = 45, + legend.position = "bottom", + legend.type = "colorbar", + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = 1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + font.size = 14, + dot.size = 1, + font.type = "sans", + plot.grid = TRUE, + grid.color = "grey90", + grid.type = "dotted", + compute_ChordDiagrams = FALSE, + sort_interactions_alphabetically = FALSE, + number.breaks = 5, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain", + return_interactions = FALSE, + invert_specificity = TRUE, + invert_magnitude = FALSE, + verbose = TRUE){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + # Checks for packages. + check_suggests(function_name = "do_LigandReceptorPlot") + `%>%` <- magrittr::`%>%` + `:=` <- rlang::`:=` + + # Check logical parameters. + logical_list <- list("dot_border" = dot_border, + "plot.grid" = plot.grid, + "sort_interactions_alphabetically" = sort_interactions_alphabetically, + "use_viridis" = use_viridis, + "return_interactions" = return_interactions, + "invert_specificity" = invert_specificity, + "invert_magnitude" = invert_magnitude, + "verbose" = verbose, + "top_interactions_by_group" = top_interactions_by_group) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("font.size" = font.size, + "top_interactions" = top_interactions, + "legend.length" = legend.length, + "legend.width" = legend.width, + "legend.framewidth" = legend.framewidth, + "legend.tickwidth" = legend.tickwidth, + "dot.size" = dot.size, + "axis.text.x.angle" = axis.text.x.angle, + "viridis.direction" = viridis.direction, + "number.breaks" = number.breaks, + "sequential.direction" = sequential.direction) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + character_list <- list("split.by" = split.by, + "keep_source" = keep_source, + "keep_target" = keep_target, + "border.color" = border.color, + "legend.position" = legend.position, + "legend.type" = legend.type, + "legend.framecolor" = legend.framecolor, + "viridis.palette" = viridis.palette, + "legend.tickcolor" = legend.tickcolor, + "font.type" = font.type, + "grid.color" = grid.color, + "grid.type" = grid.type, + "sequential.palette" = sequential.palette, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face, + "sort.by" = sort.by, + "sorting.type.specificity" = sorting.type.specificity, + "sorting.type.magnitude" = sorting.type.magnitude) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + # Check border color. + check_colors(border.color, parameter_name = "border.color") + + # Check the colors provided to legend.framecolor and legend.tickcolor. + check_colors(legend.framecolor, parameter_name = "legend.framecolor") + check_colors(legend.tickcolor, parameter_name = "legend.tickcolor") + check_colors(grid.color, parameter_name = "grid.color") + + check_parameters(parameter = font.type, parameter_name = "font.type") + check_parameters(parameter = legend.type, parameter_name = "legend.type") + check_parameters(parameter = legend.position, parameter_name = "legend.position") + check_parameters(parameter = viridis.palette, parameter_name = "viridis.palette") + check_parameters(parameter = grid.type, parameter_name = "grid.type") + check_parameters(parameter = axis.text.x.angle, parameter_name = "axis.text.x.angle") + check_parameters(parameter = number.breaks, parameter_name = "number.breaks") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + check_parameters(viridis.direction, parameter_name = "viridis.direction") + check_parameters(sequential.direction, parameter_name = "sequential.direction") + + + colors.gradient <- compute_continuous_palette(name = ifelse(isTRUE(use_viridis), viridis.palette, sequential.palette), + use_viridis = use_viridis, + direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction), + enforce_symmetry = FALSE) + + if (!is.null(split.by)){ + assertthat::assert_that(split.by %in% c("receptor.complex", "ligand.complex"), + msg = paste0(add_cross, + crayon_body("Please select one of the following for "), + crayon_key("split.by"), + crayon_body(": "), + crayon_key("ligand.complex"), + crayon_body(", "), + crayon_key("receptor.complex"), + crayon_body("."))) + } + + # Define legend parameters. Width and height values will change depending on the legend orientation. + if (legend.position %in% c("top", "bottom")){ + size_title <- "Interaction specificity" + fill.title <- "Expression Magnitude" + } else if (legend.position %in% c("left", "right")){ + size_title <- stringr::str_wrap("Interaction specificity", width = 10) + fill.title <- stringr::str_wrap("Expression Magnitude", width = 10) + } + + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Column for specificity: "), + crayon_key(specificity))) + + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Column for magnitude: "), + crayon_key(magnitude))) + } + + liana_output <- liana_output %>% + dplyr::mutate("magnitude" = .data[[magnitude]]) %>% + dplyr::mutate("specificity" = .data[[specificity]]) + + invert_function <- function(x){-log10(x + 1e-10)} + + if (isTRUE(invert_specificity)){ + liana_output <- liana_output %>% + dplyr::mutate("specificity" := invert_function(x = .data$specificity)) + } + + if (isTRUE(invert_magnitude)){ + liana_output <- liana_output %>% + dplyr::mutate("magnitude" := invert_function(.data$magnitude)) + } + + # Differential arrangement of the interactions. + liana_output <- liana_output %>% + # Merge ligand.complex and receptor.complex columns into one, that will be used for the Y axis. + tidyr::unite(c("ligand.complex", "receptor.complex"), + col = "interaction", + sep = " | ", + remove = FALSE) %>% + # Merge source and target column into one, for future filtering. + tidyr::unite(c("source", "target"), + col = "interacting_clusters", + remove = FALSE) + # For Chord diagrams. + output_copy <- liana_output %>% dplyr::filter(.data$aggregate_rank <= 0.05) + + # If the user wants to trim the matrix and subset interacting entities. + if (!(is.null(keep_source))){ + liana_output <- liana_output %>% + dplyr::filter(.data$source %in% keep_source) + output_copy <- output_copy %>% + dplyr::filter(.data$source %in% keep_source) + } + + if (!(is.null(keep_target))){ + liana_output <- liana_output %>% + dplyr::filter(.data$target %in% keep_target) + output_copy <- output_copy %>% + dplyr::filter(.data$target %in% keep_target) + } + + # Sort interactions according to user's preference. + if (sort.by == "A"){ + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting interactions by: "), + crayon_key("specificify"))) + } + + if (sorting.type.specificity == "descending"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$specificity)) + } else { + liana_output <- liana_output %>% + dplyr::arrange(.data$specificity) + } + + } else if (sort.by == "B"){ + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting interactions by: "), + crayon_key("magnitude"))) + } + + if (sorting.type.magnitude == "descending"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$magnitude)) + } else { + liana_output <- liana_output %>% + dplyr::arrange(.data$magnitude) + } + } else if (sort.by == "C"){ + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting interactions by: "), + crayon_key("specificify"), + crayon_body(" then "), + crayon_key("magnitude"), + crayon_body("."))) + } + + if (sorting.type.magnitude == "ascending" & sorting.type.specificity == "ascending"){ + liana_output <- liana_output %>% + dplyr::arrange(.data$specificity, .data$magnitude) + } else if (sorting.type.magnitude == "descending" & sorting.type.specificity == "ascending"){ + liana_output <- liana_output %>% + dplyr::arrange(.data$specificity, dplyr::desc(.data$magnitude)) + } else if (sorting.type.magnitude == "ascending" & sorting.type.specificity == "descending"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$specificity), .data$magnitude) + } else if (sorting.type.magnitude == "descending" & sorting.type.specificity == "descending"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$specificity), dplyr::desc(.data$magnitude)) + } + + } else if (sort.by == "D"){ + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting interactions by: "), + crayon_key("magnitude"), + crayon_body(" then "), + crayon_key("specificity"), + crayon_body("."))) + } + + if (sorting.type.magnitude == "ascending" & sorting.type.specificity == "ascending"){ + liana_output <- liana_output %>% + dplyr::arrange(.data$magnitude, .data$specificity) + } else if (sorting.type.magnitude == "descending" & sorting.type.specificity == "ascending"){ + liana_output <- liana_output %>% + dplyr::arrange(.data$magnitude, dplyr::desc(.data$specificity)) + } else if (sorting.type.magnitude == "ascending" & sorting.type.specificity == "descending"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$magnitude), .data$specificity) + } else if (sorting.type.magnitude == "descending" & sorting.type.specificity == "descending"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$magnitude), dplyr::desc(.data$specificity)) + } + } else if (sort.by == "E"){ + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting interactions by: "), + crayon_key("magnitude"), + crayon_body(" and "), + crayon_key("specificity"), + crayon_body(" with equal weights."))) + } + + if (sorting.type.magnitude == "ascending"){ + liana_output_magnitude <- liana_output %>% + dplyr::arrange(.data$magnitude) %>% + tibble::rowid_to_column(var = "magnitude_rank") + } else { + liana_output_magnitude <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$magnitude)) %>% + tibble::rowid_to_column(var = "magnitude_rank") + } + + if (sorting.type.specificity == "ascending"){ + liana_output_specificity <- liana_output %>% + dplyr::arrange(.data$specificity) %>% + tibble::rowid_to_column(var = "specificity_rank") + } else { + liana_output_specificity <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$specificity)) %>% + tibble::rowid_to_column(var = "specificity_rank") + } + + liana_output <- liana_output %>% + dplyr::left_join(y = liana_output_specificity %>% dplyr::select(dplyr::all_of(c("interaction", "specificity_rank"))), + by = "interaction", + relationship = "many-to-many") %>% + dplyr::left_join(y = liana_output_magnitude %>% dplyr::select(dplyr::all_of(c("interaction", "magnitude_rank"))), + by = "interaction", + relationship = "many-to-many") %>% + dplyr::mutate("rank" = .data$magnitude_rank + .data$specificity_rank) %>% + dplyr::arrange(.data$rank) %>% + dplyr::select(!dplyr::all_of(c("rank", "magnitude_rank", "specificity_rank"))) + rm(liana_output_magnitude) + rm(liana_output_specificity) + } + + if (isTRUE(verbose)){ + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting type specificity: "), + crayon_key(sorting.type.specificity))) + + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Sorting type magnitude: "), + crayon_key(sorting.type.magnitude))) + + rlang::inform(paste0(add_info(initial_newline = FALSE), + crayon_body("Plotting the following top interanctions: "), + crayon_key(top_interactions))) + } + + if (base::isFALSE(top_interactions_by_group)){ + liana_output <- liana_output %>% + # Filter based on the top X interactions of ascending sensibilities. + dplyr::inner_join(y = {liana_output %>% + dplyr::distinct_at(c("ligand.complex", "receptor.complex")) %>% + dplyr::slice_head(n = top_interactions)}, + by = c("ligand.complex", "receptor.complex"), + relationship = "many-to-many") + } else { + liana_output <- liana_output %>% + # Filter based on the top X interactions of ascending sensibilities. + dplyr::inner_join(y = {liana_output %>% + dplyr::group_by(.data$source, .data$target) %>% + dplyr::slice_head(n = top_interactions)}, + by = c("ligand.complex", "receptor.complex"), + relationship = "many-to-many") + } + + + assertthat::assert_that(nrow(liana_output) > 0, + msg = paste0(add_cross(), crayon_body("Whith the current presets of "), + crayon_key("keep_source"), + crayon_body(" and "), + crayon_key("keep_target"), + crayon_body(" there are no interactions left."))) + + # Make source and target factors, so that they do not get dropped by the plot. + if (isTRUE(sort_interactions_alphabetically)){ + liana_output$source <- factor(liana_output$source, levels = sort(unique(liana_output$source))) + liana_output$target <- factor(liana_output$target, levels = sort(unique(liana_output$target))) + liana_output$interaction <- factor(liana_output$interaction, levels = rev(sort(unique(liana_output$interaction)))) + } else if (base::isFALSE(sort_interactions_alphabetically)){ + liana_output$source <- factor(liana_output$source, levels = sort(unique(liana_output$source))) + liana_output$target <- factor(liana_output$target, levels = sort(unique(liana_output$target))) + liana_output$interaction <- factor(liana_output$interaction, levels = rev(unique(liana_output$interaction))) + } + + + # Plot. + if (isTRUE(dot_border)){ + p <- liana_output %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$target, + y = .data$interaction, + fill = .data$magnitude, + size = .data$specificity, + group = .data$interacting_clusters)) + + ggplot2::geom_point(shape = 21, + na.rm = TRUE) + } else if (base::isFALSE(dot_border)){ + p <- liana_output %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$target, + y = .data$interaction, + size = .data$specificity, + group = .data$interacting_clusters)) + + ggplot2::geom_point(mapping = ggplot2::aes(color = .data$magnitude), + shape = 19, + na.rm = TRUE) + } + + p <- p + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data$interaction)))) + + ggplot2::scale_size_continuous(name = size_title, + range = c(2 * dot.size, 10 * dot.size)) + + # Settings for bordered dots. + limits <- c(min(liana_output$magnitude, na.rm = TRUE), + max(liana_output$magnitude, na.rm = TRUE)) + + scale.setup <- compute_scales(sample = NULL, + feature = NULL, + assay = NULL, + reduction = NULL, + slot = NULL, + number.breaks = number.breaks, + min.cutoff = NA, + max.cutoff = NA, + flavor = "Seurat", + enforce_symmetry = FALSE, + from_data = TRUE, + limits.use = limits) + + if (isTRUE(dot_border)){ + # Add color to aesthetics. + p$layers[[1]]$aes_params$color <- border.color + p <- p + + ggplot2::scale_fill_gradientn(colors = colors.gradient, + na.value = NA, + name = fill.title, + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + } else { + p <- p + + ggplot2::scale_color_gradientn(colors = colors.gradient, + na.value = NA, + name = fill.title, + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + } + # Continue plotting. + if (is.null(split.by)){ + p <- p + + ggplot2::facet_grid(. ~ .data$source, + space = "free", + scales = "free", + drop = FALSE) + } else if (split.by == "ligand.complex"){ + p <- p + + ggplot2::facet_grid(.data$ligand.complex ~ .data$source, + space = "free", + scales = "free", + drop = FALSE) + } else if (split.by == "receptor.complex"){ + p <- p + + ggplot2::facet_grid(.data$receptor.complex ~ .data$source, + space = "free", + scales = "free", + drop = FALSE) + } + + + + + p <- p + + ggplot2::labs(title = "Source") + + ggplot2::xlab("Target") + + ggplot2::ylab(paste("Ligand", "|", "Receptor", sep = " ")) + + ggplot2::guides(size = ggplot2::guide_legend(title.position = "top", + title.hjust = 0.5, + override.aes = ggplot2::aes(fill = "black"))) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(plot.title = ggplot2::element_text(face = plot.title.face, + hjust = 0.5, + vjust = 0, + size = font.size), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + legend.text = ggplot2::element_text(face = legend.text.face), + legend.title = ggplot2::element_text(face = legend.title.face), + plot.title.position = "panel", + plot.caption.position = "plot", + text = ggplot2::element_text(family = font.type), + legend.justification = "center", + legend.position = legend.position, + axis.title.x = ggplot2::element_text(color = "black", face = axis.title.face, hjust = 0.5), + axis.title.y.left = ggplot2::element_text(color = "black", face = axis.title.face, angle = 90), + axis.title.y.right = ggplot2::element_blank(), + axis.text.y.right = ggplot2::element_text(color = "black", + face = axis.text.face), + axis.text.y.left = ggplot2::element_blank(), + axis.ticks.x = ggplot2::element_line(color = "black"), + axis.ticks.y.left = ggplot2::element_blank(), + axis.ticks.y.right = ggplot2::element_line(color = "black"), + axis.text.x = ggplot2::element_text(color = "black", + face = axis.text.face, + angle = get_axis_parameters(angle = axis.text.x.angle, flip = FALSE)[["angle"]], + hjust = get_axis_parameters(angle = axis.text.x.angle, flip = FALSE)[["hjust"]], + vjust = get_axis_parameters(angle = axis.text.x.angle, flip = FALSE)[["vjust"]]), + strip.text.x = ggplot2::element_text(face = "bold", + color = "black"), + strip.text.y = ggplot2::element_blank(), + panel.border = ggplot2::element_rect(color = "black", fill = NA), + panel.grid = if (isTRUE(plot.grid)){ggplot2::element_line(color = grid.color, linetype = grid.type)} else {ggplot2::element_blank()}, + plot.margin = ggplot2::margin(t = 10, r = 10, b = 10, l = 10), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "black", linetype = "solid"), + legend.background = ggplot2::element_rect(fill = "white", color = "white")) + + # Adjust for the type of legend and whether it is fill or color. + p <- modify_continuous_legend(p = p, + legend.aes = ifelse(isTRUE(dot_border), "fill", "color"), + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + + if (isTRUE(return_interactions)){ + data_interactions <- output_copy %>% + dplyr::select(dplyr::all_of(c("source", "target"))) %>% + dplyr::group_by(.data$target, .data$source) %>% + dplyr::summarise(value = dplyr::n()) %>% + dplyr::rename("from" = "source", + "to" = "target") %>% + dplyr::select(dplyr::all_of(c("from", "to", "value"))) + + + data_LF <- liana_output %>% + dplyr::filter(!(is.na(.data$magnitude))) %>% + dplyr::select(dplyr::all_of(c("ligand.complex", "receptor.complex"))) %>% + dplyr::group_by(.data$ligand.complex, .data$receptor.complex) %>% + dplyr::summarise(value = dplyr::n()) %>% + dplyr::rename("from" = "ligand.complex", + "to" = "receptor.complex") %>% + dplyr::select(dplyr::all_of(c("from", "to", "value"))) + + return(list("Plot" = p, + "Group Interactions" = data_interactions, + "LR Interactions" = data_LF)) + } else { + return(p) + } +} + + diff --git a/R/do_LoadingsPlot.R b/R/do_LoadingsPlot.R new file mode 100644 index 0000000..e7f1c0d --- /dev/null +++ b/R/do_LoadingsPlot.R @@ -0,0 +1,467 @@ +#' Compute a heatmap summary of the top and bottom genes in the PCA loadings for the desired PCs in a Seurat object. +#' +#' @inheritParams doc_function +#' @param subsample \strong{\code{\link[base]{numeric}}} | Number of cells to subsample the Seurat object to increase computational speed. Use NA to include the Seurat object as is. +#' @param dims \strong{\code{\link[base]{numeric}}} | PCs to include in the analysis. +#' @param top_loadings \strong{\code{\link[base]{numeric}}} | Number of top and bottom scored genes in the PCA Loadings for each PC. +#' @param min.cutoff.loadings,max.cutoff.loadings \strong{\code{\link[base]{numeric}}} | Cutoff to subset the scale of the Loading score heatmap. NA will use quantiles 0.05 and 0.95. +#' @param min.cutoff.expression,max.cutoff.expression \strong{\code{\link[base]{numeric}}} | Cutoff to subset the scale of the expression heatmap. NA will use 0 (no quantile) and quantile 0.95. +#' +#' @return A ggplot2 object. +#' @export +#' +#' @example /man/examples/examples_do_LoadingsPlot.R +do_LoadingsPlot <- function(sample, + group.by = NULL, + subsample = NA, + dims = 1:10, + top_loadings = 5, + assay = "SCT", + slot = "data", + grid.color = "white", + border.color = "black", + number.breaks = 5, + na.value = "grey75", + legend.position = "bottom", + legend.title = "Expression", + legend.type = "colorbar", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + font.size = 14, + font.type = "sans", + axis.text.x.angle = 45, + use_viridis = FALSE, + sequential.direction = 1, + sequential.palette = "YlGnBu", + viridis.palette = "G", + viridis.direction = -1, + diverging.palette = "RdBu", + diverging.direction = -1, + flip = FALSE, + min.cutoff.loadings = NA, + max.cutoff.loadings = NA, + min.cutoff.expression = NA, + max.cutoff.expression = NA, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain"){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests("do_LoadingsPlot") + + # Check logical parameters. + logical_list <- list("use_viridis" = use_viridis, + "flip" = flip) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("axis.text.x.angle" = axis.text.x.angle, + "legend.width" = legend.width, + "legend.length" = legend.length, + "legend.framewidth" = legend.framewidth, + "legend.tickwidth" = legend.tickwidth, + "font.size" = font.size, + "number.breaks" = number.breaks, + "viridis.direction" = viridis.direction, + "sequential.direction" = sequential.direction, + "min.cutoff.loadings" = min.cutoff.loadings, + "max.cutoff.loadings" = max.cutoff.loadings, + "min.cutoff.expression" = min.cutoff.expression, + "max.cutoff.expression" = max.cutoff.expression) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + + # Check character parameters. + character_list <- list("legend.type" = legend.type, + "font.type" = font.type, + "legend.position" = legend.position, + "legend.framecolor" = legend.framecolor, + "legend.tickcolor" = legend.tickcolor, + "na.value" = na.value, + "slot" = slot, + "assay" = assay, + "group.by" = group.by, + "diverging.palette" = diverging.palette, + "sequential.palette" = sequential.palette, + "viridis.palette" = viridis.palette, + "grid.color" = grid.color, + "border.color" = border.color, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + check_colors(na.value) + check_colors(legend.framecolor) + check_colors(legend.tickcolor) + check_colors(grid.color) + check_colors(border.color) + + check_parameters(parameter = legend.position, parameter_name = "legend.position") + check_parameters(parameter = font.type, parameter_name = "font.type") + check_parameters(parameter = legend.type, parameter_name = "legend.type") + check_parameters(parameter = number.breaks, parameter_name = "number.breaks") + check_parameters(parameter = diverging.palette, parameter_name = "diverging.palette") + check_parameters(parameter = sequential.palette, parameter_name = "sequential.palette") + check_parameters(parameter = viridis.palette, parameter_name = "viridis.palette") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + check_parameters(viridis.direction, parameter_name = "viridis.direction") + check_parameters(sequential.direction, parameter_name = "sequential.direction") + check_parameters(diverging.direction, parameter_name = "diverging.direction") + + + `%>%` <- magrittr::`%>%` + `:=` <- rlang::`:=` + + colors.gradient.loading <- compute_continuous_palette(name = diverging.palette, + use_viridis = FALSE, + direction = diverging.direction, + enforce_symmetry = TRUE) + + colors.gradient.expression <- compute_continuous_palette(name = ifelse(isTRUE(use_viridis), viridis.palette, sequential.palette), + use_viridis = use_viridis, + direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction), + enforce_symmetry = FALSE) + + # Check group.by. + out <- check_group_by(sample = sample, + group.by = group.by, + is.heatmap = TRUE) + sample <- out[["sample"]] + group.by <- out[["group.by"]] + + if (!is.na(subsample)){ + sample <- sample[, sample(colnames(sample), subsample, replace = FALSE)] + } + + loadings <- Seurat::Loadings(sample)[, dims] %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "Gene") %>% + tidyr::pivot_longer(cols = -dplyr::all_of(dplyr::all_of("Gene")), + values_to = "Loading_Score", + names_to = "PC") + + top_loadings.up <- loadings %>% + dplyr::group_by(.data$PC) %>% + dplyr::arrange(dplyr::desc(.data$Loading_Score)) %>% + dplyr::slice_head(n = top_loadings) %>% + dplyr::pull(.data$Gene) + + top_loadings.down <- loadings %>% + dplyr::group_by(.data$PC) %>% + dplyr::arrange(.data$Loading_Score) %>% + dplyr::slice_head(n = top_loadings) %>% + dplyr::pull(.data$Gene) + + genes.use <- NULL + + for (i in seq(1, length(dims) * top_loadings, by = top_loadings)){ + range <- seq(i, i + (top_loadings - 1)) + genes.add <- c(top_loadings.up[range], top_loadings.down[range]) + genes.add <- genes.add[!(genes.add %in% genes.use)] + genes.use <- append(genes.use, genes.add) + } + + loadings <- loadings %>% + dplyr::filter(.data$Gene %in% genes.use) + + embeddings <- Seurat::Embeddings(sample, reduction = "pca")[, dims] %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "Cell") %>% + tidyr::pivot_longer(cols = -dplyr::all_of(dplyr::all_of("Cell")), + values_to = "Embedding_Score", + names_to = "PC") + + metadata <- sample@meta.data %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "Cell") %>% + dplyr::select(dplyr::all_of(c("Cell", group.by))) %>% + tibble::as_tibble() + + data.use <- metadata %>% + dplyr::left_join(y = embeddings, + by = "Cell") %>% + dplyr::left_join(y = loadings, + by = "PC", + relationship = "many-to-many") + suppressWarnings({ + data.use <- data.use %>% + dplyr::left_join(y = {SeuratObject::GetAssayData(sample, + assay = assay, + slot = slot)[unique(data.use$Gene), ] %>% + as.matrix() %>% + t() %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "Cell") %>% + tidyr::pivot_longer(cols = -dplyr::all_of("Cell"), + names_to = "Gene", + values_to = "Expression")}, + by = c("Gene", "Cell")) %>% + dplyr::mutate("Gene" = factor(.data$Gene, levels = genes.use)) + }) + data.loading <- data.use %>% + dplyr::group_by(.data$Gene, .data$PC) %>% + dplyr::reframe("mean_Loading_Score" = mean(.data$Loading_Score, na.rm = TRUE)) + + data.expression <- data.use %>% + dplyr::group_by(.data[[group.by]], .data$Gene) %>% + dplyr::reframe("mean_Expression" = mean(.data$Expression, na.rm = TRUE)) + + data.expression.wide <- data.expression %>% + tidyr::pivot_wider(names_from = "Gene", + values_from = "mean_Expression") %>% + as.data.frame() %>% + tibble::column_to_rownames(var = group.by) + + data.loadings.wide <- data.loading %>% + tidyr::pivot_wider(names_from = "Gene", + values_from = "mean_Loading_Score") %>% + as.data.frame() %>% + tibble::column_to_rownames(var = "PC") + + # Cluster items. + gene.order <- genes.use[stats::hclust(stats::dist(t(data.expression.wide), method = "euclidean"), method = "ward.D")$order] + # nocov start + group.order <- if(is.factor(data.expression[[group.by]])){levels(data.expression[[group.by]])} else {sort(unique(data.expression[[group.by]]))} + # nocov end + group.order <- group.order[stats::hclust(stats::dist(data.expression.wide, method = "euclidean"), method = "ward.D")$order] + pc.order <- as.character(sort(unique(data.loading[["PC"]]))) + pc.order <- pc.order[stats::hclust(stats::dist(data.loadings.wide, method = "euclidean"), method = "ward.D")$order] + + # Reorder items. + data.loading <- data.loading %>% + dplyr::mutate("PC" = factor(.data$PC, levels = pc.order), + "Gene" = factor(.data$Gene, levels = gene.order)) + + data.expression <- data.expression %>% + dplyr::mutate("{group.by}" := factor(.data[[group.by]], levels = group.order), + "Gene" = factor(.data$Gene, levels = gene.order)) + + + + # Apply cutoffs. + if (!is.na(min.cutoff.loadings)){ + data.loading <- data.loading %>% + dplyr::mutate("mean_Loading_Score" = ifelse(.data$mean_Loading_Score < min.cutoff.loadings, min.cutoff.loadings, .data$mean_Loading_Score)) + } else { + data.loading <- data.loading %>% + dplyr::mutate("mean_Loading_Score" = ifelse(.data$mean_Loading_Score < stats::quantile(.data$mean_Loading_Score, 0.05), stats::quantile(.data$mean_Loading_Score, 0.05), .data$mean_Loading_Score)) + } + + if (!is.na(max.cutoff.loadings)){ + data.loading <- data.loading %>% + dplyr::mutate("mean_Loading_Score" = ifelse(.data$mean_Loading_Score > max.cutoff.loadings, max.cutoff.loadings, .data$mean_Loading_Score)) + } else { + data.loading <- data.loading %>% + dplyr::mutate("mean_Loading_Score" = ifelse(.data$mean_Loading_Score > stats::quantile(.data$mean_Loading_Score, 0.95), stats::quantile(.data$mean_Loading_Score, 0.95), .data$mean_Loading_Score)) + } + + + if (!is.na(min.cutoff.expression)){ + data.expression <- data.expression %>% + dplyr::mutate("mean_Expression" = ifelse(.data$mean_Expression < min.cutoff.expression, min.cutoff.expression, .data$mean_Expression)) + } + + if (!is.na(max.cutoff.expression)){ + data.expression <- data.expression %>% + dplyr::mutate("mean_Expression" = ifelse(.data$mean_Expression > max.cutoff.expression, max.cutoff.expression, .data$mean_Expression)) + } else { + data.expression <- data.expression %>% + dplyr::mutate("mean_Expression" = ifelse(.data$mean_Expression > stats::quantile(.data$mean_Expression, 0.95), stats::quantile(.data$mean_Expression, 0.95), .data$mean_Expression)) + } + + # Compute scales. + limits <- c(min(data.loading$mean_Loading_Score, na.rm = TRUE), + max(data.loading$mean_Loading_Score, na.rm = TRUE)) + + + scale.setup <- compute_scales(sample = sample, + feature = " ", + assay = "SCT", + reduction = NULL, + slot = "scale.data", + number.breaks = number.breaks, + min.cutoff = NA, + max.cutoff = NA, + flavor = "Seurat", + enforce_symmetry = TRUE, + from_data = TRUE, + limits.use = limits) + + p.loading <- data.loading %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$Gene, + y = .data$PC, + fill = .data$mean_Loading_Score)) + + ggplot2::geom_tile(color = grid.color, linewidth = 0.5) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::scale_x_discrete(expand = c(0, 0), + position = "top") + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data$PC))), + x.sec = guide_axis_label_trans(~paste0(levels(.data$Gene)))) + + ggplot2::scale_fill_gradientn(colors = colors.gradient.loading, + na.value = na.value, + name = "Avg. Loading score", + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + + ggplot2::coord_equal() + + ggplot2::xlab("Top genes") + + ggplot2::ylab("PCs") + + limits <- c(min(data.expression$mean_Expression, na.rm = TRUE), + max(data.expression$mean_Expression, na.rm = TRUE)) + scale.setup <- compute_scales(sample = sample, + feature = " ", + assay = "SCT", + reduction = NULL, + slot = "scale.data", + number.breaks = number.breaks, + min.cutoff = NA, + max.cutoff = NA, + flavor = "Seurat", + enforce_symmetry = FALSE, + from_data = TRUE, + limits.use = limits) + + p.expression <- data.expression %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$Gene, + y = .data[[group.by]], + fill = .data$mean_Expression)) + + ggplot2::geom_tile(color = grid.color, linewidth = 0.5) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::scale_x_discrete(expand = c(0, 0), + position = "top") + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data[[group.by]]))), + x.sec = guide_axis_label_trans(~paste0(levels(.data$Gene)))) + + ggplot2::coord_equal() + + ggplot2::xlab(NULL) + + ggplot2::ylab(group.by) + + ggplot2::scale_fill_gradientn(colors = colors.gradient.expression, + na.value = na.value, + name = "Avg. Expression", + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + + + + p.loading <- modify_continuous_legend(p = p.loading, + legend.title = "Avg. Loading score", + legend.aes = "fill", + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + + p.expression <- modify_continuous_legend(p = p.expression, + legend.title = "Avg. Expression", + legend.aes = "fill", + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + + list.plots <- list("Loadings" = p.loading, + "Expression" = p.expression) + counter <- 0 + for (name in rev(names(list.plots))){ + counter <- counter + 1 + + axis.parameters <- handle_axis(flip = FALSE, + group.by = "A", + group = "A", + counter = counter, + axis.text.x.angle = axis.text.x.angle, + plot.title.face = plot.title.face, + plot.subtitle.face = plot.subtitle.face, + plot.caption.face = plot.caption.face, + axis.title.face = axis.title.face, + axis.text.face = axis.text.face, + legend.title.face = legend.title.face, + legend.text.face = legend.text.face) + + list.plots[[name]] <- list.plots[[name]] + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.ticks.x.bottom = axis.parameters$axis.ticks.x.bottom, + axis.ticks.x.top = axis.parameters$axis.ticks.x.top, + axis.ticks.y.left = axis.parameters$axis.ticks.y.left, + axis.ticks.y.right = axis.parameters$axis.ticks.y.right, + axis.text.y.left = axis.parameters$axis.text.y.left, + axis.text.y.right = axis.parameters$axis.text.y.right, + axis.text.x.top = axis.parameters$axis.text.x.top, + axis.text.x.bottom = axis.parameters$axis.text.x.bottom, + axis.title.x.bottom = axis.parameters$axis.title.x.bottom, + axis.title.x.top = axis.parameters$axis.title.x.top, + axis.title.y.right = axis.parameters$axis.title.y.right, + axis.title.y.left = axis.parameters$axis.title.y.left, + axis.line = ggplot2::element_blank(), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + legend.text = ggplot2::element_text(face = legend.text.face), + legend.title = ggplot2::element_text(face = legend.title.face), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white", linewidth = 1), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.justification = "center", + plot.margin = ggplot2::margin(t = 0, r = 0, b = 0, l = 0), + panel.border = ggplot2::element_rect(fill = NA, color = border.color, linewidth = 1), + panel.grid.major = ggplot2::element_blank(), + legend.position = legend.position, + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white")) + } + list.plots[["Loadings"]] <- list.plots[["Loadings"]] + + ggplot2::xlab(paste0("Top and bottom ", top_loadings, " genes in PCA loadings")) + + ggplot2::theme(axis.title.x.top = ggplot2::element_text(face = "bold", color = "black")) + + p <- patchwork::wrap_plots(A = list.plots$Loadings, + B = list.plots$Expression, + design = "A + B", + guides = "collect") + + patchwork::plot_annotation(theme = ggplot2::theme(legend.position = legend.position, + plot.title = ggplot2::element_text(family = font.type, + color = "black", + face = plot.title.face, + hjust = 0), + plot.subtitle = ggplot2::element_text(family = font.type, + face = plot.subtitle.face, + color = "black", + hjust = 0), + plot.caption = ggplot2::element_text(family = font.type, + face = plot.caption.face, + color = "black", + hjust = 1), + plot.caption.position = "plot")) + + return(p) +} diff --git a/R/do_MetadataPlot.R b/R/do_MetadataPlot.R new file mode 100644 index 0000000..d9bdc57 --- /dev/null +++ b/R/do_MetadataPlot.R @@ -0,0 +1,345 @@ +#' Compute a heatmap of categorical variables. +#' +#' The main use of this function is to generate a metadata heatmap of your categorical data, +#' normally targeted to the different patient samples one has in the Seurat object. It requires +#' that the metadata columns chosen have one and only one possible value for each of the values in +#' group.by. +#' +#' @inheritParams doc_function +#' @param group.by \strong{\code{\link[base]{character}}} | Metadata column to use as basis for the plot. +#' @param metadata \strong{\code{\link[base]{character}}} | Metadata columns that will be used to plot the heatmap on the basis of the variable provided to group.by. +#' @param colors.use \strong{\code{\link[SCpubr]{named_list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the pacakge but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column! +#' @param heatmap.gap \strong{\code{\link[base]{numeric}}} | Size of the gap between heatmaps in mm. +#' @param from_df \strong{\code{\link[base]{logical}}} | Whether to provide a data frame with the metadata instead. +#' @param df \strong{\code{\link[base]{data.frame}}} | Data frame containing the metadata to plot. Rows contain the unique values common to all columns (metadata variables). The columns must be named. +#' @param legend.font.size \strong{\code{\link[base]{numeric}}} | Size of the font size of the legend. NULL uses default theme font size for legend according to the strong{\code{font.size}} parameter. +#' @param legend.symbol.size \strong{\code{\link[base]{numeric}}} | Size of symbols in the legend in mm. NULL uses the default size. +#' @return A ggplot2 object. +#' @export +#' +#' @example /man/examples/examples_do_MetadataPlot.R +do_MetadataPlot <- function(sample = NULL, + group.by = NULL, + metadata = NULL, + from_df = FALSE, + df = NULL, + colors.use = NULL, + cluster = TRUE, + flip = TRUE, + heatmap.gap = 1, + axis.text.x.angle = 45, + legend.position = "bottom", + font.size = 14, + legend.font.size = NULL, + legend.symbol.size = NULL, + legend.ncol = NULL, + legend.nrow = NULL, + legend.byrow = FALSE, + na.value = "grey75", + font.type = "sans", + grid.color = "white", + border.color = "black", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain", + xlab = "", + ylab = ""){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests(function_name = "do_MetadataPlot") + + # Check logical parameters. + logical_list <- list("flip" = flip, + "from_df" = from_df, + "legend.byrow" = legend.byrow, + "cluster" = cluster) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + + # Check numeric parameters. + numeric_list <- list("heatmap.gap" = heatmap.gap, + "axis.text.x.angle" = axis.text.x.angle, + "font.size" = font.size, + "legend.ncol" = legend.ncol, + "legend.nrow" = legend.nrow) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + + # Check character parameters. + character_list <- list("group.by" = group.by, + "metadata" = metadata, + "legend.position" = legend.position, + "font.type" = font.type, + "grid.color" = grid.color, + "border.color" = border.color, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face, + "xlab" = xlab, + "ylab" = ylab) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + check_colors(grid.color, parameter_name = "grid.color") + check_colors(border.color, parameter_name = "border.color") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + + `%>%` <- magrittr::`%>%` + `:=` <- rlang::`:=` + + if (base::isFALSE(from_df)){ + check_Seurat(sample = sample) + + for (meta in metadata){ + assertthat::assert_that(meta %in% colnames(sample@meta.data), + msg = paste0(add_cross(), crayon_body("Metadata column "), + crayon_key(meta), + crayon_body(" is not in the sample "), + crayon_key("metadata"), + crayon_body(". Please check."))) + } + + assertthat::assert_that(!is.null(sample) & !is.null(metadata) & !is.null(group.by), + msg = paste0(add_cross(), crayon_body("If "), + crayon_key("from_df = FALSE"), + crayon_body(" you need to use the "), + crayon_key("sample"), + crayon_body(", "), + crayon_key("group.by"), + crayon_body(", and "), + crayon_key("metadata"), + crayon_body(" parameters."))) + + # Check group.by. + out <- check_group_by(sample = sample, + group.by = group.by, + is.heatmap = TRUE) + sample <- out[["sample"]] + group.by <- out[["group.by"]] + + data.plot <- sample@meta.data %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::select(dplyr::all_of(c(group.by, metadata))) %>% + dplyr::group_by(.data[[group.by]]) %>% + dplyr::reframe(dplyr::across(.cols = dplyr::all_of(c(metadata)), unique)) + + assertthat::assert_that(length(unique(data.plot %>% dplyr::pull(.data[[group.by]]))) == nrow(data.plot), + msg = paste0(add_cross(), crayon_body("Please provide only metadata column that have a "), + crayon_key("one to one assignment"), + crayon_body(" to the unique values in "), + crayon_key("group.by"), + crayon_body("."))) + + data.order <- data.plot %>% + tibble::column_to_rownames(var = group.by) %>% + dplyr::mutate(dplyr::across(dplyr::everything(), as.factor)) + } else { + assertthat::assert_that(!is.null(df), + msg = paste0(add_cross(), crayon_body("If "), + crayon_key("from_df = TRUE"), + crayon_body(" you need to use the "), + crayon_key("df"), + crayon_body(" parameter."))) + + group.by <- "Groups" + if (base::isFALSE(flip)){ + metadata <- colnames(df) + } else { + metadata <- rev(colnames(df)) + } + + data.plot <- df %>% + tibble::rownames_to_column(var = group.by) + data.order <- data.plot %>% + tibble::column_to_rownames(var = group.by) %>% + dplyr::mutate(dplyr::across(dplyr::everything(), as.factor)) + } + + if (isTRUE(cluster)){ + order.use <- suppressWarnings({rownames(data.order)[stats::hclust(cluster::daisy(data.order, metric = "gower"), method = "ward.D")$order]}) + } else { + order.use <- rev(rownames(data.order)) + } + + + + list.heatmaps <- list() + + # Get a list of predefined colors to then compute color wheels on for each metadata variable not covered. + colors.pool <- get_SCpubr_colors() + counter <- 0 + for (name in metadata){ + # Colors + colors.use.name <- colors.use[[name]] + if (is.null(colors.use.name)){ + counter <- counter + 1 + values <- unique(data.plot %>% dplyr::pull(name)) + + colors.use.name <- stats::setNames(do_ColorPalette(n = length(values), colors.use = colors.pool[counter]), + values) + } + + + data.use <- data.plot %>% + dplyr::select(dplyr::all_of(c(group.by, name))) %>% + dplyr::mutate("{name}_fill" := factor(.data[[name]]), + "{name}" := .env$name, + "{group.by}" := factor(.data[[group.by]], levels = order.use)) %>% + # nocov start + ggplot2::ggplot(mapping = ggplot2::aes(x = if(base::isFALSE(flip)){.data[[group.by]]} else {.data[[name]]}, + y = if(base::isFALSE(flip)){.data[[name]]} else {.data[[group.by]]}, + fill = .data[[paste0(name, "_fill")]])) + + # nocov end + ggplot2::geom_tile(color = grid.color, linewidth = 0.5) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::scale_x_discrete(expand = c(0, 0), + position = "top") + + ggplot2::guides(y.sec = guide_axis_label_trans(~paste0(levels(.data[[name]]))), + x.sec = guide_axis_label_trans(~paste0(levels(.data[[group.by]])))) + + ggplot2::coord_equal() + + ggplot2::scale_fill_manual(values = colors.use.name, name = name, na.value = na.value) + list.heatmaps[[name]] <- data.use + } + + # Modify legends. + for (name in names(list.heatmaps)){ + p <- list.heatmaps[[name]] + p <- p + + ggplot2::guides(fill = ggplot2::guide_legend(legend.position = legend.position, + title.position = "top", + title.hjust = ifelse(legend.position %in% c("top", "bottom"), 0.5, 0), + ncol = legend.ncol, + nrow = legend.nrow, + byrow = legend.byrow)) + list.heatmaps[[name]] <- p + } + + # Add theme + counter <- 0 + for (name in rev(names(list.heatmaps))){ + counter <- counter + 1 + # Set axis titles. + if (base::isFALSE(flip)){ + if (counter == 1){ + xlab.use <- NULL + ylab.use <- NULL + } else if (counter == length(metadata)){ + xlab.use <- ifelse(is.null(xlab), group.by, xlab) + ylab.use <- ifelse(is.null(ylab), "", ylab) + } else { + xlab.use <- NULL + ylab.use <- NULL + } + } else { + if (counter == 1){ + xlab.use <- ifelse(is.null(xlab), "", xlab) + ylab.use <- ifelse(is.null(ylab), group.by, ylab) + } else { + xlab.use <- NULL + ylab.use <- NULL + } + } + + + p <- list.heatmaps[[name]] + + axis.parameters <- handle_axis(flip = flip, + group.by = rep("A", length(names(list.heatmaps))), + group = name, + counter = counter, + axis.text.x.angle = axis.text.x.angle, + plot.title.face = plot.title.face, + plot.subtitle.face = plot.subtitle.face, + plot.caption.face = plot.caption.face, + axis.title.face = axis.title.face, + axis.text.face = axis.text.face, + legend.title.face = legend.title.face, + legend.text.face = legend.text.face) + + p <- p + + ggplot2::xlab(xlab.use) + + ggplot2::ylab(ylab.use) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.ticks.x.bottom = axis.parameters$axis.ticks.x.bottom, + axis.ticks.x.top = axis.parameters$axis.ticks.x.top, + axis.ticks.y.left = axis.parameters$axis.ticks.y.left, + axis.ticks.y.right = axis.parameters$axis.ticks.y.right, + axis.text.y.left = axis.parameters$axis.text.y.left, + axis.text.y.right = axis.parameters$axis.text.y.right, + axis.text.x.top = axis.parameters$axis.text.x.top, + axis.text.x.bottom = axis.parameters$axis.text.x.bottom, + axis.title.x.bottom = axis.parameters$axis.title.x.bottom, + axis.title.x.top = axis.parameters$axis.title.x.top, + axis.title.y.right = axis.parameters$axis.title.y.right, + axis.title.y.left = axis.parameters$axis.title.y.left, + strip.background = axis.parameters$strip.background, + strip.clip = axis.parameters$strip.clip, + strip.text = axis.parameters$strip.text, + legend.position = legend.position, + axis.line = ggplot2::element_blank(), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white", linewidth = 1), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.text = ggplot2::element_text(face = legend.text.face, size = legend.font.size), + legend.title = ggplot2::element_text(face = legend.title.face, size = legend.font.size), + legend.justification = "center", + plot.margin = ggplot2::margin(t = heatmap.gap, r = 0, b = 0, l = heatmap.gap, unit = "mm"), + panel.border = ggplot2::element_rect(fill = NA, color = border.color, linewidth = 1), + panel.grid.major = ggplot2::element_blank(), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.spacing.x = ggplot2::unit(0, "cm")) + + if (!is.null(legend.symbol.size)){ + p <- p + ggplot2::theme(legend.key.size = ggplot2::unit(legend.symbol.size, "mm")) + } + + list.heatmaps[[name]] <- p + } + + if (isTRUE(flip)){ + names.use <- rev(metadata) + } else { + names.use <- metadata + } + p <- patchwork::wrap_plots(list.heatmaps[names.use], + ncol = if (base::isFALSE(flip)){1} else {NULL}, + nrow = if(isTRUE(flip)) {1} else {NULL}, + guides = "collect") + p <- p + + patchwork::plot_annotation(theme = ggplot2::theme(legend.position = legend.position, + plot.title = ggplot2::element_text(family = font.type, + color = "black", + face = plot.title.face, + hjust = 0), + plot.subtitle = ggplot2::element_text(family = font.type, + face = plot.subtitle.face, + color = "black", + hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, + family = font.type, + color = "black", + hjust = 1), + plot.caption.position = "plot"), + ) + + return(p) +} diff --git a/R/do_SCEnrichmentHeatmap.R b/R/do_SCEnrichmentHeatmap.R new file mode 100644 index 0000000..a680c15 --- /dev/null +++ b/R/do_SCEnrichmentHeatmap.R @@ -0,0 +1,644 @@ +#' Perform a single-cell-based heatmap showing the enrichment in a list of gene sets. +#' +#' This function is heavily inspired by \strong{\code{\link[Seurat]{DoHeatmap}}}. +#' +#' @inheritParams doc_function +#' @param proportional.size \strong{\code{\link[base]{logical}}} | Whether the groups should take the same space in the plot or not. +#' @param main.heatmap.size \strong{\code{\link[base]{numeric}}} | Controls the size of the main heatmap (proportion-wise, defaults to 0.95). +#' @param metadata \strong{\code{\link[base]{character}}} | Categorical metadata variables to plot alongside the main heatmap. +#' @param metadata.colors \strong{\code{\link[SCpubr]{named_list}}} | Named list of valid colors for each of the variables defined in \strong{\code{metadata}}. +#' @param flavor \strong{\code{\link[base]{character}}} | One of: Seurat, UCell. Compute the enrichment scores using \link[Seurat]{AddModuleScore} or \link[UCell]{AddModuleScore_UCell}. +#' @param ncores \strong{\code{\link[base]{numeric}}} | Number of cores used to run UCell scoring. +#' @param storeRanks \strong{\code{\link[base]{logical}}} | Whether to store the ranks for faster UCell scoring computations. Might require large amounts of RAM. +#' @return A ggplot2 object. +#' @export +#' +#' @example /man/examples/examples_do_SCEnrichmentHeatmap.R +do_SCEnrichmentHeatmap <- function(sample, + input_gene_list, + assay = NULL, + slot = NULL, + group.by = NULL, + features.order = NULL, + metadata = NULL, + metadata.colors = NULL, + subsample = NA, + cluster = TRUE, + flavor = "Seurat", + return_object = FALSE, + ncores = 1, + storeRanks = TRUE, + interpolate = FALSE, + nbin = 24, + ctrl = 100, + xlab = "Cells", + ylab = "Genes", + font.size = 14, + font.type = "sans", + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL, + legend.position = "bottom", + legend.title = NULL, + legend.type = "colorbar", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + strip.text.color = "black", + strip.text.angle = 0, + strip.spacing = 10, + legend.ncol = NULL, + legend.nrow = NULL, + legend.byrow = FALSE, + min.cutoff = NA, + max.cutoff = NA, + number.breaks = 5, + main.heatmap.size = 0.95, + enforce_symmetry = FALSE, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + na.value = "grey75", + diverging.palette = "RdBu", + diverging.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + proportional.size = TRUE, + verbose = FALSE, + border.color = "black", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain"){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests(function_name = "do_SCEnrichmentHeatmap") + check_Seurat(sample) + + # Check logical parameters. + logical_list <- list("enforce_symmetry" = enforce_symmetry, + "proportional.size" = proportional.size, + "verbose" = verbose, + "legend.byrow" = legend.byrow, + "use_viridis" = use_viridis, + "cluster" = cluster, + "storeRanks" = storeRanks, + "return_object" = return_object, + "interpolate" = interpolate) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("font.size" = font.size, + "legend.framewidth" = legend.framewidth, + "legend.tickwidth" = legend.tickwidth, + "legend.length" = legend.length, + "legend.width" = legend.width, + "min.cutoff" = min.cutoff, + "max.cutoff" = max.cutoff, + "number.breaks" = number.breaks, + "viridis.direction" = viridis.direction, + "legend.ncol" = legend.ncol, + "legend.nrow" = legend.ncol, + "strip.spacing" = strip.spacing, + "strip.text.angle" = strip.text.angle, + "main.heatmap.size" = main.heatmap.size, + "sequential.direction" = sequential.direction, + "nbin" = nbin, + "ctrl" = ctrl, + "ncores" = ncores, + "diverging.direction" = diverging.direction) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + character_list <- list("input_gene_list" = input_gene_list, + "assay" = assay, + "slot" = slot, + "group.by" = group.by, + "xlab" = xlab, + "ylab" = ylab, + "font.type" = font.type, + "plot.title" = plot.title, + "plot.subtitle" = plot.subtitle, + "plot.caption" = plot.caption, + "legend.position" = legend.position, + "legend.title" = legend.title, + "legend.type" = legend.type, + "legend.framecolor" = legend.framecolor, + "legend.tickcolor" = legend.tickcolor, + "strip.text.color" = strip.text.color, + "viridis.palette" = viridis.palette, + "na.value" = na.value, + "metadata" = metadata, + "metadata.colors" = metadata.colors, + "diverging.palette" = diverging.palette, + "sequential.palette" = sequential.palette, + "flavor" = flavor, + "border.color" = border.color, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + check_colors(na.value, parameter_name = "na.value") + check_colors(legend.framecolor, parameter_name = "legend.framecolor") + check_colors(legend.tickcolor, parameter_name = "legend.tickcolor") + check_colors(border.color, parameter_name = "border.color") + + check_parameters(parameter = font.type, parameter_name = "font.type") + check_parameters(parameter = legend.type, parameter_name = "legend.type") + check_parameters(parameter = legend.position, parameter_name = "legend.position") + check_parameters(parameter = viridis.palette, parameter_name = "viridis.palette") + check_parameters(parameter = number.breaks, parameter_name = "number.breaks") + check_parameters(parameter = diverging.palette, parameter_name = "diverging.palette") + check_parameters(parameter = sequential.palette, parameter_name = "sequential.palette") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + check_parameters(viridis.direction, parameter_name = "viridis.direction") + check_parameters(sequential.direction, parameter_name = "sequential.direction") + check_parameters(diverging.direction, parameter_name = "diverging.direction") + + `%>%` <- magrittr::`%>%` + + # Generate the continuous color palette. + if (isTRUE(enforce_symmetry)){ + colors.gradient <- compute_continuous_palette(name = diverging.palette, + use_viridis = FALSE, + direction = diverging.direction, + enforce_symmetry = enforce_symmetry) + } else { + colors.gradient <- compute_continuous_palette(name = ifelse(isTRUE(use_viridis), viridis.palette, sequential.palette), + use_viridis = use_viridis, + direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction), + enforce_symmetry = enforce_symmetry) + } + + if (!(is.null(assay)) & flavor == "UCell"){ + warning(paste0(add_warning(), crayon_body("When using "), + crayon_key("flavor = UCell"), + crayon_body(" do not use the "), + crayon_key("assay"), + crayon_body(" parameter.\nInstead, make sure that the "), + crayon_key("assay"), + crayon_body(" you want to compute the scores with is set as the "), + crayon_key("default"), + crayon_body(" assay. Setting it to "), + crayon_key("NULL"), + crayon_body(".")), call. = FALSE) + } + + if (!(is.null(slot)) & flavor == "Seurat"){ + warning(paste0(add_warning(), crayon_body("When using "), + crayon_key("flavor = Seurat"), + crayon_body(" do not use the "), + crayon_key("slot"), + crayon_body(" parameter.\nThis is determiend by default in "), + crayon_key("Seurat"), + crayon_body(". Setting it to "), + crayon_key("NULL"), + crayon_body(".")), call. = FALSE) + } + + if (is.null(assay)){assay <- check_and_set_assay(sample)$assay} + if (is.null(slot)){slot <- check_and_set_slot(slot)} + + if (is.character(input_gene_list)){ + stop(paste0(add_cross(), + crayon_body("You have provided a string of genes to "), + crayon_key("input_gene_list"), + crayon_body(". Please provide a "), + crayon_key("named list"), + crayon_body(" instead.")), call. = FALSE) + + } + + if (!is.null(features.order)){ + assertthat::assert_that(sum(features.order %in% names(input_gene_list)) == length(names(input_gene_list)), + msg = paste0(add_cross(), crayon_body("The names provided to "), + crayon_key("features.order"), + crayon_body(" do not match the names of the gene sets in "), + crayon_key("input_gene_list"), + crayon_body("."))) + } + + + # nocov start + if (!is.null(features.order)){ + features.order <- stringr::str_replace_all(features.order, "_", ".") + } + # nocov end + + if (is.null(legend.title)){ + if (flavor == "AUCell") { + legend.title <- "AUC" + } else if (flavor == "UCell"){ + legend.title <- "UCell score" + } else if (flavor == "Seurat"){ + legend.title <- "Enrichment" + } + } + + input_list <- input_gene_list + assertthat::assert_that(!is.null(names(input_list)), + msg = paste0(add_cross(), crayon_body("Please provide a "), + crayon_key("named list"), + crayon_body(" to "), + crayon_key("input_gene_list"), + crayon_body("."))) + if (length(unlist(stringr::str_match_all(names(input_list), "_"))) > 0){ + warning(paste0(add_warning(), crayon_body("Found "), + crayon_key("underscores (_)"), + crayon_body(" in the name of the gene sets provided. Replacing them with "), + crayon_key("dots (.)"), + crayon_body(" to avoid conflicts when generating the Seurat assay.")), call. = FALSE) + names.use <- stringr::str_replace_all(names(input_list), "_", ".") + names(input_list) <- names.use + } + + if (length(unlist(stringr::str_match_all(names(input_list), "-"))) > 0){ + warning(paste0(add_warning(), crayon_body("Found "), + crayon_key("dashes (-)"), + crayon_body(" in the name of the gene sets provided. Replacing them with "), + crayon_key("dots (.)"), + crayon_body(" to avoid conflicts when generating the Seurat assay.")), call. = FALSE) + names.use <- stringr::str_replace_all(names(input_list), "-", ".") + names(input_list) <- names.use + } + + + assertthat::assert_that(sum(names(input_list) %in% colnames(sample@meta.data)) == 0, + msg = paste0(add_cross(), crayon_body("Please make sure you do not provide a list of gene sets whose "), + crayon_key("names"), + crayon_body(" match any of the "), + crayon_key("metadata columns"), + crayon_body(" of the Seurat object."))) + # Compute the enrichment scores. + sample <- compute_enrichment_scores(sample = sample, + input_gene_list = input_list, + verbose = verbose, + nbin = nbin, + ctrl = ctrl, + flavor = flavor, + ncores = ncores, + storeRanks = storeRanks, + # nocov start + assay = if (flavor == "UCell"){NULL} else {assay}, + slot = if (flavor == "Seurat"){NULL} else {slot}) + # nocov end + + # Check group.by. + out <- check_group_by(sample = sample, + group.by = group.by, + is.heatmap = TRUE) + sample <- out[["sample"]] + group.by <- out[["group.by"]] + + assertthat::assert_that(length(group.by) == 1, + msg = paste0(add_cross(), crayon_body("Please provide only a single value to "), + crayon_key("group.by"), + crayon_body("."))) + + + + + # nocov start + # Perform hierarchical clustering cluster-wise + order.use <- if (is.factor(sample@meta.data[, group.by])){levels(sample@meta.data[, group.by])} else {sort(unique(sample@meta.data[, group.by]))} + # nocov end + + matrix <- sample@meta.data[, c(names(input_list), group.by)] %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::group_by(.data[[group.by]]) + + if (!is.na(subsample)){ + matrix <- matrix %>% + dplyr::slice_sample(n = subsample) + } + if (isTRUE(cluster)){ + # Retrieve the order median-wise to cluster heatmap bodies. + median.matrix <- matrix %>% + dplyr::summarise(dplyr::across(dplyr::all_of(names(input_list)), function(x){stats::median(x, na.rm = TRUE)})) %>% + dplyr::mutate("group.by" = as.character(.data[[group.by]])) %>% + dplyr::select(-dplyr::all_of(group.by)) %>% + as.data.frame() %>% + tibble::column_to_rownames(var = "group.by") %>% + as.matrix() %>% + t() + group_order <- stats::hclust(stats::dist(t(median.matrix), method = "euclidean"), method = "ward.D")$order + order.use <- order.use[group_order] + } + + + # Retrieve the order median-wise for the genes. + if (length(names(input_list)) == 1) { + row_order <- names(input_list)[1] + } else { + if (isTRUE(cluster)){ + row_order <- names(input_list)[stats::hclust(stats::dist(median.matrix, method = "euclidean"), method = "ward.D")$order] + } else { + row_order <- names(input_list) + } + } + + # Compute cell order to group cells withing heatmap bodies. + # nocov start + if (isTRUE(cluster)){ + if (sum(matrix %>% dplyr::pull(.data[[group.by]]) %>% table() > 65536)){ + warning(paste0(add_warning(), crayon_body("A given group in "), + crayon_key("group.by"), + crayon_body(" has more than "), + crayon_key("65536"), + crayon_body(" cells. Disabling clustering of the cells."))) + cluster <- FALSE + } + } + # nocov end + + if (isTRUE(cluster)){ + col_order <- list() + for (item in order.use){ + cells.use <- matrix %>% + dplyr::filter(.data[[group.by]] == item) %>% + dplyr::pull(.data$cell) + + matrix.subset <- matrix %>% + dplyr::ungroup() %>% + dplyr::select(-dplyr::all_of(c(group.by))) %>% + tibble::column_to_rownames(var = "cell") %>% + as.data.frame() %>% + as.matrix() %>% + t() + matrix.subset <- matrix.subset[, cells.use] + if (length(names(input_list)) == 1){ + matrix.use <- as.matrix(matrix.subset) + } else { + matrix.use <- t(matrix.subset) + } + col_order.use <- stats::hclust(stats::dist(matrix.use, method = "euclidean"), method = "ward.D")$order + + col_order[[item]] <- cells.use[col_order.use] + } + col_order <- unlist(unname(col_order)) + } else { + col_order <- matrix %>% dplyr::pull("cell") + } + + + # Retrieve metadata matrix. + metadata_plots <- list() + if (!is.null(metadata)){ + metadata.matrix <- sample@meta.data %>% + dplyr::select(dplyr::all_of(c(metadata, group.by))) %>% + dplyr::mutate("group.by" = .data[[group.by]]) %>% + as.matrix() %>% + t() + metadata.matrix <- metadata.matrix[, col_order] + + counter <- 0 + for (name in metadata){ + counter <- counter + 1 + if (counter == 1){ + name_labels <- name + } + plot_data <- metadata.matrix[c(name, "group.by"), ] %>% + t() %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::mutate("group.by" = factor(.data$group.by, levels = order.use), + "y" = .data[[name]], + "y_row" = name, + "cell" = factor(.data$cell, levels = col_order)) %>% + dplyr::select(-dplyr::all_of(name)) %>% + tibble::as_tibble() + + if (name %in% names(metadata.colors)){ + colors.use <- metadata.colors[[name]] + } else { + names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} + colors.use <- generate_color_scale(names_use = names.use) + } + p <- plot_data %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$cell, + y = .data$y_row, + fill = .data$y)) + + ggplot2::geom_tile() + + ggplot2::facet_grid(~ .data$group.by, + scales = "free_x", + # nocov start + space = if(isTRUE(proportional.size)) {"fixed"} else {"free"}) + + # nocov end + ggplot2::scale_fill_manual(values = colors.use) + + ggplot2::guides(fill = ggplot2::guide_legend(title = name, + title.position = "top", + title.hjust = 0.5, + ncol = legend.ncol, + nrow = legend.nrow, + byrow = legend.byrow)) + + ggplot2::xlab(NULL) + + ggplot2::ylab(NULL) + + metadata_plots[[name]] <- p + } + } + + # Generate the plotting data. + plot_data <- matrix %>% + dplyr::ungroup() %>% + as.data.frame() %>% + tidyr::pivot_longer(cols = -dplyr::all_of(c(group.by, "cell")), + names_to = "gene", + values_to = "expression") %>% + dplyr::rename("group.by" = dplyr::all_of(c(group.by))) %>% + dplyr::mutate("group.by" = factor(.data$group.by, levels = order.use), + "gene" = factor(.data$gene, levels = if (is.null(features.order)){rev(row_order)} else {features.order}), + "cell" = factor(.data$cell, levels = col_order)) + + + # Modify data to fit the cutoffs selected. + plot_data_limits <- plot_data + if (!is.na(min.cutoff)){ + plot_data <- plot_data %>% + dplyr::mutate("expression" = ifelse(.data$expression < min.cutoff, min.cutoff, .data$expression)) + } + + if (!is.na(max.cutoff)){ + plot_data <- plot_data %>% + dplyr::mutate("expression" = ifelse(.data$expression > max.cutoff, max.cutoff, .data$expression)) + } + + p <- plot_data %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$cell, + y = .data$gene, + fill = .data$expression)) + + ggplot2::geom_raster(interpolate = interpolate) + + + p <- p + ggplot2::facet_grid(~ .data$group.by, + scales = "free_x", + space = if(isTRUE(proportional.size)) {"fixed"} else {"free"}) + + limits.use <- c(min(plot_data_limits$expression, na.rm = TRUE), + max(plot_data_limits$expression, na.rm = TRUE)) + + scale.setup <- compute_scales(sample = sample, + feature = NULL, + assay = assay, + reduction = NULL, + slot = slot, + number.breaks = number.breaks, + min.cutoff = min.cutoff, + max.cutoff = max.cutoff, + flavor = "Seurat", + enforce_symmetry = enforce_symmetry, + from_data = TRUE, + limits.use = limits.use) + + p <- p + + ggplot2::ylab(ylab) + + ggplot2::xlab(xlab) + + ggplot2::scale_fill_gradientn(colors = colors.gradient, + na.value = na.value, + name = legend.title, + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + + p <- modify_continuous_legend(p = p, + legend.title = legend.title, + legend.aes = "fill", + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + + + # Theme setup. + metadata_plots[["main"]] <- p + + + # Configure plot margins. + + for (name in names(metadata_plots)){ + + metadata_plots[[name]] <- metadata_plots[[name]] + + ggplot2::scale_x_discrete(expand = c(0, 0)) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::labs(title = plot.title, + subtitle = plot.subtitle, + caption = plot.caption) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.text.x = ggplot2::element_blank(), + axis.text.y = ggplot2::element_text(face = axis.text.face, + color = "black"), + axis.ticks.y = ggplot2::element_line(color = "black"), + axis.ticks.x = ggplot2::element_blank(), + axis.line = ggplot2::element_blank(), + axis.title = ggplot2::element_text(face = axis.title.face, color = "black"), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + legend.text = ggplot2::element_text(face = legend.text.face), + legend.title = ggplot2::element_text(face = legend.title.face), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white"), + strip.background = ggplot2::element_blank(), + strip.clip = "off", + panel.spacing = ggplot2::unit(strip.spacing, units = "pt"), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.position = legend.position, + legend.justification = "center", + plot.margin = ggplot2::margin(t = 0, r = 10, b = 0, l = 10), + panel.border = ggplot2::element_rect(color = border.color, fill = NA), + panel.grid.major = ggplot2::element_blank(), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white")) + + if (!is.null(metadata)){ + if (name == name_labels){ + metadata_plots[[name]] <- metadata_plots[[name]] + ggplot2::theme(strip.text.x = ggplot2::element_text(family = font.type, + face = "bold", + color = strip.text.color, + angle = strip.text.angle)) + } else { + metadata_plots[[name]] <- metadata_plots[[name]] + ggplot2::theme(strip.text.x = ggplot2::element_blank()) + } + } else { + metadata_plots[[name]] <- metadata_plots[[name]] + ggplot2::theme(strip.text.x = ggplot2::element_text(family = font.type, + face = "bold", + color = strip.text.color, + angle = strip.text.angle)) + } + } + + if (!is.null(metadata)){ + plots_wrap <- c(metadata_plots[c(metadata, "main")]) + main_body_size <- main.heatmap.size + height_unit <- c(rep((1 - main_body_size) / length(metadata), length(metadata)), main_body_size) + + out <- patchwork::wrap_plots(plots_wrap, + ncol = 1, + guides = "collect", + heights = height_unit) + + patchwork::plot_annotation(title = plot.title, + subtitle = plot.subtitle, + caption = plot.caption, + theme = ggplot2::theme(legend.position = legend.position, + plot.title = ggplot2::element_text(family = font.type, + color = "black", + face = plot.title.face, + hjust = 0), + plot.subtitle = ggplot2::element_text(family = font.type, + face = plot.subtitle.face, + color = "black", + hjust = 0), + plot.caption = ggplot2::element_text(family = font.type, + face = plot.caption.face, + color = "black", + hjust = 1), + plot.caption.position = "plot")) + + } else { + out <- metadata_plots[["main"]] + } + out.list <- list() + out.list[["Heatmap"]] <- out + + if (isTRUE(return_object)){ + sample[["Enrichment"]] <- sample@meta.data %>% + dplyr::select(dplyr::all_of(names(input_list))) %>% + t() %>% + as.data.frame() %>% + Seurat::CreateAssayObject(.) + + sample@meta.data <- sample@meta.data %>% + dplyr::select(-dplyr::all_of(names(input_list))) + + sample@assays$Enrichment@key <- "Enrichment_" + + out.list[["Object"]] <- sample + + return(out.list) + } else { + return(out.list[["Heatmap"]]) + } +} diff --git a/R/do_SCExpressionHeatmap.R b/R/do_SCExpressionHeatmap.R new file mode 100644 index 0000000..ba79a8f --- /dev/null +++ b/R/do_SCExpressionHeatmap.R @@ -0,0 +1,563 @@ +#' Perform a single-cell-based heatmap showing the expression of genes. +#' +#' This function is heavily inspired by \strong{\code{\link[Seurat]{DoHeatmap}}}. +#' +#' @inheritParams doc_function +#' @param proportional.size \strong{\code{\link[base]{logical}}} | Whether the groups should take the same space in the plot or not. +#' @param main.heatmap.size \strong{\code{\link[base]{numeric}}} | Controls the size of the main heatmap (proportion-wise, defaults to 0.95). +#' @param metadata \strong{\code{\link[base]{character}}} | Categorical metadata variables to plot alongside the main heatmap. +#' @param metadata.colors \strong{\code{\link[SCpubr]{named_list}}} | Named list of valid colors for each of the variables defined in \strong{\code{metadata}}. +#' @return A ggplot2 object. +#' @export +#' +#' @example /man/examples/examples_do_SCExpressionHeatmap.R +do_SCExpressionHeatmap <- function(sample, + features, + assay = NULL, + slot = NULL, + group.by = NULL, + features.order = NULL, + metadata = NULL, + metadata.colors = NULL, + subsample = NA, + cluster = TRUE, + interpolate = FALSE, + xlab = "Cells", + ylab = "Genes", + font.size = 14, + font.type = "sans", + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL, + legend.position = "bottom", + legend.title = "Expression", + legend.type = "colorbar", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + strip.text.color = "black", + strip.text.angle = 0, + strip.spacing = 10, + legend.ncol = NULL, + legend.nrow = NULL, + legend.byrow = FALSE, + min.cutoff = NA, + max.cutoff = NA, + number.breaks = 5, + main.heatmap.size = 0.95, + enforce_symmetry = FALSE, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + na.value = "grey75", + diverging.palette = "RdBu", + diverging.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + proportional.size = TRUE, + verbose = TRUE, + border.color = "black", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain"){ + # Add lengthy error messages. + withr::local_options(.new = list("warning.length" = 8170)) + + check_suggests(function_name = "do_SCExpressionHeatmap") + check_Seurat(sample) + + if (is.null(assay)){assay <- check_and_set_assay(sample)$assay} + if (is.null(slot)){slot <- check_and_set_slot(slot)} + + # Check logical parameters. + logical_list <- list("enforce_symmetry" = enforce_symmetry, + "proportional.size" = proportional.size, + "verbose" = verbose, + "legend.byrow" = legend.byrow, + "use_viridis" = use_viridis, + "cluster" = cluster, + "interpolate" = interpolate) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("font.size" = font.size, + "legend.framewidth" = legend.framewidth, + "legend.tickwidth" = legend.tickwidth, + "legend.length" = legend.length, + "legend.width" = legend.width, + "min.cutoff" = min.cutoff, + "max.cutoff" = max.cutoff, + "number.breaks" = number.breaks, + "viridis.direction" = viridis.direction, + "legend.ncol" = legend.ncol, + "legend.nrow" = legend.ncol, + "strip.spacing" = strip.spacing, + "strip.text.angle" = strip.text.angle, + "main.heatmap.size" = main.heatmap.size, + "sequential.direction" = sequential.direction, + "diverging.direction" = diverging.direction) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + character_list <- list("features" = features, + "assay" = assay, + "slot" = slot, + "group.by" = group.by, + "xlab" = xlab, + "ylab" = ylab, + "font.type" = font.type, + "plot.title" = plot.title, + "plot.subtitle" = plot.subtitle, + "plot.caption" = plot.caption, + "legend.position" = legend.position, + "legend.title" = legend.title, + "legend.type" = legend.type, + "legend.framecolor" = legend.framecolor, + "legend.tickcolor" = legend.tickcolor, + "strip.text.color" = strip.text.color, + "viridis.palette" = viridis.palette, + "na.value" = na.value, + "metadata" = metadata, + "metadata.colors" = metadata.colors, + "diverging.palette" = diverging.palette, + "sequential.palette" = sequential.palette, + "border.color" = border.color, + "plot.title.face" = plot.title.face, + "plot.subtitle.face" = plot.subtitle.face, + "plot.caption.face" = plot.caption.face, + "axis.title.face" = axis.title.face, + "axis.text.face" = axis.text.face, + "legend.title.face" = legend.title.face, + "legend.text.face" = legend.text.face) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + check_colors(na.value, parameter_name = "na.value") + check_colors(legend.framecolor, parameter_name = "legend.framecolor") + check_colors(legend.tickcolor, parameter_name = "legend.tickcolor") + check_colors(border.color, parameter_name = "border.color") + + check_parameters(parameter = font.type, parameter_name = "font.type") + check_parameters(parameter = legend.type, parameter_name = "legend.type") + check_parameters(parameter = legend.position, parameter_name = "legend.position") + check_parameters(parameter = viridis.palette, parameter_name = "viridis.palette") + check_parameters(parameter = number.breaks, parameter_name = "number.breaks") + check_parameters(parameter = diverging.palette, parameter_name = "diverging.palette") + check_parameters(parameter = sequential.palette, parameter_name = "sequential.palette") + check_parameters(plot.title.face, parameter_name = "plot.title.face") + check_parameters(plot.subtitle.face, parameter_name = "plot.subtitle.face") + check_parameters(plot.caption.face, parameter_name = "plot.caption.face") + check_parameters(axis.title.face, parameter_name = "axis.title.face") + check_parameters(axis.text.face, parameter_name = "axis.text.face") + check_parameters(legend.title.face, parameter_name = "legend.title.face") + check_parameters(legend.text.face, parameter_name = "legend.text.face") + check_parameters(viridis.direction, parameter_name = "viridis.direction") + check_parameters(sequential.direction, parameter_name = "sequential.direction") + check_parameters(diverging.direction, parameter_name = "diverging.direction") + + + # Generate the continuous color palette. + if (isTRUE(enforce_symmetry)){ + colors.gradient <- compute_continuous_palette(name = diverging.palette, + use_viridis = FALSE, + direction = diverging.direction, + enforce_symmetry = enforce_symmetry) + } else { + colors.gradient <- compute_continuous_palette(name = ifelse(isTRUE(use_viridis), viridis.palette, sequential.palette), + use_viridis = use_viridis, + direction = ifelse(isTRUE(use_viridis), viridis.direction, sequential.direction), + enforce_symmetry = enforce_symmetry) + } + + `%>%` <- magrittr::`%>%` + + suppressWarnings({ + genes.avail <- rownames(SeuratObject::GetAssayData(sample, slot = slot, assay = assay)) + }) + + assertthat::assert_that(sum(features %in% genes.avail) > 0, + msg = paste0(add_cross(), crayon_body("None of the features are present in the row names of the assay "), + crayon_key(assay), + crayon_body(" using the slot "), + crayon_key(slot), + crayon_body(".\nPlease make sure that you only provide "), + crayon_key("genes"), + crayon_body(" as input.\nIf you select the slot "), + crayon_key("scale.data"), + crayon_body(", sometimes some of the features are missing."))) + + + missing_features <- features[!(features %in% genes.avail)] + if (length(missing_features) > 0){ + if (isTRUE(verbose)){ + warning(paste0(add_warning(), crayon_body("Some features are missing in the following assay "), + crayon_key(assay), + crayon_body(" using the slot "), + crayon_key(slot), + crayon_body(":\n"), + paste(vapply(missing_features, crayon_key, FUN.VALUE = character(1)), collapse = crayon_body(", "))), call. = FALSE) + } + } + + features <- features[features %in% genes.avail] + + if (!is.null(features.order)){ + features.order <- features.order[features.order %in% genes.avail] + assertthat::assert_that(sum(features.order %in% features) == length(features), + msg = paste0(add_cross(), crayon_body("The names provided to "), + crayon_key("features.order"), + crayon_body(" do not match the names of the gene sets in "), + crayon_key("input_gene_list"), + crayon_body("."))) + } + + suppressWarnings({ + matrix <- SeuratObject::GetAssayData(sample, + assay = assay, + slot = slot)[features, , drop = FALSE] %>% + as.matrix() + }) + # Check group.by. + out <- check_group_by(sample = sample, + group.by = group.by, + is.heatmap = TRUE) + sample <- out[["sample"]] + group.by <- out[["group.by"]] + + assertthat::assert_that(length(group.by) == 1, + msg = paste0(add_cross(), crayon_body("Please provide only a single value to "), + crayon_key("group.by"), + crayon_body("."))) + + + + + # nocov start + # Perform hierarchical clustering cluster-wise + order.use <- if (is.factor(sample@meta.data[, group.by])){levels(sample@meta.data[, group.by])} else {sort(unique(sample@meta.data[, group.by]))} + # nocov end + + matrix <- matrix %>% + t() %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::left_join(y = {sample@meta.data %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::select(dplyr::all_of(c("cell", group.by)))}, + by = "cell") %>% + dplyr::group_by(.data[[group.by]]) + if (!is.na(subsample)){ + matrix <- matrix %>% + dplyr::slice_sample(n = subsample) + } + # Retrieve the order median-wise to cluster heatmap bodies. + if (isTRUE(cluster)){ + median.matrix <- matrix %>% + dplyr::summarise(dplyr::across(dplyr::all_of(features), function(x){stats::median(x, na.rm = TRUE)})) %>% + dplyr::mutate("group.by" = as.character(.data[[group.by]])) %>% + dplyr::select(-dplyr::all_of(group.by)) %>% + as.data.frame() %>% + tibble::column_to_rownames(var = "group.by") %>% + as.matrix() %>% + t() + group_order <- stats::hclust(stats::dist(t(median.matrix), method = "euclidean"), method = "ward.D")$order + order.use <- order.use[group_order] + } + + + # Retrieve the order median-wise for the genes. + if (length(features) == 1) { + row_order <- features[1] + } else { + if (isTRUE(cluster)){ + row_order <- features[stats::hclust(stats::dist(median.matrix, method = "euclidean"), method = "ward.D")$order] + } else { + row_order <- features + } + } + + + # Compute cell order to group cells withing heatmap bodies. + # nocov start + if (isTRUE(cluster)){ + if (sum(matrix %>% dplyr::pull(dplyr::all_of(c(group.by))) %>% table() > 65536)){ + warning(paste0(add_warning(), crayon_body("A given group in "), + crayon_key("group.by"), + crayon_body(" has more than "), + crayon_key("65536"), + crayon_body(" cells. Disabling clustering of the cells.")), call. = FALSE) + cluster <- FALSE + } + } + # nocov end + + if (isTRUE(cluster)){ + col_order <- list() + for (item in order.use){ + cells.use <- matrix %>% + dplyr::filter(.data[[group.by]] == item) %>% + dplyr::pull(dplyr::all_of("cell")) + + matrix.subset <- matrix %>% + dplyr::ungroup() %>% + dplyr::select(-dplyr::all_of(c(group.by))) %>% + tibble::column_to_rownames(var = "cell") %>% + as.data.frame() %>% + as.matrix() %>% + t() + matrix.subset <- matrix.subset[, cells.use] + # nocov start + if (sum(is.na(matrix.subset)) > 0){ + warning(paste0(add_warning(), crayon_key("NA"), crayon_body("found in the "), + crayon_key("expression matrix"), + crayon_body(". Replacing them with "), + crayon_key("0"), + crayon_body(".")), call. = FALSE) + matrix.subset[is.na(matrix.subset)] <- 0 + } + # nocov end + if (length(features) == 1){ + matrix.use <- as.matrix(matrix.subset) + } else { + matrix.use <- t(matrix.subset) + } + col_order.use <- stats::hclust(stats::dist(matrix.use, method = "euclidean"), method = "ward.D")$order + + col_order[[item]] <- cells.use[col_order.use] + } + col_order <- unlist(unname(col_order)) + } else { + col_order <- matrix %>% dplyr::pull("cell") + } + + + + + + # Retrieve metadata matrix. + metadata_plots <- list() + if (!is.null(metadata)){ + metadata.matrix <- sample@meta.data %>% + dplyr::select(dplyr::all_of(c(metadata, group.by))) %>% + dplyr::mutate("group.by" = .data[[group.by]]) %>% + as.matrix() %>% + t() + metadata.matrix <- metadata.matrix[, col_order] + + counter <- 0 + for (name in metadata){ + counter <- counter + 1 + if (counter == 1){ + name_labels <- name + } + plot_data <- metadata.matrix[c(name, "group.by"), ] %>% + t() %>% + as.data.frame() %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::mutate("group.by" = factor(.data$group.by, levels = order.use), + "y" = .data[[name]], + "y_row" = name, + "cell" = factor(.data$cell, levels = col_order)) %>% + dplyr::select(-dplyr::all_of(name)) %>% + tibble::as_tibble() + + if (name %in% names(metadata.colors)){ + colors.use <- metadata.colors[[name]] + } else { + names.use <- if(is.factor(sample@meta.data[, name])){levels(sample@meta.data[, name])} else {sort(unique(sample@meta.data[, name]))} + colors.use <- generate_color_scale(names_use = names.use) + } + p <- plot_data %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$cell, + y = .data$y_row, + fill = .data$y)) + + ggplot2::geom_raster(interpolate = interpolate) + + ggplot2::facet_grid(~ .data$group.by, + scales = "free_x", + space = if(isTRUE(proportional.size)) {"fixed"} else {"free"}) + + ggplot2::scale_fill_manual(values = colors.use) + + ggplot2::guides(fill = ggplot2::guide_legend(title = name, + title.position = "top", + title.hjust = 0.5, + ncol = legend.ncol, + nrow = legend.nrow, + byrow = legend.byrow)) + + ggplot2::xlab(NULL) + + ggplot2::ylab(NULL) + + metadata_plots[[name]] <- p + } + } + + # Generate the plotting data. + plot_data <- matrix %>% + dplyr::ungroup() %>% + as.data.frame() %>% + tidyr::pivot_longer(cols = -dplyr::all_of(c(group.by, "cell")), + names_to = "gene", + values_to = "expression") %>% + dplyr::rename("group.by" = dplyr::all_of(c(group.by))) %>% + dplyr::mutate("group.by" = factor(.data$group.by, levels = order.use), + "gene" = factor(.data$gene, levels = if (is.null(features.order)){rev(row_order)} else {features.order}), + "cell" = factor(.data$cell, levels = col_order)) + + + # Modify data to fit the cutoffs selected. + plot_data_limits <- plot_data + if (!is.na(min.cutoff)){ + plot_data <- plot_data %>% + dplyr::mutate("expression" = ifelse(.data$expression < min.cutoff, min.cutoff, .data$expression)) + } + + if (!is.na(max.cutoff)){ + plot_data <- plot_data %>% + dplyr::mutate("expression" = ifelse(.data$expression > max.cutoff, max.cutoff, .data$expression)) + } + + p <- plot_data %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$cell, + y = .data$gene, + fill = .data$expression)) + + ggplot2::geom_raster() + + + p <- p + ggplot2::facet_grid(~ .data$group.by, + scales = "free_x", + space = if(isTRUE(proportional.size)) {"fixed"} else {"free"}) + + limits.use <- c(min(plot_data_limits$expression, na.rm = TRUE), + max(plot_data_limits$expression, na.rm = TRUE)) + + scale.setup <- compute_scales(sample = sample, + feature = NULL, + assay = assay, + reduction = NULL, + slot = slot, + number.breaks = number.breaks, + min.cutoff = min.cutoff, + max.cutoff = max.cutoff, + flavor = "Seurat", + enforce_symmetry = enforce_symmetry, + from_data = TRUE, + limits.use = limits.use) + + p <- p + + ggplot2::ylab(ylab) + + ggplot2::xlab(xlab) + + ggplot2::scale_fill_gradientn(colors = colors.gradient, + na.value = na.value, + name = legend.title, + breaks = scale.setup$breaks, + labels = scale.setup$labels, + limits = scale.setup$limits) + + p <- modify_continuous_legend(p = p, + legend.title = legend.title, + legend.aes = "fill", + legend.type = legend.type, + legend.position = legend.position, + legend.length = legend.length, + legend.width = legend.width, + legend.framecolor = legend.framecolor, + legend.tickcolor = legend.tickcolor, + legend.framewidth = legend.framewidth, + legend.tickwidth = legend.tickwidth) + + + + # Theme setup. + metadata_plots[["main"]] <- p + + + # Configure plot margins. + + for (name in names(metadata_plots)){ + + metadata_plots[[name]] <- metadata_plots[[name]] + + ggplot2::scale_x_discrete(expand = c(0, 0)) + + ggplot2::scale_y_discrete(expand = c(0, 0)) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.text.x = ggplot2::element_blank(), + axis.text.y = ggplot2::element_text(face = axis.text.face, + color = "black"), + axis.ticks.y = ggplot2::element_line(color = "black"), + axis.ticks.x = ggplot2::element_blank(), + axis.line = ggplot2::element_blank(), + axis.title = ggplot2::element_text(face = axis.title.face, color = "black"), + plot.title = ggplot2::element_text(face = plot.title.face, hjust = 0), + plot.subtitle = ggplot2::element_text(face = plot.subtitle.face, hjust = 0), + plot.caption = ggplot2::element_text(face = plot.caption.face, hjust = 1), + legend.text = ggplot2::element_text(face = legend.text.face), + legend.title = ggplot2::element_text(face = legend.title.face), + plot.title.position = "plot", + panel.grid = ggplot2::element_blank(), + panel.grid.minor.y = ggplot2::element_line(color = "white"), + strip.background = ggplot2::element_blank(), + strip.clip = "off", + panel.spacing = ggplot2::unit(strip.spacing, units = "pt"), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.position = legend.position, + legend.justification = "center", + plot.margin = ggplot2::margin(t = 0, r = 10, b = 0, l = 10), + panel.border = ggplot2::element_rect(color = border.color, fill = NA), + panel.grid.major = ggplot2::element_blank(), + plot.background = ggplot2::element_rect(fill = "white", color = "white"), + panel.background = ggplot2::element_rect(fill = "white", color = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white")) + + if (!is.null(metadata)){ + if (name == name_labels){ + metadata_plots[[name]] <- metadata_plots[[name]] + ggplot2::theme(strip.text.x = ggplot2::element_text(family = font.type, + face = "bold", + color = strip.text.color, + angle = strip.text.angle)) + } else { + metadata_plots[[name]] <- metadata_plots[[name]] + ggplot2::theme(strip.text.x = ggplot2::element_blank()) + } + } else { + metadata_plots[[name]] <- metadata_plots[[name]] + ggplot2::theme(strip.text.x = ggplot2::element_text(family = font.type, + face = "bold", + color = strip.text.color, + angle = strip.text.angle)) + } + } + + if (!is.null(metadata)){ + plots_wrap <- c(metadata_plots[c(metadata, "main")]) + main_body_size <- main.heatmap.size + height_unit <- c(rep((1 - main_body_size) / length(metadata), length(metadata)), main_body_size) + + out <- patchwork::wrap_plots(plots_wrap, + ncol = 1, + guides = "collect", + heights = height_unit) + + patchwork::plot_annotation(title = plot.title, + subtitle = plot.subtitle, + caption = plot.caption, + theme = ggplot2::theme(legend.position = legend.position, + plot.title = ggplot2::element_text(family = font.type, + color = "black", + face = plot.title.face, + hjust = 0), + plot.subtitle = ggplot2::element_text(family = font.type, + color = "black", + face = plot.subtitle.face, + hjust = 0), + plot.caption = ggplot2::element_text(family = font.type, + color = "black", + face = plot.caption.face, + hjust = 1), + plot.caption.position = "plot")) + + } else { + out <- metadata_plots[["main"]] + } + + + return(out) +} diff --git a/R/save_Plot.R b/R/save_Plot.R new file mode 100644 index 0000000..d1e6ac1 --- /dev/null +++ b/R/save_Plot.R @@ -0,0 +1,203 @@ +#' Save a plot as png, pdf and svg. +#' +#' +#' @param plot Plot to save. +#' @param figure_path \strong{\code{\link[base]{character}}} | Path where the figure will be stored. +#' @param create_path \strong{\code{\link[base]{logical}}} | Whether to create the path. +#' @param file_name \strong{\code{\link[base]{character}}} | Name of the file (without extension, it will be added automatically). +#' @param output_format \strong{\code{\link[base]{character}}} | Output format of the saved figure. One of: +#' \itemize{ +#' \item \emph{\code{pdf}}: Saves the figure as a PDF file. +#' \item \emph{\code{png}}: Saves the figure as a PNG file. +#' \item \emph{\code{jpeg}}: Saves the figure as a JPEG file. +#' \item \emph{\code{tiff}}: Saves the figure as a TIFF file. +#' \item \emph{\code{svg}}: Saves the figure as a SVG file. +#' \item \emph{\code{publication}}: Saves the figure as PDF, PNG and SVG files. +#' \item \emph{\code{all}}: Saves the figure in all possible formats. +#' } +#' @param dpi \strong{\code{\link[base]{numeric}}} | Dpi to use. +#' @param width,height \strong{\code{\link[base]{numeric}}} | Width and height of the figure (inches). +#' +#' @return Nothing. +#' @export +#' +#' @example /man/examples/examples_save_Plot.R +save_Plot <- function(plot, + figure_path = NULL, + create_path = TRUE, + file_name = NULL, + dpi = 300, + output_format = "publication", + width = 8, + height = 8){ + # nocov start + + # Checks for packages. + check_suggests(function_name = "save_Plot") + + # Check logical parameters. + logical_list <- list("create_path" = create_path) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("dpi" = dpi, + "width" = width, + "height" = height) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + character_list <- list("figure_path" = figure_path, + "file_name" = file_name) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + # Null file name? + if (is.null(file_name)){file_name <- "output_figure"} + # Null figure path? + if (is.null(figure_path)){figure_path <- paste0(".", .Platform$file.sep)} + + # Create directory. + if (!(dir.exists(figure_path))){ + if (isTRUE(create_path)){dir.create(figure_path, recursive = TRUE)} + } + + + + + # Handle devices: + output_options <- c("all", "publication", "pdf", "png", "jpeg", "svg", "tiff") + + assertthat::assert_that(sum(output_format %in% output_options) >= 1, + msg = "Please select a valid output format from the available options: all, publication, pdf, png, jpeg, svg, tiff") + + assertthat::assert_that(base::isFALSE("all" %in% output_format & "publication" %in% output_format), + msg = "Please select either `all` or `publication`.") + + if (output_format == "publication"){ + devices_use <- c("pdf", "png", "svg") + } else if (output_format == "all"){ + devices_use <- c("pdf", "png", "jpeg", "svg", "tiff") + } else { + possible_options <- c("pdf", "png", "jpeg", "svg", "tiff") + devices_use <- output_format[output_format %in% possible_options] + } + + # is ggplot? + + if (sum(class(plot) %in% "ggplot") >= 1){ + # Having width = NULL and height = NULL will make the ggsave() function crash. + for (device in devices_use){ + suppressMessages({ + ggplot2::ggsave(filename = sprintf("%s.%s", file_name, device), + plot = plot, + path = figure_path, + dpi = dpi, + width = width, + height = height, + device = device) + }) + } + # Is it a heatmap? + } else if (sum(class(plot) %in% c("HeatmapList", "ComplexHeatmap")) >= 1) { + suppressMessages({ + filename <- paste0(figure_path, "/", file_name) + if ("png" %in% devices_use){ + grDevices::png(filename = paste0(filename, ".png"), units = "in", height = height, width = width, res = dpi) + ComplexHeatmap::draw(plot, show_heatmap_legend = TRUE, padding = ggplot2::unit(c(20, 20, 2, 20), "mm")) + grDevices::dev.off() + } + + if ("pdf" %in% devices_use){ + grDevices::pdf(file = paste0(filename, ".pdf"), height = height, width = width) + ComplexHeatmap::draw(plot, show_heatmap_legend = TRUE, padding = ggplot2::unit(c(20, 20, 2, 20), "mm")) + grDevices::dev.off() + } + + if ("jpeg" %in% devices_use){ + grDevices::jpeg(file = paste0(filename, ".jpeg"), units = "in", height = height, width = width, res = dpi) + ComplexHeatmap::draw(plot, show_heatmap_legend = TRUE, padding = ggplot2::unit(c(20, 20, 2, 20), "mm")) + grDevices::dev.off() + } + + if ("tiff" %in% devices_use){ + grDevices::jpeg(file = paste0(filename, ".tiff"), units = "in", height = height, width = width, res = dpi) + ComplexHeatmap::draw(plot, show_heatmap_legend = TRUE, padding = ggplot2::unit(c(20, 20, 2, 20), "mm")) + grDevices::dev.off() + } + + if ("svg" %in% devices_use){ + svglite::svglite(filename = paste0(filename, ".svg"), height = height, width = width) + ComplexHeatmap::draw(plot, show_heatmap_legend = TRUE, padding = ggplot2::unit(c(20, 20, 2, 20), "mm")) + grDevices::dev.off() + } + + }) + + } else if (sum(class(plot) %in% "pheatmap") >= 1){ + suppressMessages({ + filename <- paste0(figure_path, "/", file_name) + if ("png" %in% devices_use){ + grDevices::png(filename = paste0(filename, ".png"), units = "in", height = height, width = width, res = dpi) + print(plot) + grDevices::dev.off() + + } + + if ("pdf" %in% devices_use){ + grDevices::pdf(file = paste0(filename, ".pdf"), height = height, width = width) + print(plot) + grDevices::dev.off() + } + + if ("jpeg" %in% devices_use){ + grDevices::jpeg(file = paste0(filename, ".jpeg"), units = "in", height = height, width = width, res = dpi) + print(plot) + grDevices::dev.off() + } + + if ("tiff" %in% devices_use){ + grDevices::jpeg(file = paste0(filename, ".tiff"), units = "in", height = height, width = width, res = dpi) + print(plot) + grDevices::dev.off() + } + + if ("svg" %in% devices_use){ + svglite::svglite(filename = paste0(filename, ".svg"), height = height, width = width) + print(plot) + grDevices::dev.off() + } + }) + } else if (sum(class(plot) %in% "recordedplot") >= 1){ + suppressMessages({ + filename <- paste0(figure_path, "/", file_name) + if ("png" %in% devices_use){ + grDevices::png(filename = paste0(filename, ".png"), units = "in", height = height, width = width, res = dpi) + grDevices::replayPlot(plot) + grDevices::dev.off() + + } + + if ("pdf" %in% devices_use){ + grDevices::pdf(file = paste0(filename, ".pdf"), height = height, width = width) + grDevices::replayPlot(plot) + grDevices::dev.off() + } + + if ("jpeg" %in% devices_use){ + grDevices::jpeg(file = paste0(filename, ".jpeg"), units = "in", height = height, width = width, res = dpi) + grDevices::replayPlot(plot) + grDevices::dev.off() + } + + if ("tiff" %in% devices_use){ + grDevices::jpeg(file = paste0(filename, ".tiff"), units = "in", height = height, width = width, res = dpi) + grDevices::replayPlot(plot) + grDevices::dev.off() + } + + if ("svg" %in% devices_use){ + svglite::svglite(filename = paste0(filename, ".svg"), height = height, width = width) + grDevices::replayPlot(plot) + grDevices::dev.off() + } + }) + } + # nocov end +} diff --git a/R/utils.R b/R/utils.R index 12353a4..3489be5 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1825,6 +1825,7 @@ modify_string <- function(string_to_modify){ #' @param verbose Verbose output. #' @param nbin Number of bins. #' @param ctrl Number of control genes. +#' @param norm_data Whether to 0-1 normalize the data #' #' @return None #' @noRd @@ -1841,7 +1842,8 @@ compute_enrichment_scores <- function(sample, slot = NULL, flavor = "Seurat", ncores = 1, - storeRanks = TRUE){ + storeRanks = TRUE, + norm_data = FALSE){ `%>%` <- magrittr::`%>%` # Checks for UCell. @@ -1975,11 +1977,14 @@ compute_enrichment_scores <- function(sample, by = "cell") %>% tibble::column_to_rownames(var = "cell") } - - # Compute a 0-1 normalization. - for (name in names(input_gene_list)){ - sample@meta.data[, paste0(name, "_scaled")] <- zero_one_norm(sample@meta.data[, name]) + + if (isTRUE(norm_data)){ + # Compute a 0-1 normalization. + for (name in names(input_gene_list)){ + sample@meta.data[, name] <- zero_one_norm(sample@meta.data[, name]) + } } + return(sample) } @@ -2843,28 +2848,33 @@ compute_umap_layer <- function(sample, reduction = "umap", group.by = NULL, split.by = NULL, - n = 100) { + n = 100, + skip.density = FALSE) { `%>%` <- magrittr::`%>%` embeddings <- Seurat::Embeddings(sample, - reduction = reduction)[, labels] %>% + reduction = reduction)[, labels, drop = FALSE] %>% as.data.frame() colnames(embeddings) <- c("x", "y") # Code adapted from: https://slowkow.com/notes/ggplot2-color-by-density/ # Licensed under: CC BY-SA (compatible with GPL-3). # Author: Kamil Slowikowski - https://slowkow.com/ + # Obtain density. - density <- MASS::kde2d(x = embeddings$x, - y = embeddings$y, - n = n) - # Find the intervals. - x.intervals <- findInterval(embeddings$x, density$x) - y.intervals <- findInterval(embeddings$y, density$y) - # Generate density vector to add to metadata. - interval_matrix <- cbind(x.intervals, y.intervals) - density_vector <- density$z[interval_matrix] - embeddings$density <- density_vector + if (base::isFALSE(skip.density)){ + density <- MASS::kde2d(x = embeddings$x, + y = embeddings$y, + n = n) + # Find the intervals. + x.intervals <- findInterval(embeddings$x, density$x) + y.intervals <- findInterval(embeddings$y, density$y) + # Generate density vector to add to metadata. + interval_matrix <- cbind(x.intervals, y.intervals) + density_vector <- density$z[interval_matrix] + embeddings$density <- density_vector + } + # Add the group.by and split.by layers. if (!is.null(group.by)){ @@ -2877,18 +2887,20 @@ compute_umap_layer <- function(sample, tibble::column_to_rownames(var = "cell") colnames(embeddings) <- c(colnames(embeddings)[seq(1, (length(colnames(embeddings)) - 1))], "group.by") - - density.center.group.by <- embeddings %>% - dplyr::select(dplyr::all_of(c("x", "y", "group.by", "density"))) %>% - dplyr::group_by(.data$group.by) %>% - dplyr::mutate("filt_x_up" = stats::quantile(.data$x, 0.66), - "filt_x_down" = stats::quantile(.data$x, 0.33), - "filt_y_up" = stats::quantile(.data$y, 0.66), - "filt_y_down" = stats::quantile(.data$y, 0.33)) %>% - dplyr::filter(.data$x >= .data$filt_x_down & .data$x <= .data$filt_x_up, - .data$y >= .data$filt_y_down & .data$y <= .data$filt_y_up) %>% - dplyr::summarize("x" = mean(.data$x), - "y" = mean(.data$y)) + if (base::isFALSE(skip.density)){ + density.center.group.by <- embeddings %>% + dplyr::select(dplyr::all_of(c("x", "y", "group.by", "density"))) %>% + dplyr::group_by(.data$group.by) %>% + dplyr::mutate("filt_x_up" = stats::quantile(.data$x, 0.66), + "filt_x_down" = stats::quantile(.data$x, 0.33), + "filt_y_up" = stats::quantile(.data$y, 0.66), + "filt_y_down" = stats::quantile(.data$y, 0.33)) %>% + dplyr::filter(.data$x >= .data$filt_x_down & .data$x <= .data$filt_x_up, + .data$y >= .data$filt_y_down & .data$y <= .data$filt_y_up) %>% + dplyr::summarize("x" = mean(.data$x), + "y" = mean(.data$y)) + } + } if (!is.null(split.by)){ @@ -2903,8 +2915,11 @@ compute_umap_layer <- function(sample, } # Apply filtering criteria: - embeddings <- embeddings %>% - dplyr::filter(.data$density <= stats::quantile(embeddings$density, border.density)) + if (base::isFALSE(skip.density)){ + embeddings <- embeddings %>% + dplyr::filter(.data$density <= stats::quantile(embeddings$density, border.density)) + } + # Generate base layer. if (base::isFALSE(raster)){ @@ -2954,7 +2969,7 @@ compute_umap_layer <- function(sample, # Generate center points layer. out <- list() - if (!is.null(group.by)){ + if (!is.null(group.by) & base::isFALSE(skip.density)){ # Generate colored based layer. if (base::isFALSE(raster)){ color_layer <- ggplot2::geom_point(data = embeddings, diff --git a/man/do_AffinityAnalysisPlot.Rd b/man/do_AffinityAnalysisPlot.Rd new file mode 100644 index 0000000..0923e69 --- /dev/null +++ b/man/do_AffinityAnalysisPlot.Rd @@ -0,0 +1,195 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_AffinityAnalysisPlot.R +\name{do_AffinityAnalysisPlot} +\alias{do_AffinityAnalysisPlot} +\title{Compute affinity of gene sets to cell populations using decoupleR.} +\usage{ +do_AffinityAnalysisPlot( + sample, + input_gene_list, + subsample = 2500, + group.by = NULL, + assay = NULL, + slot = NULL, + statistic = "ulm", + number.breaks = 5, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + diverging.palette = "RdBu", + diverging.direction = -1, + enforce_symmetry = TRUE, + legend.position = "bottom", + legend.width = 1, + legend.length = 20, + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.type = "colorbar", + na.value = "grey75", + font.size = 14, + font.type = "sans", + axis.text.x.angle = 45, + flip = FALSE, + colors.use = NULL, + min.cutoff = NA, + max.cutoff = NA, + verbose = TRUE, + return_object = FALSE, + grid.color = "white", + border.color = "black", + flavor = "Seurat", + nbin = 24, + ctrl = 100, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain" +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{input_gene_list}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of lists of genes to be used as input.} + +\item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subset for the analysis. NA will use all. Cells are selected at random.} + +\item{group.by}{\strong{\code{\link[base]{character}}} | Metadata variable to group the output by. Has to be a character of factor column.} + +\item{assay}{\strong{\code{\link[base]{character}}} | Assay to use. Defaults to the current assay.} + +\item{slot}{\strong{\code{\link[base]{character}}} | Data slot to use. Only one of: counts, data, scale.data. Defaults to "data".} + +\item{statistic}{\strong{\code{\link[base]{character}}} | DecoupleR statistic to use for the analysis. +values in the Idents of the Seurat object are reported, assessing how specific a given gene set is for a given cell population compared to other gene sets of equal expression.} + +\item{number.breaks}{\strong{\code{\link[base]{numeric}}} | Controls the number of breaks in continuous color scales of ggplot2-based plots.} + +\item{use_viridis}{\strong{\code{\link[base]{logical}}} | Whether to use viridis color scales.} + +\item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} + +\item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} + +\item{sequential.palette}{\strong{\code{\link[base]{character}}} | Type of sequential color palette to use. Out of the sequential palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{sequential.direction}{\strong{\code{\link[base]{numeric}}} | Direction of the sequential color scale. Either 1 or -1.} + +\item{diverging.palette}{\strong{\code{\link[base]{character}}} | Type of symmetrical color palette to use. Out of the diverging palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{diverging.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Direction of the divering palette. This basically flips the two ends.} + +\item{enforce_symmetry}{\strong{\code{\link[base]{logical}}} | Return a symmetrical plot axes-wise or continuous color scale-wise, when applicable.} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{legend.length, legend.width}{\strong{\code{\link[base]{numeric}}} | Length and width of the legend. Will adjust automatically depending on legend side.} + +\item{legend.framewidth, legend.tickwidth}{\strong{\code{\link[base]{numeric}}} | Width of the lines of the box in the legend.} + +\item{legend.framecolor}{\strong{\code{\link[base]{character}}} | Color of the lines of the box in the legend.} + +\item{legend.tickcolor}{\strong{\code{\link[base]{character}}} | Color of the ticks of the box in the legend.} + +\item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: +\itemize{ +\item \emph{\code{normal}}: Default legend displayed by \pkg{ggplot2}. +\item \emph{\code{colorbar}}: Redefined colorbar legend, using \link[ggplot2]{guide_colorbar}. +}} + +\item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{axis.text.x.angle}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} + +\item{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} + +\item{colors.use}{\strong{\code{\link[SCpubr]{named_vector}}} | Named vector of valid color representations (either name of HEX codes) with as many named colors as unique values of group.by. If group.by is not provided, defaults to the unique values of \link[Seurat]{Idents}. If not provided, a color scale will be set by default.} + +\item{min.cutoff, max.cutoff}{\strong{\code{\link[base]{numeric}}} | Set the min/max ends of the color scale. Any cell/group with a value lower than min.cutoff will turn into min.cutoff and any cell with a value higher than max.cutoff will turn into max.cutoff. In FeaturePlots, provide as many values as features. Use NAs to skip a feature.} + +\item{verbose}{\strong{\code{\link[base]{logical}}} | Whether to show extra comments, warnings,etc.} + +\item{return_object}{\strong{\code{\link[base]{logical}}} | Returns the Seurat object with the modifications performed in the function. Nomally, this contains a new assay with the data that can then be used for any other visualization desired.} + +\item{grid.color}{\strong{\code{\link[base]{character}}} | Color of the grid in the plot. In heatmaps, color of the border of the cells.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{flavor}{\strong{\code{\link[base]{character}}} | One of: Seurat, UCell. Compute the enrichment scores using \link[Seurat]{AddModuleScore} or \link[UCell]{AddModuleScore_UCell}.} + +\item{nbin}{\strong{\code{\link[base]{numeric}}} | Number of bins to use in \link[Seurat]{AddModuleScore}.} + +\item{ctrl}{\strong{\code{\link[base]{numeric}}} | Number of genes in the control set to use in \link[Seurat]{AddModuleScore}.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} +} +\value{ +A list containing different plots. +} +\description{ +Major contributions to this function: +\itemize{ +\item \href{https://github.com/MarcElosua}{Marc Elosua Bayés} for the core concept code and idea. +\item \href{https://github.com/paubadiam}{Pau Badia i Mompel} for the network generation. +} +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_AffinityAnalysisPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Genes have to be unique. + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + # Default parameters. + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + nbin = 1, + ctrl = 5, + flavor = "Seurat", + subsample = NA, + verbose = FALSE) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/do_DiffusionMapPlot.Rd b/man/do_DiffusionMapPlot.Rd new file mode 100644 index 0000000..dfc37ba --- /dev/null +++ b/man/do_DiffusionMapPlot.Rd @@ -0,0 +1,208 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_DiffusionMapPlot.R +\name{do_DiffusionMapPlot} +\alias{do_DiffusionMapPlot} +\title{Compute a heatmap of enrichment of gene sets on the context of a diffusion component.} +\usage{ +do_DiffusionMapPlot( + sample, + input_gene_list, + assay = NULL, + slot = NULL, + scale.enrichment = TRUE, + dims = 1:5, + subsample = 2500, + reduction = "diffusion", + group.by = NULL, + colors.use = NULL, + interpolate = FALSE, + nbin = 24, + ctrl = 100, + flavor = "Seurat", + main.heatmap.size = 0.95, + enforce_symmetry = ifelse(isTRUE(scale.enrichment), TRUE, FALSE), + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + font.size = 14, + font.type = "sans", + na.value = "grey75", + legend.width = 1, + legend.length = 20, + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.type = "colorbar", + legend.position = "bottom", + legend.nrow = NULL, + legend.ncol = NULL, + legend.byrow = FALSE, + number.breaks = 5, + diverging.palette = "RdBu", + diverging.direction = -1, + axis.text.x.angle = 45, + border.color = "black", + return_object = FALSE, + verbose = TRUE, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain" +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{input_gene_list}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of lists of genes to be used as input.} + +\item{assay}{\strong{\code{\link[base]{character}}} | Assay to use. Defaults to the current assay.} + +\item{slot}{\strong{\code{\link[base]{character}}} | Data slot to use. Only one of: counts, data, scale.data. Defaults to "data".} + +\item{scale.enrichment}{\strong{\code{\link[base]{logical}}} | Should the enrichment scores be scaled for better comparison in between gene sets? Setting this to TRUE should make intra- gene set comparisons easier at the cost ot not being able to compare inter- gene sets in absolute values.} + +\item{dims}{\strong{\code{\link[base]{numeric}}} | Vector of 2 numerics indicating the dimensions to plot out of the selected reduction. Defaults to c(1, 2) if not specified.} + +\item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subset for the analysis. NA will use all. Cells are selected at random.} + +\item{reduction}{\strong{\code{\link[base]{character}}} | Reduction to use. Can be the canonical ones such as "umap", "pca", or any custom ones, such as "diffusion". If you are unsure about which reductions you have, use \code{Seurat::Reductions(sample)}. Defaults to "umap" if present or to the last computed reduction if the argument is not provided.} + +\item{group.by}{\strong{\code{\link[base]{character}}} | Metadata variable to group the output by. Has to be a character of factor column.} + +\item{colors.use}{\strong{\code{\link[base]{list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the package but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column!} + +\item{interpolate}{\strong{\code{\link[base]{logical}}} | Smoothes the output heatmap, saving space on disk when saving the image. However, the image is not as crisp.} + +\item{nbin}{\strong{\code{\link[base]{numeric}}} | Number of bins to use in \link[Seurat]{AddModuleScore}.} + +\item{ctrl}{\strong{\code{\link[base]{numeric}}} | Number of genes in the control set to use in \link[Seurat]{AddModuleScore}.} + +\item{flavor}{\strong{\code{\link[base]{character}}} | One of: Seurat, UCell. Compute the enrichment scores using \link[Seurat]{AddModuleScore} or \link[UCell]{AddModuleScore_UCell}.} + +\item{main.heatmap.size}{\strong{\code{\link[base]{numeric}}} | A number from 0 to 1 corresponding to how big the main heatmap plot should be with regards to the rest (corresponds to the proportion in size).} + +\item{enforce_symmetry}{\strong{\code{\link[base]{logical}}} | Return a symmetrical plot axes-wise or continuous color scale-wise, when applicable.} + +\item{use_viridis}{\strong{\code{\link[base]{logical}}} | Whether to use viridis color scales.} + +\item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} + +\item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} + +\item{sequential.palette}{\strong{\code{\link[base]{character}}} | Type of sequential color palette to use. Out of the sequential palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{sequential.direction}{\strong{\code{\link[base]{numeric}}} | Direction of the sequential color scale. Either 1 or -1.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} + +\item{legend.length, legend.width}{\strong{\code{\link[base]{numeric}}} | Length and width of the legend. Will adjust automatically depending on legend side.} + +\item{legend.framewidth, legend.tickwidth}{\strong{\code{\link[base]{numeric}}} | Width of the lines of the box in the legend.} + +\item{legend.framecolor}{\strong{\code{\link[base]{character}}} | Color of the lines of the box in the legend.} + +\item{legend.tickcolor}{\strong{\code{\link[base]{character}}} | Color of the ticks of the box in the legend.} + +\item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: +\itemize{ +\item \emph{\code{normal}}: Default legend displayed by \pkg{ggplot2}. +\item \emph{\code{colorbar}}: Redefined colorbar legend, using \link[ggplot2]{guide_colorbar}. +}} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{legend.nrow}{\strong{\code{\link[base]{numeric}}} | Number of rows in the legend.} + +\item{legend.ncol}{\strong{\code{\link[base]{numeric}}} | Number of columns in the legend.} + +\item{legend.byrow}{\strong{\code{\link[base]{logical}}} | Whether the legend is filled by row or not.} + +\item{number.breaks}{\strong{\code{\link[base]{numeric}}} | Controls the number of breaks in continuous color scales of ggplot2-based plots.} + +\item{diverging.palette}{\strong{\code{\link[base]{character}}} | Type of symmetrical color palette to use. Out of the diverging palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{diverging.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Direction of the divering palette. This basically flips the two ends.} + +\item{axis.text.x.angle}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{return_object}{\strong{\code{\link[base]{logical}}} | Returns the Seurat object with the modifications performed in the function. Nomally, this contains a new assay with the data that can then be used for any other visualization desired.} + +\item{verbose}{\strong{\code{\link[base]{logical}}} | Whether to show extra comments, warnings,etc.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} +} +\value{ +A list of ggplot2 objects and a Seurat object if desired. +} +\description{ +Compute a heatmap of enrichment of gene sets on the context of a diffusion component. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_DiffusionMapPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Genes have to be unique. + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + # Requisite is that you have a diffusion map reduction stored in the Seurat + # object under the name "diffusion". + + # This will query, for the provided components, the enrichment of the gene + # sets for all cells and plot them in the context of the cells reordered by + # the position alonside each DC. + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + nbin = 1, + ctrl = 5, + flavor = "Seurat", + subsample = NA, + dims = 1:2, + verbose = FALSE) + + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/do_EnrichmentHeatmap.Rd b/man/do_EnrichmentHeatmap.Rd index 3b0819f..a3038cd 100644 --- a/man/do_EnrichmentHeatmap.Rd +++ b/man/do_EnrichmentHeatmap.Rd @@ -10,7 +10,7 @@ do_EnrichmentHeatmap( features.order = NULL, groups.order = NULL, cluster = TRUE, - scale_scores = TRUE, + scale_scores = FALSE, assay = NULL, slot = NULL, reduction = NULL, diff --git a/man/do_LigandReceptorPlot.Rd b/man/do_LigandReceptorPlot.Rd new file mode 100644 index 0000000..2d89896 --- /dev/null +++ b/man/do_LigandReceptorPlot.Rd @@ -0,0 +1,189 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_LigandReceptorPlot.R +\name{do_LigandReceptorPlot} +\alias{do_LigandReceptorPlot} +\title{Visualize Ligand-Receptor analysis output.} +\usage{ +do_LigandReceptorPlot( + liana_output, + split.by = NULL, + keep_source = NULL, + keep_target = NULL, + top_interactions = 25, + top_interactions_by_group = FALSE, + dot_border = TRUE, + magnitude = "sca.LRscore", + specificity = "aggregate_rank", + sort.by = "E", + sorting.type.specificity = "descending", + sorting.type.magnitude = "descending", + border.color = "black", + axis.text.x.angle = 45, + legend.position = "bottom", + legend.type = "colorbar", + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = 1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + font.size = 14, + dot.size = 1, + font.type = "sans", + plot.grid = TRUE, + grid.color = "grey90", + grid.type = "dotted", + compute_ChordDiagrams = FALSE, + sort_interactions_alphabetically = FALSE, + number.breaks = 5, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain", + return_interactions = FALSE, + invert_specificity = TRUE, + invert_magnitude = FALSE, + verbose = TRUE +) +} +\arguments{ +\item{liana_output}{\strong{\code{\link[tibble]{tibble}}} | Object resulting from running \link[liana]{liana_wrap} and \link[liana]{liana_aggregate}.} + +\item{split.by}{\strong{\code{\link[base]{character}}} | Whether to further facet the plot on the y axis by common ligand.complex or receptor.complex. Values to provide: NULL, ligand.complex, receptor.complex.} + +\item{keep_source, keep_target}{\strong{\code{\link[base]{character}}} | Identities to keep for the source/target of the interactions. NULL otherwise.} + +\item{top_interactions}{\strong{\code{\link[base]{numeric}}} | Number of unique interactions to retrieve ordered by magnitude and specificity. It does not necessarily mean that the output will contain as many, but rather an approximate value.} + +\item{top_interactions_by_group}{\strong{\code{\link[base]{logical}}} | Enforce the value on \strong{\code{top_interactions}} to be applied to each group in \strong{\code{source}} column.} + +\item{dot_border}{\strong{\code{\link[base]{logical}}} | Whether to draw a black border in the dots.} + +\item{specificity, magnitude}{\strong{\code{\link[base]{character}}} | Which columns to use for \strong{\code{specificity}} and \strong{\code{magnitude}}.} + +\item{sort.by}{\strong{\code{\link[base]{character}}} | How to arrange the top interactions. Interactions are sorted and then the top N are retrieved and displayed. This takes place after subsetting for \strong{\code{keep_source}} and \strong{\code{keep_target}} One of: +\itemize{ +\item \emph{\code{A}}: Sorts by specificity. +\item \emph{\code{B}}: Sorts by magnitude. +\item \emph{\code{C}}: Sorts by specificity, then magnitude (gives extra weight to specificity). +\item \emph{\code{D}}: Sorts by magnitude, then specificity (gives extra weight to magnitude). Might lead to the display of non-significant results. +\item \emph{\code{E}}: Sorts by specificity and magnitude equally. +}} + +\item{sorting.type.specificity, sorting.type.magnitude}{\strong{\code{\link[base]{character}}} | Whether the sorting of e \strong{\code{magnitude}} or \strong{\code{specificity}} columns is done in ascending or descending order. This synergises with the value of e \strong{\code{invert_specificity}} and e \strong{\code{invert_magnitude}} parameters.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{axis.text.x.angle}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: +\itemize{ +\item \emph{\code{normal}}: Default legend displayed by \pkg{ggplot2}. +\item \emph{\code{colorbar}}: Redefined colorbar legend, using \link[ggplot2]{guide_colorbar}. +}} + +\item{legend.length, legend.width}{\strong{\code{\link[base]{numeric}}} | Length and width of the legend. Will adjust automatically depending on legend side.} + +\item{legend.framecolor}{\strong{\code{\link[base]{character}}} | Color of the lines of the box in the legend.} + +\item{legend.tickcolor}{\strong{\code{\link[base]{character}}} | Color of the ticks of the box in the legend.} + +\item{legend.framewidth, legend.tickwidth}{\strong{\code{\link[base]{numeric}}} | Width of the lines of the box in the legend.} + +\item{use_viridis}{\strong{\code{\link[base]{logical}}} | Whether to use viridis color scales.} + +\item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} + +\item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} + +\item{sequential.palette}{\strong{\code{\link[base]{character}}} | Type of sequential color palette to use. Out of the sequential palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{sequential.direction}{\strong{\code{\link[base]{numeric}}} | Direction of the sequential color scale. Either 1 or -1.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{dot.size}{\strong{\code{\link[base]{numeric}}} | Size aesthetic for the dots.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{plot.grid}{\strong{\code{\link[base]{logical}}} | Whether to plot grid lines.} + +\item{grid.color}{\strong{\code{\link[base]{character}}} | Color of the grid in the plot. In heatmaps, color of the border of the cells.} + +\item{grid.type}{\strong{\code{\link[base]{character}}} | One of the possible linetype options: +\itemize{ +\item \emph{\code{blank}}. +\item \emph{\code{solid}}. +\item \emph{\code{dashed}}. +\item \emph{\code{dotted}}. +\item \emph{\code{dotdash}}. +\item \emph{\code{longdash}}. +\item \emph{\code{twodash}}. +}} + +\item{compute_ChordDiagrams}{\strong{\code{\link[base]{logical}}} | Whether to also compute Chord Diagrams for both the number of interactions between source and target but also between ligand.complex and receptor.complex.} + +\item{sort_interactions_alphabetically}{\strong{\code{\link[base]{logical}}} | Sort the interactions to be plotted alphabetically (\strong{\code{TRUE}}) or keep them in their original order in the matrix (\strong{\code{FALSE}}).} + +\item{number.breaks}{\strong{\code{\link[base]{numeric}}} | Controls the number of breaks in continuous color scales of ggplot2-based plots.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} + +\item{return_interactions}{\strong{\code{\link[base]{logical}}} | Whether to return the data.frames with the interactions so that they can be plotted as chord plots using other package functions.} + +\item{invert_specificity, invert_magnitude}{\strong{\code{\link[base]{logical}}} | Whether to \strong{\code{-log10}} transform \strong{\code{specificity}} and \strong{\code{magnitude}} columns.} + +\item{verbose}{\strong{\code{\link[base]{logical}}} | Whether to show extra comments, warnings,etc.} +} +\value{ +A ggplot2 plot with the results of the Ligand-Receptor analysis. +} +\description{ +This function makes use of \href{https://github.com/saezlab/liana}{liana} package to run Ligand-Receptor analysis. Takes the output of liana and generates a dot-plot visualization according to the user's specifications. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_LigandReceptorPlot", passive = TRUE) + + if (isTRUE(value)){ + liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) + # Ligand Receptor analysis plot. + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} + +} diff --git a/man/do_LoadingsPlot.Rd b/man/do_LoadingsPlot.Rd new file mode 100644 index 0000000..6e25e99 --- /dev/null +++ b/man/do_LoadingsPlot.Rd @@ -0,0 +1,165 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_LoadingsPlot.R +\name{do_LoadingsPlot} +\alias{do_LoadingsPlot} +\title{Compute a heatmap summary of the top and bottom genes in the PCA loadings for the desired PCs in a Seurat object.} +\usage{ +do_LoadingsPlot( + sample, + group.by = NULL, + subsample = NA, + dims = 1:10, + top_loadings = 5, + assay = "SCT", + slot = "data", + grid.color = "white", + border.color = "black", + number.breaks = 5, + na.value = "grey75", + legend.position = "bottom", + legend.title = "Expression", + legend.type = "colorbar", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + font.size = 14, + font.type = "sans", + axis.text.x.angle = 45, + use_viridis = FALSE, + sequential.direction = 1, + sequential.palette = "YlGnBu", + viridis.palette = "G", + viridis.direction = -1, + diverging.palette = "RdBu", + diverging.direction = -1, + flip = FALSE, + min.cutoff.loadings = NA, + max.cutoff.loadings = NA, + min.cutoff.expression = NA, + max.cutoff.expression = NA, + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain" +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{group.by}{\strong{\code{\link[base]{character}}} | Metadata variable to group the output by. Has to be a character of factor column.} + +\item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subsample the Seurat object to increase computational speed. Use NA to include the Seurat object as is.} + +\item{dims}{\strong{\code{\link[base]{numeric}}} | PCs to include in the analysis.} + +\item{top_loadings}{\strong{\code{\link[base]{numeric}}} | Number of top and bottom scored genes in the PCA Loadings for each PC.} + +\item{assay}{\strong{\code{\link[base]{character}}} | Assay to use. Defaults to the current assay.} + +\item{slot}{\strong{\code{\link[base]{character}}} | Data slot to use. Only one of: counts, data, scale.data. Defaults to "data".} + +\item{grid.color}{\strong{\code{\link[base]{character}}} | Color of the grid in the plot. In heatmaps, color of the border of the cells.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{number.breaks}{\strong{\code{\link[base]{numeric}}} | Controls the number of breaks in continuous color scales of ggplot2-based plots.} + +\item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{legend.title}{\strong{\code{\link[base]{character}}} | Title for the legend.} + +\item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: +\itemize{ +\item \emph{\code{normal}}: Default legend displayed by \pkg{ggplot2}. +\item \emph{\code{colorbar}}: Redefined colorbar legend, using \link[ggplot2]{guide_colorbar}. +}} + +\item{legend.framewidth, legend.tickwidth}{\strong{\code{\link[base]{numeric}}} | Width of the lines of the box in the legend.} + +\item{legend.length, legend.width}{\strong{\code{\link[base]{numeric}}} | Length and width of the legend. Will adjust automatically depending on legend side.} + +\item{legend.framecolor}{\strong{\code{\link[base]{character}}} | Color of the lines of the box in the legend.} + +\item{legend.tickcolor}{\strong{\code{\link[base]{character}}} | Color of the ticks of the box in the legend.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{axis.text.x.angle}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} + +\item{use_viridis}{\strong{\code{\link[base]{logical}}} | Whether to use viridis color scales.} + +\item{sequential.direction}{\strong{\code{\link[base]{numeric}}} | Direction of the sequential color scale. Either 1 or -1.} + +\item{sequential.palette}{\strong{\code{\link[base]{character}}} | Type of sequential color palette to use. Out of the sequential palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} + +\item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} + +\item{diverging.palette}{\strong{\code{\link[base]{character}}} | Type of symmetrical color palette to use. Out of the diverging palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{diverging.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Direction of the divering palette. This basically flips the two ends.} + +\item{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} + +\item{min.cutoff.loadings, max.cutoff.loadings}{\strong{\code{\link[base]{numeric}}} | Cutoff to subset the scale of the Loading score heatmap. NA will use quantiles 0.05 and 0.95.} + +\item{min.cutoff.expression, max.cutoff.expression}{\strong{\code{\link[base]{numeric}}} | Cutoff to subset the scale of the expression heatmap. NA will use 0 (no quantile) and quantile 0.95.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} +} +\value{ +A ggplot2 object. +} +\description{ +Compute a heatmap summary of the top and bottom genes in the PCA loadings for the desired PCs in a Seurat object. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_LoadingsPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:2) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/do_MetadataPlot.Rd b/man/do_MetadataPlot.Rd new file mode 100644 index 0000000..1572ff8 --- /dev/null +++ b/man/do_MetadataPlot.Rd @@ -0,0 +1,137 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_MetadataPlot.R +\name{do_MetadataPlot} +\alias{do_MetadataPlot} +\title{Compute a heatmap of categorical variables.} +\usage{ +do_MetadataPlot( + sample = NULL, + group.by = NULL, + metadata = NULL, + from_df = FALSE, + df = NULL, + colors.use = NULL, + cluster = TRUE, + flip = TRUE, + heatmap.gap = 1, + axis.text.x.angle = 45, + legend.position = "bottom", + font.size = 14, + legend.font.size = NULL, + legend.symbol.size = NULL, + legend.ncol = NULL, + legend.nrow = NULL, + legend.byrow = FALSE, + na.value = "grey75", + font.type = "sans", + grid.color = "white", + border.color = "black", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain", + xlab = "", + ylab = "" +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{group.by}{\strong{\code{\link[base]{character}}} | Metadata column to use as basis for the plot.} + +\item{metadata}{\strong{\code{\link[base]{character}}} | Metadata columns that will be used to plot the heatmap on the basis of the variable provided to group.by.} + +\item{from_df}{\strong{\code{\link[base]{logical}}} | Whether to provide a data frame with the metadata instead.} + +\item{df}{\strong{\code{\link[base]{data.frame}}} | Data frame containing the metadata to plot. Rows contain the unique values common to all columns (metadata variables). The columns must be named.} + +\item{colors.use}{\strong{\code{\link[SCpubr]{named_list}}} | A named list of named vectors. The names of the list correspond to the names of the values provided to metadata and the names of the items in the named vectors correspond to the unique values of that specific metadata variable. The values are the desired colors in HEX code for the values to plot. The used are pre-defined by the pacakge but, in order to get the most out of the plot, please provide your custom set of colors for each metadata column!} + +\item{cluster}{\strong{\code{\link[base]{logical}}} | Whether to perform clustering of rows and columns.} + +\item{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} + +\item{heatmap.gap}{\strong{\code{\link[base]{numeric}}} | Size of the gap between heatmaps in mm.} + +\item{axis.text.x.angle}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{legend.font.size}{\strong{\code{\link[base]{numeric}}} | Size of the font size of the legend. NULL uses default theme font size for legend according to the strong{\code{font.size}} parameter.} + +\item{legend.symbol.size}{\strong{\code{\link[base]{numeric}}} | Size of symbols in the legend in mm. NULL uses the default size.} + +\item{legend.ncol}{\strong{\code{\link[base]{numeric}}} | Number of columns in the legend.} + +\item{legend.nrow}{\strong{\code{\link[base]{numeric}}} | Number of rows in the legend.} + +\item{legend.byrow}{\strong{\code{\link[base]{logical}}} | Whether the legend is filled by row or not.} + +\item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{grid.color}{\strong{\code{\link[base]{character}}} | Color of the grid in the plot. In heatmaps, color of the border of the cells.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} + +\item{xlab, ylab}{\strong{\code{\link[base]{character}}} | Titles for the X and Y axis.} +} +\value{ +A ggplot2 object. +} +\description{ +The main use of this function is to generate a metadata heatmap of your categorical data, +normally targeted to the different patient samples one has in the Seurat object. It requires +that the metadata columns chosen have one and only one possible value for each of the values in +group.by. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_MetadataPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Can also use a Seurat object. + df <- data.frame(row.names = letters[1:5], + "A" = as.character(seq(1, 5)), + "B" = rev(as.character(seq(1, 5)))) + + p <- SCpubr::do_MetadataPlot(from_df = TRUE, + df = df) + + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/do_SCEnrichmentHeatmap.Rd b/man/do_SCEnrichmentHeatmap.Rd new file mode 100644 index 0000000..7a9c85a --- /dev/null +++ b/man/do_SCEnrichmentHeatmap.Rd @@ -0,0 +1,230 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_SCEnrichmentHeatmap.R +\name{do_SCEnrichmentHeatmap} +\alias{do_SCEnrichmentHeatmap} +\title{Perform a single-cell-based heatmap showing the enrichment in a list of gene sets.} +\usage{ +do_SCEnrichmentHeatmap( + sample, + input_gene_list, + assay = NULL, + slot = NULL, + group.by = NULL, + features.order = NULL, + metadata = NULL, + metadata.colors = NULL, + subsample = NA, + cluster = TRUE, + flavor = "Seurat", + return_object = FALSE, + ncores = 1, + storeRanks = TRUE, + interpolate = FALSE, + nbin = 24, + ctrl = 100, + xlab = "Cells", + ylab = "Genes", + font.size = 14, + font.type = "sans", + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL, + legend.position = "bottom", + legend.title = NULL, + legend.type = "colorbar", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + strip.text.color = "black", + strip.text.angle = 0, + strip.spacing = 10, + legend.ncol = NULL, + legend.nrow = NULL, + legend.byrow = FALSE, + min.cutoff = NA, + max.cutoff = NA, + number.breaks = 5, + main.heatmap.size = 0.95, + enforce_symmetry = FALSE, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + na.value = "grey75", + diverging.palette = "RdBu", + diverging.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + proportional.size = TRUE, + verbose = FALSE, + border.color = "black", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain" +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{input_gene_list}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of lists of genes to be used as input.} + +\item{assay}{\strong{\code{\link[base]{character}}} | Assay to use. Defaults to the current assay.} + +\item{slot}{\strong{\code{\link[base]{character}}} | Data slot to use. Only one of: counts, data, scale.data. Defaults to "data".} + +\item{group.by}{\strong{\code{\link[base]{character}}} | Metadata variable to group the output by. Has to be a character of factor column.} + +\item{features.order}{\strong{\code{\link[base]{character}}} | Should the gene sets be ordered in a specific way? Provide it as a vector of characters with the same names as the names of the gene sets.} + +\item{metadata}{\strong{\code{\link[base]{character}}} | Categorical metadata variables to plot alongside the main heatmap.} + +\item{metadata.colors}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of valid colors for each of the variables defined in \strong{\code{metadata}}.} + +\item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subset for the analysis. NA will use all. Cells are selected at random.} + +\item{cluster}{\strong{\code{\link[base]{logical}}} | Whether to perform clustering of rows and columns.} + +\item{flavor}{\strong{\code{\link[base]{character}}} | One of: Seurat, UCell. Compute the enrichment scores using \link[Seurat]{AddModuleScore} or \link[UCell]{AddModuleScore_UCell}.} + +\item{return_object}{\strong{\code{\link[base]{logical}}} | Returns the Seurat object with the modifications performed in the function. Nomally, this contains a new assay with the data that can then be used for any other visualization desired.} + +\item{ncores}{\strong{\code{\link[base]{numeric}}} | Number of cores used to run UCell scoring.} + +\item{storeRanks}{\strong{\code{\link[base]{logical}}} | Whether to store the ranks for faster UCell scoring computations. Might require large amounts of RAM.} + +\item{interpolate}{\strong{\code{\link[base]{logical}}} | Smoothes the output heatmap, saving space on disk when saving the image. However, the image is not as crisp.} + +\item{nbin}{\strong{\code{\link[base]{numeric}}} | Number of bins to use in \link[Seurat]{AddModuleScore}.} + +\item{ctrl}{\strong{\code{\link[base]{numeric}}} | Number of genes in the control set to use in \link[Seurat]{AddModuleScore}.} + +\item{xlab, ylab}{\strong{\code{\link[base]{character}}} | Titles for the X and Y axis.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{plot.title, plot.subtitle, plot.caption}{\strong{\code{\link[base]{character}}} | Title, subtitle or caption to use in the plot.} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{legend.title}{\strong{\code{\link[base]{character}}} | Title for the legend.} + +\item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: +\itemize{ +\item \emph{\code{normal}}: Default legend displayed by \pkg{ggplot2}. +\item \emph{\code{colorbar}}: Redefined colorbar legend, using \link[ggplot2]{guide_colorbar}. +}} + +\item{legend.framewidth, legend.tickwidth}{\strong{\code{\link[base]{numeric}}} | Width of the lines of the box in the legend.} + +\item{legend.length, legend.width}{\strong{\code{\link[base]{numeric}}} | Length and width of the legend. Will adjust automatically depending on legend side.} + +\item{legend.framecolor}{\strong{\code{\link[base]{character}}} | Color of the lines of the box in the legend.} + +\item{legend.tickcolor}{\strong{\code{\link[base]{character}}} | Color of the ticks of the box in the legend.} + +\item{strip.text.color}{\strong{\code{\link[base]{character}}} | Color of the strip text.} + +\item{strip.text.angle}{\strong{\code{\link[base]{numeric}}} | Rotation of the strip text (angles).} + +\item{strip.spacing}{\strong{\code{\link[base]{numeric}}} | Controls the size between the different facets.} + +\item{legend.ncol}{\strong{\code{\link[base]{numeric}}} | Number of columns in the legend.} + +\item{legend.nrow}{\strong{\code{\link[base]{numeric}}} | Number of rows in the legend.} + +\item{legend.byrow}{\strong{\code{\link[base]{logical}}} | Whether the legend is filled by row or not.} + +\item{min.cutoff, max.cutoff}{\strong{\code{\link[base]{numeric}}} | Set the min/max ends of the color scale. Any cell/group with a value lower than min.cutoff will turn into min.cutoff and any cell with a value higher than max.cutoff will turn into max.cutoff. In FeaturePlots, provide as many values as features. Use NAs to skip a feature.} + +\item{number.breaks}{\strong{\code{\link[base]{numeric}}} | Controls the number of breaks in continuous color scales of ggplot2-based plots.} + +\item{main.heatmap.size}{\strong{\code{\link[base]{numeric}}} | Controls the size of the main heatmap (proportion-wise, defaults to 0.95).} + +\item{enforce_symmetry}{\strong{\code{\link[base]{logical}}} | Return a symmetrical plot axes-wise or continuous color scale-wise, when applicable.} + +\item{use_viridis}{\strong{\code{\link[base]{logical}}} | Whether to use viridis color scales.} + +\item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} + +\item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} + +\item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} + +\item{diverging.palette}{\strong{\code{\link[base]{character}}} | Type of symmetrical color palette to use. Out of the diverging palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{diverging.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Direction of the divering palette. This basically flips the two ends.} + +\item{sequential.palette}{\strong{\code{\link[base]{character}}} | Type of sequential color palette to use. Out of the sequential palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{sequential.direction}{\strong{\code{\link[base]{numeric}}} | Direction of the sequential color scale. Either 1 or -1.} + +\item{proportional.size}{\strong{\code{\link[base]{logical}}} | Whether the groups should take the same space in the plot or not.} + +\item{verbose}{\strong{\code{\link[base]{logical}}} | Whether to show extra comments, warnings,etc.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} +} +\value{ +A ggplot2 object. +} +\description{ +This function is heavily inspired by \strong{\code{\link[Seurat]{DoHeatmap}}}. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_SCEnrichmentHeatmap", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Genes have to be unique. + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + nbin = 1, + ctrl = 5, + flavor = "Seurat", + subsample = NA) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/do_SCExpressionHeatmap.Rd b/man/do_SCExpressionHeatmap.Rd new file mode 100644 index 0000000..53baaed --- /dev/null +++ b/man/do_SCExpressionHeatmap.Rd @@ -0,0 +1,204 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_SCExpressionHeatmap.R +\name{do_SCExpressionHeatmap} +\alias{do_SCExpressionHeatmap} +\title{Perform a single-cell-based heatmap showing the expression of genes.} +\usage{ +do_SCExpressionHeatmap( + sample, + features, + assay = NULL, + slot = NULL, + group.by = NULL, + features.order = NULL, + metadata = NULL, + metadata.colors = NULL, + subsample = NA, + cluster = TRUE, + interpolate = FALSE, + xlab = "Cells", + ylab = "Genes", + font.size = 14, + font.type = "sans", + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL, + legend.position = "bottom", + legend.title = "Expression", + legend.type = "colorbar", + legend.framewidth = 0.5, + legend.tickwidth = 0.5, + legend.length = 20, + legend.width = 1, + legend.framecolor = "grey50", + legend.tickcolor = "white", + strip.text.color = "black", + strip.text.angle = 0, + strip.spacing = 10, + legend.ncol = NULL, + legend.nrow = NULL, + legend.byrow = FALSE, + min.cutoff = NA, + max.cutoff = NA, + number.breaks = 5, + main.heatmap.size = 0.95, + enforce_symmetry = FALSE, + use_viridis = FALSE, + viridis.palette = "G", + viridis.direction = -1, + na.value = "grey75", + diverging.palette = "RdBu", + diverging.direction = -1, + sequential.palette = "YlGnBu", + sequential.direction = 1, + proportional.size = TRUE, + verbose = TRUE, + border.color = "black", + plot.title.face = "bold", + plot.subtitle.face = "plain", + plot.caption.face = "italic", + axis.title.face = "bold", + axis.text.face = "plain", + legend.title.face = "bold", + legend.text.face = "plain" +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{features}{\strong{\code{\link[base]{character}}} | Features to represent.} + +\item{assay}{\strong{\code{\link[base]{character}}} | Assay to use. Defaults to the current assay.} + +\item{slot}{\strong{\code{\link[base]{character}}} | Data slot to use. Only one of: counts, data, scale.data. Defaults to "data".} + +\item{group.by}{\strong{\code{\link[base]{character}}} | Metadata variable to group the output by. Has to be a character of factor column.} + +\item{features.order}{\strong{\code{\link[base]{character}}} | Should the gene sets be ordered in a specific way? Provide it as a vector of characters with the same names as the names of the gene sets.} + +\item{metadata}{\strong{\code{\link[base]{character}}} | Categorical metadata variables to plot alongside the main heatmap.} + +\item{metadata.colors}{\strong{\code{\link[SCpubr]{named_list}}} | Named list of valid colors for each of the variables defined in \strong{\code{metadata}}.} + +\item{subsample}{\strong{\code{\link[base]{numeric}}} | Number of cells to subset for the analysis. NA will use all. Cells are selected at random.} + +\item{cluster}{\strong{\code{\link[base]{logical}}} | Whether to perform clustering of rows and columns.} + +\item{interpolate}{\strong{\code{\link[base]{logical}}} | Smoothes the output heatmap, saving space on disk when saving the image. However, the image is not as crisp.} + +\item{xlab, ylab}{\strong{\code{\link[base]{character}}} | Titles for the X and Y axis.} + +\item{font.size}{\strong{\code{\link[base]{numeric}}} | Overall font size of the plot. All plot elements will have a size relationship with this font size.} + +\item{font.type}{\strong{\code{\link[base]{character}}} | Base font family for the plot. One of: +\itemize{ +\item \emph{\code{mono}}: Mono spaced font. +\item \emph{\code{serif}}: Serif font family. +\item \emph{\code{sans}}: Default font family. +}} + +\item{plot.title, plot.subtitle, plot.caption}{\strong{\code{\link[base]{character}}} | Title, subtitle or caption to use in the plot.} + +\item{legend.position}{\strong{\code{\link[base]{character}}} | Position of the legend in the plot. One of: +\itemize{ +\item \emph{\code{top}}: Top of the figure. +\item \emph{\code{bottom}}: Bottom of the figure. +\item \emph{\code{left}}: Left of the figure. +\item \emph{\code{right}}: Right of the figure. +\item \emph{\code{none}}: No legend is displayed. +}} + +\item{legend.title}{\strong{\code{\link[base]{character}}} | Title for the legend.} + +\item{legend.type}{\strong{\code{\link[base]{character}}} | Type of legend to display. One of: +\itemize{ +\item \emph{\code{normal}}: Default legend displayed by \pkg{ggplot2}. +\item \emph{\code{colorbar}}: Redefined colorbar legend, using \link[ggplot2]{guide_colorbar}. +}} + +\item{legend.framewidth, legend.tickwidth}{\strong{\code{\link[base]{numeric}}} | Width of the lines of the box in the legend.} + +\item{legend.length, legend.width}{\strong{\code{\link[base]{numeric}}} | Length and width of the legend. Will adjust automatically depending on legend side.} + +\item{legend.framecolor}{\strong{\code{\link[base]{character}}} | Color of the lines of the box in the legend.} + +\item{legend.tickcolor}{\strong{\code{\link[base]{character}}} | Color of the ticks of the box in the legend.} + +\item{strip.text.color}{\strong{\code{\link[base]{character}}} | Color of the strip text.} + +\item{strip.text.angle}{\strong{\code{\link[base]{numeric}}} | Rotation of the strip text (angles).} + +\item{strip.spacing}{\strong{\code{\link[base]{numeric}}} | Controls the size between the different facets.} + +\item{legend.ncol}{\strong{\code{\link[base]{numeric}}} | Number of columns in the legend.} + +\item{legend.nrow}{\strong{\code{\link[base]{numeric}}} | Number of rows in the legend.} + +\item{legend.byrow}{\strong{\code{\link[base]{logical}}} | Whether the legend is filled by row or not.} + +\item{min.cutoff, max.cutoff}{\strong{\code{\link[base]{numeric}}} | Set the min/max ends of the color scale. Any cell/group with a value lower than min.cutoff will turn into min.cutoff and any cell with a value higher than max.cutoff will turn into max.cutoff. In FeaturePlots, provide as many values as features. Use NAs to skip a feature.} + +\item{number.breaks}{\strong{\code{\link[base]{numeric}}} | Controls the number of breaks in continuous color scales of ggplot2-based plots.} + +\item{main.heatmap.size}{\strong{\code{\link[base]{numeric}}} | Controls the size of the main heatmap (proportion-wise, defaults to 0.95).} + +\item{enforce_symmetry}{\strong{\code{\link[base]{logical}}} | Return a symmetrical plot axes-wise or continuous color scale-wise, when applicable.} + +\item{use_viridis}{\strong{\code{\link[base]{logical}}} | Whether to use viridis color scales.} + +\item{viridis.palette}{\strong{\code{\link[base]{character}}} | A capital letter from A to H or the scale name as in \link[viridis]{scale_fill_viridis}.} + +\item{viridis.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Controls how the gradient of viridis scale is formed.} + +\item{na.value}{\strong{\code{\link[base]{character}}} | Color value for NA.} + +\item{diverging.palette}{\strong{\code{\link[base]{character}}} | Type of symmetrical color palette to use. Out of the diverging palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{diverging.direction}{\strong{\code{\link[base]{numeric}}} | Either 1 or -1. Direction of the divering palette. This basically flips the two ends.} + +\item{sequential.palette}{\strong{\code{\link[base]{character}}} | Type of sequential color palette to use. Out of the sequential palettes defined in \strong{\code{\link[RColorBrewer]{brewer.pal}}}.} + +\item{sequential.direction}{\strong{\code{\link[base]{numeric}}} | Direction of the sequential color scale. Either 1 or -1.} + +\item{proportional.size}{\strong{\code{\link[base]{logical}}} | Whether the groups should take the same space in the plot or not.} + +\item{verbose}{\strong{\code{\link[base]{logical}}} | Whether to show extra comments, warnings,etc.} + +\item{border.color}{\strong{\code{\link[base]{character}}} | Color for the border of the heatmap body.} + +\item{plot.title.face, plot.subtitle.face, plot.caption.face, axis.title.face, axis.text.face, legend.title.face, legend.text.face}{\strong{\code{\link[base]{character}}} | Controls the style of the font for the corresponding theme element. One of: +\itemize{ +\item \emph{\code{plain}}: For normal text. +\item \emph{\code{italic}}: For text in itallic. +\item \emph{\code{bold}}: For text in bold. +\item \emph{\code{bold.italic}}: For text both in itallic and bold. +}} +} +\value{ +A ggplot2 object. +} +\description{ +This function is heavily inspired by \strong{\code{\link[Seurat]{DoHeatmap}}}. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_SCExpressionHeatmap", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:2], + subsample = NA) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/examples/examples_do_AffinityAnalysisPlot.R b/man/examples/examples_do_AffinityAnalysisPlot.R new file mode 100644 index 0000000..3a2eec7 --- /dev/null +++ b/man/examples/examples_do_AffinityAnalysisPlot.R @@ -0,0 +1,30 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_AffinityAnalysisPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Genes have to be unique. + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + # Default parameters. + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + nbin = 1, + ctrl = 5, + flavor = "Seurat", + subsample = NA, + verbose = FALSE) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_do_DiffusionMapPlot.R b/man/examples/examples_do_DiffusionMapPlot.R new file mode 100644 index 0000000..46dfb08 --- /dev/null +++ b/man/examples/examples_do_DiffusionMapPlot.R @@ -0,0 +1,37 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_DiffusionMapPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Genes have to be unique. + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + # Requisite is that you have a diffusion map reduction stored in the Seurat + # object under the name "diffusion". + + # This will query, for the provided components, the enrichment of the gene + # sets for all cells and plot them in the context of the cells reordered by + # the position alonside each DC. + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + nbin = 1, + ctrl = 5, + flavor = "Seurat", + subsample = NA, + dims = 1:2, + verbose = FALSE) + + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_do_LigandReceptorPlot.R b/man/examples/examples_do_LigandReceptorPlot.R new file mode 100644 index 0000000..b7099a5 --- /dev/null +++ b/man/examples/examples_do_LigandReceptorPlot.R @@ -0,0 +1,16 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_LigandReceptorPlot", passive = TRUE) + + if (isTRUE(value)){ + liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) + # Ligand Receptor analysis plot. + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} + diff --git a/man/examples/examples_do_LoadingsPlot.R b/man/examples/examples_do_LoadingsPlot.R new file mode 100644 index 0000000..b21016a --- /dev/null +++ b/man/examples/examples_do_LoadingsPlot.R @@ -0,0 +1,19 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_LoadingsPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:2) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_do_MetadataPlot.R b/man/examples/examples_do_MetadataPlot.R new file mode 100644 index 0000000..c6293a1 --- /dev/null +++ b/man/examples/examples_do_MetadataPlot.R @@ -0,0 +1,22 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_MetadataPlot", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Can also use a Seurat object. + df <- data.frame(row.names = letters[1:5], + "A" = as.character(seq(1, 5)), + "B" = rev(as.character(seq(1, 5)))) + + p <- SCpubr::do_MetadataPlot(from_df = TRUE, + df = df) + + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_do_SCEnrichmentHeatmap.R b/man/examples/examples_do_SCEnrichmentHeatmap.R new file mode 100644 index 0000000..c94c834 --- /dev/null +++ b/man/examples/examples_do_SCEnrichmentHeatmap.R @@ -0,0 +1,28 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_SCEnrichmentHeatmap", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Genes have to be unique. + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + nbin = 1, + ctrl = 5, + flavor = "Seurat", + subsample = NA) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_do_SCExpressionHeatmap.R b/man/examples/examples_do_SCExpressionHeatmap.R new file mode 100644 index 0000000..cb58d39 --- /dev/null +++ b/man/examples/examples_do_SCExpressionHeatmap.R @@ -0,0 +1,20 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_SCExpressionHeatmap", passive = TRUE) + + if (isTRUE(value)){ + # Consult the full documentation in https://enblacar.github.io/SCpubr-book/ + + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:2], + subsample = NA) + p + + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_save_Plot.R b/man/examples/examples_save_Plot.R new file mode 100644 index 0000000..7263174 --- /dev/null +++ b/man/examples/examples_save_Plot.R @@ -0,0 +1,47 @@ +\dontrun{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "save_Plot", passive = TRUE) + + if (isTRUE(value)){ + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Generate a plot. + p <- SCpubr::do_DimPlot(sample = sample) + + # Default parameters. + SCpubr::save_Plot(plot = p) + + # Specifying the name and folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure") + + # Specify to also create a new folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE) + + # Set dimensions for the figure. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8) + + # Set quality (dpi). + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8, + dpi = 300) + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} + diff --git a/man/save_Plot.Rd b/man/save_Plot.Rd new file mode 100644 index 0000000..109e8d4 --- /dev/null +++ b/man/save_Plot.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/save_Plot.R +\name{save_Plot} +\alias{save_Plot} +\title{Save a plot as png, pdf and svg.} +\usage{ +save_Plot( + plot, + figure_path = NULL, + create_path = TRUE, + file_name = NULL, + dpi = 300, + output_format = "publication", + width = 8, + height = 8 +) +} +\arguments{ +\item{plot}{Plot to save.} + +\item{figure_path}{\strong{\code{\link[base]{character}}} | Path where the figure will be stored.} + +\item{create_path}{\strong{\code{\link[base]{logical}}} | Whether to create the path.} + +\item{file_name}{\strong{\code{\link[base]{character}}} | Name of the file (without extension, it will be added automatically).} + +\item{dpi}{\strong{\code{\link[base]{numeric}}} | Dpi to use.} + +\item{output_format}{\strong{\code{\link[base]{character}}} | Output format of the saved figure. One of: +\itemize{ +\item \emph{\code{pdf}}: Saves the figure as a PDF file. +\item \emph{\code{png}}: Saves the figure as a PNG file. +\item \emph{\code{jpeg}}: Saves the figure as a JPEG file. +\item \emph{\code{tiff}}: Saves the figure as a TIFF file. +\item \emph{\code{svg}}: Saves the figure as a SVG file. +\item \emph{\code{publication}}: Saves the figure as PDF, PNG and SVG files. +\item \emph{\code{all}}: Saves the figure in all possible formats. +}} + +\item{width, height}{\strong{\code{\link[base]{numeric}}} | Width and height of the figure (inches).} +} +\value{ +Nothing. +} +\description{ +Save a plot as png, pdf and svg. +} +\examples{ +\dontrun{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "save_Plot", passive = TRUE) + + if (isTRUE(value)){ + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Generate a plot. + p <- SCpubr::do_DimPlot(sample = sample) + + # Default parameters. + SCpubr::save_Plot(plot = p) + + # Specifying the name and folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure") + + # Specify to also create a new folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE) + + # Set dimensions for the figure. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8) + + # Set quality (dpi). + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8, + dpi = 300) + } else if (base::isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} + +} diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R index 0e51578..abf52db 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -75,26 +75,26 @@ if (base::isFALSE(dep_check[["do_GroupedGOTermPlot"]]) | base::isFALSE(dep_check # nolint end # Remove this for publication in CRAN. -# if (base::isFALSE(dep_check[["do_LigandReceptorPlot"]])){ -# liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) -# } -# -# if (base::isFALSE(dep_check[["do_DimPlot"]]) & -# base::isFALSE(dep_check[["do_CorrelationPlot"]]) & -# base::isFALSE(dep_check[["do_ChordDiagramPlot"]]) & -# isTRUE(requireNamespace(pkg, quietly = TRUE)) & -# base::isFALSE(dep_check[["save_Plot"]])){ -# p <- SCpubr::do_DimPlot(sample) -# data <- data.frame("A" = stats::runif(n = 10), -# "B" = stats::runif(n = 10), -# "C" = stats::runif(n = 10), -# "D" = stats::runif(n = 10)) -# data <- as.matrix(data) -# p.pheatmap <- pheatmap::pheatmap(data, cluster_rows = FALSE, cluster_cols = FALSE) -# p.heatmap <- ComplexHeatmap::Heatmap(data, cluster_rows = FALSE, cluster_columns = FALSE) -# p.chord <- SCpubr::do_ChordDiagramPlot(sample = sample, from = "seurat_clusters", to = "orig.ident") -# figure_path <- getwd() -# } +if (base::isFALSE(dep_check[["do_LigandReceptorPlot"]])){ + liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) +} + +if (base::isFALSE(dep_check[["do_DimPlot"]]) & + base::isFALSE(dep_check[["do_CorrelationPlot"]]) & + base::isFALSE(dep_check[["do_ChordDiagramPlot"]]) & + isTRUE(requireNamespace(pkg, quietly = TRUE)) & + base::isFALSE(dep_check[["save_Plot"]])){ + p <- SCpubr::do_DimPlot(sample) + data <- data.frame("A" = stats::runif(n = 10), + "B" = stats::runif(n = 10), + "C" = stats::runif(n = 10), + "D" = stats::runif(n = 10)) + data <- as.matrix(data) + p.pheatmap <- pheatmap::pheatmap(data, cluster_rows = FALSE, cluster_cols = FALSE) + p.heatmap <- ComplexHeatmap::Heatmap(data, cluster_rows = FALSE, cluster_columns = FALSE) + p.chord <- SCpubr::do_ChordDiagramPlot(sample = sample, from = "seurat_clusters", to = "orig.ident") + figure_path <- getwd() +} #monocle_sample <- sample diff --git a/tests/testthat/test-do_AffinityAnalysisPlot.R b/tests/testthat/test-do_AffinityAnalysisPlot.R new file mode 100644 index 0000000..3588401 --- /dev/null +++ b/tests/testthat/test-do_AffinityAnalysisPlot.R @@ -0,0 +1,365 @@ +if (base::isFALSE(dep_check[["do_AffinityAnalysisPlot"]])){ + + testthat::test_that("do_AffinityAnalysisPlot: CRAN essentials", { + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = NA, + nbin = 1, + ctrl = 5, + verbose = FALSE) + testthat::expect_type(p, "list") + + + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - default", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = TRUE) + testthat::expect_type(p, "list") + + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:11], + "C" = rownames(sample)[12:19]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + group.by = c("seurat_clusters", "orig.ident"), + flip = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + group.by = c("seurat_clusters", "orig.ident"), + flip = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + group.by = c("seurat_clusters", "orig.ident"), + flip = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + group.by = c("seurat_clusters", "orig.ident"), + flip = FALSE) + testthat::expect_type(p, "list") + + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = TRUE, + return_object = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - robustness", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = FALSE) + testthat::expect_type(p, "list") + + suppressMessages({testthat::expect_message({p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = TRUE, + flip = TRUE)})}) + testthat::expect_type(p, "list") + + genes <- list("A" = rownames(sample)[1:3], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[9:15]) + testthat::expect_error({SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE)}) + genes <- list("A" = rownames(sample)[1:15], + "B" = rownames(sample)[16:40], + "C" = rownames(sample)[41:80]) + + SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE) + testthat::expect_type(p, "list") + + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - symmetry", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + enforce_symmetry = FALSE, + use_viridis = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + enforce_symmetry = FALSE, + use_viridis = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + enforce_symmetry = TRUE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - add enrichment", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + use_viridis = TRUE, + flip = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + use_viridis = TRUE, + flip = FALSE) + testthat::expect_type(p, "list") + + suppressMessages({testthat::expect_message({ p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = TRUE, + use_viridis = TRUE)})}) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + use_viridis = TRUE, + flavor = "UCell") + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + use_viridis = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + enforce_symmetry = TRUE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - flip", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + flip = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - cutoffs", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE, + min.cutoff = -0.25, + max.cutoff = 0.25) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - multiple group.by", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + group.by = c("seurat_clusters", "orig.ident"), + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - verbose", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + testthat::expect_message({p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = TRUE)}) + + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - underscores", { + testthat::skip_on_cran() + genes <- list("_A" = rownames(sample)[1:5], + "_B" = rownames(sample)[6:10], + "_C" = rownames(sample)[11:15]) + + testthat::expect_warning({p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE)}) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_AffinityAnalysisPlot: PASS - different length of gene sets", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:15], + "C" = rownames(sample)[15:30]) + + p <- SCpubr::do_AffinityAnalysisPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + verbose = FALSE) + testthat::expect_type(p, "list") + }) + +} + + diff --git a/tests/testthat/test-do_DiffusionMapPlot.R b/tests/testthat/test-do_DiffusionMapPlot.R new file mode 100644 index 0000000..df3c7ea --- /dev/null +++ b/tests/testthat/test-do_DiffusionMapPlot.R @@ -0,0 +1,157 @@ +if (base::isFALSE(dep_check[["do_DiffusionMapPlot"]])){ + + testthat::test_that("do_DiffusionMapPlot: CRAN essentials", { + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = NA, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + verbose = FALSE) + testthat::expect_type(p, "list") + + + }) + + testthat::test_that("do_DiffusionMapPlot: PASS - default", { + testthat::skip_on_cran() + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = NA, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "Seurat", + use_viridis = TRUE, + enforce_symmetry = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = NA, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "Seurat", + use_viridis = FALSE, + sequential.direction = 1, + enforce_symmetry = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = NA, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "Seurat", + use_viridis = FALSE, + sequential.direction = -1, + enforce_symmetry = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = NA, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "AUCell", + use_viridis = TRUE, + enforce_symmetry = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "UCell", + use_viridis = FALSE, + enforce_symmetry = FALSE) + testthat::expect_type(p, "list") + + testthat::expect_warning({SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "UCell", + assay = "SCT", + use_viridis = FALSE, + enforce_symmetry = FALSE)}) + + testthat::expect_warning({SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "Seurat", + slot = "data", + use_viridis = FALSE, + enforce_symmetry = FALSE)}) + + suppressMessages({testthat::expect_message({p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = TRUE)})}) + testthat::expect_type(p, "list") + + p <- SCpubr::do_DiffusionMapPlot(sample = sample, + input_gene_list = genes, + subsample = 100, + group.by = c("orig.ident", "seurat_clusters"), + colors.use = list("orig.ident" = c("Cell" = "red")), + nbin = 1, + ctrl = 5, + reduction = "umap", + dims = 1:2, + return_object = TRUE, + verbose = FALSE, + flavor = "UCell", + use_viridis = FALSE, + enforce_symmetry = FALSE) + testthat::expect_type(p, "list") + + }) +} + + diff --git a/tests/testthat/test-do_LigandReceptorPlot.R b/tests/testthat/test-do_LigandReceptorPlot.R new file mode 100644 index 0000000..7500d80 --- /dev/null +++ b/tests/testthat/test-do_LigandReceptorPlot.R @@ -0,0 +1,415 @@ +if(base::isFALSE(dep_check[["do_LigandReceptorPlot"]])){ + testthat::test_that("do_LigandReceptorPlot: CRAN essentials", { + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - from output", { + testthat::skip_on_cran() + + suppressMessages({testthat::expect_message({p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = TRUE)})}) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "A", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + + + + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "B", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "C", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "D", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = TRUE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = TRUE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "ascending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "ascending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE, sort.by = "E", invert_specificity = FALSE, invert_magnitude = FALSE, sorting.type.specificity = "descending", sorting.type.magnitude = "descending") + testthat::expect_type(p, "list") + + + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = TRUE, use_viridis = TRUE, viridis.direction = 1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = TRUE, use_viridis = TRUE, viridis.direction = -1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = TRUE, use_viridis = FALSE, sequential.direction = -1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = TRUE, use_viridis = FALSE, sequential.direction = 1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = FALSE, use_viridis = TRUE, viridis.direction = 1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = FALSE, use_viridis = TRUE, viridis.direction = -1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = FALSE, use_viridis = FALSE, sequential.direction = -1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, dot_border = FALSE, use_viridis = FALSE, sequential.direction = 1, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, plot.grid = TRUE, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, plot.grid = FALSE, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, plot.grid = TRUE, dot_border = FALSE, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + keep_source = c("NK", "B"), + keep_target = "CD8 T", verbose = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - from output different n", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, verbose = FALSE) + testthat::expect_type(p, "list") + }) + + + testthat::test_that("do_LigandReceptorPlot: PASS - split.by", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "ligand.complex", verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "receptor.complex", verbose = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - from output, angle ", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + axis.text.x.angle = 0, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + axis.text.x.angle = 45, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + axis.text.x.angle = 90, verbose = FALSE) + testthat::expect_type(p, "list") + }) + + + testthat::test_that("do_LigandReceptorPlot: PASS - from output legend.position", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + legend.position = "bottom", verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + legend.position = "right", verbose = FALSE) + testthat::expect_type(p, "list") + }) + + + + + testthat::test_that("do_LigandReceptorPlot: PASS - sort interactions", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + sort_interactions_alphabetically = TRUE, verbose = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + sort_interactions_alphabetically = FALSE, verbose = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: FAIL - wrong parameters", { + testthat::skip_on_cran() + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + font.type = "wrong", verbose = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "wrong", verbose = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + axis.text.x.angle = 10, verbose = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + font.type = "wrong", verbose = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.position = "wrong", verbose = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + grid.type = "wrong", verbose = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "wrong", verbose = FALSE)}) + + }) +} + diff --git a/tests/testthat/test-do_LoadingsPlot.R b/tests/testthat/test-do_LoadingsPlot.R new file mode 100644 index 0000000..865ca7e --- /dev/null +++ b/tests/testthat/test-do_LoadingsPlot.R @@ -0,0 +1,69 @@ +if (base::isFALSE(dep_check[["do_LoadingsPlot"]])){ + + testthat::test_that("do_LoadingsPlot: CRAN essentials", { + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:5) + testthat::expect_type(p, "list") + + + }) + + testthat::test_that("do_LoadingsPlot: PASS - default", { + testthat::skip_on_cran() + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + subsample = 100) + testthat::expect_type(p, "list") + + sample$test <- as.factor(sample$seurat_clusters) + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + group.by = "test") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + min.cutoff.loadings = -0.01, + max.cutoff.loadings = 0.01, + min.cutoff.expression = 0, + max.cutoff.expression = 0.75) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + use_viridis = TRUE, + viridis.direction = 1) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + use_viridis = TRUE, + viridis.direction = -1) + testthat::expect_type(p, "list") + + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + use_viridis = FALSE, + sequential.direction = 1) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LoadingsPlot(sample = sample, + dims = 1:10, + use_viridis = FALSE, + sequential.direction = -1) + testthat::expect_type(p, "list") + + + }) +} + + diff --git a/tests/testthat/test-do_MetadataPlot.R b/tests/testthat/test-do_MetadataPlot.R new file mode 100644 index 0000000..f040c83 --- /dev/null +++ b/tests/testthat/test-do_MetadataPlot.R @@ -0,0 +1,47 @@ +if (base::isFALSE(dep_check[["do_MetadataPlot"]])){ + + testthat::test_that("do_MetadataPlot: CRAN essentials", { + df <- data.frame(row.names = letters[1:5], + "A" = as.character(seq(1, 5)), + "B" = rev(as.character(seq(1, 5)))) + + p <- SCpubr::do_MetadataPlot(from_df = TRUE, + df = df) + testthat::expect_type(p, "list") + + + }) + + testthat::test_that("do_MetadataPlot: PASS - default", { + testthat::skip_on_cran() + + df <- data.frame(row.names = letters[1:5], + "A" = as.character(seq(1, 5)), + "B" = rev(as.character(seq(1, 5))), + "C" = c("1", "2", "3", "5", "7")) + + p <- SCpubr::do_MetadataPlot(from_df = TRUE, + df = df, + flip = FALSE, + legend.symbol.size = 2) + testthat::expect_type(p, "list") + + p <- SCpubr::do_MetadataPlot(from_df = TRUE, + df = df, + flip = TRUE) + testthat::expect_type(p, "list") + + sample$labelling <- sample(c("A", "B"), ncol(sample), replace = TRUE) + p <- SCpubr::do_MetadataPlot(sample = sample, + group.by = "labelling", + metadata = "orig.ident", + flip = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_MetadataPlot(sample = sample, + group.by = "labelling", + metadata = "orig.ident", + flip = TRUE) + testthat::expect_type(p, "list") + }) +} \ No newline at end of file diff --git a/tests/testthat/test-do_SCEnrichmentHeatmap.R b/tests/testthat/test-do_SCEnrichmentHeatmap.R new file mode 100644 index 0000000..db0a9d4 --- /dev/null +++ b/tests/testthat/test-do_SCEnrichmentHeatmap.R @@ -0,0 +1,254 @@ +if (base::isFALSE(dep_check[["do_SCEnrichmentHeatmap"]])){ + + testthat::test_that("do_SCEnrichmentHeatmap: CRAN essentials", { + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + assay = "SCT", + nbin = 1, + ctrl = 5) + testthat::expect_type(p, "list") + + + }) + + testthat::test_that("do_SCEnrichmentHeatmap: PASS - default", { + testthat::skip_on_cran() + + + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + assay = "SCT", + nbin = 1, + ctrl = 5, + cluster = FALSE, + features.order = c("B", "C", "A")) + testthat::expect_type(p, "list") + + genes <- list("A_A" = rownames(sample)[1:5], + "B_A" = rownames(sample)[6:10], + "C_A" = rownames(sample)[11:15]) + + suppressWarnings({testthat::expect_warning({p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + assay = "SCT", + slot = "data", + nbin = 1, + ctrl = 5)})}) + testthat::expect_type(p, "list") + + genes <- list("A" = rownames(sample)[1:5], + "B" = rownames(sample)[6:10], + "C" = rownames(sample)[11:15]) + + testthat::expect_error({p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = "EPC1", + flavor = "Seurat", + assay = "SCT", + nbin = 1, + ctrl = 5)}) + + sample$test <- as.factor(sample$seurat_clusters) + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + group.by = "test", + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5) + testthat::expect_type(p, "list") + + genes <- list("A" = rownames(sample)[1:5]) + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + subsample = 100, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5) + testthat::expect_type(p, "list") + + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5, + cluster = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5, + cluster = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5, + metadata = c("orig.ident", "seurat_clusters"), + metadata.colors = list("orig.ident" = c("Cell" = "red"))) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5, + proportional.size = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5, + proportional.size = FALSE) + testthat::expect_type(p, "list") + + + testthat::expect_warning({p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + assay = "SCT", + slot = "data", + nbin = 1, + ctrl = 5)}) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "AUCell", + assay = "SCT", + nbin = 1, + ctrl = 5) + testthat::expect_type(p, "list") + + testthat::expect_warning({p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "UCell", + assay = "SCT", + nbin = 1, + ctrl = 5)}) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident")) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5, + use_viridis = TRUE, + viridis.direction = 1) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5, + use_viridis = TRUE, + viridis.direction = -1) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5, + use_viridis = FALSE, + sequential.direction = 1) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5, + use_viridis = FALSE, + sequential.direction = -1) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5, + enforce_symmetry = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + metadata = c("seurat_clusters", "orig.ident"), + min.cutoff = 0, + max.cutoff = 0.5, + enforce_symmetry = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCEnrichmentHeatmap(sample = sample, + input_gene_list = genes, + flavor = "Seurat", + nbin = 1, + ctrl = 5, + return_object = TRUE) + testthat::expect_type(p, "list") + + }) +} + + diff --git a/tests/testthat/test-do_SCExpressionHeatmap.R b/tests/testthat/test-do_SCExpressionHeatmap.R new file mode 100644 index 0000000..649ff2e --- /dev/null +++ b/tests/testthat/test-do_SCExpressionHeatmap.R @@ -0,0 +1,107 @@ +if (base::isFALSE(dep_check[["do_SCExpressionHeatmap"]])){ + + testthat::test_that("do_SCExpressionHeatmap: CRAN essentials", { + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5]) + testthat::expect_type(p, "list") + + + }) + + testthat::test_that("do_SCExpressionHeatmap: PASS - default", { + testthat::skip_on_cran() + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + features.order = rownames(sample)[c(4, 2, 1, 3, 5)], + cluster = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5]) + testthat::expect_type(p, "list") + + testthat::expect_warning({p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = c(rownames(sample)[1:5], "pepe"))}) + testthat::expect_type(p, "list") + + + sample$test <- as.factor(sample$seurat_clusters) + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + group.by = "test") + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + subsample = 100) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1]) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + cluster = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters")) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters"), + metadata.colors = list("orig.ident" = c("Cell" = "blue"))) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters"), + min.cutoff = 1, + max.cutoff = 2) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters"), + min.cutoff = 1, + max.cutoff = 2, + proportional.size = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters"), + min.cutoff = 1, + max.cutoff = 2, + proportional.size = FALSE, + enforce_symmetry = FALSE, + use_viridis = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters"), + min.cutoff = 1, + max.cutoff = 2, + proportional.size = FALSE, + enforce_symmetry = FALSE, + use_viridis = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_SCExpressionHeatmap(sample = sample, + features = rownames(sample)[1:5], + metadata = c("orig.ident", "seurat_clusters"), + min.cutoff = 1, + max.cutoff = 2, + proportional.size = FALSE, + enforce_symmetry = TRUE, + use_viridis = FALSE) + testthat::expect_type(p, "list") + }) +} + + diff --git a/tests/testthat/test-save_Plot.R b/tests/testthat/test-save_Plot.R new file mode 100644 index 0000000..9e33f2d --- /dev/null +++ b/tests/testthat/test-save_Plot.R @@ -0,0 +1,222 @@ +if(base::isFALSE(dep_check[["save_Plot"]])){ + testthat::test_that("save_Plot: PASS - no file", { + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + output_format = "svg")) + + }) + + testthat::test_that("save_Plot: PASS - no file path", { + + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + file_name = "test", + output_format = "svg")) + + }) + + testthat::test_that("save_Plot: PASS - null file path", { + + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + file_name = "test", + output_format = "svg")) + + }) + + testthat::test_that("save_Plot: PASS - no file path", { + + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = paste0(figure_path, "/deleteme"), + file_name = "test", + output_format = "svg")) + + }) + + testthat::test_that("save_Plot: FAIL - wrong output format", { + testthat::skip_on_ci() + testthat::expect_error(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "wrong")) + + }) + + testthat::test_that("save_Plot: FAIL - all and publication at the same time.", { + + + testthat::expect_error(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = c("all", "publication"))) + }) + + testthat::test_that("save_Plot: PASS - all", { + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "all")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "all")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "all")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.chord, + figure_path = figure_path, + file_name = "test", + output_format = "all")) + + }) + + testthat::test_that("save_Plot: PASS - publication", { + + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "publication")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "publication")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "publication")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.chord, + figure_path = figure_path, + file_name = "test", + output_format = "publication")) + + + }) + + testthat::test_that("save_Plot: PASS - jpeg", { + + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "jpeg")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "jpeg")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "jpeg")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.chord, + figure_path = figure_path, + file_name = "test", + output_format = "jpeg")) + }) + + testthat::test_that("save_Plot: PASS - png", { + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "png")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "png")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "png")) + }) + + testthat::test_that("save_Plot: PASS - pdf", { + + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "pdf")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "pdf")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "pdf")) + }) + + testthat::test_that("save_Plot: PASS - tiff", { + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "tiff")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "tiff")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "tiff")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.chord, + figure_path = figure_path, + file_name = "test", + output_format = "tiff")) + }) + + testthat::test_that("save_Plot: PASS - svg", { + testthat::skip_on_ci() + testthat::expect_silent(SCpubr::save_Plot(plot = p, + figure_path = figure_path, + file_name = "test", + output_format = "svg")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.heatmap, + figure_path = figure_path, + file_name = "test", + output_format = "svg")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.pheatmap, + figure_path = figure_path, + file_name = "test", + output_format = "svg")) + + testthat::expect_silent(SCpubr::save_Plot(plot = p.chord, + figure_path = figure_path, + file_name = "test", + output_format = "svg")) + }) + + + unlink(paste0(figure_path, "*.svg")) + unlink(paste0(figure_path, "test.jpeg")) + unlink(paste0(figure_path, "test.pdf")) + unlink(paste0(figure_path, "test.tiff")) + unlink(paste0(figure_path, "test.png")) + unlink(paste0(figure_path, "/deleteme"), recursive = TRUE) + +} +