diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 49cb814..192c50d 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 2.0.0 -Date: 2023-08-09 13:21:38 UTC -SHA: aa0e071e38d4c36ab1357304b698d72ffac20e44 +Version: 2.0.1 +Date: 2023-08-13 10:28:15 UTC +SHA: f88f6e19ce2d121e82869c4418d26fe9ff7b1db9 diff --git a/DESCRIPTION b/DESCRIPTION index c25c0ac..9a55482 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.0.9000 +Version: 2.0.1 Authors@R: person("Enrique", "Blanco-Carmona", , "scpubr@gmail.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-1208-1691")) @@ -75,10 +75,7 @@ Suggests: tidyr, UCell, viridis, - withr, - liana (>= 0.1.6) -Remotes: - saezlab/liana + withr VignetteBuilder: knitr biocViews: Software, SingleCell, Visualization diff --git a/NAMESPACE b/NAMESPACE index 64258ca..01c5a5f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -export(do_AffinityAnalysisPlot) export(do_AlluvialPlot) export(do_BarPlot) export(do_BeeSwarmPlot) @@ -10,7 +9,6 @@ export(do_ChordDiagramPlot) export(do_ColorPalette) export(do_CopyNumberVariantPlot) export(do_CorrelationPlot) -export(do_DiffusionMapPlot) export(do_DimPlot) export(do_DotPlot) export(do_EnrichmentHeatmap) @@ -20,17 +18,11 @@ 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 d2fd523..ef5f8e3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,24 @@ -# SCpubr v2.X.X (next release) +# SCpbur v2.0.1 + +## General. +- Fixed a bug that prevented error messages stating the dependencies missing per function to show up properly. + +## do_BeeSwarmPlot() +- Changed default continuous palette to `YlGnBu`. +- Changed default legend title to `feature_to_rank` if `continous_feature = TRUE`. +- Changed default value of `sequential.direction` to `1`. +- Changed default value of `legend.position` to `bottom` when `continuous_feature = FALSE`. + +## do_BoxPlot() +- Changed default value of `legend.position` to `bottom`. +- Fixed a bug in which legend key glyphs would not show up when using `use_silhouette = TRUE`. + +## do_ViolinPlot() +- Changed default value of `legend.position` to `bottom`. +- Fixed a bug in which the default color palette would not be applied when `plot_boxplots = FALSE`. +- Added `legend.title.position` parameter and set it up as `top` by default. + +# SCpubr v2.0.1 ## General - Refactored startup messages to comply with CRAN policies. @@ -8,7 +28,7 @@ ## `SCpubr::do_EnrichmentHeatmap` -- Fixed a bug that checked the pacakge dependencies for the wrong function. +- Fixed a bug that checked the package dependencies for the wrong function. # SCpubr v2.0.0 @@ -71,7 +91,6 @@ Many (except a few selected cases) of the functions that returned list of differ ## `SCpubr::do_BarPlot` - Added `facet.by` parameter to extra group the bars by a third metadata variable. -- Added `facet.by.direction` parameter to decide in which direction the facets are drawn. - Added `order.by` to reorder the bars when using `position = fill` based on a value in `group.by`. - Limited the possible interactions from `group.by`, `split.by` and `order.by` to those that make sense to plot. For instance, a bar plot using `group.by` and `position = fill` but not using `split.by ` resulted in bars of equal lenght with only one value per group of proportion `1`. - Set default value of `plot.grid` to `FALSE`. diff --git a/R/do_AffinityAnalysisPlot.R b/R/do_AffinityAnalysisPlot.R deleted file mode 100644 index a1398ff..0000000 --- a/R/do_AffinityAnalysisPlot.R +++ /dev/null @@ -1,538 +0,0 @@ -#' 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 = "norm_wmean", - 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. - mat <- .GetAssayData(sample, - assay = assay, - slot = slot) - - # Compute activities. - if(isTRUE(verbose)){message(paste0(add_info(), crayon_body("Computing "), - crayon_key("activities"), - crayon_body("...")))} - - 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 - data.use <- .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_BeeSwarmPlot.R b/R/do_BeeSwarmPlot.R index 5ccf73f..a519d0f 100644 --- a/R/do_BeeSwarmPlot.R +++ b/R/do_BeeSwarmPlot.R @@ -20,7 +20,7 @@ do_BeeSwarmPlot <- function(sample, colors.use = NULL, legend.title = NULL, legend.type = "colorbar", - legend.position = if (isTRUE(continuous_feature)) {"bottom"} else {"none"}, + legend.position = "bottom", legend.framewidth = 0.5, legend.tickwidth = 0.5, legend.length = 20, @@ -39,11 +39,11 @@ do_BeeSwarmPlot <- function(sample, remove_x_axis = FALSE, remove_y_axis = FALSE, flip = FALSE, - use_viridis = TRUE, + use_viridis = FALSE, viridis.palette = "G", viridis.direction = 1, sequential.palette = "YlGnBu", - sequential.direction = -1, + sequential.direction = 1, verbose = TRUE, raster = FALSE, raster.dpi = 300, @@ -182,6 +182,12 @@ do_BeeSwarmPlot <- function(sample, sample <- out[["sample"]] group.by <- out[["group.by"]] + # Assign legend title. + if (is.null(legend.title)){ + legend.title <- if (isTRUE(continuous_feature)) {feature_to_rank} else {group.by} + } + + dim_colnames <- check_feature(sample = sample, features = feature_to_rank, dump_reduction_names = TRUE) if (feature_to_rank %in% colnames(sample@meta.data)) { sample@meta.data$rank_me <- sample@meta.data[, feature_to_rank] diff --git a/R/do_BoxPlot.R b/R/do_BoxPlot.R index 6d7fdb8..3ef3ed9 100644 --- a/R/do_BoxPlot.R +++ b/R/do_BoxPlot.R @@ -36,7 +36,7 @@ do_BoxPlot <- function(sample, ylab = NULL, legend.title = NULL, legend.title.position = "top", - legend.position = NULL, + legend.position = "bottom", boxplot.line.color = "black", outlier.color = "black", outlier.alpha = 0.5, @@ -122,14 +122,7 @@ do_BoxPlot <- function(sample, `%>%` <- magrittr::`%>%` - if (is.null(legend.position)){ - if (is.null(split.by)) { - legend.position <- "none" - } else { - legend.position <- "bottom" - } - } - + check_colors(na.value, parameter_name = "na.value") check_colors(boxplot.line.color, parameter_name = "boxplot.line.color") check_colors(outlier.color, parameter_name = "outlier.color") @@ -227,8 +220,10 @@ do_BoxPlot <- function(sample, width = boxplot.width, lwd = boxplot.linewidth, fatten = 1, - key_glyph = "rect", - na.rm = TRUE) + na.rm = TRUE) + + ggplot2::guides(color = ggplot2::guide_legend(title = legend.title, + title.position = legend.title.position, + title.hjust = 0.5)) } else if (isTRUE(use_silhouette) & !is.null(split.by)){ stop(paste0(add_cross(), crayon_body("Parameter "), crayon_key("use_silhouette"), crayon_body("can not be used alongside "), crayon_key("split.by"), crayon_body(".")), call. = FALSE) } else if (base::isFALSE(use_silhouette)){ @@ -252,7 +247,10 @@ do_BoxPlot <- function(sample, lwd = boxplot.linewidth, fatten = 1, key_glyph = "rect", - na.rm = TRUE) + na.rm = TRUE) + + ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title, + title.position = legend.title.position, + title.hjust = 0.5)) } p <- p + @@ -260,10 +258,7 @@ do_BoxPlot <- function(sample, subtitle = plot.subtitle, caption = plot.caption) + ggplot2::xlab(if (is.null(xlab)) {"Groups"} else (xlab)) + - ggplot2::ylab(if (is.null(ylab)) {feature} else (ylab)) + - ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title, - title.position = legend.title.position, - title.hjust = 0.5)) + + ggplot2::ylab(if (is.null(ylab)) {feature} else (ylab)) + ggplot2::theme_minimal(base_size = font.size) + ggplot2::theme(axis.title = ggplot2::element_text(color = "black", face = axis.title.face), diff --git a/R/do_DiffusionMapPlot.R b/R/do_DiffusionMapPlot.R deleted file mode 100644 index 8d1f63f..0000000 --- a/R/do_DiffusionMapPlot.R +++ /dev/null @@ -1,422 +0,0 @@ -#' 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_LigandReceptorPlot.R b/R/do_LigandReceptorPlot.R deleted file mode 100644 index 96141f0..0000000 --- a/R/do_LigandReceptorPlot.R +++ /dev/null @@ -1,574 +0,0 @@ -#' 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 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, - 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) - 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))) - } - - 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") - - 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 deleted file mode 100644 index ace6b17..0000000 --- a/R/do_LoadingsPlot.R +++ /dev/null @@ -1,467 +0,0 @@ -#' 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") - - data.use <- data.use %>% - dplyr::left_join(y = {.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 deleted file mode 100644 index d9bdc57..0000000 --- a/R/do_MetadataPlot.R +++ /dev/null @@ -1,345 +0,0 @@ -#' 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 deleted file mode 100644 index a680c15..0000000 --- a/R/do_SCEnrichmentHeatmap.R +++ /dev/null @@ -1,644 +0,0 @@ -#' 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 deleted file mode 100644 index 49ab6ff..0000000 --- a/R/do_SCExpressionHeatmap.R +++ /dev/null @@ -1,560 +0,0 @@ -#' 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::`%>%` - genes.avail <- rownames(.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("."))) - } - - - matrix <- .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/do_ViolinPlot.R b/R/do_ViolinPlot.R index f4f65bd..9be8c0f 100644 --- a/R/do_ViolinPlot.R +++ b/R/do_ViolinPlot.R @@ -25,7 +25,7 @@ do_ViolinPlot <- function(sample, y_cut = rep(NA, length(features)), plot_boxplot = TRUE, boxplot_width = 0.2, - legend.position = "none", + legend.position = "bottom", plot.title = NULL, plot.subtitle = NULL, plot.caption = NULL, @@ -41,6 +41,7 @@ do_ViolinPlot <- function(sample, ncol = NULL, share.y.lims = FALSE, legend.title = NULL, + legend.title.position = "top", legend.ncol = NULL, legend.nrow = NULL, legend.byrow = FALSE, @@ -103,7 +104,8 @@ do_ViolinPlot <- function(sample, "axis.title.face" = axis.title.face, "axis.text.face" = axis.text.face, "legend.title.face" = legend.title.face, - "legend.text.face" = legend.text.face) + "legend.text.face" = legend.text.face, + "legend.title.position" = legend.title.position) check_type(parameters = character_list, required_type = "character", test_function = is.character) @@ -164,6 +166,11 @@ do_ViolinPlot <- function(sample, sample <- out[["sample"]] group.by <- out[["group.by"]] + # Assign legend title. + if (is.null(legend.title)){ + legend.title <- group.by + } + if (is.null(colors.use)){ if (is.factor(sample@meta.data[, group.by])){ names.use <- levels(sample@meta.data[, group.by]) @@ -226,7 +233,8 @@ do_ViolinPlot <- function(sample, p <- p + ggplot2::geom_violin(color = "black", linewidth = line_width, - na.rm = TRUE) + na.rm = TRUE) + + ggplot2::scale_fill_manual(values = colors.use) if (isTRUE(plot_boxplot)){ assertthat::assert_that(is.null(split.by), msg = paste0(add_cross(), crayon_key("Boxplots"), @@ -243,8 +251,7 @@ do_ViolinPlot <- function(sample, width = boxplot_width, outlier.shape = NA, fatten = 1, - na.rm = TRUE) + - ggplot2::scale_fill_manual(values = colors.use) + na.rm = TRUE) } if (is.na(xlab[counter])){ xlab.use <- "Groups" @@ -265,10 +272,11 @@ do_ViolinPlot <- function(sample, subtitle = plot.subtitle, caption = plot.caption) + ggplot2::guides(fill = ggplot2::guide_legend(title = legend.title, + title.hjust = 0.5, ncol = legend.ncol, nrow = legend.nrow, byrow = legend.byrow, - title.position = "top")) + + title.position = legend.title.position)) + ggplot2::theme_minimal(base_size = font.size) + ggplot2::theme(axis.text.x = ggplot2::element_text(color = "black", face = axis.text.face, diff --git a/R/save_Plot.R b/R/save_Plot.R deleted file mode 100644 index d1e6ac1..0000000 --- a/R/save_Plot.R +++ /dev/null @@ -1,203 +0,0 @@ -#' 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 0eaec1f..9a95b19 100644 --- a/R/utils.R +++ b/R/utils.R @@ -464,7 +464,7 @@ check_suggests <- function(function_name, passive = FALSE){ pkgs <- vapply(pkgs, requireNamespace, quietly = TRUE, FUN.VALUE = logical(1)) # nocov start if(sum(!pkgs) > 0){ - missing_pkgs <- names(pkgs[base::isFALSE(pkgs)]) + missing_pkgs <- names(pkgs[vapply(pkgs, function(x){base::isFALSE(x)}, FUN.VALUE = logical(1))]) if (base::isFALSE(passive)){ stop(paste0(add_cross(), crayon_body("Packages "), paste(vapply(missing_pkgs, crayon_key, FUN.VALUE = character(1)), collapse = crayon_body(", ")), @@ -600,7 +600,8 @@ package_report <- function(startup = FALSE, "do_SCExpressionHeatmap", "do_SCEnrichmentHeatmap", "do_AffinityAnalysisPlot", - "do_DiffusionMapPlot")){x <- paste0(x, cli::col_cyan(" | DEV"))} else {x}}, FUN.VALUE = character(1))) + "do_DiffusionMapPlot", + "do_LoadingsPlot")){x <- paste0(x, cli::col_cyan(" | DEV"))} else {x}}, FUN.VALUE = character(1))) functions <- vapply(functions, check_suggests, passive = TRUE, FUN.VALUE = logical(1)) names(functions) <- names.use # nocov start @@ -611,7 +612,8 @@ package_report <- function(startup = FALSE, "do_SCExpressionHeatmap", "do_SCEnrichmentHeatmap", "do_AffinityAnalysisPlot", - "do_DiffusionMapPlot"))] + "do_DiffusionMapPlot", + "do_LoadingsPlot"))] functions <- vapply(functions, check_suggests, passive = TRUE, FUN.VALUE = logical(1)) } # nocov end diff --git a/cran-comments.md b/cran-comments.md index 7130f62..57a94bc 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,9 +1,19 @@ -# Submission version 2.0.0 -Major rework of the underlying code of the package and visualization. -Resubmission fixing conditional use of AUCell package. +# Submission version 2.0.1 +Fixed Startup messages and loading time at startup. + +The package no longer calls for any mirrors to check package versions. I have removed every instance of this. + +While `devtools::check` returns no warnings, `R CMD CHECK` does return: +ā”€ checking package dependencies ...Warning: unable to access index for repository https://bioconductor.org/packages/3.15/bioc/src/contrib: (3s) + cannot open URL 'https://bioconductor.org/packages/3.15/bioc/src/contrib/PACKAGES' + Warning: unable to access index for repository https://bioconductor.org/packages/3.15/data/annotation/src/contrib: + cannot open URL 'https://bioconductor.org/packages/3.15/data/annotation/src/contrib/PACKAGES' + Warning: unable to access index for repository https://bioconductor.org/packages/3.15/data/experiment/src/contrib: + cannot open URL 'https://bioconductor.org/packages/3.15/data/experiment/src/contrib/PACKAGES' + +For which I am unable to locate the exact reason why it only appears there. Would it be possible to receive guidance on this if this +turns out to be a real problem? -If further tests are failing, would it be possible to get further insights on -how to test it on my end? Because on my side all checks are successful. Thanks! ## `devtools` R CMD check results There were no ERRORs, WARNINGs or NOTEs. diff --git a/man/do_AffinityAnalysisPlot.Rd b/man/do_AffinityAnalysisPlot.Rd deleted file mode 100644 index 2793d21..0000000 --- a/man/do_AffinityAnalysisPlot.Rd +++ /dev/null @@ -1,195 +0,0 @@ -% 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 = "norm_wmean", - 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_BeeSwarmPlot.Rd b/man/do_BeeSwarmPlot.Rd index a650d77..b33d9c0 100644 --- a/man/do_BeeSwarmPlot.Rd +++ b/man/do_BeeSwarmPlot.Rd @@ -16,12 +16,7 @@ do_BeeSwarmPlot( colors.use = NULL, legend.title = NULL, legend.type = "colorbar", - legend.position = if (isTRUE(continuous_feature)) { - "bottom" - } else { - - "none" - }, + legend.position = "bottom", legend.framewidth = 0.5, legend.tickwidth = 0.5, legend.length = 20, @@ -40,11 +35,11 @@ do_BeeSwarmPlot( remove_x_axis = FALSE, remove_y_axis = FALSE, flip = FALSE, - use_viridis = TRUE, + use_viridis = FALSE, viridis.palette = "G", viridis.direction = 1, sequential.palette = "YlGnBu", - sequential.direction = -1, + sequential.direction = 1, verbose = TRUE, raster = FALSE, raster.dpi = 300, diff --git a/man/do_BoxPlot.Rd b/man/do_BoxPlot.Rd index a818692..50e182c 100644 --- a/man/do_BoxPlot.Rd +++ b/man/do_BoxPlot.Rd @@ -23,7 +23,7 @@ do_BoxPlot( ylab = NULL, legend.title = NULL, legend.title.position = "top", - legend.position = NULL, + legend.position = "bottom", boxplot.line.color = "black", outlier.color = "black", outlier.alpha = 0.5, diff --git a/man/do_DiffusionMapPlot.Rd b/man/do_DiffusionMapPlot.Rd deleted file mode 100644 index dfc37ba..0000000 --- a/man/do_DiffusionMapPlot.Rd +++ /dev/null @@ -1,208 +0,0 @@ -% 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_LigandReceptorPlot.Rd b/man/do_LigandReceptorPlot.Rd deleted file mode 100644 index fad2554..0000000 --- a/man/do_LigandReceptorPlot.Rd +++ /dev/null @@ -1,186 +0,0 @@ -% 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, - 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{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 deleted file mode 100644 index 6e25e99..0000000 --- a/man/do_LoadingsPlot.Rd +++ /dev/null @@ -1,165 +0,0 @@ -% 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 deleted file mode 100644 index 1572ff8..0000000 --- a/man/do_MetadataPlot.Rd +++ /dev/null @@ -1,137 +0,0 @@ -% 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 deleted file mode 100644 index 7a9c85a..0000000 --- a/man/do_SCEnrichmentHeatmap.Rd +++ /dev/null @@ -1,230 +0,0 @@ -% 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 deleted file mode 100644 index 53baaed..0000000 --- a/man/do_SCExpressionHeatmap.Rd +++ /dev/null @@ -1,204 +0,0 @@ -% 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/do_ViolinPlot.Rd b/man/do_ViolinPlot.Rd index 2da8cf7..d9a82a6 100644 --- a/man/do_ViolinPlot.Rd +++ b/man/do_ViolinPlot.Rd @@ -17,7 +17,7 @@ do_ViolinPlot( y_cut = rep(NA, length(features)), plot_boxplot = TRUE, boxplot_width = 0.2, - legend.position = "none", + legend.position = "bottom", plot.title = NULL, plot.subtitle = NULL, plot.caption = NULL, @@ -33,6 +33,7 @@ do_ViolinPlot( ncol = NULL, share.y.lims = FALSE, legend.title = NULL, + legend.title.position = "top", legend.ncol = NULL, legend.nrow = NULL, legend.byrow = FALSE, @@ -117,6 +118,14 @@ do_ViolinPlot( \item{legend.title}{\strong{\code{\link[base]{character}}} | Title for the legend.} +\item{legend.title.position}{\strong{\code{\link[base]{character}}} | Position for the title of the legend. One of: +\itemize{ +\item \emph{\code{top}}: Top of the legend. +\item \emph{\code{bottom}}: Bottom of the legend. +\item \emph{\code{left}}: Left of the legend. +\item \emph{\code{right}}: Right of the legend. +}} + \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.} diff --git a/man/examples/examples_do_AffinityAnalysisPlot.R b/man/examples/examples_do_AffinityAnalysisPlot.R deleted file mode 100644 index 3a2eec7..0000000 --- a/man/examples/examples_do_AffinityAnalysisPlot.R +++ /dev/null @@ -1,30 +0,0 @@ -\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 deleted file mode 100644 index 46dfb08..0000000 --- a/man/examples/examples_do_DiffusionMapPlot.R +++ /dev/null @@ -1,37 +0,0 @@ -\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 deleted file mode 100644 index b7099a5..0000000 --- a/man/examples/examples_do_LigandReceptorPlot.R +++ /dev/null @@ -1,16 +0,0 @@ -\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 deleted file mode 100644 index b21016a..0000000 --- a/man/examples/examples_do_LoadingsPlot.R +++ /dev/null @@ -1,19 +0,0 @@ -\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 deleted file mode 100644 index c6293a1..0000000 --- a/man/examples/examples_do_MetadataPlot.R +++ /dev/null @@ -1,22 +0,0 @@ -\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 deleted file mode 100644 index c94c834..0000000 --- a/man/examples/examples_do_SCEnrichmentHeatmap.R +++ /dev/null @@ -1,28 +0,0 @@ -\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 deleted file mode 100644 index cb58d39..0000000 --- a/man/examples/examples_do_SCExpressionHeatmap.R +++ /dev/null @@ -1,20 +0,0 @@ -\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 deleted file mode 100644 index 7263174..0000000 --- a/man/examples/examples_save_Plot.R +++ /dev/null @@ -1,47 +0,0 @@ -\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 deleted file mode 100644 index 109e8d4..0000000 --- a/man/save_Plot.Rd +++ /dev/null @@ -1,96 +0,0 @@ -% 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 19148cf..0e51578 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -31,7 +31,7 @@ enriched_terms <- readRDS(system.file("extdata/enriched_terms_example.rds", pack # Get packages. -dependencies <- SCpubr::check_dependencies(return_dependencies = TRUE) +dependencies <- SCpubr:::return_dependencies() dependencies[["utils"]] <- c("Seurat", "rlang", @@ -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 deleted file mode 100644 index 3588401..0000000 --- a/tests/testthat/test-do_AffinityAnalysisPlot.R +++ /dev/null @@ -1,365 +0,0 @@ -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 deleted file mode 100644 index df3c7ea..0000000 --- a/tests/testthat/test-do_DiffusionMapPlot.R +++ /dev/null @@ -1,157 +0,0 @@ -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 deleted file mode 100644 index 7500d80..0000000 --- a/tests/testthat/test-do_LigandReceptorPlot.R +++ /dev/null @@ -1,415 +0,0 @@ -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 deleted file mode 100644 index 865ca7e..0000000 --- a/tests/testthat/test-do_LoadingsPlot.R +++ /dev/null @@ -1,69 +0,0 @@ -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 deleted file mode 100644 index f040c83..0000000 --- a/tests/testthat/test-do_MetadataPlot.R +++ /dev/null @@ -1,47 +0,0 @@ -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 deleted file mode 100644 index db0a9d4..0000000 --- a/tests/testthat/test-do_SCEnrichmentHeatmap.R +++ /dev/null @@ -1,254 +0,0 @@ -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 deleted file mode 100644 index 649ff2e..0000000 --- a/tests/testthat/test-do_SCExpressionHeatmap.R +++ /dev/null @@ -1,107 +0,0 @@ -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 deleted file mode 100644 index 9e33f2d..0000000 --- a/tests/testthat/test-save_Plot.R +++ /dev/null @@ -1,222 +0,0 @@ -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) - -} -