From 4f3f9dc095fb81d8972f246ac251686d26a2853f Mon Sep 17 00:00:00 2001 From: enblacar Date: Thu, 12 Jan 2023 10:21:04 +0100 Subject: [PATCH] Hotfix update 1.1.1 to comply with CRAN internal checks. --- DESCRIPTION | 9 +- NAMESPACE | 3 + R/do_LigandReceptorPlot.R | 461 ++++++++++++++++++ R/do_SankeyPlot.R | 281 +++++++++++ R/save_Plot.R | 203 ++++++++ man/do_LigandReceptorPlot.Rd | 150 ++++++ man/do_SankeyPlot.Rd | 140 ++++++ man/examples/examples_do_LigandReceptorPlot.R | 16 + man/examples/examples_do_SankeyPlot.R | 46 ++ man/examples/examples_save_Plot.R | 47 ++ man/save_Plot.Rd | 96 ++++ tests/testthat/setup.R | 32 +- tests/testthat/test-do_LigandReceptorPlot.R | 265 ++++++++++ tests/testthat/test-do_SankeyPlot.R | 177 +++++++ tests/testthat/test-save_Plot.R | 222 +++++++++ 15 files changed, 2130 insertions(+), 18 deletions(-) create mode 100644 R/do_LigandReceptorPlot.R create mode 100644 R/do_SankeyPlot.R create mode 100644 R/save_Plot.R create mode 100644 man/do_LigandReceptorPlot.Rd create mode 100644 man/do_SankeyPlot.Rd create mode 100644 man/examples/examples_do_LigandReceptorPlot.R create mode 100644 man/examples/examples_do_SankeyPlot.R create mode 100644 man/examples/examples_save_Plot.R create mode 100644 man/save_Plot.Rd create mode 100644 tests/testthat/test-do_LigandReceptorPlot.R create mode 100644 tests/testthat/test-do_SankeyPlot.R create mode 100644 tests/testthat/test-save_Plot.R diff --git a/DESCRIPTION b/DESCRIPTION index a6f0d38..48513ab 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SCpubr Type: Package Title: Generate Publication Ready Visualizations of Single Cell Transcriptomics Data -Version: 1.1.1 +Version: 1.1.1.9000 Authors@R: person("Enrique", "Blanco-Carmona", email = "scpubr@gmail.com", role = c("cre", "aut"), comment = c(ORCID = "0000-0002-1208-1691")) Description: A system that provides a streamlined way of generating publication ready plots for known Single-Cell transcriptomics data in a “publication ready” format. This is, the goal is to automatically generate plots with the highest quality possible, that can be used right away or with minimal modifications for a research article. License: GPL-3 @@ -61,8 +61,13 @@ Suggests: enrichplot, ggnewscale, AnnotationDbi, - org.Hs.eg.db + org.Hs.eg.db, + liana (>= 0.1.6), + ggsankey (>= 0.0.99999) VignetteBuilder: knitr Config/testthat/edition: 3 biocViews: Software, SingleCell, Visualization +Remotes: + saezlab/liana, + davidsjoberg/ggsankey diff --git a/NAMESPACE b/NAMESPACE index 88ff6a1..f798ac8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -19,11 +19,14 @@ export(do_FunctionalAnnotationPlot) export(do_GeyserPlot) export(do_GroupedGOTermPlot) export(do_GroupwiseDEPlot) +export(do_LigandReceptorPlot) export(do_NebulosaPlot) export(do_PathwayActivityPlot) export(do_RidgePlot) +export(do_SankeyPlot) export(do_TFActivityPlot) export(do_TermEnrichmentPlot) export(do_ViolinPlot) export(do_VolcanoPlot) +export(save_Plot) export(state_dependencies) diff --git a/R/do_LigandReceptorPlot.R b/R/do_LigandReceptorPlot.R new file mode 100644 index 0000000..3a694cb --- /dev/null +++ b/R/do_LigandReceptorPlot.R @@ -0,0 +1,461 @@ +#' 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}. +#' @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 rotate_strip_text \strong{\code{\link[base]{logical}}} | Whether the text in the strips should be flipped 90 degrees. +#' @param dot.size \strong{\code{\link[base]{numeric}}} | Size aesthetic for the dots. +#' @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 add_missing_LR_combinations \strong{\code{\link[base]{logical}}} | Depending on the value provided to \strong{\code{top_interactions}}, there might be some source-target combinations missing. If set to TRUE, those combinations will be brought back to the plot as NA values. +#' @param arrange_interactions_by \strong{\code{\link[base]{character}}} | Select the method in which the output matrix of interactions is arranged for plotting. One of: +#' \itemize{ +#' \item \emph{\code{aggregate_rank}}: Uses the output matrix of \strong{\code{\link[liana]{liana_aggregate}}}. Interactions are ordered based on \strong{\code{aggregate_rank}}. +#' \item \emph{\code{specificity}}: Uses the \strong{\code{natmi.edge_specificity}} column to arrange the interactions by their specificity. +#' \item \emph{\code{magnitude}}: Uses the \strong{\code{sca.LRscore}} column to arrange the interactions by their specificity. +#' \item \emph{\code{both}}: Uses both \strong{\code{sca.LRscore}} and \strong{\code{natmi.edge_specificity}} columns to arrange the interactions by their specificity and magnitude altogether. +#' } +#' @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}}). + +#' @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, + border.color = "black", + rotate_x_axis_labels = 45, + rotate_strip_text = FALSE, + 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, + viridis_color_map = "G", + viridis_direction = 1, + font.size = 14, + dot.size = 1, + font.type = "sans", + flip = FALSE, + plot.grid = TRUE, + grid.color = "grey90", + grid.type = "dotted", + compute_ChordDiagrams = FALSE, + add_missing_LR_combinations = TRUE, + arrange_interactions_by = "both", + sort_interactions_alphabetically = FALSE){ + + # Checks for packages. + check_suggests(function_name = "do_LigandReceptorPlot") + `%>%` <- magrittr::`%>%` + + # Check logical parameters. + logical_list <- list("dot_border" = dot_border, + "flip" = flip, + "rotate_strip_text" = rotate_strip_text, + "plot.grid" = plot.grid, + "add_missing_LR_combinations" = add_missing_LR_combinations, + "sort_interactions_alphabetically" = sort_interactions_alphabetically) + 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, + "rotate_x_axis_labels" = rotate_x_axis_labels, + "viridis_direction" = viridis_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_color_map" = viridis_color_map, + "legend.tickcolor" = legend.tickcolor, + "font.type" = font.type, + "grid.color" = grid.color, + "grid.type" = grid.type, + "arrange_interactions_by" = arrange_interactions_by) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + # Check border color. + check_colors(border.color, parameter_name = "border.color") + + # Check viridis_color_map. + check_viridis_color_map(viridis_color_map = viridis_color_map) + + # 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_direction, parameter_name = "viridis_direction") + check_parameters(parameter = viridis_color_map, parameter_name = "viridis_color_map") + check_parameters(parameter = grid.type, parameter_name = "grid.type") + check_parameters(parameter = rotate_x_axis_labels, parameter_name = "rotate_x_axis_labels") + check_parameters(parameter = arrange_interactions_by, parameter_name = "arrange_interactions_by") + + if (!is.null(split.by)){ + assertthat::assert_that(split.by %in% c("receptor.complex", "ligand.complex"), + msg = "Please select one of the following for split.by: ligand.complex, receptor.complex.") + } + + # Define legend parameters. Width and height values will change depending on the legend orientation. + if (legend.position %in% c("top", "bottom")){ + legend.barwidth <- legend.length + legend.barheight <- legend.width + size_title <- "Interaction specificity" + fill.title <- "Expression Magnitude" + } else if (legend.position %in% c("left", "right")){ + legend.barwidth <- legend.width + legend.barheight <- legend.length + size_title <- stringr::str_wrap("Interaction specificity", width = 10) + fill.title <- stringr::str_wrap("Expression Magnitude", width = 10) + } + + liana_output <- liana_output %>% + liana::liana_aggregate(verbose = FALSE) + + # This is to later on add missing interacting pairs. + possible_interacting_clusters <- c() + + # If we are subsetting the final plot. + if (isTRUE(add_missing_LR_combinations)){ + possible_sources <- if(is.null(keep_source)){sort(unique(liana_output$source))} else {sort(unique(liana_output$source))[sort(unique(liana_output$source)) %in% keep_source]} + possible_targets <- if(is.null(keep_target)){sort(unique(liana_output$target))} else {sort(unique(liana_output$target))[sort(unique(liana_output$target)) %in% keep_target]} + + for (source in possible_sources){ + for (target in possible_targets){ + name <- paste0(source, "_", target) + possible_interacting_clusters <- c(possible_interacting_clusters, name) + } + } + } + + liana_output <- liana_output %>% + dplyr::mutate(magnitude = .data$sca.LRscore) %>% + dplyr::mutate(specificity = .data$natmi.edge_specificity) + + # Differential arrangement of the interactions. + if (arrange_interactions_by == "aggregate_rank"){ + liana_output <- liana_output %>% + dplyr::arrange(.data$aggregate_rank) + } else if (arrange_interactions_by == "specificity"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$specificity)) + } else if (arrange_interactions_by == "magnitude"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$magnitude)) + } else if (arrange_interactions_by == "both"){ + liana_output <- liana_output %>% + dplyr::arrange(dplyr::desc(.data$specificity), dplyr::desc(.data$magnitude)) + } + + 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) + + + 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")) + if (isTRUE(add_missing_LR_combinations)){ + # Fix to add missing "NA" interactions. + liana_output <- liana_output %>% + dplyr::select(dplyr::all_of(c("interacting_clusters", + "source", + "target", + "interaction", + "ligand.complex", + "receptor.complex", + "magnitude", + "specificity"))) + + # Iterate over each possible interaction and each interacting pair. + not_found_interaction_pairs <- possible_interacting_clusters[possible_interacting_clusters %!in% unique(liana_output$interacting_clusters)] + interactions <- unique(liana_output$interaction) + + # Iterate over each interaction. + for(interaction in interactions){ + ligand.complex <- stringr::str_split(interaction, pattern = " \\| ")[[1]][1] + receptor.complex <- stringr::str_split(interaction, pattern = " \\| ")[[1]][2] + # For each missing interaction pair. + for (interacting_cluster in not_found_interaction_pairs){ + source <- stringr::str_split(interacting_cluster, pattern = "_")[[1]][1] + target <- stringr::str_split(interacting_cluster, pattern = "_")[[1]][2] + + # If the interacting pair - interaction is missing, add a mock row with it. + column <- tibble::tibble("interacting_clusters" = interacting_cluster, + "source" = source, + "target" = target, + "interaction" = interaction, + "ligand.complex" = ligand.complex, + "receptor.complex" = receptor.complex, + "magnitude" = NA, + "specificity" = NA) + liana_output <- liana_output %>% dplyr::bind_rows(column) + } + } + } + + # 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) + } + + # 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 (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(flip)){ + if (isTRUE(dot_border)){ + p <- liana_output %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$interaction, + y = .data$target, + fill = .data$magnitude, + size = .data$specificity, + group = .data$interacting_clusters)) + + ggplot2::geom_point(shape = 21, + na.rm = TRUE) + } else if (isFALSE(dot_border)) { + p <- liana_output %>% + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$interaction, + y = .data$target, + size = .data$specificity, + group = .data$interacting_clusters)) + + ggplot2::geom_point(mapping = ggplot2::aes(color = .data$magnitude), + shape = 19, + na.rm = TRUE) + } + } else if (isFALSE(flip)){ + 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 (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::scale_size_continuous(name = size_title, + range = c(1 * dot.size, 5 * dot.size)) + # Settings for bordered dots. + if (isTRUE(dot_border)){ + # Add color to aesthetics. + p$layers[[1]]$aes_params$color <- border.color + p <- p + + ggplot2::scale_fill_viridis_c(option = viridis_color_map, + name = fill.title, + direction = viridis_direction, + na.value = NA) + } else { + p <- p + + ggplot2::scale_color_viridis_c(option = viridis_color_map, + name = fill.title, + direction = viridis_direction, + na.value = NA) + } + # Continue plotting. + if (isFALSE(flip)){ + if (isTRUE(rotate_strip_text)){ + strip_text_angle <- 90 + } else { + strip_text_angle <- 0 + } + 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) + } + } else if (isTRUE(flip)) { + if (isTRUE(rotate_strip_text)){ + strip_text_angle <- 0 + } else { + strip_text_angle <- 270 + } + 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$source ~ .data$ligand.complex, + space = "free", + scales = "free", + drop = FALSE) + } else if (split.by == "receptor.complex"){ + p <- p + + ggplot2::facet_grid(.data$source ~ .data$receptor.complex, + space = "free", + scales = "free", + drop = FALSE) + } + } + + + + p <- p + + ggplot2::labs(title = "Source") + + ggplot2::xlab(if (isTRUE(flip)){paste("Ligand", "|", "Receptor", sep = " ")} else if (isFALSE(flip)){"Target"}) + + ggplot2::ylab(if (isFALSE(flip)){paste("Ligand", "|", "Receptor", sep = " ")} else if (isTRUE(flip)){"Target"}) + + 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 = "bold", + hjust = if (isFALSE(flip)){0.5} else {1}, + vjust = 0, + size = font.size), + plot.subtitle = ggplot2::element_text(hjust = 0), + plot.caption = ggplot2::element_text(hjust = 1), + plot.title.position = if (isFALSE(flip)){"panel"} else {"plot"}, + plot.caption.position = "plot", + text = ggplot2::element_text(family = font.type), + legend.justification = "center", + legend.text = ggplot2::element_text(face = "bold"), + legend.title = ggplot2::element_text(face = "bold"), + legend.position = legend.position, + axis.title.x = ggplot2::element_text(face = "bold", hjust = 0.5), + axis.title.y = ggplot2::element_text(face = "bold", angle = 90), + axis.text.y = ggplot2::element_text(face = "bold"), + axis.text = ggplot2::element_text(face = "bold", color = "black"), + axis.ticks = ggplot2::element_line(color = "black"), + axis.text.x = ggplot2::element_text(color = "black", + face = "bold", + angle = get_axis_parameters(angle = rotate_x_axis_labels, flip = flip)[["angle"]], + hjust = get_axis_parameters(angle = rotate_x_axis_labels, flip = flip)[["hjust"]], + vjust = get_axis_parameters(angle = rotate_x_axis_labels, flip = flip)[["vjust"]]), + strip.text.x = if (isFALSE(flip)) {ggplot2::element_text(face = "bold", + angle = strip_text_angle)} + else {ggplot2::element_blank()}, + strip.text.y = if (isFALSE(flip)) {ggplot2::element_blank()} + else {ggplot2::element_text(face = "bold", + angle = strip_text_angle)}, + 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(compute_ChordDiagrams)){ + data <- 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"))) + p.source_target <- SCpubr::do_ChordDiagramPlot(from_df = TRUE, df = data, link.border.color = "black", z_index = TRUE) + + data <- 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"))) + p.ligand_receptor <- SCpubr::do_ChordDiagramPlot(from_df = TRUE, df = data, link.border.color = "black", z_index = TRUE) + return(list("dotplot" = p, + "chord_total_interactions" = p.source_target, + "chord_ligand_receptor" = p.ligand_receptor)) + } else { + return(p) + } + +} + + diff --git a/R/do_SankeyPlot.R b/R/do_SankeyPlot.R new file mode 100644 index 0000000..fe1d58a --- /dev/null +++ b/R/do_SankeyPlot.R @@ -0,0 +1,281 @@ + +#' Do Sankey or Alluvial plots. +#' +#' @inheritParams doc_function +#' @param first_group \strong{\code{\link[base]{character}}} | Categorical metadata variable. First group of nodes of the sankey plot. +#' @param last_group \strong{\code{\link[base]{character}}} | Categorical metadata variable. Last group of nodes of the sankey plot. +#' @param middle_groups \strong{\code{\link[base]{character}}} | Categorical metadata variable. Vector of groups of nodes of the sankey plot. +#' @param type \strong{\code{\link[base]{character}}} | Type of plot to make. One of: +#' \itemize{ +#' \item \emph{\code{sankey}}: Generates a sankey plot. +#' \item \emph{\code{alluvial}}: Generated an Alluvial plot, a kind of sankey plot where all groups have the same height. +#' } +#' @param width \strong{\code{\link[base]{numeric}}} | Width of the nodes. +#' @param space \strong{\code{\link[base]{numeric}}} | Vertical space between the nodes. It appears to be equal to a single cell. Use big numbers to see a difference (like, 1000 or 10000). +#' @param position \strong{\code{\link[base]{character}}} | GGplot2 position. +#' @param node.fill \strong{\code{\link[base]{character}}} | Color to fill the nodes. +#' @param node.color \strong{\code{\link[base]{character}}} | Color for the contour of the nodes. +#' @param flow.alpha \strong{\code{\link[base]{character}}} | Alpha of the connections. +#' @param flow.color \strong{\code{\link[base]{character}}} | Color for the contour of the connections. +#' @param text_size \strong{\code{\link[base]{numeric}}} | Size of the labels. +#' @param text_color \strong{\code{\link[base]{character}}} | Color of the labels. +#' @param smooth \strong{\code{\link[base]{numeric}}} | How smooth the connections are. +#' @param colors.first,colors.middle,colors.last \strong{\code{\link[base]{character}}} | Named vector of colors equal to ALL unique values in first_group, middle_groups, or last_group. +#' @param use_labels \strong{\code{\link[base]{logical}}} | Whether to use labels or text for the node names. +#' @param hjust \strong{\code{\link[base]{numeric}}} | General hjust for the labels. +#' +#' @return A ggplot2 object. +#' @export +#' +#' @example /man/examples/examples_do_SankeyPlot.R +do_SankeyPlot <- function(sample, + first_group, + last_group, + type = "sankey", + middle_groups = NULL, + width = 0.1, + space = ifelse(type == "sankey", 0.05 * ncol(sample), 0), + position = "identity", + node.fill = "white", + node.color = "white", + flow.alpha = 0.75, + flow.color = "black", + text_size = 3, + text_color = "black", + font.size = 14, + font.type = "sans", + smooth = 8, + use_labels = FALSE, + hjust = NULL, + colors.first = NULL, + colors.middle = NULL, + colors.last = NULL, + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL){ + + # Checks for packages. + check_suggests(function_name = "do_SankeyPlot") + # Check if the sample provided is a Seurat object. + check_Seurat(sample = sample) + + # Check logical parameters. + logical_list <- list("use_labels" = use_labels) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("width" = width, + "space" = space, + "flow.alpha" = flow.alpha, + "text_size" = text_size, + "font.size" = font.size, + "smooth" = smooth, + "hjust" = hjust) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + + character_list <- list("first_group" = first_group, + "last_group" = last_group, + "middle_groups" = middle_groups, + "type" = type, + "position" = position, + "node.color" = node.color, + "flow.color" = flow.color, + "text_color" = text_color, + "font.type" = font.type, + "colors.first" = colors.first, + "colors.middle" = colors.middle, + "colors.last" = colors.last, + "node.fill" = node.fill, + "plot.title" = plot.title, + "plot.subtitle" = plot.subtitle, + "plot.caption" = plot.caption) + # Checks + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + check_colors(node.color, parameter_name = "node.color") + check_colors(flow.color, parameter_name = "flow.color") + check_colors(text_color, parameter_name = "text_color") + + check_parameters(parameter = font.type, parameter_name = "font.type") + + # Wrong type. + assertthat::assert_that(type %in% c("alluvial", "sankey"), + msg = "Please provide either sankey or alluvial to type.") + + # Wrong position. + assertthat::assert_that(position %in% c("identity", "nudge"), + msg = "This position type has not been tested.") + + # Not a metadata column. + assertthat::assert_that(first_group %in% colnames(sample@meta.data), + msg = "The metadata variable for first_group is not in the metadata of the object.") + + assertthat::assert_that(class(sample@meta.data[, first_group]) %in% c("character", "factor"), + msg = "The metadata variable for first_group has to be either a character vector or a factor.") + + assertthat::assert_that(last_group %in% colnames(sample@meta.data), + msg = "The metadata variable for last_group is not in the metadata of the object.") + + assertthat::assert_that(class(sample@meta.data[, last_group]) %in% c("character", "factor"), + msg = "The metadata variable for last_group has to be either a character vector or a factor.") + + + for (var in middle_groups){ + assertthat::assert_that(var %in% colnames(sample@meta.data), + msg = "The metadata variable for middle_groups is not in the metadata of the object.") + + assertthat::assert_that(class(sample@meta.data[, var]) %in% c("character", "factor"), + msg = "The metadata variable for middle_groups has to be either a character vector or a factor.") + } + + + `%>%` <- magrittr::`%>%` + + data <- suppressWarnings({sample@meta.data %>% + dplyr::select(dplyr::all_of(c(first_group, middle_groups, last_group))) %>% + tibble::rownames_to_column(var = "cell") %>% + dplyr::select(-.data$cell) %>% + ggsankey::make_long(dplyr::all_of(c(first_group, middle_groups, last_group))) %>% + dplyr::rowwise() %>% + dplyr::mutate(hjust = if(.data$x %in% middle_groups){0.5} + else if (.data$x == last_group){0} + else if (.data$x == first_group){1})}) + if (!is.null(hjust)){data$hjust <- hjust} + + if (!(is.null(colors.first))){ + check_colors(colors.first, parameter_name = "colors.first") + if (sum(names(colors.first) %!in% unique(sample@meta.data[, first_group])) > 0){ + stop("Not all colors provided for the first group match the unique values for first_group.", call. = FALSE) + } + + if (length(colors.first) != length(unique(sample@meta.data[, first_group]))){ + stop("The colors provided for the first group do not match the number of unique nodes.", call. = FALSE) + } + } else { + colors.first <- viridis::viridis(n = length(unique(sample@meta.data[, first_group])), option = "G") + if (is.factor(sample@meta.data[, first_group])){ + names(colors.first) <- levels(sample@meta.data[, first_group]) + } else { + names(colors.first) <- sort(unique(sample@meta.data[, first_group])) + } + } + + if (!(is.null(colors.last))){ + check_colors(colors.last, parameter_name = "colors.last") + if (sum(names(colors.last) %!in% unique(sample@meta.data[, last_group])) > 0){ + stop("Not all colors provided for the last group match the unique values for last_group", call. = FALSE) + } + + if (length(colors.last) != length(unique(sample@meta.data[, last_group]))){ + stop("The colors provided for the last group do not match the number of unique nodes.", call. = FALSE) + } + } else{ + colors.last <- viridis::viridis(n = length(unique(sample@meta.data[, last_group])), option = "D") + if (is.factor(sample@meta.data[, last_group])){ + names(colors.last) <- levels(sample@meta.data[, last_group]) + } else { + names(colors.last) <- sort(unique(sample@meta.data[, last_group])) + } + } + + if (!(is.null(colors.middle))){ + check_colors(colors.middle, parameter_name = "colors.middle") + + unique_middle_values <- c() + for(var in middle_groups){ + if (is.factor(sample@meta.data[, var])){ + unique_middle_values <- c(unique_middle_values, levels(sample@meta.data[, var])) + } else { + unique_middle_values <- c(unique_middle_values, sort(unique(sample@meta.data[, var]))) + } + } + + if (sum(names(colors.middle) %!in% unique_middle_values) > 0){ + stop("Not all colors provided for the middle groups match the unique values for middle_groups", call. = FALSE) + } + + if (length(colors.middle) != length(unique_middle_values)){ + stop("The colors provided for the middle groups do not match the number of unique nodes.", call. = FALSE) + } + } else { + unique_middle_values <- c() + for(var in middle_groups){ + if (is.factor(sample@meta.data[, var])){ + unique_middle_values <- c(unique_middle_values, levels(sample@meta.data[, var])) + } else { + unique_middle_values <- c(unique_middle_values, sort(unique(sample@meta.data[, var]))) + } + } + + colors.middle <- viridis::viridis(n = length(unique_middle_values), option = "C") + names(colors.middle) <- unique_middle_values + } + + colors.use <- c(colors.first, colors.middle, colors.last) + func_use <- ifelse(isTRUE(use_labels), ggsankey::geom_sankey_label, ggsankey::geom_sankey_text) + + p <- data %>% + + ggplot2::ggplot(mapping = ggplot2::aes(x = .data$x, + next_x = .data$next_x, + node = .data$node, + next_node = .data$next_node, + fill = factor(.data$node), + label = .data$node, + hjust = .data$hjust)) + + ggsankey::geom_sankey(flow.alpha = flow.alpha, + node.color = node.color, + node.fill = node.fill, + color = flow.color, + width = width, + position = position, + type = type, + space = space) + + func_use(size = text_size, + color = text_color, + fontface = "bold", + position = position, + type = type, + space = space) + + ggplot2::scale_fill_manual(values = colors.use) + + ggplot2::xlab("") + + ggplot2::ylab("") + + ggplot2::labs(title = plot.title, + subtitle = plot.subtitle, + caption = plot.caption) + + ggplot2::theme_minimal(base_size = font.size) + + ggplot2::theme(axis.title = ggplot2::element_text(color = "black", + face = "bold"), + axis.line.x = ggplot2::element_blank(), + axis.text.x = ggplot2::element_text(color = "black", + face = "bold", + angle = 0, + hjust = 0.5, + vjust = 1), + axis.text.x.top = ggplot2::element_text(color = "black", + face = "bold", + angle = 0, + hjust = 0.5, + vjust = 1), + axis.text.y = ggplot2::element_blank(), + axis.ticks = ggplot2::element_blank(), + panel.grid.major = ggplot2::element_blank(), + plot.title.position = "plot", + plot.title = ggplot2::element_text(face = "bold", hjust = 0), + plot.subtitle = ggplot2::element_text(hjust = 0), + plot.caption = ggplot2::element_text(hjust = 1), + panel.grid = ggplot2::element_blank(), + text = ggplot2::element_text(family = font.type), + plot.caption.position = "plot", + legend.text = ggplot2::element_text(face = "bold"), + legend.position = "none", + legend.title = ggplot2::element_text(face = "bold"), + legend.justification = "center", + 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 = "white"), + legend.background = ggplot2::element_rect(fill = "white", color = "white"), + strip.text =ggplot2::element_text(color = "black", face = "bold")) + + return(p) +} diff --git a/R/save_Plot.R b/R/save_Plot.R new file mode 100644 index 0000000..ac4965b --- /dev/null +++ b/R/save_Plot.R @@ -0,0 +1,203 @@ +#' Save a plot as png, pdf and svg. +#' +#' +#' @param plot Plot to save. +#' @param figure_path \strong{\code{\link[base]{character}}} | Path where the figure will be stored. +#' @param create_path \strong{\code{\link[base]{logical}}} | Whether to create the path. +#' @param file_name \strong{\code{\link[base]{character}}} | Name of the file (without extension, it will be added automatically). +#' @param output_format \strong{\code{\link[base]{character}}} | Output format of the saved figure. One of: +#' \itemize{ +#' \item \emph{\code{pdf}}: Saves the figure as a PDF file. +#' \item \emph{\code{png}}: Saves the figure as a PNG file. +#' \item \emph{\code{jpeg}}: Saves the figure as a JPEG file. +#' \item \emph{\code{tiff}}: Saves the figure as a TIFF file. +#' \item \emph{\code{svg}}: Saves the figure as a SVG file. +#' \item \emph{\code{publication}}: Saves the figure as PDF, PNG and SVG files. +#' \item \emph{\code{all}}: Saves the figure in all possible formats. +#' } +#' @param dpi \strong{\code{\link[base]{numeric}}} | Dpi to use. +#' @param width,height \strong{\code{\link[base]{numeric}}} | Width and height of the figure (inches). +#' +#' @return Nothing. +#' @export +#' +#' @example /man/examples/examples_save_Plot.R +save_Plot <- function(plot, + figure_path = NULL, + create_path = TRUE, + file_name = NULL, + dpi = 300, + output_format = "publication", + width = 8, + height = 8){ + # nocov start + + # Checks for packages. + check_suggests(function_name = "save_Plot") + + # Check logical parameters. + logical_list <- list("create_path" = create_path) + check_type(parameters = logical_list, required_type = "logical", test_function = is.logical) + # Check numeric parameters. + numeric_list <- list("dpi" = dpi, + "width" = width, + "height" = height) + check_type(parameters = numeric_list, required_type = "numeric", test_function = is.numeric) + # Check character parameters. + character_list <- list("figure_path" = figure_path, + "file_name" = file_name) + check_type(parameters = character_list, required_type = "character", test_function = is.character) + + # Null file name? + if (is.null(file_name)){file_name <- "output_figure"} + # Null figure path? + if (is.null(figure_path)){figure_path <- paste0(".", .Platform$file.sep)} + + # Create directory. + if (!(dir.exists(figure_path))){ + if (isTRUE(create_path)){dir.create(figure_path, recursive = TRUE)} + } + + + + + # Handle devices: + output_options <- c("all", "publication", "pdf", "png", "jpeg", "svg", "tiff") + + assertthat::assert_that(sum(output_format %in% output_options) >= 1, + msg = "Please select a valid output format from the available options: all, publication, pdf, png, jpeg, svg, tiff") + + assertthat::assert_that(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 { + options <- c("pdf", "png", "jpeg", "svg", "tiff") + devices_use <- output_format[output_format %in% options] + } + + # is ggplot? + + if (sum(class(plot) %in% c("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% c("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% c("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/man/do_LigandReceptorPlot.Rd b/man/do_LigandReceptorPlot.Rd new file mode 100644 index 0000000..f5e8d04 --- /dev/null +++ b/man/do_LigandReceptorPlot.Rd @@ -0,0 +1,150 @@ +% 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, + border.color = "black", + rotate_x_axis_labels = 45, + rotate_strip_text = FALSE, + 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, + viridis_color_map = "G", + viridis_direction = 1, + font.size = 14, + dot.size = 1, + font.type = "sans", + flip = FALSE, + plot.grid = TRUE, + grid.color = "grey90", + grid.type = "dotted", + compute_ChordDiagrams = FALSE, + add_missing_LR_combinations = TRUE, + arrange_interactions_by = "both", + sort_interactions_alphabetically = FALSE +) +} +\arguments{ +\item{liana_output}{\strong{\code{\link[tibble]{tibble}}} | Object resulting from running \link[liana]{liana_wrap}.} + +\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{border.color}{\strong{\code{\link[base]{character}}} | Color to use for the border of the cells.} + +\item{rotate_x_axis_labels}{\strong{\code{\link[base]{numeric}}} | Degree to rotate the X labels. One of: 0, 45, 90.} + +\item{rotate_strip_text}{\strong{\code{\link[base]{logical}}} | Whether the text in the strips should be flipped 90 degrees.} + +\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 \emph{\code{colorsteps}}: Redefined legend with colors going by range, in steps, using \link[ggplot2]{guide_colorsteps}. +}} + +\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{viridis_color_map}{\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{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{flip}{\strong{\code{\link[base]{logical}}} | Whether to invert the axis of the displayed plot.} + +\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 panels.} + +\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{add_missing_LR_combinations}{\strong{\code{\link[base]{logical}}} | Depending on the value provided to \strong{\code{top_interactions}}, there might be some source-target combinations missing. If set to TRUE, those combinations will be brought back to the plot as NA values.} + +\item{arrange_interactions_by}{\strong{\code{\link[base]{character}}} | Select the method in which the output matrix of interactions is arranged for plotting. One of: +\itemize{ +\item \emph{\code{aggregate_rank}}: Uses the output matrix of \strong{\code{\link[liana]{liana_aggregate}}}. Interactions are ordered based on \strong{\code{aggregate_rank}}. +\item \emph{\code{specificity}}: Uses the \strong{\code{natmi.edge_specificity}} column to arrange the interactions by their specificity. +\item \emph{\code{magnitude}}: Uses the \strong{\code{sca.LRscore}} column to arrange the interactions by their specificity. +\item \emph{\code{both}}: Uses both \strong{\code{sca.LRscore}} and \strong{\code{natmi.edge_specificity}} columns to arrange the interactions by their specificity and magnitude altogether. +}} + +\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}}).} +} +\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 (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_SankeyPlot.Rd b/man/do_SankeyPlot.Rd new file mode 100644 index 0000000..d7a5749 --- /dev/null +++ b/man/do_SankeyPlot.Rd @@ -0,0 +1,140 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/do_SankeyPlot.R +\name{do_SankeyPlot} +\alias{do_SankeyPlot} +\title{Do Sankey or Alluvial plots.} +\usage{ +do_SankeyPlot( + sample, + first_group, + last_group, + type = "sankey", + middle_groups = NULL, + width = 0.1, + space = ifelse(type == "sankey", 0.05 * ncol(sample), 0), + position = "identity", + node.fill = "white", + node.color = "white", + flow.alpha = 0.75, + flow.color = "black", + text_size = 3, + text_color = "black", + font.size = 14, + font.type = "sans", + smooth = 8, + use_labels = FALSE, + hjust = NULL, + colors.first = NULL, + colors.middle = NULL, + colors.last = NULL, + plot.title = NULL, + plot.subtitle = NULL, + plot.caption = NULL +) +} +\arguments{ +\item{sample}{\strong{\code{\link[SeuratObject]{Seurat}}} | A Seurat object, generated by \link[Seurat]{CreateSeuratObject}.} + +\item{first_group}{\strong{\code{\link[base]{character}}} | Categorical metadata variable. First group of nodes of the sankey plot.} + +\item{last_group}{\strong{\code{\link[base]{character}}} | Categorical metadata variable. Last group of nodes of the sankey plot.} + +\item{type}{\strong{\code{\link[base]{character}}} | Type of plot to make. One of: +\itemize{ +\item \emph{\code{sankey}}: Generates a sankey plot. +\item \emph{\code{alluvial}}: Generated an Alluvial plot, a kind of sankey plot where all groups have the same height. +}} + +\item{middle_groups}{\strong{\code{\link[base]{character}}} | Categorical metadata variable. Vector of groups of nodes of the sankey plot.} + +\item{width}{\strong{\code{\link[base]{numeric}}} | Width of the nodes.} + +\item{space}{\strong{\code{\link[base]{numeric}}} | Vertical space between the nodes. It appears to be equal to a single cell. Use big numbers to see a difference (like, 1000 or 10000).} + +\item{position}{\strong{\code{\link[base]{character}}} | GGplot2 position.} + +\item{node.fill}{\strong{\code{\link[base]{character}}} | Color to fill the nodes.} + +\item{node.color}{\strong{\code{\link[base]{character}}} | Color for the contour of the nodes.} + +\item{flow.alpha}{\strong{\code{\link[base]{character}}} | Alpha of the connections.} + +\item{flow.color}{\strong{\code{\link[base]{character}}} | Color for the contour of the connections.} + +\item{text_size}{\strong{\code{\link[base]{numeric}}} | Size of the labels.} + +\item{text_color}{\strong{\code{\link[base]{character}}} | Color of the labels.} + +\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{smooth}{\strong{\code{\link[base]{numeric}}} | How smooth the connections are.} + +\item{use_labels}{\strong{\code{\link[base]{logical}}} | Whether to use labels or text for the node names.} + +\item{hjust}{\strong{\code{\link[base]{numeric}}} | General hjust for the labels.} + +\item{colors.first, colors.middle, colors.last}{\strong{\code{\link[base]{character}}} | Named vector of colors equal to ALL unique values in first_group, middle_groups, or last_group.} + +\item{plot.title, plot.subtitle, plot.caption}{\strong{\code{\link[base]{character}}} | Title, subtitle or caption to use in the plot.} +} +\value{ +A ggplot2 object. +} +\description{ +Do Sankey or Alluvial plots. +} +\examples{ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_SankeyPlot", passive = TRUE) + + if (isTRUE(value)){ + library(dplyr) + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Compute basic sankey plot. + p1 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + type = "sankey") + + # Compute basic alluvial plot. + p2 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + type = "alluvial") + + p <- p1 / p2 + p + + sample$assignment <- ifelse(sample$seurat_clusters \%in\% c("0", "2", "4"), "A", "B") + + # Add more groups. + p1 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + middle_groups = c("assignment"), + last_group = "orig.ident", + type = "sankey") + + p2 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + middle_groups = c("assignment"), + last_group = "orig.ident", + type = "alluvial") + + p <- p1 / p2 + p + } else if (isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} +} diff --git a/man/examples/examples_do_LigandReceptorPlot.R b/man/examples/examples_do_LigandReceptorPlot.R new file mode 100644 index 0000000..327aa82 --- /dev/null +++ b/man/examples/examples_do_LigandReceptorPlot.R @@ -0,0 +1,16 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_LigandReceptorPlot", passive = TRUE) + + if (isTRUE(value)){ + liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) + # Ligand Receptor analysis plot. + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output) + p + + } else if (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_SankeyPlot.R b/man/examples/examples_do_SankeyPlot.R new file mode 100644 index 0000000..219785f --- /dev/null +++ b/man/examples/examples_do_SankeyPlot.R @@ -0,0 +1,46 @@ +\donttest{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "do_SankeyPlot", passive = TRUE) + + if (isTRUE(value)){ + library(dplyr) + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Compute basic sankey plot. + p1 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + type = "sankey") + + # Compute basic alluvial plot. + p2 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + type = "alluvial") + + p <- p1 / p2 + p + + sample$assignment <- ifelse(sample$seurat_clusters %in% c("0", "2", "4"), "A", "B") + + # Add more groups. + p1 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + middle_groups = c("assignment"), + last_group = "orig.ident", + type = "sankey") + + p2 <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + middle_groups = c("assignment"), + last_group = "orig.ident", + type = "alluvial") + + p <- p1 / p2 + p + } else if (isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} diff --git a/man/examples/examples_save_Plot.R b/man/examples/examples_save_Plot.R new file mode 100644 index 0000000..1d48ddd --- /dev/null +++ b/man/examples/examples_save_Plot.R @@ -0,0 +1,47 @@ +\dontrun{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "save_Plot", passive = TRUE) + + if (isTRUE(value)){ + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Generate a plot. + p <- SCpubr::do_DimPlot(sample = sample) + + # Default parameters. + SCpubr::save_Plot(plot = p) + + # Specifying the name and folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure") + + # Specify to also create a new folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE) + + # Set dimensions for the figure. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8) + + # Set quality (dpi). + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8, + dpi = 300) + } else if (isFALSE(value)){ + message("This function can not be used without its suggested packages.") + message("Check out which ones are needed using `SCpubr::state_dependencies()`.") + } +} + diff --git a/man/save_Plot.Rd b/man/save_Plot.Rd new file mode 100644 index 0000000..1bb8bf6 --- /dev/null +++ b/man/save_Plot.Rd @@ -0,0 +1,96 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/save_Plot.R +\name{save_Plot} +\alias{save_Plot} +\title{Save a plot as png, pdf and svg.} +\usage{ +save_Plot( + plot, + figure_path = NULL, + create_path = TRUE, + file_name = NULL, + dpi = 300, + output_format = "publication", + width = 8, + height = 8 +) +} +\arguments{ +\item{plot}{Plot to save.} + +\item{figure_path}{\strong{\code{\link[base]{character}}} | Path where the figure will be stored.} + +\item{create_path}{\strong{\code{\link[base]{logical}}} | Whether to create the path.} + +\item{file_name}{\strong{\code{\link[base]{character}}} | Name of the file (without extension, it will be added automatically).} + +\item{dpi}{\strong{\code{\link[base]{numeric}}} | Dpi to use.} + +\item{output_format}{\strong{\code{\link[base]{character}}} | Output format of the saved figure. One of: +\itemize{ +\item \emph{\code{pdf}}: Saves the figure as a PDF file. +\item \emph{\code{png}}: Saves the figure as a PNG file. +\item \emph{\code{jpeg}}: Saves the figure as a JPEG file. +\item \emph{\code{tiff}}: Saves the figure as a TIFF file. +\item \emph{\code{svg}}: Saves the figure as a SVG file. +\item \emph{\code{publication}}: Saves the figure as PDF, PNG and SVG files. +\item \emph{\code{all}}: Saves the figure in all possible formats. +}} + +\item{width, height}{\strong{\code{\link[base]{numeric}}} | Width and height of the figure (inches).} +} +\value{ +Nothing. +} +\description{ +Save a plot as png, pdf and svg. +} +\examples{ +\dontrun{ + # Check Suggests. + value <- SCpubr:::check_suggests(function_name = "save_Plot", passive = TRUE) + + if (isTRUE(value)){ + # Define your Seurat object. + sample <- readRDS(system.file("extdata/seurat_dataset_example.rds", package = "SCpubr")) + + # Generate a plot. + p <- SCpubr::do_DimPlot(sample = sample) + + # Default parameters. + SCpubr::save_Plot(plot = p) + + # Specifying the name and folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure") + + # Specify to also create a new folder. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE) + + # Set dimensions for the figure. + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8) + + # Set quality (dpi). + SCpubr::save_Plot(plot = p, + figure_path = "/path/to/my/figures/", + file_name = "my_figure", + create_path = TRUE, + width = 8, + height = 8, + dpi = 300) + } else if (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 5090ef4..7242a7c 100644 --- a/tests/testthat/setup.R +++ b/tests/testthat/setup.R @@ -61,22 +61,22 @@ for (func in names(dependencies)){ # Remove this for publication in CRAN. -#if (isFALSE(dep_check[["do_LigandReceptorPlot"]])){ -# liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) -#} -# -#if (isFALSE(dep_check[["do_DimPlot"]]) & -# isFALSE(dep_check[["do_CorrelationPlot"]]) & -# isFALSE(dep_check[["do_ChordDiagramPlot"]]) & -# isTRUE(requireNamespace(pkg, quietly = TRUE)) & -# isFALSE(dep_check[["save_Plot"]])){ -# p <- SCpubr::do_DimPlot(sample) -# p.heatmap <- SCpubr::do_CorrelationPlot(sample) -# data <- p.heatmap@ht_list$`Pearson coef.`@matrix -# p.pheatmap <- pheatmap::pheatmap(data) -# p.chord <- SCpubr::do_ChordDiagramPlot(sample = sample, from = "seurat_clusters", to = "orig.ident") -# figure_path <- getwd() -#} +if (isFALSE(dep_check[["do_LigandReceptorPlot"]])){ + liana_output <- readRDS(system.file("extdata/liana_output_example.rds", package = "SCpubr")) +} + +if (isFALSE(dep_check[["do_DimPlot"]]) & + isFALSE(dep_check[["do_CorrelationPlot"]]) & + isFALSE(dep_check[["do_ChordDiagramPlot"]]) & + isTRUE(requireNamespace(pkg, quietly = TRUE)) & + isFALSE(dep_check[["save_Plot"]])){ + p <- SCpubr::do_DimPlot(sample) + p.heatmap <- SCpubr::do_CorrelationPlot(sample) + data <- p.heatmap@ht_list$`Pearson coef.`@matrix + p.pheatmap <- pheatmap::pheatmap(data) + 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_LigandReceptorPlot.R b/tests/testthat/test-do_LigandReceptorPlot.R new file mode 100644 index 0000000..d754907 --- /dev/null +++ b/tests/testthat/test-do_LigandReceptorPlot.R @@ -0,0 +1,265 @@ +if(isFALSE(dep_check[["do_LigandReceptorPlot"]])){ + testthat::test_that("do_LigandReceptorPlot: CRAN essentials", { + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - from output", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = FALSE, plot.grid = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = FALSE, plot.grid = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = TRUE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = TRUE, keep_source = c("0", "3", "5"), keep_target = c("0", "2", "4")) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + dot_border = FALSE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + flip = TRUE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + rotate_strip_text = TRUE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + rotate_strip_text = TRUE, + flip = TRUE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + rotate_strip_text = TRUE, + flip = TRUE, + dot_border = FALSE, + add_missing_LR_combinations = 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, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - legend.type", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "normal", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "colorbar", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "colorsteps", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "colorsteps", + dot_border = FALSE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "normal", + dot_border = FALSE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "colorbar", + dot_border = FALSE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "colorsteps", + add_missing_LR_combinations = 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", + dot_border = FALSE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "receptor.complex", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "ligand.complex", + flip = TRUE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "receptor.complex", + flip = TRUE) + 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, + rotate_x_axis_labels = 0, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + rotate_x_axis_labels = 45, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + rotate_x_axis_labels = 90, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - from output flip", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + flip = TRUE, + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - from output different keep", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + keep_source = "0", + keep_target = "0", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + keep_source = "0", + keep_target = "0", + flip = TRUE, + add_missing_LR_combinations = 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, + flip = TRUE, + legend.position = "bottom", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + flip = TRUE, + legend.position = "right", + add_missing_LR_combinations = FALSE) + testthat::expect_type(p, "list") + }) + + + testthat::test_that("do_LigandReceptorPlot: PASS - arrange interactions", { + testthat::skip_on_cran() + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + arrange_interactions_by = "aggregate_rank") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + arrange_interactions_by = "specificity") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + arrange_interactions_by = "magnitude") + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + arrange_interactions_by = "both") + 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) + testthat::expect_type(p, "list") + + p <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + top_interactions = 50, + sort_interactions_alphabetically = 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", + add_missing_LR_combinations = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.type = "wrong", + add_missing_LR_combinations = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + rotate_x_axis_labels = 10, + add_missing_LR_combinations = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + font.type = "wrong", + add_missing_LR_combinations = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + legend.position = "wrong", + add_missing_LR_combinations = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + grid.type = "wrong", + add_missing_LR_combinations = FALSE)}) + + testthat::expect_error({SCpubr::do_LigandReceptorPlot(liana_output = liana_output, + split.by = "wrong", + add_missing_LR_combinations = FALSE)}) + + }) + + testthat::test_that("do_LigandReceptorPlot: PASS - chord diagrams", { + testthat::skip_on_cran() + out <- SCpubr::do_LigandReceptorPlot(liana_output = liana_output, add_missing_LR_combinations = FALSE, compute_ChordDiagrams = TRUE) + testthat::expect_type(out, "list") + testthat::expect_length(out, 3) + testthat::expect_s3_class(out$dotplot, c("gg", "ggplot")) + testthat::expect_s3_class(out$chord_total_interactions, c("recordedplot")) + testthat::expect_s3_class(out$chord_ligand_receptor, c("recordedplot")) + }) +} + diff --git a/tests/testthat/test-do_SankeyPlot.R b/tests/testthat/test-do_SankeyPlot.R new file mode 100644 index 0000000..8c87262 --- /dev/null +++ b/tests/testthat/test-do_SankeyPlot.R @@ -0,0 +1,177 @@ +if(isFALSE(dep_check[["do_SankeyPlot"]])){ + testthat::test_that("do_SankeyPlot: CRAN essentials", { + + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident") + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_SankeyPlot: PASS - default", { + testthat::skip_on_cran() + + + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident") + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_SankeyPlot: PASS - test colors when colors.use is null", { + testthat::skip_on_cran() + sample$first_group <- as.character(sample$orig.ident) + sample$middle_group <- as.character(sample$orig.ident) + sample$middle_group2 <- as.character(ifelse(sample$seurat_clusters %in% c("0"), "A", "B")) + sample$last_group <- as.character(sample$orig.ident) + sample$first_group_factor <- factor(sample$orig.ident) + sample$middle_group_factor <- factor(sample$orig.ident) + sample$middle_group2_factor <- factor(ifelse(sample$seurat_clusters %in% c("0"), "A", "B")) + sample$last_group_factor <- factor(sample$orig.ident) + + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group", + middle_groups = "middle_group", + last_group = "last_group") + testthat::expect_type(p, "list") + + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group", + middle_groups = "middle_group", + last_group = "last_group", + colors.middle = c("Cell" = "red")) + testthat::expect_type(p, "list") + + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group", + middle_groups = "middle_group", + last_group = "last_group", + colors.middle = c("Cell?" = "red"))}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group", + middle_groups = "middle_group2", + last_group = "last_group", + colors.middle = c("A" = "red"))}) + + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group_factor", + middle_groups = "middle_group_factor", + last_group = "last_group_factor") + testthat::expect_type(p, "list") + + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group_factor", + middle_groups = "middle_group_factor", + last_group = "last_group_factor", + colors.middle = c("Cell" = "red")) + testthat::expect_type(p, "list") + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group_factor", + middle_groups = "middle_group_factor", + last_group = "last_group_factor", + colors.middle = c("Cell?" = "red"))}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "first_group_factor", + middle_groups = "middle_group2_factor", + last_group = "last_group_factor", + colors.middle = c("A" = "red"))}) + }) + + testthat::test_that("do_SankeyPlot: PASS - middle_groups", { + testthat::skip_on_cran() + + + sample$middle_group <- sample$seurat_clusters + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + middle_group = "middle_group") + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_SankeyPlot: PASS - hjust", { + + testthat::skip_on_cran() + + sample$middle_group <- sample$seurat_clusters + p <- SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + hjust = 0.5) + testthat::expect_type(p, "list") + }) + + testthat::test_that("do_SankeyPlot: FAILS", { + testthat::skip_on_cran() + + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + type = "wrong")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + position = "wrong")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "wrong", + last_group = "orig.ident")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "nCount_RNA", + last_group = "orig.ident")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + last_group = "wrong", + first_group = "orig.ident")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + last_group = "nCount_RNA", + first_group = "orig.ident")}) + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + last_group = "seurat_clusters", + middle_groups = "wrong", + first_group = "orig.ident")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + last_group = "seurat_clusters", + middle_groups = "nCount_RNA", + first_group = "orig.ident")}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + colors.first = c("A" = "red"))}) + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + colors.first = c("0" = "red"))}) + + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + middle_groups = "middle_group", + last_group = "orig.ident", + colors.middle = c("A" = "red"))}) + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + middle_groups = "middle_group", + last_group = "orig.ident", + colors.middle = c("0" = "red"))}) + sample$orig.ident <- ifelse(sample$seurat_clusters == "0", "C", "B") + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + colors.last = c("A" = "red"))}) + testthat::expect_error({SCpubr::do_SankeyPlot(sample = sample, + first_group = "seurat_clusters", + last_group = "orig.ident", + colors.last = c("B" = "red"))}) + }) +} + + diff --git a/tests/testthat/test-save_Plot.R b/tests/testthat/test-save_Plot.R new file mode 100644 index 0000000..2ad4938 --- /dev/null +++ b/tests/testthat/test-save_Plot.R @@ -0,0 +1,222 @@ +if(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) + +} +