diff --git a/.gitignore b/.gitignore index de3794a3..ce4ab9cd 100644 --- a/.gitignore +++ b/.gitignore @@ -10,4 +10,4 @@ renv/ renv.lock .Rprofile .idea - +*.Rproj diff --git a/DESCRIPTION b/DESCRIPTION index 264f1c3e..27a1597a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: miaViz Title: Microbiome Analysis Plotting and Visualization -Version: 1.15.4 +Version: 1.15.5 Authors@R: c(person(given = "Tuomas", family = "Borman", role = c("aut", "cre"), email = "tuomas.v.borman@utu.fi", @@ -47,8 +47,6 @@ Imports: dplyr, ggnewscale, ggrepel, - ggplot2, - ggraph, ggtree, methods, rlang, @@ -79,3 +77,6 @@ Remotes: Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.2 VignetteBuilder: knitr +URL: https://github.com/microbiome/miaViz +BugReports: https://github.com/microbiome/miaViz/issues + diff --git a/NAMESPACE b/NAMESPACE index 12132f47..21273c9f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -58,9 +58,13 @@ importFrom(BiocParallel,bpstop) importFrom(DelayedArray,rowMeans) importFrom(DelayedArray,rowSums) importFrom(DirichletMultinomial,mixture) +importFrom(S4Vectors,SimpleList) importFrom(S4Vectors,metadata) +importFrom(S4Vectors,unfactor) importFrom(SingleCellExperiment,reducedDim) importFrom(SingleCellExperiment,reducedDimNames) +importFrom(SingleCellExperiment,reducedDims) +importFrom(SummarizedExperiment,"rowData<-") importFrom(SummarizedExperiment,assay) importFrom(SummarizedExperiment,colData) importFrom(SummarizedExperiment,rowData) @@ -69,6 +73,7 @@ importFrom(ape,drop.tip) importFrom(ape,keep.tip) importFrom(ape,rotateConstr) importFrom(dplyr,"%>%") +importFrom(dplyr,across) importFrom(dplyr,all_of) importFrom(dplyr,arrange) importFrom(dplyr,bind_cols) diff --git a/R/AllGenerics.R b/R/AllGenerics.R new file mode 100644 index 00000000..b8195c87 --- /dev/null +++ b/R/AllGenerics.R @@ -0,0 +1,131 @@ +# All generic methods are listed here + +#' @rdname getNeatOrder +setGeneric("getNeatOrder", signature = c("x"), + function(x, centering = "mean", ...) + standardGeneric("getNeatOrder")) + +#' @rdname plotAbundance +setGeneric("plotAbundance", signature = c("x"), function(x, ...) + standardGeneric("plotAbundance")) + +#' @rdname plotAbundanceDensity +#' @export +setGeneric("plotAbundanceDensity", signature = c("x"), function(x, ...) + standardGeneric("plotAbundanceDensity")) + +#' @rdname plotCCA +#' @aliases plotRDA +#' @export +setGeneric("plotCCA", signature = c("x"), function(x, ...) + standardGeneric("plotCCA")) + +#' @rdname plotCCA +#' @aliases plotCCA +#' @export +setGeneric("plotRDA", signature = c("x"), function(x, ...) + standardGeneric("plotRDA")) + +#' @rdname plotColTile +#' @export +setGeneric("plotColTile", signature = c("object"), + function(object, x, y, ...) + standardGeneric("plotColTile")) + +#' @rdname plotColTile +#' @export +setGeneric("plotRowTile", signature = c("object"), + function(object, x, y, ...) + standardGeneric("plotRowTile")) + +#' @rdname plotDMN +#' @export +setGeneric("plotDMNFit", signature = "x", + function(x, name = "DMN", type = c("laplace","AIC","BIC"), ...) + standardGeneric("plotDMNFit")) + +#' @rdname plotGraph +#' @export +setGeneric("plotColGraph", signature = c("x","y"), + function(x, y, ...) + standardGeneric("plotColGraph")) + +#' @rdname plotGraph +#' @export +setGeneric("plotRowGraph", signature = c("x","y"), + function(x, y, ...) + standardGeneric("plotRowGraph")) + +#' @rdname plotLoadings +setGeneric("plotLoadings", signature = c("x"), + function(x, ...) + standardGeneric("plotLoadings")) + +#' @rdname plotPrevalence +#' @export +setGeneric("plotRowPrevalence", signature = c("x"), + function(x, ...) + standardGeneric("plotRowPrevalence")) + +#' @rdname plotPrevalence +#' @export +setGeneric("plotPrevalentAbundance", signature = c("x"), + function(x, ...) + standardGeneric("plotPrevalentAbundance")) + +#' @rdname plotPrevalence +#' @export +setGeneric("plotPrevalence", signature = c("x"), + function(x, ...) + standardGeneric("plotPrevalence")) + +#' @rdname plotScree +#' @export +setGeneric("plotScree", signature = c("x"), + function(x, ...) + standardGeneric("plotScree")) + +#' @rdname plotSeries +#' @export +setGeneric("plotSeries", signature = c("object"), + function(object, ...) + standardGeneric("plotSeries")) + +#' @rdname plotTree +setGeneric("plotRowTree", signature = c("x"), + function(x, ...) + standardGeneric("plotRowTree")) +#' @rdname plotTree +setGeneric("plotColTree", signature = c("x"), + function(x, ...) + standardGeneric("plotColTree")) + +#' @rdname treeData +setGeneric("rowTreeData", signature = c("x"), + function(x, ...) + standardGeneric("rowTreeData")) + +#' @rdname treeData +setGeneric("colTreeData", signature = c("x"), + function(x, ...) + standardGeneric("colTreeData")) + +#' @rdname treeData +setGeneric("rowTreeData<-", signature = c("x"), + function(x, tree.name = tree_name, tree_name = "phylo", value) + standardGeneric("rowTreeData<-")) + +#' @rdname treeData +setGeneric("colTreeData<-", signature = c("x"), + function(x, tree.name = tree_name, tree_name = "phylo", value) + standardGeneric("colTreeData<-")) + +#' @rdname treeData +setGeneric("combineTreeData", signature = c("x"), + function(x, other.fields = other_fields, other_fields = list()) + standardGeneric("combineTreeData")) + +#' @rdname treeData +setGeneric("combineTreeData", signature = c("x"), + function(x, other.fields = other_fields, other_fields = list()) + standardGeneric("combineTreeData")) diff --git a/R/deprecate.R b/R/deprecate.R new file mode 100644 index 00000000..caa6b2e4 --- /dev/null +++ b/R/deprecate.R @@ -0,0 +1,42 @@ +#' These functions will be deprecated. Please use other functions instead. +#' +#' @param x - +#' +#' @param ... - +#' +#' @name deprecate +NULL + +#' @rdname deprecate +#' @export +setGeneric("plotTaxaPrevalence", signature = c("x"), + function(x, ...) + standardGeneric("plotTaxaPrevalence")) + +#' @rdname deprecate +#' @export +setMethod("plotTaxaPrevalence", signature = c(x = "ANY"), function(x, ...){ + .Deprecated( + old ="plotTaxaPrevalence", new = "plotRowPrevalence", + msg = paste0("The 'plotTaxaPrevalence' function is ", + "deprecated. Use 'plotRowPrevalence' instead.")) + plotRowPrevalence(x, ...) + } +) + +#' @rdname deprecate +#' @export +setGeneric("plotFeaturePrevalence", signature = c("x"), + function(x, ...) + standardGeneric("plotFeaturePrevalence")) + +#' @rdname deprecate +#' @export +setMethod("plotFeaturePrevalence", signature = c(x = "ANY"), function(x, ...){ + .Deprecated( + old ="plotFeaturePrevalence", new = "plotRowPrevalence", + msg = paste0("The 'plotFeaturePrevalence' function is ", + "deprecated. Use 'plotRowPrevalence' instead.")) + plotRowPrevalence(x, ...) + } +) diff --git a/R/getNeatOrder.R b/R/getNeatOrder.R index 226aac9d..111d1f14 100644 --- a/R/getNeatOrder.R +++ b/R/getNeatOrder.R @@ -1,50 +1,51 @@ #' Sorting by radial theta angle -#' +#' #' @description \code{getNeatOrder} sorts already ordinated data by the radial #' theta angle. This method is useful for organizing data points based on their #' angular position in a 2D space, typically after an ordination technique such -#' as PCA or NMDS has been applied. -#' -#' The function takes in a matrix of ordinated data, optionally +#' as PCA or NMDS has been applied. +#' +#' The function takes in a matrix of ordinated data, optionally #' centers the data using specified methods (\code{mean}, \code{median}, or #' \code{NULL}), and then calculates the angle (theta) for each point relative #' to the centroid. The data points are then sorted based on these theta values -#' in ascending order. -#' -#' One significant application of this sorting method is in plotting heatmaps. +#' in ascending order. +#' +#' One significant application of this sorting method is in plotting heatmaps. #' By using radial theta sorting, the relationships between data points can be #' preserved according to the ordination method's spatial configuration, rather #' than relying on hierarchical clustering, which may distort these #' relationships. This approach allows for a more faithful representation of the #' data's intrinsic structure as captured by the ordination process. -#' +#' #' @param x A matrix containing the ordinated data to be sorted. Columns should #' represent the principal components (PCs) and rows should represent the #' entities being analyzed (e.g. features or samples). There should be 2 columns #' only representing 2 PCs. -#' +#' #' @param centering \code{Character scalar}. Specifies the method to #' center the data. Options are \code{"mean"}, \code{"median"}, or \code{NULL} #' if your data is already centered. (Default: \code{"mean"}) -#' +#' #' @param ... Additional arguments passed to other methods. #' #' @return A \code{character} vector of row indices in the sorted order. -#' -#' @details +#' +#' @details #' It's important to note that the #' [\pkg{sechm}](https://bioconductor.org/packages/3.18/bioc/vignettes/sechm/inst/doc/sechm.html#row-ordering) #' package does actually have the functionality for plotting a heatmap using -#' this radial theta angle ordering, though only by using an MDS ordination. -#' +#' this radial theta angle ordering, though only by using an MDS ordination. +#' #' That being said, the \code{getNeatOrder} function is more modular and #' separate to the plotting, and can be applied to any kind of ordinated data #' which can be valuable depending on the use case. -#' -#' [Rajaram & Oono (2010) NeatMap - non-clustering heat map alternatives in R](https://doi.org/10.1186/1471-2105-11-45) outlines this in more detail. -#' +#' +#' [Rajaram & Oono (2010) NeatMap - non-clustering heat map alternatives in R](https://doi.org/10.1186/1471-2105-11-45) +#' outlines this in more detail. +#' #' @name getNeatOrder -#' +#' #' @examples #' # Load the required libraries and dataset #' library(mia) @@ -52,30 +53,30 @@ #' library(ComplexHeatmap) #' library(circlize) #' data(peerj13075) -#' +#' #' # Group data by taxonomic order #' tse <- agglomerateByRank(peerj13075, rank = "order", onRankOnly = TRUE) -#' +#' #' # Transform the samples into relative abundances using CLR #' tse <- transformAssay( #' tse, assay.type = "counts", method="clr", MARGIN = "cols", #' name="clr", pseudocount = TRUE) -#' +#' #' # Transform the features (taxa) into zero mean, unit variance #' # (standardize transformation) #' tse <- transformAssay( #' tse, assay.type="clr", method="standardize", MARGIN = "rows") -#' +#' #' # Perform PCA using calculatePCA #' res <- calculatePCA(tse, assay.type = "standardize", ncomponents = 10) -#' +#' #' # Sort by radial theta and sort the original assay data #' sorted_order <- getNeatOrder(res[, c(1,2)], centering = "mean") #' tse <- tse[, sorted_order] -#' +#' #' # Define the color function and cap the colors at [-5, 5] #' col_fun <- colorRamp2(c(-5, 0, 5), c("blue", "white", "red")) -#' +#' #' # Create the heatmap #' heatmap <- Heatmap(assay(tse, "standardize"), #' name = "NeatMap", @@ -84,20 +85,14 @@ #' cluster_columns = FALSE, # Do not cluster columns #' show_row_dend = FALSE, #' show_column_dend = FALSE, -#' row_names_gp = gpar(fontsize = 4), -#' column_names_gp = gpar(fontsize = 6), -#' heatmap_width = unit(20, "cm"), -#' heatmap_height = unit(15, "cm") +#' row_names_gp = gpar(fontsize = 4), +#' column_names_gp = gpar(fontsize = 6), +#' heatmap_width = unit(20, "cm"), +#' heatmap_height = unit(15, "cm") #' ) -#' +#' NULL -#' @rdname getNeatOrder -setGeneric("getNeatOrder", signature = c("x"), - function(x, centering = "mean", ...) - standardGeneric("getNeatOrder")) - - # Implementation for taking in a raw matrix. #' @rdname getNeatOrder #' @export @@ -147,7 +142,7 @@ setMethod("getNeatOrder", signature = c("matrix"), center_fun <- switch(centering, "median" = median, "mean" = mean) center_vals <- apply(data, 2, center_fun) data <- scale(data, center = center_vals, scale = FALSE) - } + } # Compute the radial theta values using the centered data theta <- atan2(data[, 2], data[, 1]) # Set the names of theta values to the row names of the centered data and diff --git a/R/plotAbundance.R b/R/plotAbundance.R index 6cfe8d93..66290806 100644 --- a/R/plotAbundance.R +++ b/R/plotAbundance.R @@ -158,10 +158,6 @@ #' order.row.by="abund", order.col.by = "Bacteroidetes") NULL -#' @rdname plotAbundance -setGeneric("plotAbundance", signature = c("x"), function(x, ...) - standardGeneric("plotAbundance")) - #' @rdname plotAbundance #' @importFrom ggplot2 facet_wrap #' @export @@ -298,11 +294,13 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"), function( # This function ensures that all the time points have all the patients so that # comparison is possible. #' @importFrom dplyr group_by summarize pull select distinct mutate -#' row_number ungroup +#' row_number ungroup across #' @importFrom tidyr complete .add_paired_samples <- function( df, paired = FALSE, order.col.by = order_sample_by, order_sample_by = NULL, col.var = features, features = NULL, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + colour_by <- count <- X <- NULL # if(!.is_a_bool(paired)){ stop("'paired' must be TRUE or FALSE.", call. = FALSE) @@ -362,10 +360,13 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"), function( # This function modifies factor of rows/features to follow the user-specified # order. #' @importFrom dplyr group_by summarise arrange desc distinct pull +#' @importFrom S4Vectors unfactor .order_abundance_rows <- function( df, order.row.by = order_rank_by, order_rank_by = "name", row.levels = NULL, order.col.by = order_sample_by, order_sample_by = NULL, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + colour_by <- Y <- mean_abundance <- NULL # correct <- .is_a_string(order.row.by) && order.row.by %in% c("name", "abund", "revabund") @@ -420,6 +421,8 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"), function( .order_abundance_cols <- function( df, order.col.by = order_sample_by, order_sample_by = NULL, col.levels = NULL, decreasing = TRUE, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + X <- Y <- colour_by <- NULL # The ordering factor must be found from colData or be one of the rows is_coldata <- .is_a_string(order.col.by) && order.col.by %in% colnames(df) is_feat <- .is_a_string(order.col.by) && order.col.by %in% df$colour_by @@ -494,6 +497,8 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"), function( use_relative = FALSE, ... ){ + # To disable "no visible binding for global variable" message in cmdcheck + X <- Y <- NULL # Start plotting. From barplot, we exclude 0 values. As we use borders by # default, 0 values get also borders which looks like they have also # abundance. @@ -555,6 +560,8 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"), function( facet.cols = FALSE, facet.rows = one.facet, one.facet = one_facet, one_facet = FALSE, ncol = 2, scales = "fixed", ...){ + # To disable "no visible binding for global variable" message in cmdcheck + X <- NULL # if( !(is.null(col.var) || (is.character(col.var) && all(col.var %in% colnames(df)))) ){ @@ -679,6 +686,8 @@ setMethod("plotAbundance", signature = c("SummarizedExperiment"), function( add_x_text, point_alpha, point_size){ + # To disable "no visible binding for global variable" message in cmdcheck + X <- Y <- NULL # If the values are factors, use coloring to plot them. This step is to # ensure that this functions works both with factors and numeric values. if( is.factor(feature_data$Y) ){ diff --git a/R/plotAbundanceDensity.R b/R/plotAbundanceDensity.R index b97e9c3e..47b518b5 100644 --- a/R/plotAbundanceDensity.R +++ b/R/plotAbundanceDensity.R @@ -1,83 +1,89 @@ #' Plot abundance density #' -#' This function plots abundance of the most abundant taxa. -#' +#' This function plots abundance of the most abundant taxa. +#' #' @inheritParams plotAbundance #' #' @param layout \code{Character scalar}. Selects the layout of the plot. #' There are three different options: \code{jitter}, \code{density}, and #' \code{point} plot. (default: \code{layout = "jitter"}) -#' -#' @param n \code{Integer scalar}. Specifies the number of the most abundant taxa -#' to show. (Default: \code{min(nrow(x), 25L)}) -#' +#' +#' @param n \code{Integer scalar}. Specifies the number of the most abundant +#' taxa to show. (Default: \code{min(nrow(x), 25L)}) +#' #' @param colour.by \code{Character scalar}. Defines a column from #' \code{colData}, that is used to color plot. Must be a value of #' \code{colData()} function. (Default: \code{NULL}) -#' +#' #' @param colour_by Deprecated. Use \code{colour.by} instead. -#' +#' #' @param shape.by \code{Character scalar}. Defines a column from #' \code{colData}, that is used to group observations to different point shape #' groups. Must be a value of \code{colData()} function. \code{shape.by} is #' disabled when \code{layout = "density"}. (Default: \code{NULL}) -#' +#' #' @param shape_by Deprecated. Use \code{shape.by} instead. -#' +#' #' @param size.by \code{Character scalar}. Defines a column from #' \code{colData}, that is used to group observations to different point size #' groups. Must be a value of \code{colData()} function. \code{size.by} is #' disabled when \code{layout = "density"}. (Default: \code{NULL}) -#' +#' #' @param size_by Deprecated. Use \code{size.by} instead. -#' -#' @param decreasing \code{Logical scalar}. Indicates whether the results should be ordered -#' in a descending order or not. If \code{NA} is given the order +#' +#' @param decreasing \code{Logical scalar}. Indicates whether the results should +#' be ordered in a descending order or not. If \code{NA} is given the order #' as found in \code{x} for the \code{n} most abundant taxa is used. #' (Default: \code{TRUE}) -#' +#' #' @param order_descending Deprecated. Use \code{order.descending} instead. -#' -#' @param ... additional parameters for plotting. +#' +#' @param ... additional parameters for plotting. #' \itemize{ -#' \item \code{xlab} \code{Character scalar}. Selects the x-axis label. +#' \item \code{xlab} \code{Character scalar}. Selects the x-axis label. #' (Default: \code{assay.type}) -#' -#' \item \code{ylab} \code{Character scalar}. Selects the y-axis label. -#' \code{ylab} is disabled when \code{layout = "density"}. +#' +#' \item \code{ylab} \code{Character scalar}. Selects the y-axis label. +#' \code{ylab} is disabled when \code{layout = "density"}. #' (Default: \code{"Taxa"}) -#' -#' \item \code{point.alpha} \code{Numeric scalar}. From range 0 to 1. Selects the transparency of +#' +#' \item \code{point.alpha} \code{Numeric scalar}. From range 0 to 1. Selects +#' the transparency of #' colour in \code{jitter} and \code{point} plot. (Default: \code{0.6}) -#' -#' \item \code{point.shape} \code{Positive integer scalar}. Value selecting the shape of point in +#' +#' \item \code{point.shape} \code{Positive integer scalar}. Value selecting +#' the shape of point in #' \code{jitter} and \code{point} plot. (Default: \code{21}) -#' -#' \item \code{point.size} \code{Positive integer scalar}. Selects the size of point in +#' +#' \item \code{point.size} \code{Positive integer scalar}. Selects the size of +#' point in #' \code{jitter} and \code{point} plot. (Default: \code{2}) -#' -#' \item \code{add_legend} \code{Logical scalar}. Determines if legend is added. -#' (Default: \code{TRUE}) -#' -#' \item \code{flipped}: \code{Logical scalar}. Determines if the orientation of plot is changed -#' so that x-axis and y-axis are swapped. (Default: \code{FALSE}) -#' -#' \item \code{add_x_text} \code{Logical scalar}. Determines if text that represents values is included -#' in x-axis. (Default: \code{TRUE}) +#' +#' \item \code{add_legend} \code{Logical scalar}. Determines if legend is +#' added. (Default: \code{TRUE}) +#' +#' \item \code{flipped}: \code{Logical scalar}. Determines if the orientation +#' of plot is changed so that x-axis and y-axis are swapped. +#' (Default: \code{FALSE}) +#' +#' \item \code{add_x_text} \code{Logical scalar}. Determines if text that +#' represents values is included in x-axis. (Default: \code{TRUE}) #' } -#' See \code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")} +#' See \code{\link{mia-plot-args}} for more details i.e. call +#' \code{help("mia-plot-args")} #' #' @details -#' This function plots abundance of the most abundant taxa. Abundance can be plotted as -#' a jitter plot, a density plot, or a point plot. By default, x-axis represents abundance -#' and y-axis taxa. In a jitter and point plot, each point represents abundance of -#' individual taxa in individual sample. Most common abundances are shown as a higher density. -#' -#' A density plot can be seen as a smoothened bar plot. It visualized distribution of -#' abundances where peaks represent most common abundances. +#' This function plots abundance of the most abundant taxa. Abundance can be +#' plotted as a jitter plot, a density plot, or a point plot. By default, x-axis +#' represents abundance and y-axis taxa. In a jitter and point plot, each point +#' represents abundance of individual taxa in individual sample. Most common +#' abundances are shown as a higher density. +#' +#' A density plot can be seen as a smoothened bar plot. It visualized +#' distribution of abundances where peaks represent most common abundances. #' -#' @return -#' A \code{ggplot2} object +#' @return +#' A \code{ggplot2} object #' #' @name plotAbundanceDensity #' @@ -89,39 +95,41 @@ #' @examples #' data("peerj13075", package = "mia") #' tse <- peerj13075 -#' -#' # Plots the abundances of 25 most abundant taxa. Jitter plot is the default option. +#' +#' # Plots the abundances of 25 most abundant taxa. Jitter plot is the default +#' # option. #' plotAbundanceDensity(tse, assay.type = "counts") -#' +#' #' # Counts relative abundances #' tse <- transformAssay(tse, method = "relabundance") -#' -#' # Plots the relative abundance of 10 most abundant taxa. -#' # "nationality" information is used to color the points. X-axis is log-scaled. +#' +#' # Plots the relative abundance of 10 most abundant taxa. +#' # "nationality" information is used to color the points. X-axis is +#' # log-scaled. #' plotAbundanceDensity( #' tse, layout = "jitter", assay.type = "relabundance", n = 10, #' colour.by = "Geographical_location") + -#' scale_x_log10() -#' +#' scale_x_log10() +#' #' # Plots the relative abundance of 10 most abundant taxa as a density plot. #' # X-axis is log-scaled #' plotAbundanceDensity( #' tse, layout = "density", assay.type = "relabundance", n = 10 ) + #' scale_x_log10() -#' +#' #' # Plots the relative abundance of 10 most abundant taxa as a point plot. #' # Point shape is changed from default (21) to 41. #' plotAbundanceDensity( #' tse, layout = "point", assay.type = "relabundance", n = 10, #' point.shape = 41) -#' +#' #' # Plots the relative abundance of 10 most abundant taxa as a point plot. -#' # In addition to colour, groups can be visualized by size and shape in point plots, -#' # and adjusted for point size +#' # In addition to colour, groups can be visualized by size and shape in point +#' # plots, and adjusted for point size #' plotAbundanceDensity( #' tse, layout = "point", assay.type = "relabundance", n = 10, #' shape.by = "Geographical_location", size.by = "Age", point.size=1) -#' +#' #' # Ordering via decreasing #' plotAbundanceDensity( #' tse, assay.type = "relabundance", decreasing = FALSE) @@ -130,103 +138,95 @@ #' # to your wishes #' plotAbundanceDensity( #' tse, assay.type = "relabundance", decreasing = NA) -#' -#' # Box plots and violin plots are supported by scater::plotExpression. +#' +#' # Box plots and violin plots are supported by scater::plotExpression. #' # Plots the relative abundance of 5 most abundant taxa as a violin plot. #' library(scater) #' top <- getTop(tse, top = 5) -#' plotExpression(tse, features = top, assay.type = "relabundance") + ggplot2::coord_flip() -#' +#' plotExpression(tse, features = top, assay.type = "relabundance") + +#' ggplot2::coord_flip() +#' #' # Plots the relative abundance of 5 most abundant taxa as a box plot. -#' plotExpression(tse, features = top, assay.type = "relabundance", +#' plotExpression(tse, features = top, assay.type = "relabundance", #' show_violin = FALSE, show_box = TRUE) + ggplot2::coord_flip() #' NULL -#' @rdname plotAbundanceDensity -#' @export -setGeneric("plotAbundanceDensity", signature = c("x"), - function(x, ...) - standardGeneric("plotAbundanceDensity")) - #' @rdname plotAbundanceDensity #' @export setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), - function(x, - layout = c("jitter", "density", "point"), - assay.type = assay_name, assay_name = "counts", - n = min(nrow(x), 25L), colour.by = colour_by, - colour_by = NULL, - shape.by = shape_by, - shape_by = NULL, - size.by = size_by, - size_by = NULL, - decreasing = order_descending, - order_descending = TRUE, - ...){ - ############################# Input Check ############################## - # Check layout - layout <- match.arg(layout, c("jitter", "density", "point")) - # Checks assay.type - .check_assay_present(assay.type, x) - # Checks n - if( !(length(n)==1 && is.numeric(n) && n%%1==0 && n>0) ){ - stop("'n' must be a positive integer.", call. = FALSE) - } - # Checks colour.by - if( !is.null(colour.by) && !.is_a_string(colour.by)){ - stop("'colour.by' must be a single character value.", - call. = FALSE) - } - # Checks shape.by - if( !is.null(shape.by) && !.is_a_string(shape.by)){ - stop("'shape.by' must be a single character value.", - call. = FALSE) - } - # Checks shape.by - if( !is.null(shape.by) && !.is_a_string(shape.by)){ - stop("'shape.by' must be a single character value.", - call. = FALSE) - } - # Checks decreasing - if( !is.na(decreasing) && !.is_a_bool(decreasing)){ - stop("'decreasing' must be TRUE, FALSE or NA.", - call. = FALSE) - } - ########################### Input Check end ############################ - # Gets data that will be plotted. Gets a list - density_data_list <- .incorporate_density_data(object = x, - assay.type = assay.type, - n = n, - colour_by = colour.by, - shape_by = shape.by, - size_by = size.by, - order_descending = decreasing) - # Extracts the density data and aesthetic from the list - density_data <- density_data_list$density_data - colour_by <- density_data_list$colour_by - shape_by <- density_data_list$shape_by - size_by <- density_data_list$size_by - - # Gets the plot from plotter - plot_out <- .density_plotter(density_data = density_data, - layout = layout, - xlab = assay.type, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by, - ...) - return(plot_out) - } + function( + x, + layout = c("jitter", "density", "point"), + assay.type = assay_name, assay_name = "counts", + n = min(nrow(x), 25L), colour.by = colour_by, + colour_by = NULL, + shape.by = shape_by, + shape_by = NULL, + size.by = size_by, + size_by = NULL, + decreasing = order_descending, + order_descending = TRUE, + ...){ + ############################# Input Check ############################## + # Check layout + layout <- match.arg(layout, c("jitter", "density", "point")) + # Checks assay.type + .check_assay_present(assay.type, x) + # Checks n + if( !(length(n)==1 && is.numeric(n) && n%%1==0 && n>0) ){ + stop("'n' must be a positive integer.", call. = FALSE) + } + # Checks colour.by + if( !is.null(colour.by) && !.is_a_string(colour.by)){ + stop("'colour.by' must be a single character value.", call. = FALSE) + } + # Checks shape.by + if( !is.null(shape.by) && !.is_a_string(shape.by)){ + stop("'shape.by' must be a single character value.", call. = FALSE) + } + # Checks shape.by + if( !is.null(shape.by) && !.is_a_string(shape.by)){ + stop("'shape.by' must be a single character value.", call. = FALSE) + } + # Checks decreasing + if( !is.na(decreasing) && !.is_a_bool(decreasing)){ + stop("'decreasing' must be TRUE, FALSE or NA.", call. = FALSE) + } + ########################### Input Check end ############################ + # Gets data that will be plotted. Gets a list + density_data_list <- .incorporate_density_data( + object = x, + assay.type = assay.type, + n = n, + colour_by = colour.by, + shape_by = shape.by, + size_by = size.by, + order_descending = decreasing) + # Extracts the density data and aesthetic from the list + density_data <- density_data_list$density_data + colour_by <- density_data_list$colour_by + shape_by <- density_data_list$shape_by + size_by <- density_data_list$size_by + + # Gets the plot from plotter + plot_out <- .density_plotter( + density_data = density_data, + layout = layout, + xlab = assay.type, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by, + ...) + return(plot_out) + } ) ################################ HELP FUNCTIONS ################################ -.incorporate_density_data <- function(object, assay.type, n, - colour_by, - shape_by, - size_by, - order_descending = TRUE){ +.incorporate_density_data <- function( + object, assay.type, n, colour_by, shape_by, size_by, + order_descending = TRUE){ # Gets the assay mat <- assay(object, assay.type, withDimnames = TRUE) # Gets the most abundant taxa @@ -240,7 +240,7 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), # melt the data density_data <- t(mat) %>% as.data.frame() %>% - rownames_to_column("Sample") + rownames_to_column("Sample") # Gets coloring information if 'colour_by' is not NULL if (!is.null(colour_by)) { # Gets information from colData @@ -266,8 +266,8 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), cols <- cols[cols %in% colnames(density_data)] density_data <- density_data %>% pivot_longer(cols = !cols, names_to = "Y", values_to = "X") - # Converts taxa to factor. Order of levels is the opposite than in 'top_taxa' - # so that taxa with highest abundance is on top + # Converts taxa to factor. Order of levels is the opposite than in + # 'top_taxa' so that taxa with highest abundance is on top if(is.na(order_descending)){ lvls <- rownames(object[rownames(object) %in% top_taxa,]) } else if(order_descending) { @@ -276,14 +276,16 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), lvls <- top_taxa } density_data$Y <- factor( density_data$Y, lvls ) - return(list(density_data = density_data, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by)) + res <- list( + density_data = density_data, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by) + return(res) } .density_plotter <- function( - density_data, + density_data, layout, add_legend = TRUE, xlab, @@ -310,13 +312,13 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), ylab(ylab) # Layout can be "density", "jitter", or "point" if (layout == "density"){ - plot_out$data$Y <- factor(plot_out$data$Y, - levels = rev(levels(plot_out$data$Y)) ) - point_args <- .get_density_args(colour_by, - alpha = point_alpha) + plot_out$data$Y <- factor( + plot_out$data$Y, levels = rev(levels(plot_out$data$Y)) ) + point_args <- .get_density_args(colour_by, alpha = point_alpha) # density specific options for flipping - grid_args <- list(switch = ifelse(flipped, "x", "y"), - scales = ifelse(scales_free, "free", "fixed")) + grid_args <- list( + switch = ifelse(flipped, "x", "y"), + scales = ifelse(scales_free, "free", "fixed")) if(flipped){ grid_args$cols <- vars(!!sym("Y")) } else { @@ -324,19 +326,20 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), } # plot_out <- plot_out + - do.call(geom_density, point_args$args) + + do.call(geom_density, point_args$args) + do.call(facet_grid, grid_args) shape_by <- NULL size_by <- NULL angle_x_text <- FALSE } else if (layout %in% c("point","jitter")) { - point_args <- .get_point_args(colour_by, - shape_by = shape_by, - size_by = size_by, - alpha = point_alpha, - shape = point_shape, - size = point_size, - colour = point_colour) + point_args <- .get_point_args( + colour_by, + shape_by = shape_by, + size_by = size_by, + alpha = point_alpha, + shape = point_shape, + size = point_size, + colour = point_colour) point_args$args$mapping$y <- sym("Y") if (layout == "point"){ plot_out <- plot_out + @@ -353,17 +356,19 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), } # If colour_by is specified, colours are resolved if (!is.null(colour_by)) { - plot_out <- .resolve_plot_colours(plot_out, - density_data$colour_by, - colour_by, - fill = point_args$fill, - na.translate = FALSE) + plot_out <- .resolve_plot_colours( + plot_out, + density_data$colour_by, + colour_by, + fill = point_args$fill, + na.translate = FALSE) if(layout == "density"){ - plot_out <- .resolve_plot_colours(plot_out, - density_data$colour_by, - colour_by, - fill = !point_args$fill, - na.translate = FALSE) + plot_out <- .resolve_plot_colours( + plot_out, + density_data$colour_by, + colour_by, + fill = !point_args$fill, + na.translate = FALSE) } } # set the theme @@ -375,20 +380,20 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), theme(strip.background = element_blank()) if(flipped){ plot_out <- plot_out + - # Removes label grid, horizontal labels - theme(strip.text.x.bottom = element_text(angle = 90, hjust = 1), - axis.ticks.x = element_blank(), - axis.text.x = element_blank(), # Removes x-axis - axis.title.x = element_blank(), - axis.line.x = element_blank()) # Removes x-axis + # Removes label grid, horizontal labels + theme(strip.text.x.bottom = element_text(angle = 90, hjust = 1), + axis.ticks.x = element_blank(), + axis.text.x = element_blank(), # Removes x-axis + axis.title.x = element_blank(), + axis.line.x = element_blank()) # Removes x-axis } else { plot_out <- plot_out + - # Removes label grid, horizontal labels - theme(strip.text.y.left = element_text(angle = 0, hjust = 1), - axis.ticks.y = element_blank(), - axis.text.y = element_blank(), # Removes y-axis - axis.title.y = element_blank(), - axis.line.y = element_blank()) # Removes y-axis + # Removes label grid, horizontal labels + theme(strip.text.y.left = element_text(angle = 0, hjust = 1), + axis.ticks.y = element_blank(), + axis.text.y = element_blank(), # Removes y-axis + axis.title.y = element_blank(), + axis.line.y = element_blank()) # Removes y-axis } } # add additional guides @@ -396,9 +401,8 @@ setMethod("plotAbundanceDensity", signature = c(x = "SummarizedExperiment"), # add legend plot_out <- .add_legend(plot_out, add_legend) # flip - plot_out <- .flip_plot(plot_out, - flipped = flipped, - add_x_text = TRUE, - angle_x_text = angle_x_text) + plot_out <- .flip_plot( + plot_out, flipped = flipped, add_x_text = TRUE, + angle_x_text = angle_x_text) return(plot_out) -} \ No newline at end of file +} diff --git a/R/plotCCA.R b/R/plotCCA.R index f285ff55..c4babe5d 100644 --- a/R/plotCCA.R +++ b/R/plotCCA.R @@ -8,12 +8,12 @@ #' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} #' or a matrix of weights. The latter is returned as output from #' \code{\link[mia:runCCA]{getRDA}}. -#' +#' #' @param dimred \code{Character scalar} or \code{integer scalar}. Determines #' the reduced dimension to #' plot. This is the output of \code{\link[mia:runCCA]{addRDA}} and resides in #' \code{reducedDim(tse, dimred)}. -#' +#' #' @param ... additional parameters for plotting, inherited from #' \code{\link[scater:plotReducedDim]{plotReducedDim}}, #' \code{\link[ggplot2:geom_label]{geom_label}} and @@ -23,71 +23,71 @@ #' \code{c(TRUE, FALSE, "fill", "colour")}, indicating whether #' ellipses should be present, absent, filled or colored. #' (default: \code{ellipse.fill = TRUE}) -#' +#' #' \item \code{ellipse.alpha}: \code{Numeric scalar}. Between 0 and 1. #' Adjusts the opacity of ellipses. (Default: \code{0.2}) -#' +#' #' \item \code{ellipse.linewidth}: \code{Numeric scalar}. Specifies the size #' of ellipses. (Default: \code{0.1}) -#' +#' #' \item \code{ellipse.linetype}: \code{Integer scalar}. Specifies the style #' of ellipses. (Default: \code{1}) -#' +#' #' \item \code{confidence.level}: \code{Numeric scalar}. Between 0 and 1. #' Adjusts confidence level. (Default: \code{0.95}) -#' +#' #' \item \code{add.vectors}: \code{Logical scalar} or \code{character vector}. #' If boolean, should vectors appear in the plot. If character, #' selects vectors that are showed. The matching is done with regular #' expression. (Default: \code{TRUE}) -#' +#' #' \item \code{vec.size}: \code{Numeric scalar}. Specifies the size of #' vectors. (Default: \code{0.5}) -#' +#' #' \item \code{vec.colour}: \code{Character scalar}. Specifies the colour of #' vectors. (Default: \code{"black"}) -#' +#' #' \item \code{vec.linetype}: \code{Integer scalar}. Specifies the style of #' vector lines. (Default: \code{1}) -#' +#' #' \item \code{arrow.size}: \code{Numeric scalar}. Specifies the size of #' arrows. (Default: \code{arrow.size = 0.25}) -#' +#' #' \item \code{label.size}: \code{Numeric scalar}. Specifies the size of text #' and labels. (Default: \code{4}) -#' +#' #' \item \code{label.colour}: \code{Character scalar}. Specifies the colour of #' text and labels. (Default: \code{"black"}) -#' +#' #' \item \code{sep.group}: \code{Character scalar}. Specifies the separator #' used in the labels. (Default: \code{"\U2014"}) -#' +#' #' \item \code{repl.underscore}: \code{Character scalar}. Used to replace #' underscores in the labels. (Default: \code{" "}) -#' +#' #' \item \code{vec.text}: \code{Logical scalar}. Should text instead of labels #' be used to label vectors. (Default: \code{TRUE}) -#' +#' #' \item \code{repel.labels}: \code{Logical scalar}. Should labels be #' repelled. (Default: \code{TRUE}) -#' +#' #' \item \code{parse.labels}: \code{Logical scalar}. Should labels be parsed. #' (Default: \code{TRUE}) -#' +#' #' \item \code{add.significance}: \code{Logical scalar}. Should explained #' variance and p-value appear in the labels. (Default: \code{TRUE}) -#' +#' #' \item \code{add.expl.var}: \code{Logical scalar}. Should explained #' variance appear on the coordinate axes. (Default: \code{FALSE}) -#' +#' #' \item \code{add.centroids}: \code{Logical scalar}. Should centroids #' of variables be added. (Default: \code{FALSE}) -#' +#' #' \item \code{add.species}: \code{Logical scalar}. Should species #' scores be added. (Default: \code{FALSE}) #' } #' -#' +#' #' @details #' \code{plotRDA} and \code{plotCCA} create an RDA/CCA plot starting from the #' output of \code{\link[mia:runCCA]{CCA and RDA}} functions, two common methods @@ -100,9 +100,9 @@ #' getRDA. However, the first method is recommended because it provides #' the option to adjust aesthetics to the colData variables through the #' arguments inherited from \code{\link[scater:plotReducedDim]{plotReducedDim}}. -#' -#' @return -#' A \code{ggplot2} object +#' +#' @return +#' A \code{ggplot2} object #' #' @name plotCCA #' @@ -111,7 +111,7 @@ #' library(miaViz) #' data("enterotype", package = "mia") #' tse <- enterotype -#' +#' #' # Run RDA and store results into TreeSE #' tse <- addRDA( #' tse, @@ -120,22 +120,22 @@ #' distance = "bray", #' na.action = na.exclude #' ) -#' +#' #' # Create RDA plot coloured by variable #' plotRDA(tse, "RDA", colour.by = "ClinicalStatus") -#' +#' #' # Create RDA plot with empty ellipses #' plotRDA(tse, "RDA", colour.by = "ClinicalStatus", add.ellipse = "colour") -#' +#' #' # Create RDA plot with text encased in labels #' plotRDA(tse, "RDA", colour.by = "ClinicalStatus", vec.text = FALSE) -#' +#' #' # Create RDA plot without repelling text #' plotRDA(tse, "RDA", colour.by = "ClinicalStatus", repel.labels = FALSE) -#' +#' #' # Create RDA plot without vectors #' plotRDA(tse, "RDA", colour.by = "ClinicalStatus", add.vectors = FALSE) -#' +#' #' # Calculate RDA as a separate object #' rda_mat <- getRDA( #' tse, @@ -144,17 +144,11 @@ #' distance = "bray", #' na.action = na.exclude #' ) -#' +#' #' # Create RDA plot from RDA matrix #' plotRDA(rda_mat) NULL -#' @rdname plotCCA -#' @aliases plotRDA -#' @export -setGeneric("plotCCA", signature = c("x"), - function(x, ...) standardGeneric("plotCCA")) - #' @rdname plotCCA #' @aliases plotRDA #' @export @@ -175,12 +169,6 @@ setMethod("plotCCA", signature = c(x = "matrix"), } ) -#' @rdname plotCCA -#' @aliases plotCCA -#' @export -setGeneric("plotRDA", signature = c("x"), - function(x, ...) standardGeneric("plotRDA")) - #' @rdname plotCCA #' @aliases plotCCA #' @export @@ -237,6 +225,7 @@ setMethod("plotRDA", signature = c(x = "matrix"), # Construct TreeSE from matrix to pass it to downstream functions. It is useful # for instance if get* functios was used instead of add*. +#' @importFrom S4Vectors SimpleList .rda2tse <- function(object) { # Convert rda/cca object to TreeSE object <- TreeSummarizedExperiment( @@ -364,7 +353,7 @@ setMethod("plotRDA", signature = c(x = "matrix"), vector_data <- NULL } } - + # Get sample metadata. Check if all biplot covariate names can be found # from sample metadata. As biplot have merged names, we have to use sample # metadata later to make the vector labels tidier. @@ -374,7 +363,7 @@ setMethod("plotRDA", signature = c(x = "matrix"), vapply(variable_names, function(y) grepl(y, x), logical(1L)), logical(ncol(coldata)) ) all_var_found <- all( colSums(all_var_found) == 1) - + # Make the vector labels tidier. For instance, covriate name and value # are separated. This applies only when labels were not provided by user. if( !is.null(vector_data) && is.null(vec.lab) && all_var_found ){ @@ -393,7 +382,7 @@ setMethod("plotRDA", signature = c(x = "matrix"), # If they are, add labels to data vector_data[["vector_label"]] <- vec.lab } - + # Add significance information to the labels signif_data <- if( add.significance && !is.null(vector_data) && all_var_found ) .get_rda_attribute(reduced_dim, "significance") @@ -410,14 +399,14 @@ setMethod("plotRDA", signature = c(x = "matrix"), warning("Significance data was not found. please compute", "CCA/RDA by using add* function.", call. = FALSE) } - + return(vector_data) } # Make vector labels more tidy, i.e, separate variable and group names. We need # colData for this because in the biplot data, covariate name and values are # just combined, i.e., we do not know if "group" is the group name or is it -# "groupName" when the name in biplot is "groupNameValue". +# "groupName" when the name in biplot is "groupNameValue". # Replace also underscores with space. .tidy_vector_labels <- function( vector_label, coldata, sep.group, repl.underscore, ...){ @@ -449,6 +438,8 @@ setMethod("plotRDA", signature = c(x = "matrix"), # This function adds significance info to vector labels .add_signif_to_vector_labels <- function( vector_label, var_names, signif_data, repl.underscore = " ", ...){ + # To disable "no visible binding for global variable" message in cmdcheck + italic <- NULL # Replace underscores from significance data and variable names to match # labels rownames(signif_data) <- lapply( @@ -558,7 +549,6 @@ setMethod("plotRDA", signature = c(x = "matrix"), # Convert to explained variance and take only first two components expl_var <- eigen_vals / sum(eigen_vals) expl_var <- expl_var[seq_len(ncomponents)]*100 - expl_var <- summary(rda)$concont$importance*100 } # Create argument list args <- c(list(object = tse, dimred = dimred, ncomponents = ncomponents, @@ -601,6 +591,8 @@ setMethod("plotRDA", signature = c(x = "matrix"), plot, plot_data, add.ellipse = TRUE, ellipse.alpha = 0.2, ellipse.linewidth = 0.1, ellipse.linetype = 1, confidence.level = 0.95, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + color <- NULL # if( !(add.ellipse %in% c(TRUE, FALSE, "fill", "color", "colour") && length(add.ellipse) == 1L ) ){ @@ -737,6 +729,8 @@ setMethod("plotRDA", signature = c(x = "matrix"), # This function adds centroids or species layer to the plot. .rda_plotter_centroids_or_species <- function(plot, plot_data, type){ + # To disable "no visible binding for global variable" message in cmdcheck + x <- y <- NULL data <- plot_data[[type]] if( !is.null(data) ){ plot <- plot + geom_point( diff --git a/R/plotColTile.R b/R/plotColTile.R index 24d8d9e1..79f126ef 100644 --- a/R/plotColTile.R +++ b/R/plotColTile.R @@ -1,48 +1,41 @@ #' Plot factor data as tiles -#' +#' #' Relative relations of two grouping can be visualized by plotting tiles with -#' relative sizes. \code{plotColTile} and \code{plotRowTile} can be used for +#' relative sizes. \code{plotColTile} and \code{plotRowTile} can be used for #' this. -#' +#' #' @param object a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' object. -#' -#' @param x \code{Character scalar}. Specifies the column-level metadata field to show on the x-axis. -#' Alternatively, an \link{AsIs} vector or data.frame, see +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} +#' object. +#' +#' @param x \code{Character scalar}. Specifies the column-level metadata field +#' to show on the x-axis. +#' Alternatively, an \link{AsIs} vector or data.frame, see #' \code{?\link{retrieveFeatureInfo}} or \code{?\link{retrieveCellInfo}}. Must #' result in a returned \code{character} or \code{factor} vector. -#' -#' @param y \code{Character scalar}. Specifies the column-level metadata to show on the y-axis. -#' Alternatively, an \link{AsIs} vector or data.frame, see +#' +#' @param y \code{Character scalar}. Specifies the column-level metadata to +#' show on the y-axis. +#' Alternatively, an \link{AsIs} vector or data.frame, see #' \code{?\link{retrieveFeatureInfo}} or \code{?\link{retrieveCellInfo}}. Must #' result in a returned \code{character} or \code{factor} vector. -#' -#' @param ... additional arguments for plotting. See -#' \code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")} -#' -#' @return -#' A \code{ggplot2} object or \code{plotly} object, if more than one +#' +#' @param ... additional arguments for plotting. See +#' \code{\link{mia-plot-args}} for more details i.e. call +#' \code{help("mia-plot-args")} +#' +#' @return +#' A \code{ggplot2} object or \code{plotly} object, if more than one #' \code{prevalences} was defined. -#' +#' #' @name plotColTile -#' +#' #' @examples #' data(GlobalPatterns) #' se <- GlobalPatterns #' plotColTile(se,"SampleType","Primer") NULL -#' @rdname plotColTile -#' @export -setGeneric("plotColTile", signature = c("object"), - function(object, x, y, ...) standardGeneric("plotColTile")) -#' @rdname plotColTile -#' @export -setGeneric("plotRowTile", signature = c("object"), - function(object, x, y, ...) standardGeneric("plotRowTile")) - - #' @rdname plotColTile #' @export setMethod("plotColTile", signature = c("SummarizedExperiment"), @@ -59,16 +52,15 @@ setMethod("plotRowTile", signature = c("SummarizedExperiment"), } ) -.get_tile_data <- function(object, - type, - x, - y){ - retrieve_FUN <- switch(type, - "row" = retrieveFeatureInfo, - "column" = retrieveCellInfo) - retrieve_search <- switch(type, - "row" = "rowData", - "column" = "colData") +.get_tile_data <- function(object, type, x, y){ + retrieve_FUN <- switch( + type, + "row" = retrieveFeatureInfo, + "column" = retrieveCellInfo) + retrieve_search <- switch( + type, + "row" = "rowData", + "column" = "colData") # x_by_out <- retrieve_FUN(object, x, search = retrieve_search) x_lab <- x_by_out$name @@ -82,64 +74,59 @@ setMethod("plotRowTile", signature = c("SummarizedExperiment"), stop("'y' must specify a factor or character vector.", call. = FALSE) } # - list(data = data.frame(X = factor(x_by_out$value), - Y = factor(y_by_out$value)), - x_lab = x_lab, - y_lab = y_lab) + list( + data = data.frame( + X = factor(x_by_out$value), + Y = factor(y_by_out$value)), + x_lab = x_lab, + y_lab = y_lab) } #' @importFrom dplyr group_by mutate summarise ungroup n -.summarise_tile_data <- function(object, - data, - type){ - retrieve_FUN <- switch(type, - "row" = retrieveFeatureInfo, - "column" = retrieveCellInfo) - retrieve_search <- switch(type, - "row" = "rowData", - "column" = "colData") - x_group <- data %>% - group_by(.data$X) %>% +.summarise_tile_data <- function(object, data, type){ + retrieve_FUN <- switch( + type, + "row" = retrieveFeatureInfo, + "column" = retrieveCellInfo) + retrieve_search <- switch( + type, + "row" = "rowData", + "column" = "colData") + x_group <- data %>% + group_by(.data$X) %>% summarise(group_n = n()) %>% - mutate(group_freq = .data$group_n/sum(.data$group_n), - x = cumsum(.data$group_freq), - xmin = c(0,.data$x[-length(.data$x)])) + mutate( + group_freq = .data$group_n/sum(.data$group_n), + x = cumsum(.data$group_freq), + xmin = c(0,.data$x[-length(.data$x)])) data <- data %>% group_by(.data$X, .data$Y) %>% summarise(fill_n = n(), .groups = "rowwise") %>% dplyr::left_join(x_group, by = "X") %>% mutate(fill_freq = .data$fill_n/.data$group_n) %>% group_by(.data$X) %>% - mutate(y = cumsum(.data$fill_freq), - ymin = c(0,.data$y[-length(.data$y)])) %>% + mutate( + y = cumsum(.data$fill_freq), + ymin = c(0,.data$y[-length(.data$y)])) %>% ungroup() data } -.plot_tile_data <- function(object, - type = c("row", "column"), - x, - y, - ...){ +.plot_tile_data <- function(object, type = c("row", "column"), x, y, ...){ type <- match.arg(type) tile_out <- .get_tile_data(object, type, x, y) tile_data <- tile_out$data xlab <- tile_out$x_lab ylab <- tile_out$y_lab - tile_data <- .summarise_tile_data(object, - tile_data, - type) + tile_data <- .summarise_tile_data(object, tile_data, type) tile_data$colour_by <- tile_data$Y - .tile_plotter(tile_data, - xlab = xlab, - ylab = ylab, - ...) + .tile_plotter(tile_data, xlab = xlab, ylab = ylab, ...) } .get_xcoord_mid <- function(data){ - data %>% + data %>% ungroup() %>% - select(.data$X, .data$x, .data$xmin) %>% + select(.data$X, .data$x, .data$xmin) %>% unique() %>% mutate(xmid = .data$xmin + (.data$x - .data$xmin)/2 ) } @@ -157,34 +144,31 @@ setMethod("plotRowTile", signature = c("SummarizedExperiment"), na.value = "grey80"){ coord <- .get_xcoord_mid(data) # get plotting arguments for rect - rect_args <- .get_rect_args(colour_by = ylab, - alpha = rect_alpha, - colour = rect_colour) + rect_args <- .get_rect_args( + colour_by = ylab, alpha = rect_alpha, colour = rect_colour) rect_args$args$mapping$xmin <- sym("xmin") rect_args$args$mapping$xmax <- sym("x") rect_args$args$mapping$ymin <- sym("ymin") rect_args$args$mapping$ymax <- sym("y") # start plotting - plot_out <- ggplot(data) + plot_out <- ggplot(data) plot_out <- plot_out + do.call(geom_rect,rect_args$args) # add scales plot_out <- plot_out + - scale_x_continuous(name = paste0("Fraction (",xlab,")"), - expand = c(0,0), - breaks = seq(0,1,0.1), - sec.axis = dup_axis(name = xlab, - breaks = coord$xmid, - labels = coord$X)) + - scale_y_continuous(name = paste0("Fraction (",ylab,")"), - expand = c(0,0), - breaks = seq(0,1,0.1)) + scale_x_continuous( + name = paste0("Fraction (",xlab,")"), + expand = c(0,0), + breaks = seq(0,1,0.1), + sec.axis = dup_axis( + name = xlab, breaks = coord$xmid, labels = coord$X)) + + scale_y_continuous( + name = paste0("Fraction (",ylab,")"), + expand = c(0,0), + breaks = seq(0,1,0.1)) # resolve the fill colours - plot_out <- .resolve_plot_colours(plot_out, - data$colour_by, - ylab, - fill = TRUE, - na.value = na.value) + plot_out <- .resolve_plot_colours( + plot_out, data$colour_by, ylab, fill = TRUE, na.value = na.value) # add legend and theme plot_out <- plot_out + theme_classic() diff --git a/R/plotDMN.R b/R/plotDMN.R index b8bf70e6..ffd32def 100644 --- a/R/plotDMN.R +++ b/R/plotDMN.R @@ -2,16 +2,16 @@ #' #' To plot DMN fits generated with `mia` use \code{plotDMNFit}. #' -#' @param x a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' object contain the DMN data in \code{metadata}. -#' -#' @param type \code{Character scalar}. The type of measure for access the goodness of fit. One of -#' \sQuote{laplace}, \sQuote{AIC} or \sQuote{BIC}. +#' @param x a +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} +#' object contain the DMN data in \code{metadata}. +#' +#' @param type \code{Character scalar}. The type of measure for access the +#' goodness of fit. One of \sQuote{laplace}, \sQuote{AIC} or \sQuote{BIC}. #' #' @param name \code{Character scalar}. The name to store the result in -#' \code{\link[SummarizedExperiment:RangedSummarizedExperiment-class]{metadata}} -#' (Default: \code{"DMN"}) +#' \code{\link[SummarizedExperiment:RangedSummarizedExperiment-class]{metadata}} +#' (Default: \code{"DMN"}) #' #' @param ... optional arguments not used. #' @@ -26,25 +26,19 @@ #' @examples #' library(mia) #' library(bluster) -#' +#' #' # Get dataset #' data("peerj13075", package = "mia") #' tse <- peerj13075 -#' +#' #' # Cluster the samples #' tse <- addCluster(tse, DmmParam(k = 1:4), name = "DMM", full = TRUE) -#' +#' #' # Plot the fit #' plotDMNFit(tse, name = "DMM", type = "laplace") -#' +#' NULL -#' @rdname plotDMN -#' @export -setGeneric("plotDMNFit", signature = "x", - function(x, name = "DMN", type = c("laplace","AIC","BIC"), ...) - standardGeneric("plotDMNFit")) - #' @rdname plotDMN #' @importFrom DirichletMultinomial mixture #' @importFrom ggplot2 ggplot aes geom_point geom_line theme_bw labs @@ -55,7 +49,7 @@ setMethod("plotDMNFit", signature = c(x = "SummarizedExperiment"), if (!is.null(metadata(x)[[name]]$dmm)) { dmn <- metadata(x)[[name]]$dmm } else { - .Deprecated(old="getDMN", new="addCluster", + .Deprecated(old="getDMN", new="addCluster", paste0( "Now runDMN and calculateDMN are deprecated. Use ", "addCluster with DMMParam parameter and full ", @@ -67,10 +61,11 @@ setMethod("plotDMNFit", signature = c(x = "SummarizedExperiment"), k <- vapply(dmn, function(d){ncol(mixture(d))}, numeric(1)) fit <- vapply(dmn, fit_FUN, numeric(1)) ggplot(data.frame(k = k, fit = fit), aes(x = k, y = fit)) + - geom_point() + - geom_line() + - theme_bw() + - labs(x = "Number of Dirichlet Components", - y = paste0("Model Fit (",type,")")) + geom_point() + + geom_line() + + theme_bw() + + labs( + x = "Number of Dirichlet Components", + y = paste0("Model Fit (",type,")")) } ) diff --git a/R/plotGraph.R b/R/plotGraph.R index 9366c02e..7c275c17 100644 --- a/R/plotGraph.R +++ b/R/plotGraph.R @@ -1,101 +1,108 @@ #' Plotting igraph objects with information from a \code{SummarizedExperiment} -#' +#' #' \code{plotGraph} plots an \code{igraph} object with additional information #' matched from a \code{SummarizedExperiment} object for the nodes only. #' Information on the edges have to provided manually. #' #' @param x,y a graph object and a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' object or just a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}}. -#' For the latter object a graph object must be stored in \code{metadata(x)$name}. -#' -#' @param name \code{Character scalar}. If \code{x} is a #' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' the key for subsetting the \code{metadata(x)} to a graph object. (Default: \code{"graph"}) -#' -#' @param show.label \code{Logical scalar}, \code{integer vector} or \code{character vector} -#' If a \code{logical} scalar is given, should tip labels be plotted -#' or if a logical vector is provided, which labels should be shown? If an -#' \code{integer} or \code{character} vector is provided, it will be converted -#' to a logical vector. The \code{integer} values must be in the range of 1 -#' and number of nodes, whereas the values of a \code{character} vector must -#' match values of a \code{label} or \code{name} column in the node data. In -#' case of a \code{character} vector only values corresponding to actual -#' labels will be plotted and if no labels are provided no labels will be -#' shown. (Default: \code{FALSE}) -#' +#' object or just a +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}}. +#' For the latter object a graph object must be stored in +#' \code{metadata(x)$name}. +#' +#' @param name \code{Character scalar}. If \code{x} is a +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} +#' the key for subsetting the \code{metadata(x)} to a graph object. +#' (Default: \code{"graph"}) +#' +#' @param show.label \code{Logical scalar}, \code{integer vector} or +#' \code{character vector} +#' If a \code{logical} scalar is given, should tip labels be plotted +#' or if a logical vector is provided, which labels should be shown? If an +#' \code{integer} or \code{character} vector is provided, it will be converted +#' to a logical vector. The \code{integer} values must be in the range of 1 +#' and number of nodes, whereas the values of a \code{character} vector must +#' match values of a \code{label} or \code{name} column in the node data. In +#' case of a \code{character} vector only values corresponding to actual +#' labels will be plotted and if no labels are provided no labels will be +#' shown. (Default: \code{FALSE}) +#' #' @param show_label Deprecated. Use \code{show.label} instead. -#' -#' @param add.legend \code{Logical scalar}. Should legends be plotted? +#' +#' @param add.legend \code{Logical scalar}. Should legends be plotted? #' (Default: \code{TRUE}) -#' +#' #' @param add_legend Deprecated. Use \code{add.legend} instead. -#' -#' @param layout \code{Character scalar}. Layout for the plotted graph. See +#' +#' @param layout \code{Character scalar}. Layout for the plotted graph. See #' \code{\link[ggraph:ggraph]{ggraph}} for details. (Default: \code{"kk"}) -#' -#' @param edge.type \code{Character scalar}. Type of edge plotted on the graph. See -#' \code{\link[ggraph:geom_edge_fan]{geom_edge_fan}} for details and other -#' available geoms. (Default: \code{"fan"}) -#' +#' +#' @param edge.type \code{Character scalar}. Type of edge plotted on the graph. +#' See \code{\link[ggraph:geom_edge_fan]{geom_edge_fan}} for details and other +#' available geoms. (Default: \code{"fan"}) +#' #' @param edge_type Deprecated. Use \code{edge.type} instead. -#' -#' @param edge.colour.by \code{Character scalar}. Specification of an edge -#' metadata field to use for setting colours of the edges. (Default: \code{NULL}) -#' +#' +#' @param edge.colour.by \code{Character scalar}. Specification of an edge +#' metadata field to use for setting colours of the edges. +#' (Default: \code{NULL}) +#' #' @param edge_colour_by Deprecated. Use \code{edge.colour.by} instead. -#' -#' @param edge.width.by \code{Character scalar}. Specification of an edge metadata -#' field to use for setting width of the edges. (Default: \code{NULL}) -#' +#' +#' @param edge.width.by \code{Character scalar}. Specification of an edge +#' metadata +#' field to use for setting width of the edges. (Default: \code{NULL}) +#' #' @param edge_width_by Deprecated. Use \code{edge.width.by} instead. -#' -#' @param colour.by \code{Character scalar}. Specification of a column metadata -#' field or a feature to colour graph nodes by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible -#' values. (Default: \code{NULL}) -#' +#' +#' @param colour.by \code{Character scalar}. Specification of a column metadata +#' field or a feature to colour graph nodes by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' values. (Default: \code{NULL}) +#' #' @param colour_by Deprecated. Use \code{colour.by} instead. -#' -#' @param shape.by \code{Character scalar}. Specification of a column metadata -#' field or a feature to shape graph nodes by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' +#' @param shape.by \code{Character scalar}. Specification of a column metadata +#' field or a feature to shape graph nodes by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible #' values. (Default: \code{NULL}) -#' +#' #' @param shape_by Deprecated. Use \code{shape.by} instead. -#' -#' @param size.by \code{Character scalar}. Specification of a column metadata -#' field or a feature to size graph nodes by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' +#' @param size.by \code{Character scalar}. Specification of a column metadata +#' field or a feature to size graph nodes by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible #' values. (Default: \code{NULL}) -#' +#' #' @param size_by Deprecated. Use \code{size.by} instead. -#' -#' @param assay.type \code{Character scalar}. or \code{integer scalar}. Specifies -#' which assay to obtain expression values from, for use in point aesthetics - see the -#' \code{exprs_values} argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. -#' (Default: \code{"counts"}) -#' +#' +#' @param assay.type \code{Character scalar}. or \code{integer scalar}. +#' Specifies which assay to obtain expression values from, for use in point +#' aesthetics - see the \code{exprs_values} argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. +#' (Default: \code{"counts"}) +#' #' @param by_exprs_values Deprecated. Use \code{assay.type} instead. -#' +#' #' @param other.fields Additional fields to include in the node information #' without plotting them. -#' -#' @param other_fields Deprecated. Use \code{other.fields} instead. -#' -#' @param ... additional arguments for plotting. See -#' \code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")} -#' +#' +#' @param other_fields Deprecated. Use \code{other.fields} instead. +#' +#' @param ... additional arguments for plotting. See +#' \code{\link{mia-plot-args}} for more details i.e. call +#' \code{help("mia-plot-args")} +#' #' @details -#' Internally \code{tidygraph} and \code{ggraph} are used. Therefore, all +#' Internally \code{tidygraph} and \code{ggraph} are used. Therefore, all #' graph types which can be converted by \code{tidygraph::as_tbl_graph} can #' be used. -#' +#' #' @return a \code{\link{ggtree}} plot -#' +#' #' @name plotGraph -#' +#' #' @examples #' \donttest{ #' # data setup @@ -105,12 +112,12 @@ #' data(row_graph) #' data(row_graph_order) #' metadata(GlobalPatterns)$col_graph <- col_graph -#' +#' #' genus <- agglomerateByRank(GlobalPatterns,"Genus",na.rm=TRUE) #' metadata(genus)$row_graph <- row_graph #' order <- agglomerateByRank(genus,"Order",na.rm=TRUE) #' metadata(order)$row_graph <- row_graph_order -#' +#' #' # plot a graph independently #' plotColGraph(col_graph, #' genus, @@ -118,22 +125,22 @@ #' edge.colour.by = "weight", #' edge.width.by = "weight", #' show.label = TRUE) -#' +#' #' # plot the graph stored in the object #' plotColGraph(genus, #' name = "col_graph", #' colour.by = "SampleType", #' edge.colour.by = "weight", #' edge.width.by = "weight") -#' -#' +#' +#' #' # plot a graph independently #' plotRowGraph(row_graph, #' genus, #' colour.by = "Kingdom", #' edge.colour.by = "weight", #' edge.width.by = "weight") -#' +#' #' # plot the graph stored in the object #' plotRowGraph(genus, #' name = "row_graph", @@ -141,31 +148,31 @@ #' edge.colour.by = "weight", #' edge.width.by = "weight") #' -#' +#' #' # plot a graph independently #' plotRowGraph(row_graph_order, #' order, #' colour.by = "Kingdom", #' edge.colour.by = "weight", #' edge.width.by = "weight") -#' +#' #' # plot the graph stored in the object and include some labels #' plotRowGraph(order, #' name = "row_graph", #' colour.by = "Phylum", #' edge.colour.by = "weight", -#' edge.width.by = "weight", +#' edge.width.by = "weight", #' show.label = c("Sulfolobales","Spirochaetales", #' "Verrucomicrobiales")) -#' +#' #' # labels can also be included via selecting specific rownames of x/y #' plotRowGraph(order, #' name = "row_graph", #' colour.by = "Phylum", #' edge.colour.by = "weight", -#' edge.width.by = "weight", +#' edge.width.by = "weight", #' show.label = c(1,10,50)) -#' +#' #' # labels can also be included via a logical vector, which has the same length #' # as nodes are present #' label_select <- rep(FALSE,nrow(order)) @@ -179,25 +186,15 @@ #' } NULL -#' @rdname plotGraph -#' @export -setGeneric("plotColGraph", signature = c("x","y"), - function(x, y, ...) standardGeneric("plotColGraph")) - -#' @rdname plotGraph -#' @export -setGeneric("plotRowGraph", signature = c("x","y"), - function(x, y, ...) standardGeneric("plotRowGraph")) - .check_graph_plot_switches <- function(show_label, add_legend){ if(!.is_a_bool(show_label)){ - if( (!is.logical(show_label) && !is.character(show_label) && + if( (!is.logical(show_label) && !is.character(show_label) && !is.numeric(show_label)) || is.null(show_label)){ stop("'show_label' must be either TRUE or FALSE or logical, ", - "integer or character ", - "vector. Character alues should match the label of the graph.", - call. = FALSE) + "integer or character ", + "vector. Character alues should match the label of the graph.", + call. = FALSE) } } if(!.is_a_bool(add_legend)){ @@ -217,42 +214,43 @@ setGeneric("plotRowGraph", signature = c("x","y"), setMethod("plotColGraph", signature = c(x = "ANY",y = "SummarizedExperiment"), function(x, y, - show.label = show_label, - show_label = FALSE, - add.legend = add_legend, - add_legend = TRUE, - layout = "kk", - edge.type = edge_type, - edge_type = c("fan","link","arc","parallel"), - edge.colour.by = edge_colour_by, - edge_colour_by = NULL, - edge.width.by = edge_width_by, - edge_width_by = NULL, - colour.by = colour_by, - colour_by = NULL, - shape.by = shape_by, - shape_by = NULL, - size.by = size_by, - size_by = NULL, - assay.type = by_exprs_values, - by_exprs_values = "counts", - other.fields = other_fields, - other_fields = list(), - ...){ - .plot_row_column_graph(x = x, y = y, - show_label = show.label, - add_legend = add.legend, - layout = layout, - edge_type = edge.type, - edge_colour_by = edge.colour.by, - edge_width_by = edge.width.by, - colour_by = colour.by, - shape_by = shape.by, - size_by = size.by, - by_exprs_values = assay.type, - other_fields = other.fields, - type = "column", - ...) + show.label = show_label, + show_label = FALSE, + add.legend = add_legend, + add_legend = TRUE, + layout = "kk", + edge.type = edge_type, + edge_type = c("fan","link","arc","parallel"), + edge.colour.by = edge_colour_by, + edge_colour_by = NULL, + edge.width.by = edge_width_by, + edge_width_by = NULL, + colour.by = colour_by, + colour_by = NULL, + shape.by = shape_by, + shape_by = NULL, + size.by = size_by, + size_by = NULL, + assay.type = by_exprs_values, + by_exprs_values = "counts", + other.fields = other_fields, + other_fields = list(), + ...){ + .plot_row_column_graph( + x = x, y = y, + show_label = show.label, + add_legend = add.legend, + layout = layout, + edge_type = edge.type, + edge_colour_by = edge.colour.by, + edge_width_by = edge.width.by, + colour_by = colour.by, + shape_by = shape.by, + size_by = size.by, + by_exprs_values = assay.type, + other_fields = other.fields, + type = "column", + ...) } ) @@ -276,41 +274,42 @@ setMethod("plotColGraph", setMethod("plotRowGraph", signature = c(x = "ANY",y = "SummarizedExperiment"), function(x, y, - show.label = show_label, - show_label = FALSE, - add.legend = add_legend, - add_legend = TRUE, - layout = "kk", - edge.type = edge_type, - edge_type = c("fan","link","arc","parallel"), - edge.colour.by = edge_colour_by, - edge_colour_by = NULL, - edge.width.by = edge_width_by, - edge_width_by = NULL, - colour.by = colour_by, - colour_by = NULL, - shape.by = shape_by, - shape_by = NULL, - size.by = NULL, - assay.type = by_exprs_values, - by_exprs_values = "counts", - other.fields = other_fields, - other_fields = list(), - ...){ - .plot_row_column_graph(x = x, y = y, - show_label = show.label, - add_legend = add.legend, - layout = layout, - edge_type = edge.type, - edge_colour_by = edge.colour.by, - edge_width_by = edge.width.by, - colour_by = colour.by, - shape_by = shape.by, - size_by = size.by, - by_exprs_values = assay.type, - other_fields = other.fields, - type = "row", - ...) + show.label = show_label, + show_label = FALSE, + add.legend = add_legend, + add_legend = TRUE, + layout = "kk", + edge.type = edge_type, + edge_type = c("fan","link","arc","parallel"), + edge.colour.by = edge_colour_by, + edge_colour_by = NULL, + edge.width.by = edge_width_by, + edge_width_by = NULL, + colour.by = colour_by, + colour_by = NULL, + shape.by = shape_by, + shape_by = NULL, + size.by = NULL, + assay.type = by_exprs_values, + by_exprs_values = "counts", + other.fields = other_fields, + other_fields = list(), + ...){ + .plot_row_column_graph( + x = x, y = y, + show_label = show.label, + add_legend = add.legend, + layout = layout, + edge_type = edge.type, + edge_colour_by = edge.colour.by, + edge_width_by = edge.width.by, + colour_by = colour.by, + shape_by = shape.by, + size_by = size.by, + by_exprs_values = assay.type, + other_fields = other.fields, + type = "row", + ...) } ) @@ -329,23 +328,22 @@ setMethod("plotRowGraph", ) .plot_row_column_graph <- function(x, y, - show_label = FALSE, - add_legend = TRUE, - layout = "kk", - edge_type = c("fan","link","arc","parallel"), - edge_colour_by = NULL, - edge_width_by = NULL, - colour_by = NULL, - shape_by = NULL, - size_by = NULL, - by_exprs_values = "counts", - other_fields = list(), - type = c("row","column"), - ...){ + show_label = FALSE, + add_legend = TRUE, + layout = "kk", + edge_type = c("fan","link","arc","parallel"), + edge_colour_by = NULL, + edge_width_by = NULL, + colour_by = NULL, + shape_by = NULL, + size_by = NULL, + by_exprs_values = "counts", + other_fields = list(), + type = c("row","column"), + ...){ type <- match.arg(type) # input check - .check_graph_plot_switches(show_label = show_label, - add_legend = add_legend) + .check_graph_plot_switches(show_label = show_label, add_legend = add_legend) norm_out <- .norm_layout_edge_type(layout, edge_type) layout <- norm_out$layout edge_type <- norm_out$edge_type @@ -354,33 +352,35 @@ setMethod("plotRowGraph", label_out <- .add_graph_node_labels(graph_data, show_label) graph_data <- label_out$df show_label <- label_out$show_label - vis_out <- .incorporate_graph_vis(graph_data, - se = y, - edge_colour_by = edge_colour_by, - edge_width_by = edge_width_by, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by, - by_exprs_values = by_exprs_values, - other_fields = other_fields, - type = type) + vis_out <- .incorporate_graph_vis( + graph_data, + se = y, + edge_colour_by = edge_colour_by, + edge_width_by = edge_width_by, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by, + by_exprs_values = by_exprs_values, + other_fields = other_fields, + type = type) graph_data <- vis_out$df edge_colour_by <- vis_out$edge_colour_by edge_width_by <- vis_out$edge_width_by colour_by <- vis_out$colour_by shape_by <- vis_out$shape_by size_by <- vis_out$size_by - .graph_plotter(graph_data, - layout = layout, - edge_type = edge_type, - add_legend = add_legend, - show_label = show_label, - edge_colour_by = edge_colour_by, - edge_width_by = edge_width_by, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by, - ...) + .graph_plotter( + graph_data, + layout = layout, + edge_type = edge_type, + add_legend = add_legend, + show_label = show_label, + edge_colour_by = edge_colour_by, + edge_width_by = edge_width_by, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by, + ...) } ################################################################################ @@ -395,19 +395,18 @@ setMethod("plotRowGraph", #' @importFrom dplyr mutate .add_graph_node_labels <- function(graph_data, show_label){ if(!("label" %in% .colnames_tbl_graph(graph_data, "nodes")) && - ("name" %in% .colnames_tbl_graph(graph_data, "nodes"))){ + ("name" %in% .colnames_tbl_graph(graph_data, "nodes"))){ graph_data <- graph_data %>% activate("nodes") %>% mutate(label = .data$name) } - + if(!is.logical(show_label) || length(show_label) > 1L) { - data <- graph_data %>% + data <- graph_data %>% activate("nodes") %>% as_tibble() - if(is.character(show_label) && - length(show_label) == nrow(data)) { - graph_data <- graph_data %>% + if(is.character(show_label) && length(show_label) == nrow(data)) { + graph_data <- graph_data %>% activate("nodes") %>% mutate(label = show_label) show_label <- TRUE @@ -421,12 +420,10 @@ setMethod("plotRowGraph", } else { if(is.numeric(show_label)){ if(any(show_label != as.integer(show_label)) || - min(show_label) < 1 || - max(show_label) > nrow(data)){ + min(show_label) < 1 || max(show_label) > nrow(data)){ stop("If 'show_label' is numeric, values have to be whole ", - "numbers and must be between 1 and the number of nodes ", - "in the graph", - call. = FALSE) + "numbers and must be between 1 and the number of ", + "nodes in the graph", call. = FALSE) } label <- rep(FALSE, nrow(data)) label[show_label] <- TRUE @@ -434,13 +431,11 @@ setMethod("plotRowGraph", } else if(is.character(show_label)) { show_label <- data$label %in% show_label } - if(is.logical(show_label) && - length(show_label) != nrow(data)){ + if(is.logical(show_label) && length(show_label) != nrow(data)){ stop("If 'show_label' is logical, it must have the length as ", - "nodes are in the graph.", - call. = FALSE) + "nodes are in the graph.", call. = FALSE) } - graph_data <- graph_data %>% + graph_data <- graph_data %>% activate("nodes") %>% mutate(label = ifelse(show_label, label, NA_character_)) show_label <- TRUE @@ -456,9 +451,9 @@ setMethod("plotRowGraph", #' @importFrom tidygraph activate as_tibble .colnames_tbl_graph <- function(graph_data, type){ - graph_data %>% - activate(!!sym(type)) %>% - as_tibble() %>% + graph_data %>% + activate(!!sym(type)) %>% + as_tibble() %>% colnames() } @@ -470,7 +465,7 @@ setMethod("plotRowGraph", "Data will not be added.", call. = FALSE) } - graph_data %>% + graph_data %>% activate(!!sym(type)) %>% mutate(!!sym(data$name) := data$value) } @@ -479,23 +474,24 @@ setMethod("plotRowGraph", #' @importFrom dplyr rename #' @importFrom tibble rownames_to_column #' @importFrom tidygraph activate as_tibble -.incorporate_graph_vis <- function(graph_data, - se, - edge_colour_by, - edge_width_by, - colour_by, - shape_by, - size_by, - by_exprs_values = "counts", - other_fields = list(), - type = c("row","column")){ +.incorporate_graph_vis <- function( + graph_data, + se, + edge_colour_by, + edge_width_by, + colour_by, + shape_by, + size_by, + by_exprs_values = "counts", + other_fields = list(), + type = c("row","column")){ type <- match.arg(type) - type_FUN <- switch(type, - row = scater::retrieveFeatureInfo, - column = scater::retrieveCellInfo) - variables <- c(colour_by = colour_by, - shape_by = shape_by, - size_by = size_by) + type_FUN <- switch( + type, + row = scater::retrieveFeatureInfo, + column = scater::retrieveCellInfo) + variables <- c( + colour_by = colour_by, shape_by = shape_by, size_by = size_by) colour_by <- NULL shape_by <- NULL size_by <- NULL @@ -510,10 +506,10 @@ setMethod("plotRowGraph", for(i in seq_along( variables[f])){ var_name <- names(variables[f])[i] # mirror back variable name - assign(var_name, .get_new_var_name_value(get(var_name), - variables[f][i])) + assign(var_name, .get_new_var_name_value( + get(var_name), variables[f][i])) # rename columns by their usage - graph_data %>% + graph_data %>% activate("nodes") %>% dplyr::rename(!!sym(var_name) := variables[f][i]) } @@ -521,45 +517,44 @@ setMethod("plotRowGraph", } } if(length(variables) > 0L){ - dim_graph_nodes <- graph_data %>% + dim_graph_nodes <- graph_data %>% activate("nodes") %>% as_tibble() %>% dim() - dim_se <- switch(type, - row = nrow(se), - column = ncol(se)) + dim_se <- switch( + type, + row = nrow(se), + column = ncol(se)) if(dim_graph_nodes[1] != dim_se){ stop("The number of nodes in the graph and chosen dimension ", - "of the SummarizedExperiment must be equal.", - call. = FALSE) + "of the SummarizedExperiment must be equal.", call. = FALSE) } for(i in seq_along(variables)){ # get data - feature_info <- type_FUN(se, variables[i], - exprs_values = by_exprs_values) + feature_info <- type_FUN( + se, variables[i], exprs_values = by_exprs_values) feature_info_name <- feature_info$name # mirror back variable name, if a partial match was used var_name <- names(variables)[i] - assign(var_name, .get_new_var_name_value(get(var_name), - feature_info$name)) + assign(var_name, .get_new_var_name_value( + get(var_name), feature_info$name)) # rename columns by their usage feature_info$name <- var_name - graph_data <- .add_graph_data_or_warn(feature_info, graph_data, - type = "nodes", - feature_info_name) + graph_data <- .add_graph_data_or_warn( + feature_info, graph_data, type = "nodes", feature_info_name) } } } if(length(other_fields) != 0L){ for (o in other_fields) { other <- type_FUN(se, o, exprs_values = by_exprs_values) - graph_data <- .add_graph_data_or_warn(other, graph_data, - type = "nodes") + graph_data <- .add_graph_data_or_warn( + other, graph_data, type = "nodes") } } # edge data - variables <- c(edge_colour_by = edge_colour_by, - edge_width_by = edge_width_by) + variables <- c( + edge_colour_by = edge_colour_by, edge_width_by = edge_width_by) edge_colour_by <- NULL edge_width_by <- NULL cn <- .colnames_tbl_graph(graph_data,"edges") @@ -568,21 +563,23 @@ setMethod("plotRowGraph", for(i in seq_along(variables)){ var_name <- names(variables)[i] # mirror back variable name - assign(var_name, .get_new_var_name_value(get(var_name), - variables[i])) + assign(var_name, .get_new_var_name_value( + get(var_name), variables[i])) # rename columns by their usage - graph_data <- graph_data %>% + graph_data <- graph_data %>% activate("edges") %>% mutate(!!sym(var_name) := !!sym(unname(variables[i]))) } } # - return(list(df = graph_data, - edge_colour_by = edge_colour_by, - edge_width_by = edge_width_by, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by)) + res <- list( + df = graph_data, + edge_colour_by = edge_colour_by, + edge_width_by = edge_width_by, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by) + return(res) } .graph_plotter <- function( @@ -610,16 +607,18 @@ setMethod("plotRowGraph", point_size_range = point.size.range, point.size.range = c(1,4)){ # assemble arg list - point_out <- .get_point_args(colour_by, - shape_by, - size_by, - alpha = point_alpha, - size = point_size) - edge_out <- .get_graph_edge_args(edge_colour_by, - edge_width_by, - alpha = line_alpha, - size = line_width, - edge_type) + point_out <- .get_point_args( + colour_by, + shape_by, + size_by, + alpha = point_alpha, + size = point_size) + edge_out <- .get_graph_edge_args( + edge_colour_by, + edge_width_by, + alpha = line_alpha, + size = line_width, + edge_type) edge_FUN <- match.fun(paste0("geom_edge_",edge_type)) # begin plotting if(!is.null(algorithm)){ @@ -634,16 +633,15 @@ setMethod("plotRowGraph", plot_out <- .add_graph_labels(plot_out, show_label) # adjust edge colours if(!is.null(edge_colour_by)){ - plot_out <- .resolve_plot_colours(plot_out, - object %>% - activate("edges") %>% - pull("edge_colour_by"), - edge_colour_by, - type = "edges", - na.translate = FALSE, - # Specify guide - guide = "edge_colourbar" - ) + plot_out <- .resolve_plot_colours( + plot_out, + object %>% activate("edges") %>% pull("edge_colour_by"), + edge_colour_by, + type = "edges", + na.translate = FALSE, + # Specify guide + guide = "edge_colourbar" + ) } if (!is.null(edge_width_by)) { if(is.numeric(object %>% activate("edges") %>% pull("edge_width_by"))){ @@ -665,15 +663,14 @@ setMethod("plotRowGraph", } # adjust point colours if(!is.null(colour_by)){ - plot_out <- .resolve_plot_colours(plot_out, - object %>% - activate("nodes") %>% - pull("colour_by"), - colour_by, - fill = point_out$fill, - na.translate = FALSE) + plot_out <- .resolve_plot_colours( + plot_out, + object %>% activate("nodes") %>% pull("colour_by"), + colour_by, + fill = point_out$fill, + na.translate = FALSE) } - + # add additional guides plot_out <- .add_extra_guide(plot_out, shape_by, size_by) # add theme @@ -692,16 +689,16 @@ setMethod("plotRowGraph", if(show_label){ label_data <- plot_out$data %>% drop_na(label) plot_out <- plot_out + - geom_node_label(mapping = aes(label = .data[["label"]]), - data = label_data, - repel = TRUE, - max.overlaps = 100) + geom_node_label( + mapping = aes(label = .data[["label"]]), + data = label_data, + repel = TRUE, + max.overlaps = 100) } plot_out } .theme_plotGraph <- function(plot){ - plot + - theme_graph(base_family = "", - background = NA) + plot + + theme_graph(base_family = "", background = NA) } diff --git a/R/plotLoadings.R b/R/plotLoadings.R index d4c67142..49f41236 100644 --- a/R/plotLoadings.R +++ b/R/plotLoadings.R @@ -1,92 +1,87 @@ -#' Plot feature loadings for TreeSummarizedExperiment +#' Plot feature loadings for TreeSummarizedExperiment #' objects or feature loadings numeric matrix. #' #' This function is used after performing a reduction method. If \code{TreeSE} #' is given it retrieves the feature loadings matrix to plot values. #' A tree from \code{rowTree} can be added to heatmap layout. -#' +#' #' @inheritParams plotTree -#' +#' #' @param dimred \code{Character scalar}. Determines the reduced dimension to #' plot. -#' +#' #' @param layout \code{Character scalar}. Determines the layout of plot. Must be #' either \code{"barplot"}, \code{"heatmap"}, or \code{"lollipop"}. #' (Default: \code{"barplot"}) -#' +#' #' @param ncomponents \code{Numeric scalar}. Number of components must be lower #' or equal to the number of components chosen in the reduction method. #' (Default: \code{5}) -#' +#' #' @param add.tree \code{Logical scalar}. Whether to add tree to heatmap layout. #' (Default: \code{FALSE}) -#' +#' #' @param row.var \code{NULL} or \code{Character scalar}. Specifies a #' variable from \code{rowData} to plot with tree heatmap layout. #' (Default: \code{NULL}) -#' +#' #' @param ... additional parameters for plotting. #' \itemize{ #' \item \code{n}: \code{Integer scalar}. Number of features to be plotted. #' Applicable when \code{layout="barplot"}. (Default: \code{10})) -#' +#' #' \item \code{absolute.scale}: ("barplot", "lollipop") \code{Logical scalar}. #' Specifies whether a barplot or a lollipop plot should be visualized in #' absolute scale. (Default: \code{TRUE}) #' } -#' +#' #' @details -#' +#' #' These method visualize feature loadings of dimension reduction results. #' Inspired by the \code{plotASVcircular} method using \code{phyloseq}. #' \code{TreeSummarizedExperiment} object is expected to have #' content in \code{reducedDim} slot calculated with standardized methods from #' \code{mia} or \code{scater} package. -#' -#' @return +#' +#' @return #' A \code{ggplot2} object. #' #' @name plotLoadings #' @export #' #' @examples -#' +#' #' library(mia) #' library(scater) #' data("GlobalPatterns", package = "mia") #' tse <- GlobalPatterns -#' +#' #' # Calculate PCA #' tse <- agglomerateByPrevalence(tse, rank="Phylum", update.tree = TRUE) #' tse <- transformAssay(tse, method = "clr", pseudocount = 1) #' tse <- runPCA(tse, ncomponents = 5, assay.type = "clr") -#' +#' #' #' # Plotting feature loadings with tree #' plotLoadings(tse, dimred = "PCA", layout = "heatmap", add.tree = TRUE) -#' +#' #' # Plotting matrix as a barplot #' loadings_matrix <- attr(reducedDim(tse, "PCA"), "rotation") #' plotLoadings(loadings_matrix) -#' +#' #' # Plotting more features but less components #' plotLoadings(tse, dimred = "PCA", ncomponents = 2, n = 12) -#' +#' #' # Plotting matrix as heatmap without tree #' plotLoadings(loadings_matrix, layout = "heatmap") -#' +#' #' # Plot with less components #' plotLoadings(tse, "PCA", layout = "heatmap", ncomponents = 2) -#' +#' NULL #' @rdname plotLoadings -setGeneric("plotLoadings", signature = c("x"), - function(x, ...) - standardGeneric("plotLoadings")) - - -#' @rdname plotLoadings -#' @export +#' @export +#' @importFrom SingleCellExperiment reducedDims setMethod("plotLoadings", signature = c(x = "TreeSummarizedExperiment"), function( x, dimred, layout = "barplot", ncomponents = 5, tree.name = "phylo", @@ -108,7 +103,7 @@ setMethod("plotLoadings", signature = c(x = "TreeSummarizedExperiment"), } # Check that tree.name. If user wants to add tree, the tree name must # specify a tree - if(add.tree && !(.is_a_string(tree.name) && + if(add.tree && !(.is_a_string(tree.name) && tree.name %in% rowTreeNames(x)) ){ stop( "'tree.name' must be a string specifying a rowTree.", @@ -134,14 +129,15 @@ setMethod("plotLoadings", signature = c(x = "TreeSummarizedExperiment"), } else { # Utilize matrix method to create a plot p <- plotLoadings( - mat, layout = layout, ncomponents = ncomponents, ...) + mat, layout = layout, ncomponents = ncomponents, ...) } return(p) } ) #' @rdname plotLoadings -#' @export +#' @export +#' @importFrom SingleCellExperiment reducedDims setMethod("plotLoadings", signature = c(x = "SingleCellExperiment"), function(x, dimred, layout = "barplot", ncomponents = 5, ...){ # Check that there are reducedDim @@ -159,13 +155,13 @@ setMethod("plotLoadings", signature = c(x = "SingleCellExperiment"), mat <- .get_loadings_matrix(x, dimred, ...) # Utilize matrix method to create a plot p <- plotLoadings( - mat, layout = layout, ncomponents = ncomponents, ...) + mat, layout = layout, ncomponents = ncomponents, ...) return(p) } ) #' @rdname plotLoadings -#' @export +#' @export setMethod("plotLoadings", signature = c(x = "matrix"), function(x, layout = "barplot", ncomponents = 5, ...) { # Input check @@ -231,7 +227,7 @@ setMethod("plotLoadings", signature = c(x = "matrix"), # This function manipulates the loadings data into correct format. The output # is data.frame in long format directly usable for ggplot. -#' @importFrom tibble rownames_to_column +#' @importFrom tibble rownames_to_column #' @importFrom tidyr pivot_longer .get_loadings_plot_data <- function(df, layout, ncomponents, n = 10, ...) { # Transform into a dataframe @@ -249,8 +245,8 @@ setMethod("plotLoadings", signature = c(x = "matrix"), res <- df %>% rownames_to_column(var = "Feature") %>% pivot_longer( - cols = components, - names_to = "PC", + cols = components, + names_to = "PC", values_to = "Value") } # Convert into data.frame @@ -266,7 +262,7 @@ setMethod("plotLoadings", signature = c(x = "matrix"), } # This function subsets the data so that it selects top features that have the -# greatest loadings for single component. +# greatest loadings for single component. .process_component <- function(i, df, n) { # Get order of loadings based on absolute value ind <- order(-abs(df[[i]])) @@ -287,6 +283,8 @@ setMethod("plotLoadings", signature = c(x = "matrix"), # This function calculates place for +/- sign in barplot/lollipop plot #' @importFrom dplyr %>% group_by mutate case_when ungroup .calculate_max_and_min_for_loadings <- function(df){ + # To disable "no visible binding for global variable" message in cmdcheck + Value <- PC <- NULL # Add column that shows the values in absolute scale, and another column # showing sign df[["Value_abs"]] <- abs(df[["Value"]]) @@ -318,6 +316,8 @@ setMethod("plotLoadings", signature = c(x = "matrix"), # This functions plots a data.frame in barplot or heatmap layout. #' @importFrom ggplot2 geom_tile scale_fill_gradient2 .plot_loadings <- function(df, layout, ...) { + # To disable "no visible binding for global variable" message in cmdcheck + PC <- Feature <- Value <- NULL # Initialize a plot plot_out <- ggplot(df) # Either create a heatmap or barplot/lollipop @@ -333,7 +333,7 @@ setMethod("plotLoadings", signature = c(x = "matrix"), limits = c(-max(abs(df$Value)), max(abs(df$Value))), low = "darkblue", mid = "white", high = "darkred" ) - + } else if( layout %in% c("barplot", "lollipop") ){ plot_out <- .plot_bar_or_lollipop(plot_out, df, layout, ...) } @@ -349,6 +349,8 @@ setMethod("plotLoadings", signature = c(x = "matrix"), .plot_bar_or_lollipop <- function( plot_out, df, layout, absolute.scale = TRUE, show.color = TRUE, show.sign = FALSE, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + Sign <- max_scale_abs <- max_scale <- NULL # if( !.is_a_bool(absolute.scale) ){ stop("'absolute.scale' must be TRUE or FALSE.", call. = FALSE) @@ -371,7 +373,7 @@ setMethod("plotLoadings", signature = c(x = "matrix"), if(absolute.scale) -df$Value_abs else df$Value, df$PC ) - + # Plot barplot or lollipop if (layout == "barplot") { # This creates a barplot @@ -398,7 +400,7 @@ setMethod("plotLoadings", signature = c(x = "matrix"), color = if (show.color) Sign else NULL )) } - + # Add sign labels if needed if( show.sign ){ plot_out <- plot_out + geom_text(aes( @@ -409,7 +411,7 @@ setMethod("plotLoadings", signature = c(x = "matrix"), fontface = "bold" )) } - + # Customize the legend for Sign as "Effect" if( show.color ) { # Get correct function, barplot uses fill, lollipop color @@ -419,18 +421,18 @@ setMethod("plotLoadings", signature = c(x = "matrix"), # values shows + or -. Make the legend nicer. plot_out <- plot_out + scale_FUN( - name = "Effect", + name = "Effect", values = c("+" = "blue", "-" = "red"), labels = c("+" = "positive", "-" = "negative") ) } - + # Final wrangle, set facets and order the data plot_out <- plot_out + scale_y_reordered() + facet_wrap(~PC, scales = "free") + labs(x = "Value", y = "Feature") - + return(plot_out) } diff --git a/R/plotNDMS.R b/R/plotNDMS.R index dadfed23..57005276 100644 --- a/R/plotNDMS.R +++ b/R/plotNDMS.R @@ -1,16 +1,15 @@ #' Wrapper for scater::plotReducedDim() -#' +#' #' @param x a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' object. -#' -#' @param ncomponents -#' \code{Numeric scalar}. indicating the number of dimensions to plot, starting from -#' the first dimension. Alternatively, a numeric vector specifying the -#' dimensions to be plotted. (Default: \code{2}) -#' +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} +#' object. +#' +#' @param ncomponents \code{Numeric scalar}. indicating the number of dimensions +#' to plot, starting from the first dimension. Alternatively, a numeric vector +#' specifying the dimensions to be plotted. (Default: \code{2}) +#' #' @param ... additional arguments passed to scater::plotReducedDim(). -#' +#' #' @name plotNMDS NULL diff --git a/R/plotPrevalence.R b/R/plotPrevalence.R index eb1e0fce..045c21a9 100644 --- a/R/plotPrevalence.R +++ b/R/plotPrevalence.R @@ -1,137 +1,144 @@ #' Plot prevalence information -#' -#' \code{plotPrevalence} and \code{plotRowPrevalence} visualize prevalence +#' +#' \code{plotPrevalence} and \code{plotRowPrevalence} visualize prevalence #' information. -#' +#' #' Whereas \code{plotPrevalence} produces a line plot, \code{plotRowPrevalence} -#' returns a heatmap. -#' +#' returns a heatmap. +#' #' @param x a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' object. -#' +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} +#' object. +#' #' @param rank,... additional arguments #' \itemize{ #' \item as.relative \code{Logical scalar}. Should the relative values -#' be calculated? (Default: \code{FALSE}) -#' +#' be calculated? (Default: \code{FALSE}) +#' #' \item ndetection \code{Integer scalar}. Determines the number of breaks #' calculated detection thresholds when \code{detection=NULL}. When #' \code{TRUE}, \code{as_relative} is then also regarded as \code{TRUE}. #' (Default: \code{20}) -#' +#' #' \item{If \code{!is.null(rank)} matching arguments are passed on to #' \code{\link[=agglomerate-methods]{agglomerateByRank}}. See #' \code{\link[=agglomerate-methods]{?agglomerateByRank}} for more details. #' } -#' -#' \item{additional arguments for plotting. See +#' +#' \item{additional arguments for plotting. See #' \code{\link{mia-plot-args}} for more details i.e. call #' \code{help("mia-plot-args")}} #' } -#' -#' +#' +#' #' @param assay.type \code{Character scalar}. Defines which assay data to #' use. (Default: \code{"relabundance"}) -#' +#' #' @param assay_name Deprecated. Use \code{assay.type} instead. -#' -#' @param colour.by \code{Character scalar}. Specification of a feature to colour points by, see the -#' \code{by} argument in \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for -#' possible values. Only used with \code{layout = "point"}. (Default: \code{NULL}) -#' +#' +#' @param colour.by \code{Character scalar}. Specification of a feature to +#' colour points by, see the \code{by} argument in +#' \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for +#' possible values. Only used with \code{layout = "point"}. +#' (Default: \code{NULL}) +#' #' @param colour_by Deprecated. Use \code{colour.by} instead. -#' -#' @param shape.by \code{Character scalar}. Specification of a feature to shape points by, see the -#' \code{by} argument in \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for -#' possible values. Only used with \code{layout = "point"}. (Default: \code{NULL}) -#' -#' @param shape_by Deprecated. Use \code{shape.by} instead. -#' -#' @param size.by \code{Character scalar}. Specification of a feature to size points by, see the -#' \code{by} argument in \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for -#' possible values. Only used with \code{layout = "point"}. (Default: \code{NULL}) -#' +#' +#' @param shape.by \code{Character scalar}. Specification of a feature to shape +#' points by, see the \code{by} argument in +#' \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for +#' possible values. Only used with \code{layout = "point"}. +#' (Default: \code{NULL}) +#' +#' @param shape_by Deprecated. Use \code{shape.by} instead. +#' +#' @param size.by \code{Character scalar}. Specification of a feature to size +#' points by, see the \code{by} argument in +#' \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for +#' possible values. Only used with \code{layout = "point"}. +#' (Default: \code{NULL}) +#' #' @param size_by Deprecated. Use \code{size.by} instead. -#' -#' @param facet.by \code{Character scalar}. Taxonomic rank to facet the plot by. +#' +#' @param facet.by \code{Character scalar}. Taxonomic rank to facet the plot by. #' Value must be of \code{taxonomyRanks(x)} -#' Argument can only be used in function plotPrevalentAbundance. -#' +#' Argument can only be used in function plotPrevalentAbundance. +#' #' @param facet_by Deprecated. Use \code{facet.by} instead. -#' -#' @param show.label \code{Logical scalar}, \code{character scalar} or \code{integer vector} -#' for selecting labels from the rownames of \code{x}. If \code{rank} is not -#' \code{NULL} the rownames might change. (Default: \code{NULL}) -#' +#' +#' @param show.label \code{Logical scalar}, \code{character scalar} or +#' \code{integer vector} for selecting labels from the rownames of \code{x}. +#' If \code{rank} is not \code{NULL} the rownames might change. +#' (Default: \code{NULL}) +#' #' @param label Deprecated. Use \code{show.label} instead. #' -#' @param detection \code{Numeric scalar}. Detection thresholds for absence/presence. Either an -#' absolutes value compared directly to the values of \code{x} or a relative -#' value between 0 and 1, if \code{TRUE}. -#' +#' @param detection \code{Numeric scalar}. Detection thresholds for +#' absence/presence. Either an absolutes value compared directly to the values +#' of \code{x} or a relative value between 0 and 1, if \code{TRUE}. +#' #' @param detections Deprecated. Use \code{detection} instead. -#' -#' @param prevalence \code{Numeric scalar}. Prevalence thresholds (in 0 to 1). The -#' required prevalence is strictly greater by default. To include the -#' limit, set \code{include.lowest} to \code{TRUE}. -#' +#' +#' @param prevalence \code{Numeric scalar}. Prevalence thresholds (in 0 to 1). +#' The required prevalence is strictly greater by default. To include the +#' limit, set \code{include.lowest} to \code{TRUE}. +#' #' @param prevalences Deprecated. Use \code{prevalence} instead. #' -#' @param min.prevalence \code{Numeric scalar}. Applied as a threshold for +#' @param min.prevalence \code{Numeric scalar}. Applied as a threshold for #' plotting. The threshold is applied per row and column. #' (Default: \code{0}) -#' +#' #' @param min_prevalence Deprecated. Use \code{min.prevalence} instead. -#' +#' #' @param BPPARAM A #' \code{\link[BiocParallel:BiocParallelParam-class]{BiocParallelParam}} #' object specifying whether the UniFrac calculation should be parallelized. -#' -#' @details -#' Agglomeration on different taxonomic levels is available through the -#' \code{rank} argument. -#' -#' To exclude certain taxa, preprocess \code{x} to your liking, for example -#' with subsetting via \code{getPrevalent} or +#' +#' @details +#' Agglomeration on different taxonomic levels is available through the +#' \code{rank} argument. +#' +#' To exclude certain taxa, preprocess \code{x} to your liking, for example +#' with subsetting via \code{getPrevalent} or #' \code{agglomerateByPrevalence}. -#' -#' @return -#' A \code{ggplot2} object or \code{plotly} object, if more than one +#' +#' @return +#' A \code{ggplot2} object or \code{plotly} object, if more than one #' \code{prevalence} was defined. -#' -#' @seealso +#' +#' @seealso #' \code{\link[mia:getPrevalence]{getPrevalence}}, #' \code{\link[mia:getPrevalence]{agglomerateByPrevalence}}, #' \code{\link[mia:agglomerate-methods]{agglomerateByRank}} -#' +#' #' @name plotPrevalence -#' -#' @examples +#' +#' @examples #' data(GlobalPatterns, package = "mia") -#' +#' #' # Apply relative transformation #' GlobalPatterns <- transformAssay(GlobalPatterns, method = "relabundance") -#' +#' #' # plotting N of prevalence exceeding taxa on the Phylum level #' plotPrevalence(GlobalPatterns, rank = "Phylum") #' plotPrevalence(GlobalPatterns, rank = "Phylum") + scale_x_log10() -#' +#' #' # plotting prevalence per taxa for different detection thresholds as heatmap #' plotRowPrevalence(GlobalPatterns, rank = "Phylum") -#' -#' # by default a continuous scale is used for different detection levels, +#' +#' # by default a continuous scale is used for different detection levels, #' # but this can be adjusted #' plotRowPrevalence( #' GlobalPatterns, rank = "Phylum", assay.type = "relabundance", #' detection = c(0, 0.001, 0.01, 0.1, 0.2)) -#' +#' #' # point layout for plotRowPrevalence can be used to visualize by additional #' # information #' plotPrevalentAbundance( #' GlobalPatterns, rank = "Family", colour.by = "Phylum") + #' scale_x_log10() -#' +#' #' # When using function plotPrevalentAbundace, it is possible to create facets #' # with 'facet.by'. #' plotPrevalentAbundance( @@ -143,11 +150,6 @@ NULL ################################################################################ # plotPrevalence -#' @rdname plotPrevalence -#' @export -setGeneric("plotPrevalence", signature = c("x"), - function(x, ...) standardGeneric("plotPrevalence")) - #' @rdname plotPrevalence #' @export setMethod("plotPrevalence", signature = c(x = "SummarizedExperiment"), @@ -164,9 +166,9 @@ setMethod("plotPrevalence", signature = c(x = "SummarizedExperiment"), stop("'detection' must be numeric values.", call. = FALSE) } if(!all(.is_numeric_string(prevalence)) || any(prevalence < 0) || - any(prevalence > 1)){ + any(prevalence > 1)){ stop("'prevalence' must be numeric values between 0 and 1.", - call. = FALSE) + call. = FALSE) } .check_assay_present(assay.type, x) # @@ -179,7 +181,7 @@ setMethod("plotPrevalence", signature = c(x = "SummarizedExperiment"), x, assay.type, detection, prevalence, BPPARAM, ...) plot_data$colour_by <- plot_data$colour_by * 100 # Plot the data - p <- .prevalence_plotter(plot_data, + p <- .prevalence_plotter(plot_data, layout = "line", ylab = "N", colour_by = "Prevalence [%]", @@ -246,11 +248,6 @@ setMethod("plotPrevalence", signature = c(x = "SummarizedExperiment"), ################################################################################ # plotPrevalentAbundance -#' @rdname plotPrevalence -#' @export -setGeneric("plotPrevalentAbundance", signature = c("x"), - function(x, ...) standardGeneric("plotPrevalentAbundance")) - #' @rdname plotPrevalence #' @export setMethod("plotPrevalentAbundance", signature = c(x = "SummarizedExperiment"), @@ -271,7 +268,7 @@ setMethod("plotPrevalentAbundance", signature = c(x = "SummarizedExperiment"), # input check .check_assay_present(assay.type, x) - # Check facet.by It is FALSE by default, but user can specify it, but + # Check facet.by It is FALSE by default, but user can specify it, but # the value must be in taxonomyRanks. if(!(is.null(facet.by) || facet.by %in% taxonomyRanks(x))){ stop("'facet.by' must be in taxonomyRanks.", call. = FALSE) @@ -303,7 +300,7 @@ setMethod("plotPrevalentAbundance", signature = c(x = "SummarizedExperiment"), ylab <- paste0( "Prevalence (", ifelse(is.null(rank), "Features", rank), ") [%]") # Plot the data - plot <- .prevalence_plotter(plot_data, + plot <- .prevalence_plotter(plot_data, layout = "point", ylab = ylab, colour_by = colour_by, @@ -313,7 +310,7 @@ setMethod("plotPrevalentAbundance", signature = c(x = "SummarizedExperiment"), # If facet.by is not NULL, user has specified it. Adds the facets to # the plot. if(!is.null(facet.by)){ - plot <- plot + + plot <- plot + # Create facets facet_wrap(vars(!!sym("facet_by"))) } @@ -404,12 +401,6 @@ setMethod("plotPrevalentAbundance", signature = c(x = "SummarizedExperiment"), ################################################################################ # plotRowPrevalence -#' @rdname plotPrevalence -#' @aliases plotTaxaPrevalence -#' @export -setGeneric("plotRowPrevalence", signature = c("x"), - function(x, ...) standardGeneric("plotRowPrevalence")) - #' @rdname plotPrevalence #' @export setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), @@ -427,10 +418,10 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), stop("'detection' must be numeric values.", call. = FALSE) } .check_assay_present(assay.type, x) - + if(length(min.prevalence) != 1 || !.is_numeric_string(min.prevalence)){ stop("'min.prevalence' must be single numeric values.", - call. = FALSE) + call. = FALSE) } # # Agglomerate data if specified @@ -444,7 +435,7 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), ylab <- ifelse(is.null(rank), "Features", rank) colour_by <- "Prevalence [%]" # Plot the data - p <- .prevalence_plotter(plot_data, + p <- .prevalence_plotter(plot_data, layout = "heatmap", ylab = ylab, colour_by = colour_by, @@ -471,13 +462,15 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), BPPARAM = BiocParallel::SerialParam(), as.relative = as_relative, as_relative = FALSE, ndetection = 20, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + ID <- NULL # Input check if(!.is_a_bool(as_relative)){ stop("'as_relative' must be TRUE or FALSE.", call. = FALSE) } if(as_relative && (any(detections < 0) || any(detections > 1))){ stop("If 'as_relative' == TRUE, detection' must be numeric ", - "values between 0 and 1.", call. = FALSE) + "values between 0 and 1.", call. = FALSE) } if( !.is_an_integer(ndetection) ){ stop("'ndetection' must be a single integer value.", call. = FALSE) @@ -523,7 +516,7 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), # If there are no data to plot anymro e after subsetting, give error. if(any(dim(ans) == 0)){ stop("No data left after apply threshold 'min_prevalence'.", - call. = FALSE) + call. = FALSE) } # Get the taxa order, the most abundant taxa comes first lvls <- rownames(ans)[order(rowSums(ans))] @@ -531,9 +524,7 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), ans[["ID"]] <- rownames(x)[rowSums(f) != 0] # Convert the table to long format ans <- ans %>% - pivot_longer(!ID, - names_to = "detection", - values_to = "prevalence") + pivot_longer(!ID, names_to = "detection", values_to = "prevalence") colnames(ans) <- c("Y","X","colour_by") # Round values ans$X <- round(as.numeric(ans$X),4) * 100 @@ -585,7 +576,7 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), line_args <- .get_line_args( colour_by = colour_by, linetype_by = NULL, size_by = NULL, alpha = line_alpha, linetype = line_type, linewidth = line_size) - # Add grouping. Otherwise, the line does not follow the same value as + # Add grouping. Otherwise, the line does not follow the same value as # colouring. point_args$args$mapping$group <- sym("colour_by") line_args$args$mapping$group <- sym("colour_by") @@ -624,10 +615,10 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), # Add scale. If numeric, add continuous scaling, if discrete, add # discrete scaling. if(is.factor(plot_data$X)){ - plot_out <- plot_out + + plot_out <- plot_out + scale_x_discrete(expand = c(0,0)) } else { - plot_out <- plot_out + + plot_out <- plot_out + scale_x_continuous(expand = c(0,0), n.breaks = 7L) } } else { @@ -643,37 +634,3 @@ setMethod("plotRowPrevalence", signature = c(x = "SummarizedExperiment"), plot_out, flipped, add_x_text = TRUE, angle_x_text = FALSE) return(plot_out) } - -#' @rdname plotPrevalence -#' @aliases plotRowPrevalence -#' @export -setGeneric("plotTaxaPrevalence", signature = c("x"), - function(x, ...) - standardGeneric("plotTaxaPrevalence")) - -#' @rdname plotPrevalence -#' @aliases plotRowPrevalence -#' @export -setMethod("plotTaxaPrevalence", signature = c(x = "ANY"), - function(x, ...){ - .Deprecated(old ="plotTaxaPrevalence", new = "plotRowPrevalence", msg = "The 'plotTaxaPrevalence' function is deprecated. Use 'plotRowPrevalence' instead.") - plotRowPrevalence(x, ...) - } -) - -#' @rdname plotPrevalence -#' @aliases plotRowPrevalence -#' @export -setGeneric("plotFeaturePrevalence", signature = c("x"), - function(x, ...) - standardGeneric("plotFeaturePrevalence")) - -#' @rdname plotPrevalence -#' @aliases plotRowPrevalence -#' @export -setMethod("plotFeaturePrevalence", signature = c(x = "ANY"), - function(x, ...){ - .Deprecated(old ="plotFeaturePrevalence", new = "plotRowPrevalence", msg = "The 'plotFeaturePrevalence' function is deprecated. Use 'plotRowPrevalence' instead.") - plotRowPrevalence(x, ...) - } -) diff --git a/R/plotScree.R b/R/plotScree.R index 66bb329a..686dcdff 100644 --- a/R/plotScree.R +++ b/R/plotScree.R @@ -1,16 +1,16 @@ #' @name #' plotScree -#' +#' #' @title #' Create a scree plot -#' -#' @description +#' +#' @description #' \code{plotScree} generates a scree plot to visualize the eigenvalues. #' The eigenvalues can be provided either as a part of a #' \code{TreeSummarizedExperiment} object or as a separate \code{vector}. #' This plot illustrates the decline in eigenvalues across components, #' helping to assess the importance of each component. -#' +#' #' @details #' \code{plotScree} generates a scree plot to visualize the relative importance #' of components in dimensionality reduction techniques such as Principal @@ -21,81 +21,76 @@ #' function. Alternatively, if the input is a \code{vector} or an #' \code{eigenvals} object, these values are directly used as eigenvalues for #' the plot. -#' +#' #' The plot can include a combination of barplot, points, connecting lines, #' and labels, which can be controlled using the \code{show.*} parameters. -#' +#' #' An option to show cumulative explained variance is also available by setting #' \code{add.cumulative = TRUE}. -#' -#' @return -#' A \code{ggplot2} object -#' +#' +#' @return +#' A \code{ggplot2} object +#' #' @param x a #' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-constructor]{TreeSummarizedExperiment}} #' \code{\link[vegan:eigenvals]{eigenvals}} or a vector. -#' +#' #' @param dimred \code{Character scalar} or \code{integer scalar}. Determines #' the reduced dimension to plot. This is used when \code{x} is a #' \code{TreeSummarizedExperiment} to extract the eigenvalues from #' \code{reducedDim(x, dimred)}. -#' +#' #' @param ... additional parameters for plotting #' \itemize{ #' \item \code{show.barplot}: \code{Logical scalar}. Whether to show a #' barplot. (Default: \code{TRUE}) -#' +#' #' \item \code{show.points}: \code{Logical scalar}. Whether to show a #' points. (Default: \code{TRUE}) -#' +#' #' \item \code{show.line}: \code{Logical scalar}. Whether to show a #' line. (Default: \code{TRUE}) -#' +#' #' \item \code{show.labels}: \code{Logical scalar}. Whether to show a #' labels for each point. (Default: \code{FALSE}) -#' +#' #' \item \code{add.proportion}: \code{Logical scalar}. Whether to show #' proportion of explained variance, i.e., raw eigenvalues. #' (Default: \code{TRUE}) -#' +#' #' \item \code{add.cumulative}: \code{Logical scalar}. Whether to show #' cumulative explained variance calculated from eigenvalues. #' (Default: \code{FALSE}) -#' +#' #' \item \code{n}: \code{Integer scalar}. Number of eigenvalues to plot. #' If \code{NULL}, all eigenvalues are plotted. (Default: \code{NULL}) -#' +#' #' \item \code{show.names}: \code{Logical scalar}. Whether to show names of #' components in x-axis. If \code{FALSE}, the index of component is shown #' instead of names. (Default: \code{FALSE}) -#' +#' #' \item \code{eig.name}: \code{Character scalar}. The name of the attribute #' in \code{reducedDim(x, dimred)} that contains the eigenvalues. #' (Default: \code{c("eig", "varExplained")}) #' } #' #' @examples -#' +#' #' library(miaViz) #' library(scater) -#' +#' #' data("enterotype", package = "mia") #' tse <- enterotype -#' +#' #' # Run PCA and store results into TreeSE #' tse <- transformAssay(tse, method = "clr", pseudocount = TRUE) #' tse <- runPCA(tse, assay.type = "clr") -#' +#' #' # Plot scree plot #' plotScree(tse, "PCA", add.cumulative = TRUE) -#' +#' NULL -#' @rdname plotScree -#' @export -setGeneric("plotScree", signature = c("x"), - function(x, ...) standardGeneric("plotScree")) - #' @rdname plotScree #' @export setMethod("plotScree", signature = c(x = "SingleCellExperiment"), @@ -130,6 +125,7 @@ setMethod("plotScree", signature = c(x = "ANY"), # This function retrieves the eigenvalues from reducedDim. The ordination must # be calculated with dedicaded function in mia or scater so that the eigenvalues # are stored in correct place. +#' @importFrom SingleCellExperiment reducedDim .get_eigenvalues <- function( x, dimred, eig.name = c("eig", "varExplained"), ...){ # Get reducedDim @@ -178,8 +174,8 @@ setMethod("plotScree", signature = c(x = "ANY"), sum(df_cum[["y"]], na.rm = TRUE) df_cum[["type"]] <- "cumulative" df <- rbind(df, df_cum) - - # Based on user preference, keep proportion or/and cumulative values + + # Based on user preference, keep proportion or/and cumulative values if( !add.proportion ){ df <- df[df[["type"]] != "proportion", ] } @@ -204,6 +200,8 @@ setMethod("plotScree", signature = c(x = "ANY"), .scree_plotter <- function( df, show.points = TRUE, show.line = TRUE, show.barplot = FALSE, show.labels = FALSE, ...){ + # To disable "no visible binding for global variable" message in cmdcheck + x <- y <- type <- NULL # Input check if( !.is_a_bool(show.points) ){ stop("'show.points' must be TRUE or FALSE.", call. = FALSE) @@ -224,7 +222,7 @@ setMethod("plotScree", signature = c(x = "ANY"), ind <- df[["type"]] == "cumulative" df[ind, "y"] <- df[ind, "y"] * max(df[!ind, "y"]) # Scale } - + # Create base plot p <- ggplot(df, aes( x = x, @@ -246,7 +244,7 @@ setMethod("plotScree", signature = c(x = "ANY"), if( show.labels ){ p <- p + geom_label(aes(label = round(y, 2))) } - + # If user wants to add barplots or labels with both cumulative and # propotion values, the plot is splitted into two facets. Otherwise the # the plot would be too messy to read. diff --git a/R/plotSeries.R b/R/plotSeries.R index 0a53c0ef..0cd4d9e9 100644 --- a/R/plotSeries.R +++ b/R/plotSeries.R @@ -3,53 +3,55 @@ #' This function plots series data. #' #' @param object a -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -#' object. +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} +#' object. #' #' @param assay.type \code{Character scalar}. selecting the -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{assay}} to be -#' plotted. (Default: \code{"counts"}) -#' +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{assay}} to be +#' plotted. (Default: \code{"counts"}) +#' #' @param assay_name Deprecated. Use \code{assay.type} instead. #' #' @param x \code{Character scalar}. selecting the column from -#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{ColData}} that -#' will specify values of x-axis. -#' +#' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{ColData}} that +#' will specify values of x-axis. +#' #' @param y \code{Character scalar}. Selects the taxa from #' \code{\link[SummarizedExperiment:SummarizedExperiment-class]{rownames}}. #' This parameter specifies taxa whose abundances will be plotted. -#' -#' @param rank \code{Character scalar}. A taxonomic rank, that is used -#' to agglomerate the data. Must be a value of \code{taxonomicRanks()} +#' +#' @param rank \code{Character scalar}. A taxonomic rank, that is used +#' to agglomerate the data. Must be a value of \code{taxonomicRanks()} #' function. (Default: \code{NULL}) -#' +#' #' @param colour.by \code{Character scalar}. A taxonomic rank, that is used to -#' color plot. Must be a value of \code{taxonomicRanks()} function. (Default: \code{NULL}) -#' +#' color plot. Must be a value of \code{taxonomicRanks()} function. +#' (Default: \code{NULL}) +#' #' @param colour_by Deprecated. Use \code{colour.by} instead. -#' +#' #' @param linetype.by \code{Character scalar}. A taxonomic rank, that -#' is used to divide taxa to different line types. Must be a value of -#' \code{taxonomicRanks()} function. (Default: \code{NULL}) -#' +#' is used to divide taxa to different line types. Must be a value of +#' \code{taxonomicRanks()} function. (Default: \code{NULL}) +#' #' @param linetype_by Deprecated. Use \code{linetype.by} instead. -#' +#' #' @param size.by \code{Character scalar}. A taxonomic rank, that is -#' used to divide taxa to different line size types. Must be a value of -#' \code{taxonomicRanks()} function. (Default: \code{NULL}) -#' +#' used to divide taxa to different line size types. Must be a value of +#' \code{taxonomicRanks()} function. (Default: \code{NULL}) +#' #' @param size_by Deprecated. Use \code{size.by} instead. -#' -#' @param ... additional parameters for plotting. See -#' \code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")} +#' +#' @param ... additional parameters for plotting. See +#' \code{\link{mia-plot-args}} for more details i.e. call +#' \code{help("mia-plot-args")} #' #' @details -#' This function creates series plot, where x-axis includes e.g. time points, and -#' y-axis abundances of selected taxa. +#' This function creates series plot, where x-axis includes e.g. time points, +#' and y-axis abundances of selected taxa. #' -#' @return -#' A \code{ggplot2} object +#' @return +#' A \code{ggplot2} object #' #' @name plotSeries #' @@ -62,72 +64,56 @@ #' library("miaTime") #' data(SilvermanAGutData) #' object <- SilvermanAGutData -#' +#' #' # Plots 2 most abundant taxa, which are colored by their family #' plotSeries(object, #' x = "DAY_ORDER", #' y = getTop(object, 2), #' colour.by = "Family") -#' +#' #' # Counts relative abundances #' object <- transformAssay(object, method = "relabundance") -#' +#' #' # Selects taxa #' taxa <- c("seq_1", "seq_2", "seq_3", "seq_4", "seq_5") -#' +#' #' # Plots relative abundances of phylums #' plotSeries(object[taxa,], -#' x = "DAY_ORDER", +#' x = "DAY_ORDER", #' colour.by = "Family", #' linetype.by = "Phylum", #' assay.type = "relabundance") -#' -#' # In addition to 'colour.by' and 'linetype.by', 'size.by' can also be used to group taxa. +#' +#' # In addition to 'colour.by' and 'linetype.by', 'size.by' can also be used +#' # to group taxa. #' plotSeries(object, -#' x = "DAY_ORDER", -#' y = getTop(object, 5), +#' x = "DAY_ORDER", +#' y = getTop(object, 5), #' colour.by = "Family", #' size.by = "Phylum", #' assay.type = "counts") #' } NULL -#' @rdname plotSeries -#' @export -setGeneric("plotSeries", signature = c("object"), - function(object, - x, - y = NULL, - rank = NULL, - colour.by = colour_by, - colour_by = NULL, - size.by = size_by, - size_by = NULL, - linetype.by = linetype_by, - linetype_by = NULL, - assay.type = assay_name, assay_name = "counts", - ...) - standardGeneric("plotSeries")) - - #' @rdname plotSeries #' @importFrom SummarizedExperiment colData rowData assay #' @importFrom mia meltSE #' @importFrom stats sd #' @export setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), - function(object, - x, - y = NULL, - rank = NULL, - colour.by = colour_by, - colour_by = NULL, - size.by = size_by, - size_by = NULL, - linetype.by = linetype_by, - linetype_by = NULL, - assay.type = assay_name, assay_name = "counts", - ...){ + function( + object, + x, + y = NULL, + rank = NULL, + colour.by = colour_by, + colour_by = NULL, + size.by = size_by, + size_by = NULL, + linetype.by = linetype_by, + linetype_by = NULL, + assay.type = assay_name, assay_name = "counts", + ...){ ###################### Input check ####################### # Checks assay.type .check_assay_present(assay.type, object) @@ -135,24 +121,22 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), if( !.is_a_string(x) || !(x %in% names(colData(object))) ){ stop("'x' must be a name of column of colData(object)", - call. = FALSE) + call. = FALSE) } # If rank is not null, data will be agglomerated by rank if( !is.null(rank) ){ # Check rank .check_taxonomic_rank(rank, object) - + # Agglomerates the object object <- agglomerateByRank(object, rank = rank) } # Checks Y # If Y is not null, user has specified it if (!is.null(y)){ - if(!is.character(y) || - !all( y %in% rownames(object))){ - stop("'y' must be in rownames(x). \n If 'rank' was used, check ", - "that 'y' matches agglomerated data.", - call. = FALSE) + if(!is.character(y) || !all( y %in% rownames(object))){ + stop("'y' must be in rownames(x). \n If 'rank' was used, ", + "check that 'y' matches agglomerated data.", call. = FALSE) } # Select taxa that user has specified object <- object[y,] @@ -173,7 +157,7 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), ylab <- paste0(assay.type) # Create the plot p <- .series_plotter( - plot_data, + plot_data, xlab = xlab, ylab = ylab, colour_by = colour.by, @@ -191,8 +175,11 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), #' @importFrom dplyr group_by summarize ungroup #' @importFrom stats sd #' @importFrom mia meltSE +#' @importFrom SummarizedExperiment rowData<- .get_series_data <- function( object, assay.type, x, colour.by, size.by, linetype.by){ + # To disable "no visible binding for global variable" message in cmdcheck + Y <- NULL # Get variables that can be found from rowData row_vars <- c( colour_by = colour.by, size_by = size.by, linetype_by = linetype.by) @@ -203,7 +190,7 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), colnames(rowData(object))[ match(row_vars, colnames(rowData(object))) ] <- names(row_vars) row_vars <- names(row_vars) - + # Melt SE object. If value is not found from rowData/colData, user get # informative error message. plot_data <- meltSE( @@ -259,23 +246,23 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), plot_data$colour_by <- plot_data$feature } # Creates a "draft" of a plot - plot_out <- ggplot(plot_data, - aes(x = .data[["X"]], y = .data[["Y"]])) + + plot_out <- ggplot(plot_data, aes(x = .data[["X"]], y = .data[["Y"]])) + labs(x = xlab, y = ylab) # if sd column is present add a ribbon if(!is.null(plot_data$sd)){ - ribbon_args <- .get_ribbon_args(colour_by = colour_by, - alpha = ribbon_alpha) + ribbon_args <- .get_ribbon_args( + colour_by = colour_by, alpha = ribbon_alpha) plot_out <- plot_out + do.call(geom_ribbon, ribbon_args$args) } # Fetches arguments for geom_line - line_args <- .get_line_args(colour_by = colour_by, - linetype_by = linetype_by, - size_by = size_by, - alpha = line_alpha, - linetype = line_type, - linewidth = line_width) + line_args <- .get_line_args( + colour_by = colour_by, + linetype_by = linetype_by, + size_by = size_by, + alpha = line_alpha, + linetype = line_type, + linewidth = line_width) # Adds arguments to the plot plot_out <- plot_out + do.call(geom_line, line_args$args) @@ -290,16 +277,12 @@ setMethod("plotSeries", signature = c(object = "SummarizedExperiment"), SIZEFUN(range = line_width_range) } # Resolves the colours - plot_out <- .resolve_plot_colours(plot_out, - plot_data$colour_by, - colour_by, - fill = FALSE) + plot_out <- .resolve_plot_colours( + plot_out, plot_data$colour_by, colour_by, fill = FALSE) if(!is.null(plot_data$sd)){ - plot_out <- .resolve_plot_colours(plot_out, - plot_data$colour_by, - colour_by, - fill = TRUE) - } + plot_out <- .resolve_plot_colours( + plot_out, plot_data$colour_by, colour_by, fill = TRUE) + } # add additional guides plot_out <- .add_extra_line_guide(plot_out, linetype_by, size_by) # To choose if legend is kept, and its position diff --git a/R/plotTree.R b/R/plotTree.R index 8c00d2bf..c05952fc 100644 --- a/R/plotTree.R +++ b/R/plotTree.R @@ -6,30 +6,29 @@ #' additional information. #' #' @param x a -#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} -#' x. -#' +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}}. +#' #' @param tree.name \code{Character scalar}. Specifies a rowTree/colTree from -#' \code{x}. (Default: \code{tree.name = "phylo"}) -#' +#' \code{x}. (Default: \code{tree.name = "phylo"}) +#' #' @param tree_name Deprecated. Use \code{tree.name} instead. #' -#' @param relabel.tree \code{Logical scalar}. Should the tip labels be relabeled using -#' the output of \code{getTaxonomyLabels(x, with_rank = TRUE)}? -#' (Default: \code{FALSE}) -#' +#' @param relabel.tree \code{Logical scalar}. Should the tip labels be relabeled +#' using the output of \code{getTaxonomyLabels(x, with_rank = TRUE)}? +#' (Default: \code{FALSE}) +#' #' @param relabel_tree Deprecated. Use \code{relavel.tree} instead. -#' -#' @param order.tree \code{Logical scalar}. Should the tree be ordered based on +#' +#' @param order.tree \code{Logical scalar}. Should the tree be ordered based on #' alphabetic order of taxonomic levels? (Default: \code{FALSE}) -#' +#' #' @param order_tree Deprecated. Use \code{order.tree} instead. -#' +#' #' @param levels.rm \code{Logical scalar}. Should taxonomic level information #' be removed from labels? (Default: \code{FALSE}) -#' +#' #' @param remove_levels Deprecated. Use \code{levels.rm} instead. -#' +#' #' @param show.label,show.highlights,show.highlight.label,abbr.label #' \code{logical} (scalar), \code{integer} or \code{character} vector. If a #' \code{logical} scalar is given, should tip labels be plotted or if a @@ -39,97 +38,105 @@ #' and number of nodes, whereas the values of a \code{character} vector must #' match values of the \code{label} column in the node data. In case of a #' \code{character} vector only values corresponding to actual labels will be -#' plotted and if no labels are provided no labels will be shown. (default: +#' plotted and if no labels are provided no labels will be shown. (Default: #' \code{FALSE}) -#' -#' @param show_label,show_highlights,show_highlight_label,abbr_label Deprecated. -#' Use \code{show.label, show.highlights, show.highlight.label, abbr_label} instead. -#' -#' @param add.legend \code{Logical scalar}. Should legends be plotted? +#' +#' @param show_label,show_highlights,show_highlight_label,abbr_label Deprecated. +#' Use \code{show.label, show.highlights, show.highlight.label, abbr_label} +#' instead. +#' +#' @param add.legend \code{Logical scalar}. Should legends be plotted? #' (Default: \code{TRUE}) -#' +#' #' @param add_legend Deprecated. Use \code{add.legend} instead. -#' -#' @param layout layout for the plotted tree. See +#' +#' @param layout layout for the plotted tree. See #' \code{\link[ggtree:ggtree]{ggtree}} for details. -#' -#' @param edge.colour.by \code{Character scalar}. Specification of a column metadata field or a feature -#' to colour tree edges by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible -#' values. -#' +#' +#' @param edge.colour.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to colour tree edges by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' values. +#' #' @param edge_colour_by Deprecated. Use \code{edge.colour.by} instead. -#' -#' @param edge.size.by \code{Character scalar}. Specification of a column metadata field or a feature -#' to size tree edges by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible -#' values. (Default: \code{NULL}) -#' +#' +#' @param edge.size.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to size tree edges by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' values. (Default: \code{NULL}) +#' #' @param edge_size_by Deprecated. Use \code{edge.size.by} instead. -#' -#' @param tip.colour.by \code{Character scalar}. Specification of a column metadata field or a feature to -#' colour tree tips by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible -#' values. (Default: \code{NULL}) -#' +#' +#' @param tip.colour.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to colour tree tips by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' values. (Default: \code{NULL}) +#' #' @param tip_colour_by Deprecated. Use \code{tip.colour.by} instead. -#' -#' @param tip.shape.by \code{Character scalar}. Specification of a column metadata field or a feature to -#' shape tree tips by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible -#' values. (Default: \code{NULL}) -#' +#' +#' @param tip.shape.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to shape tree tips by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' values. (Default: \code{NULL}) +#' #' @param tip_shape_by Deprecated. Use \code{tip.shape.by} isntead. -#' -#' @param tip.size.by \code{Character scalar}. Specification of a column metadata field or a feature to -#' size tree tips by, see the by argument in -#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible -#' values. (Default: \code{NULL}) -#' +#' +#' @param tip.size.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to size tree tips by, see the by argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible +#' values. (Default: \code{NULL}) +#' #' @param tip_size_by Deprecated. Use \code{tip.size.by} instead. -#' -#' @param node.colour.by \code{Character scalar}. Specification of a column metadata field or a feature to -#' colour tree nodes by. Must be a field from \code{other.fields}. (Default: \code{NULL}) -#' +#' +#' @param node.colour.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to colour tree nodes by. Must be a field from +#' \code{other.fields}. (Default: \code{NULL}) +#' #' @param node_colour_by Deprecated. Use \code{node.colour.by} instead. -#' -#' @param node.shape.by \code{Character scalar}. Specification of a column metadata field or a feature to -#' shape tree nodes by. Must be a field from \code{other.fields}. (Default: \code{NULL}) -#' +#' +#' @param node.shape.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to shape tree nodes by. Must be a field from +#' \code{other.fields}. (Default: \code{NULL}) +#' #' @param node_shape_by Deprecated. Use \code{node.shape.by} instead. -#' -#' @param node.size.by \code{Character scalar}. Specification of a column metadata field or a feature to -#' size tree nodes by. Must be a field from \code{other.fields}. (Default: \code{NULL}) -#' +#' +#' @param node.size.by \code{Character scalar}. Specification of a column +#' metadata field or a feature to size tree nodes by. Must be a field from +#' \code{other.fields}. (Default: \code{NULL}) +#' #' @param node_size_by Deprecated. Use \code{node.size.by} instead. -#' -#' @param colour.highlights.by \code{Logical scalar}. Should the highlights be colour differently? -#' If \code{show.highlights = TRUE}, \code{colour_highlights} will be set to -#' \code{TRUE} as default. (Default: \code{FALSE}) -#' -#' @param colour_highlights_by Deprecated. Use \code{colour.highlights.by} instead. -#' -#' @param assay.type \code{Character scalar}. or \code{integer scalar}. Specifies which assay to -#' obtain expression values from, for use in point aesthetics - see the -#' \code{exprs_values} argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. -#' (Default: \code{"counts"}) -#' +#' +#' @param colour.highlights.by \code{Logical scalar}. Should the highlights be +#' colour differently? If \code{show.highlights = TRUE}, +#' \code{colour_highlights} will be set to \code{TRUE} as default. +#' (Default: \code{FALSE}) +#' +#' @param colour_highlights_by Deprecated. Use \code{colour.highlights.by} +#' instead. +#' +#' @param assay.type \code{Character scalar}. or \code{integer scalar}. +#' Specifies which assay to obtain expression values from, for use in point +#' aesthetics - see the \code{exprs_values} argument in +#' \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. +#' (Default: \code{"counts"}) +#' #' @param by_exprs_values Deprecated. Use \code{assay.type} instead. -#' -#' @param other.fields \code{Character vector}. Additional fields to include in the node information -#' without plotting them. (Default: \code{list()}) -#' +#' +#' @param other.fields \code{Character vector}. Additional fields to include in +#' the node information without plotting them. (Default: \code{list()}) +#' #' @param other_fields Deprecated. Use \code{other.fields} instead. -#' -#' @param ... additional arguments for plotting. See -#' \code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")} #' -#' @details +#' @param ... additional arguments for plotting. See +#' \code{\link{mia-plot-args}} for more details i.e. call +#' \code{help("mia-plot-args")} +#' +#' @details #' If \code{show.label} or \code{show.highlight.label} have the same length #' as the number of nodes, the vector will be used to relabel the nodes. #' #' @return a \code{\link{ggtree}} plot -#' +#' #' @seealso #' \code{\link[mia:agglomerate-methods]{agglomerateByRanks}} #' @@ -141,7 +148,8 @@ #' # preparation of some data #' data(GlobalPatterns) #' GlobalPatterns <- agglomerateByRanks(GlobalPatterns) -#' altExp(GlobalPatterns,"Genus") <- addPerFeatureQC(altExp(GlobalPatterns,"Genus")) +#' altExp(GlobalPatterns,"Genus") <- addPerFeatureQC( +#' altExp(GlobalPatterns,"Genus")) #' rowData(altExp(GlobalPatterns,"Genus"))$log_mean <- #' log(rowData(altExp(GlobalPatterns,"Genus"))$mean) #' rowData(altExp(GlobalPatterns,"Genus"))$detected <- @@ -155,7 +163,7 @@ #' plotRowTree(x[rownames(x) %in% top_genus,], #' tip.colour.by = "log_mean", #' tip.size.by = "detected") -#' +#' #' # plot with tip labels #' plotRowTree(x[rownames(x) %in% top_genus,], #' tip.colour.by = "log_mean", @@ -168,7 +176,7 @@ #' tip.size.by = "detected", #' show.label = labels, #' layout="rectangular") -#' +#' #' # plot with labeled edges #' plotRowTree(x[rownames(x) %in% top_genus,], #' edge.colour.by = "Phylum", @@ -178,7 +186,7 @@ #' edge.colour.by = "Phylum", #' edge.size.by = "detected", #' tip.colour.by = "log_mean") -#' +#' #' # aggregating data over the taxonomic levels for plotting a taxonomic tree #' # please note that the original tree of GlobalPatterns is dropped by #' # unsplitByRanks @@ -197,7 +205,7 @@ #' }) #' x <- unsplitByRanks(GlobalPatterns) #' x <- addHierarchyTree(x) -#' +#' #' highlights <- c("Phylum:Firmicutes","Phylum:Bacteroidetes", #' "Family:Pseudomonadaceae","Order:Bifidobacteriales") #' plotRowTree(x[rowData(x)$Phylum %in% top_phyla,], @@ -206,7 +214,7 @@ #' show.highlights = highlights, #' show.highlight.label = highlights, #' colour.highlights.by = "Phylum") -#' +#' #' plotRowTree(x[rowData(x)$Phylum %in% top_phyla,], #' edge.colour.by = "Phylum", #' edge.size.by = "detected", @@ -214,15 +222,6 @@ #' node.colour.by = "log_mean") NULL -#' @rdname plotTree -setGeneric("plotRowTree", signature = c("x"), - function(x, ...) - standardGeneric("plotRowTree")) -#' @rdname plotTree -setGeneric("plotColTree", signature = c("x"), - function(x, ...) - standardGeneric("plotColTree")) - #' @rdname plotTree #' @export setMethod("plotColTree", signature = c(x = "TreeSummarizedExperiment"), @@ -269,7 +268,7 @@ setMethod("plotColTree", signature = c(x = "TreeSummarizedExperiment"), other.fields = other_fields, other_fields = list(), ...){ - .plot_row_column_tree(x, + .plot_row_column_tree(x, tree_name = tree.name, relabel_tree = relabel.tree, order_tree = order.tree, @@ -373,7 +372,7 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), relabel_tree, remove_levels, order_tree, - show_label, + show_label, show_highlights, show_highlight_label, abbr_label, @@ -392,42 +391,40 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), } if(!.is_a_bool(show_label)){ if( (!is.logical(show_label) && !is.character(show_label) && - !is.numeric(show_label)) || - is.null(show_label)){ + !is.numeric(show_label)) || is.null(show_label)){ stop("'show.label' must be either TRUE or FALSE or logical, ", - "integer or character ", - "vector. Character alues should match the label of the tree.", - call. = FALSE) + "integer or character ", + "vector. Character alues should match the label of the tree.", + call. = FALSE) } } if(!.is_a_bool(show_highlights)){ if( (!is.logical(show_highlights) && !is.character(show_highlights) && - !is.numeric(show_highlights)) || - is.null(show_highlights)){ + !is.numeric(show_highlights)) || is.null(show_highlights)){ stop("'show.label' must be either TRUE or FALSE or logical, ", - "integer or character ", - "vector. Character alues should match the label of the tree.", - call. = FALSE) + "integer or character ", + "vector. Character alues should match the label of the tree.", + call. = FALSE) } } if(!.is_a_bool(show_highlight_label)){ - if( (!is.logical(show_highlight_label) && !is.character(show_highlight_label) && - !is.numeric(show_highlight_label)) || - is.null(show_highlight_label)){ - stop("'show.highlight.label' must be either TRUE or FALSE or logical, ", - "integer or character ", - "vector. Character alues should match the label of the tree.", - call. = FALSE) + if( (!is.logical(show_highlight_label) && + !is.character(show_highlight_label) && + !is.numeric(show_highlight_label)) || + is.null(show_highlight_label)){ + stop("'show.highlight.label' must be either TRUE or FALSE or ", + "logical, integer or character ", + "vector. Character alues should match the label of the tree.", + call. = FALSE) } } if(!.is_a_bool(abbr_label)){ if( (!is.logical(abbr_label) && !is.character(abbr_label) && - !is.numeric(abbr_label)) || - is.null(abbr_label)){ + !is.numeric(abbr_label)) || is.null(abbr_label)){ stop("'abbr.label' must be either TRUE or FALSE or logical, ", - "integer or character ", - "vector. Character alues should match the label of the tree.", - call. = FALSE) + "integer or character ", + "vector. Character alues should match the label of the tree.", + call. = FALSE) } } if(!.is_a_bool(add_legend)){ @@ -463,12 +460,13 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), # input check # Check tree_name if( !.is_a_string(tree_name) ){ - stop("'tree.name' must be a single character value specifying a colTree.", - call. = FALSE) + stop("'tree.name' must be a single character value specifying a ", + "colTree.", call. = FALSE) } - FUN <- switch(type, - row = "rowTree", - column = "colTree") + FUN <- switch( + type, + row = "rowTree", + column = "colTree") if(is.null(do.call(FUN,list(x = object, whichTree = tree_name)))){ stop(FUN,"(object, tree.name) is empty.", call. = FALSE) } @@ -497,25 +495,26 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), label_out <- .add_tree_highlights(tree_data, show_highlights) tree_data <- label_out$df show_highlights <- label_out$show_highlights - label_out <- .add_tree_highlight_labels(tree_data, show_highlight_label, - remove_levels) + label_out <- .add_tree_highlight_labels( + tree_data, show_highlight_label, remove_levels) tree_data <- label_out$df show_highlight_label <- label_out$show_highlight_label # - vis_out <- .incorporate_tree_vis(tree_data, - se = object, - edge_colour_by = edge_colour_by, - edge_size_by = edge_size_by, - tip_colour_by = tip_colour_by, - tip_shape_by = tip_shape_by, - tip_size_by = tip_size_by, - node_colour_by = node_colour_by, - node_shape_by = node_shape_by, - node_size_by = node_size_by, - colour_highlights_by = colour_highlights_by, - by_exprs_values = by_exprs_values, - other_fields = other_fields, - type = type) + vis_out <- .incorporate_tree_vis( + tree_data, + se = object, + edge_colour_by = edge_colour_by, + edge_size_by = edge_size_by, + tip_colour_by = tip_colour_by, + tip_shape_by = tip_shape_by, + tip_size_by = tip_size_by, + node_colour_by = node_colour_by, + node_shape_by = node_shape_by, + node_size_by = node_size_by, + colour_highlights_by = colour_highlights_by, + by_exprs_values = by_exprs_values, + other_fields = other_fields, + type = type) tree_data <- vis_out$df edge_colour_by <- vis_out$edge_colour_by edge_size_by <- vis_out$edge_size_by @@ -523,38 +522,37 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), shape_by <- vis_out$shape_by size_by <- vis_out$size_by colour_highlights_by <- vis_out$colour_highlights_by - show_tips <- any(!vapply(c(tip_colour_by, tip_shape_by, tip_size_by), - is.null, logical(1))) - show_nodes <- any(!vapply(c(node_colour_by, node_shape_by, node_size_by), - is.null, logical(1))) + show_tips <- any(!vapply( + c(tip_colour_by, tip_shape_by, tip_size_by), + is.null, logical(1))) + show_nodes <- any(!vapply( + c(node_colour_by, node_shape_by, node_size_by), + is.null, logical(1))) # - object <- .create_treedata_for_plotting(tree_data, - tree, - edge_colour_by, - edge_size_by, - shape_by, - size_by) - .tree_plotter(object, - layout = layout, - add_legend = add_legend, - show_label = show_label, - show_highlights = show_highlights, - show_highlight_label = show_highlight_label, - abbr_label = abbr_label, - show_tips = show_tips, - show_nodes = show_nodes, - edge_colour_by = edge_colour_by, - edge_size_by = edge_size_by, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by, - colour_highlights_by = colour_highlights_by, - order_tree = order_tree, - ...) + object <- .create_treedata_for_plotting( + tree_data, tree, edge_colour_by, edge_size_by, shape_by, size_by) + .tree_plotter( + object, + layout = layout, + add_legend = add_legend, + show_label = show_label, + show_highlights = show_highlights, + show_highlight_label = show_highlight_label, + abbr_label = abbr_label, + show_tips = show_tips, + show_nodes = show_nodes, + edge_colour_by = edge_colour_by, + edge_size_by = edge_size_by, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by, + colour_highlights_by = colour_highlights_by, + order_tree = order_tree, + ...) } #' @importFrom ape keep.tip as.phylo drop.tip -#' @importFrom tidytree as_tibble +#' @importFrom tidytree as_tibble .get_object_and_trimmed_tree <- function( object, tree_name = "phylo", @@ -586,7 +584,7 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), # Get tree and links tree <- tree_FUN(object, tree_name) links <- links_FUN(object) - + # Remove those tips that are not leaves tips <- sort(setdiff(tree$edge[, 2], tree$edge[, 1])) drop_tip <- tips[!(tips %in% unique(links$nodeNum[links$isLeaf]))] @@ -607,7 +605,7 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), object <- changeTree( x = object, colTree = newTree, colNodeLab = newAlias) } - + # Get tree, links and row/colnames tree <- tree_FUN(object) links <- links_FUN(object) @@ -617,7 +615,7 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), m <- match(links$nodeNum,tree_data$node) node_labels <- tree_data$label[m] # If user wants to rename rows/cols or if some nodes cannot be found from - # rows/cols + # rows/cols if( relabel || !all(node_labels %in% dimnames) ){ # Rename rows/cols new_node_labels <- getTaxonomyLabels( @@ -631,7 +629,7 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), "Data includes ununique ", type, "s. Making them unique.", call. = FALSE) object <- add_names_FUN(object, make.unique(dimnames_FUN(object))) - + } # Rename labels of tree with row/colnames tree_data$label[m] <- dimnames_FUN(object) @@ -641,10 +639,10 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), "Tree includes ununique nodes. Making them unique.", call. = FALSE) tree_data$label[-m] <- make.unique( tree_data$label[-m] ) } - + # Convert tree data back to tree-format tree <- as.phylo(tree_data) - # If specified, order the tree based on alphabetical order + # If specified, order the tree based on alphabetical order if(order){ tree <- .order_tree(tree) } @@ -659,11 +657,13 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), return("") } labels <- children$label - add_labels <- lapply(children$node, - .get_tree_labels_for_ordering, - tree_data = tree_data) - unlist(mapply(paste,labels,add_labels,sep="__:__",SIMPLIFY = FALSE), - use.names = FALSE) + add_labels <- lapply( + children$node, + .get_tree_labels_for_ordering, + tree_data = tree_data) + unlist( + mapply(paste,labels,add_labels,sep="__:__",SIMPLIFY = FALSE), + use.names = FALSE) } #' @importFrom tidytree rootnode as_tibble @@ -672,11 +672,10 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), tree_data <- tidytree::as_tibble(tree) root_node <- rootnode(tree_data) labels <- paste0("__:__", - .get_tree_labels_for_ordering(tree_data, root_node$node)) + .get_tree_labels_for_ordering(tree_data, root_node$node)) tip_labels <- regmatches(labels,regexec(".*__:__(.+?)__:__$",labels)) tip_labels <- vapply(tip_labels,"[",character(1),2L) - o <- order(labels, - decreasing = TRUE) + o <- order(labels, decreasing = TRUE) contraint <- tip_labels[o] tree <- ape::rotateConstr(tree, rev(contraint)) tree @@ -693,18 +692,15 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), #' @importFrom tidygraph activate #' @importFrom dplyr mutate -.add_tree_node_labels <- function(tree_data, - show_label, - remove_levels = FALSE){ +.add_tree_node_labels <- function( + tree_data, show_label, remove_levels = FALSE){ if("label" %in% colnames(tree_data)){ - tree_data <- tree_data %>% - mutate(node_label = .data$label) + tree_data <- tree_data %>% mutate(node_label = .data$label) } - + if(!is.logical(show_label) || length(show_label) > 1L) { - if(is.character(show_label) && - length(show_label) == nrow(tree_data)) { - tree_data <- tree_data %>% + if(is.character(show_label) && length(show_label) == nrow(tree_data)) { + tree_data <- tree_data %>% mutate(node_label = show_label) show_label <- TRUE } else if(!("node_label" %in% colnames(tree_data))){ @@ -717,12 +713,11 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), } else { if(is.numeric(show_label)){ if(any(show_label != as.integer(show_label)) || - min(show_label) < 1 || - max(show_label) > nrow(tree_data)){ + min(show_label) < 1 || + max(show_label) > nrow(tree_data)){ stop("If 'show.label' is numeric, values have to be whole ", - "numbers and must be between 1 and the number of nodes ", - "in the graph", - call. = FALSE) + "numbers and must be between 1 and the number of ", + "nodes in the graph", call. = FALSE) } label <- rep(FALSE, nrow(tree_data)) label[tree_data$node %in% show_label] <- TRUE @@ -730,16 +725,13 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), } else if(is.character(show_label)) { show_label <- tree_data$node_label %in% show_label } - if(is.logical(show_label) && - length(show_label) != nrow(tree_data)){ + if(is.logical(show_label) && length(show_label) != nrow(tree_data)){ stop("If 'show.label' is logical, it must have the length as ", - "nodes are in the graph.", - call. = FALSE) + "nodes are in the graph.", call. = FALSE) } - tree_data <- tree_data %>% - mutate(node_label = ifelse(show_label, - .data$node_label, - NA_character_)) + tree_data <- tree_data %>% + mutate(node_label = ifelse( + show_label, .data$node_label, NA_character_)) show_label <- TRUE } if(all(is.na(tree_data %>% pull("node_label")))){ @@ -747,32 +739,31 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), warning("No labels to plot.", call. = FALSE) } } else if(is.logical(show_label) && length(show_label) == 1L && - !show_label) { - tree_data <- tree_data %>% + !show_label) { + tree_data <- tree_data %>% mutate(node_label = FALSE) } if(remove_levels){ - tree_data$node_label <- - .remove_taxonomic_level_from_labels(tree_data$node_label) + tree_data$node_label <- .remove_taxonomic_level_from_labels( + tree_data$node_label) } - return(list(df = tree_data, - show_label = show_label)) + res <- list(df = tree_data, show_label = show_label) + return(res) } #' @importFrom tidygraph activate #' @importFrom dplyr mutate .add_tree_highlights <- function(tree_data, show_highlights){ tree_data$highlight <- FALSE - + if(!is.logical(show_highlights) || length(show_highlights) > 1L) { if(is.numeric(show_highlights)){ if(any(show_highlights != as.integer(show_highlights)) || - min(show_highlights) < 1 || - max(show_highlights) > nrow(tree_data)){ - stop("If 'show.highlights' is numeric, values have to be whole ", - "numbers and must be between 1 and the number of nodes ", - "in the graph", - call. = FALSE) + min(show_highlights) < 1 || + max(show_highlights) > nrow(tree_data)){ + stop("If 'show.highlights' is numeric, values have to be ", + "whole numbers and must be between 1 and the number of ", + "nodes in the graph", call. = FALSE) } label <- rep(FALSE, nrow(tree_data)) label[tree_data$node %in% show_highlights] <- TRUE @@ -781,12 +772,11 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), show_highlights <- tree_data$label %in% show_highlights } if(is.logical(show_highlights) && - length(show_highlights) != nrow(tree_data)){ + length(show_highlights) != nrow(tree_data)){ stop("If 'show.highlights' is logical, it must have the length as ", - "nodes are in the graph.", - call. = FALSE) + "nodes are in the graph.", call. = FALSE) } - tree_data <- tree_data %>% + tree_data <- tree_data %>% mutate(highlight = show_highlights) show_highlights <- TRUE if(!any(tree_data %>% pull("highlight"))){ @@ -794,34 +784,32 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), warning("No highlights to plot.", call. = FALSE) } } else if(is.logical(show_highlights) && length(show_highlights) == 1L && - show_highlights){ + show_highlights){ tree_data$highlight <- TRUE } - return(list(df = tree_data, - show_highlights = show_highlights)) + res <- list(df = tree_data, show_highlights = show_highlights) + return(res) } #' @importFrom tidygraph activate #' @importFrom dplyr mutate -.add_tree_highlight_labels <- function(tree_data, - show_highlight_label, - remove_levels = FALSE){ +.add_tree_highlight_labels <- function( + tree_data, show_highlight_label, remove_levels = FALSE){ if(!any(tree_data$highlight)){ show_highlight_label <- FALSE tree_data$highlight_label <- FALSE - return(list(df = tree_data, - show_highlight_label = show_highlight_label)) + res <- list(df = tree_data, show_highlight_label = show_highlight_label) + return(res) } - + if("label" %in% colnames(tree_data)){ tree_data <- tree_data %>% mutate(highlight_label = .data$label) } - if(!is.logical(show_highlight_label) || - length(show_highlight_label) > 1L) { - if(is.character(show_highlight_label) && - length(show_highlight_label) == nrow(tree_data)) { - tree_data <- tree_data %>% + if(!is.logical(show_highlight_label) || length(show_highlight_label) > 1L) { + if(is.character(show_highlight_label) && + length(show_highlight_label) == nrow(tree_data)) { + tree_data <- tree_data %>% mutate(highlight_label = show_highlight_label) show_highlight_label <- TRUE } else if(!("highlight_label" %in% colnames(tree_data))){ @@ -832,59 +820,57 @@ setMethod("plotRowTree", signature = c(x = "TreeSummarizedExperiment"), show_highlight_label <- FALSE } else { if(is.numeric(show_highlight_label)){ - if(any(show_highlight_label != as.integer(show_highlight_label)) || - min(show_highlight_label) < 1 || - max(show_highlight_label) > nrow(tree_data)){ + if(any(show_highlight_label != + as.integer(show_highlight_label)) || + min(show_highlight_label) < 1 || + max(show_highlight_label) > nrow(tree_data)){ stop("If 'show.highlight.label' is numeric, values have ", - "to be whole numbers and must be between 1 and the ", - "number of nodes in the graph", - call. = FALSE) + "to be whole numbers and must be between 1 and the ", + "number of nodes in the graph", call. = FALSE) } label <- rep(FALSE, nrow(tree_data)) label[tree_data$node %in% show_highlight_label] <- TRUE show_highlight_label <- label } else if(is.character(show_highlight_label)) { - show_highlight_label <- + show_highlight_label <- tree_data$highlight_label %in% show_highlight_label } if(is.logical(show_highlight_label) && - length(show_highlight_label) != nrow(tree_data)){ + length(show_highlight_label) != nrow(tree_data)){ stop("If 'show.highlight.label' is logical, it must have the ", - "length as nodes are in the graph.", - call. = FALSE) + "length as nodes are in the graph.", call. = FALSE) } - tree_data <- tree_data %>% - mutate(highlight_label = ifelse(show_highlight_label & - tree_data$highlight, - .data$highlight_label, - NA_character_)) + tree_data <- tree_data %>% + mutate(highlight_label = ifelse( + show_highlight_label & tree_data$highlight, + .data$highlight_label, NA_character_)) show_highlight_label <- TRUE } if(!any(tree_data %>% pull("highlight")) || - all(is.na(tree_data %>% pull("highlight_label")))){ + all(is.na(tree_data %>% pull("highlight_label")))){ show_highlight_label <- FALSE warning("No highlights to label.", call. = FALSE) } } else if(is.logical(show_highlight_label) && - length(show_highlight_label) == 1L && - !show_highlight_label){ + length(show_highlight_label) == 1L && !show_highlight_label){ tree_data <- tree_data %>% mutate(highlight_label = NA_character_) } if(remove_levels){ - tree_data$highlight_label <- - .remove_taxonomic_level_from_labels(tree_data$highlight_label) + tree_data$highlight_label <- .remove_taxonomic_level_from_labels( + tree_data$highlight_label) } - return(list(df = tree_data, - show_highlight_label = show_highlight_label)) + res <- list(df = tree_data, show_highlight_label = show_highlight_label) + return(res) } ################################################################################ #' @importFrom tibble tibble .get_feature_info <- function(by, se, FUN, exprs_values, var_name){ - feature_info <- try(FUN(se, by = by, exprs_values = exprs_values), - silent = TRUE) + feature_info <- try( + FUN(se, by = by, exprs_values = exprs_values), + silent = TRUE) if(is(feature_info,"try-error")){ stop(feature_info, "for '",var_name,"'", call. = FALSE) } @@ -896,12 +882,9 @@ TIP_VARIABLES <- c("tip_colour_by", "tip_shape_by", "tip_size_by") NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") .get_new_var_name_value <- function(var_name_value, add){ - if(!is.null(var_name_value) && - add != var_name_value){ - new_var_name_value <- - paste0(var_name_value, - ifelse(is.null(var_name_value),"", " & "), - add) + if(!is.null(var_name_value) && add != var_name_value){ + new_var_name_value <- paste0( + var_name_value, ifelse(is.null(var_name_value),"", " & "), add) } else { new_var_name_value <- add } @@ -911,33 +894,36 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") #' @importFrom scater retrieveFeatureInfo retrieveCellInfo #' @importFrom dplyr bind_cols mutate relocate #' @importFrom tibble rownames_to_column -.incorporate_tree_vis <- function(tree_data, - se, - edge_colour_by, - edge_size_by, - tip_colour_by, - tip_shape_by, - tip_size_by, - node_colour_by, - node_shape_by, - node_size_by, - colour_highlights_by, - by_exprs_values = "counts", - other_fields = other_fields, - type = c("row","column")){ +.incorporate_tree_vis <- function( + tree_data, + se, + edge_colour_by, + edge_size_by, + tip_colour_by, + tip_shape_by, + tip_size_by, + node_colour_by, + node_shape_by, + node_size_by, + colour_highlights_by, + by_exprs_values = "counts", + other_fields = other_fields, + type = c("row","column")){ type <- match.arg(type) - type_FUN <- switch(type, - row = scater::retrieveFeatureInfo, - column = scater::retrieveCellInfo) - variables <- c(edge_colour_by = edge_colour_by, - edge_size_by = edge_size_by, - tip_colour_by = tip_colour_by, - tip_shape_by = tip_shape_by, - tip_size_by = tip_size_by, - node_colour_by = node_colour_by, - node_shape_by = node_shape_by, - node_size_by = node_size_by, - colour_highlights_by = colour_highlights_by) + type_FUN <- switch( + type, + row = scater::retrieveFeatureInfo, + column = scater::retrieveCellInfo) + variables <- c( + edge_colour_by = edge_colour_by, + edge_size_by = edge_size_by, + tip_colour_by = tip_colour_by, + tip_shape_by = tip_shape_by, + tip_size_by = tip_size_by, + node_colour_by = node_colour_by, + node_shape_by = node_shape_by, + node_size_by = node_size_by, + colour_highlights_by = colour_highlights_by) edge_colour_by <- NULL edge_size_by <- NULL colour_by <- NULL @@ -954,13 +940,14 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") if(any(f)){ tree_data <- tree_data[,c(DEFAULT_TREE_DATA_COLS,variables[f])] # rename columns by their usage and merge by node type - colnames(tree_data) <- c(DEFAULT_TREE_DATA_COLS,names(variables)[f]) + colnames(tree_data) <- c( + DEFAULT_TREE_DATA_COLS,names(variables)[f]) # mirror back variable name for(i in variables[f]){ var_name <- gsub("tip_|node_","",names(variables)[f][i]) - assign(var_name, - .get_new_var_name_value(get(var_name), - variables[f][i])) + assign( + var_name, + .get_new_var_name_value(get(var_name), variables[f][i])) } variables <- variables[!f] } @@ -970,16 +957,13 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") for(i in seq_along(variables)){ # get data var_name <- names(variables)[i] - feature_info[[i]] <- - .get_feature_info(variables[i], se = se, - FUN = type_FUN, - exprs_values = by_exprs_values, - var_name = var_name) + feature_info[[i]] <- .get_feature_info( + variables[i], se = se, FUN = type_FUN, + exprs_values = by_exprs_values, var_name = var_name) # mirror back variable name, if a partial match was used var_name <- gsub("tip_|node_","",var_name) - assign(var_name, - .get_new_var_name_value(get(var_name), - colnames(feature_info[[i]]))) + assign(var_name, .get_new_var_name_value( + get(var_name), colnames(feature_info[[i]]))) # rename columns by their usage colnames(feature_info[[i]]) <- names(variables[i]) } @@ -1000,13 +984,15 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") tree_data <- .merge_tree_vis_data(tree_data, other, se) } } - return(list(df = tree_data, - edge_colour_by = edge_colour_by, - edge_size_by = edge_size_by, - colour_by = colour_by, - shape_by = shape_by, - size_by = size_by, - colour_highlights_by = colour_highlights_by)) + res <- list( + df = tree_data, + edge_colour_by = edge_colour_by, + edge_size_by = edge_size_by, + colour_by = colour_by, + shape_by = shape_by, + size_by = size_by, + colour_highlights_by = colour_highlights_by) + return(res) } .merge_tip_node_tree_data <- function(tree_data){ @@ -1024,24 +1010,27 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") # cn <- colnames(tree_data) if(all(c("tip_colour_by","node_colour_by") %in% cn)){ - colour_by <- c(tree_data$node_colour_by[!is_leaf_o], - tree_data$tip_colour_by[is_leaf_o]) + colour_by <- c( + tree_data$node_colour_by[!is_leaf_o], + tree_data$tip_colour_by[is_leaf_o]) } else if("tip_colour_by" %in% cn) { colour_by <- tree_data$tip_colour_by } else if("node_colour_by" %in% cn) { colour_by <- tree_data$node_colour_by } if(all(c("tip_shape_by","node_shape_by") %in% cn)){ - shape_by <- c(tree_data$node_shape_by[!is_leaf_o], - tree_data$tip_shape_by[is_leaf_o]) + shape_by <- c( + tree_data$node_shape_by[!is_leaf_o], + tree_data$tip_shape_by[is_leaf_o]) } else if("tip_shape_by" %in% cn) { shape_by <- tree_data$tip_shape_by } else if("node_shape_by" %in% cn) { shape_by <- tree_data$node_shape_by } if(all(c("tip_size_by","node_size_by") %in% cn)){ - size_by <- c(tree_data$node_size_by[!is_leaf_o], - tree_data$tip_size_by[is_leaf_o]) + size_by <- c( + tree_data$node_size_by[!is_leaf_o], + tree_data$tip_size_by[is_leaf_o]) } else if("tip_size_by" %in% cn) { size_by <- tree_data$tip_size_by } else if("node_size_by" %in% cn) { @@ -1067,31 +1056,26 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") # due to a bug in ggtree/tidytree the treedata object needs to be constructed # in a separate step -# +# # also there is some data wrangling needed #' @importFrom tidytree as.treedata -.create_treedata_for_plotting <- function(tree_data, - tree, - edge_colour_by, - edge_size_by, - shape_by, - size_by){ +.create_treedata_for_plotting <- function( + tree_data, tree, edge_colour_by, edge_size_by, shape_by, size_by){ # cleanup - if (!is.null(edge_colour_by) && + if (!is.null(edge_colour_by) && anyNA(tree_data$edge_colour_by) && !is.numeric(tree_data$edge_colour_by)) { - tree_data <- groupOTU(tree_data, - split(tree_data$node, tree_data$edge_colour_by), - group_name = "group") + tree_data <- groupOTU( + tree_data, + split(tree_data$node, tree_data$edge_colour_by), + group_name = "group") f_zero <- tree_data$group != 0 f_zero <- f_zero[!is.na(f_zero)] - tree_data$edge_colour_by[f_zero] <- - as.character(tree_data$group[f_zero]) + tree_data$edge_colour_by[f_zero] <- as.character( + tree_data$group[f_zero]) } - tree_data <- .na_replace_from_plot_data(tree_data, - edge_size_by, - shape_by, - size_by) + tree_data <- .na_replace_from_plot_data( + tree_data, edge_size_by, shape_by, size_by) object <- tidytree::as.treedata(tree_data) # tree needs to be restored since the original leave/tip/node orientation # is not compatible with ladderiez = FALSE @@ -1137,41 +1121,22 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") highlight_font_size = highlight.font.size, highlight.font.size = 3){ # start plotting - plot_out <- ggtree(object, - ladderize = !order_tree, - layout = layout) + plot_out <- ggtree(object, ladderize = !order_tree, layout = layout) # add highlights - plot_out <- - .plot_tree_plot_highlights(plot_out, - layout, - show_highlights, - show_highlight_label, - abbr_label, - colour_highlights_by, - highlight_font_size = highlight_font_size) + plot_out <- .plot_tree_plot_highlights( + plot_out, layout, show_highlights, show_highlight_label, abbr_label, + colour_highlights_by, highlight_font_size = highlight_font_size) # add tree and adjust edges - plot_out <- .plot_tree_edges(plot_out, - edge_colour_by, - edge_size_by, - line_alpha, - line_width, - line_width_range, - layout) + plot_out <- .plot_tree_edges( + plot_out, edge_colour_by, edge_size_by, line_alpha, line_width, + line_width_range, layout) # add tip and node points - plot_out <- .plot_tree_node_points(plot_out, - show_tips, - show_nodes, - colour_by, - shape_by, - size_by, - point_alpha, - point_size, - point_size_range) + plot_out <- .plot_tree_node_points( + plot_out, show_tips, show_nodes, colour_by, shape_by, size_by, + point_alpha, point_size, point_size_range) # add tip and node labels - plot_out <- .plot_tree_node_labels(plot_out, - show_label, - abbr_label, - label_font_size) + plot_out <- .plot_tree_node_labels( + plot_out, show_label, abbr_label, label_font_size) # add additional guides plot_out <- .add_extra_guide(plot_out, shape_by, size_by) # add abbreviation guide @@ -1186,9 +1151,8 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") plot_out } -.add_label_abbreviations <- function(plot_out, - label_col, - subset = NULL){ +.add_label_abbreviations <- function( + plot_out, label_col, subset = NULL){ non_abbr_text_col <- paste0("abbr_",label_col) if(is.null(subset)){ subset <- seq_len(nrow(plot_out$data)) @@ -1205,9 +1169,8 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") bak_text <- text # abbreviate with unique element u_text <- unique(text) - abbr <- abbreviate(gsub("[_]|[-][ ]","",u_text), - minlength = 1, - dot = TRUE) + abbr <- abbreviate( + gsub("[_]|[-][ ]","",u_text), minlength = 1, dot = TRUE) # reflate to original positions abbr <- abbr[match(text, u_text)] # exchange label @@ -1234,9 +1197,8 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") return(list(args = geom_args)) } -.get_cladelab_args <- function(nodes, - layout, - highlight_font_size){ +.get_cladelab_args <- function( + nodes, layout, highlight_font_size){ aes_args <- list() aes_args$subset <- paste0("node %in% c(",paste(nodes, collapse = ","), ")") aes_args$node <- ~node @@ -1259,51 +1221,59 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") } #' @importFrom dplyr mutate -.calc_highlight_extendto <- function(highlight_data, - layout) { +.calc_highlight_extendto <- function(highlight_data, layout) { if(layout %in% c("fan","circular","radial")){ ans <- highlight_data %>% - mutate(highlight_extendto = (max(.data$x) - .data$x) / 1.5, - highlight_extendto = .data$highlight_extendto + max(.data$x) + 0.07) + mutate( + highlight_extendto = (max(.data$x) - .data$x) / 1.5, + highlight_extendto = .data$highlight_extendto + + max(.data$x) + 0.07) } else if(layout %in% c("rectangular","slanted","ellipse","roundrect")){ ans <- highlight_data %>% - mutate(highlight_extendto = (max(.data$x) - .data$x) / 1.5, - highlight_extendto = .data$highlight_extendto + max(.data$x) + 0.01) + mutate( + highlight_extendto = (max(.data$x) - .data$x) / 1.5, + highlight_extendto = .data$highlight_extendto + + max(.data$x) + 0.01) } else if(layout %in% c("dendrogram")){ warning("highlights with layout `dendrogram` are buggy.") ans <- highlight_data %>% - mutate(highlight_extendto = .data$x / 1.5, - highlight_extendto = (.data$highlight_extendto - 0.01) * -1) + mutate( + highlight_extendto = .data$x / 1.5, + highlight_extendto = (.data$highlight_extendto - 0.01) * -1) } else if(layout %in% c("inward_circular")){ warning("highlights with layout `inward_circular` are buggy.") ans <- highlight_data %>% - mutate(highlight_extendto = (max(.data$x) - .data$x) / 1.5, - highlight_extendto = .data$highlight_extendto + max(.data$x) + 0.07, - highlight_extendto = .data$highlight_extendto * -1) + mutate( + highlight_extendto = (max(.data$x) - .data$x) / 1.5, + highlight_extendto = .data$highlight_extendto + max(.data$x) + + 0.07, + highlight_extendto = .data$highlight_extendto * -1) } else { - ans <- highlight_data %>% + ans <- highlight_data %>% mutate(highlight_extendto = .data$x) } ans } #' @importFrom dplyr mutate -.calc_highlight_label_text_offset <- function(label_data, - layout){ +.calc_highlight_label_text_offset <- function(label_data, layout){ if(layout %in% c("fan","circular","radial")){ ans <- label_data %>% - mutate(highlight_offset = .data$highlight_extendto - max(.data$x) + 0.015 - 0.07) + mutate(highlight_offset = .data$highlight_extendto - max(.data$x) + + 0.015 - 0.07) } else if(layout %in% c("rectangular","slanted","ellipse","roundrect")){ ans <- label_data %>% - mutate(highlight_offset = .data$highlight_extendto - max(.data$x) - 0.01) + mutate(highlight_offset = .data$highlight_extendto - max(.data$x) - + 0.01) } else if(layout %in% c("dendrogram")){ ans <- label_data %>% mutate(highlight_offset = .data$highlight_extendto - 0.1) } else if(layout %in% c("inward_circular")){ ans <- label_data %>% - mutate(highlight_offset = (.data$highlight_extendto *-1) - max(.data$x) - 0.022) + mutate(highlight_offset = (.data$highlight_extendto *-1) - + max(.data$x) - 0.022) } else { - ans <- label_data %>% + ans <- label_data %>% mutate(highlight_offset = .data$highlight_extendto) } ans @@ -1313,13 +1283,9 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") #' @importFrom ggtree geom_highlight geom_cladelab #' @importFrom ggnewscale new_scale_fill new_scale_colour #' @importFrom tidytree rootnode -.plot_tree_plot_highlights <- function(plot_out, - layout, - show_highlights, - show_highlight_label, - abbr_label, - colour_highlights_by, - highlight_font_size){ +.plot_tree_plot_highlights <- function( + plot_out, layout, show_highlights, show_highlight_label, abbr_label, + colour_highlights_by, highlight_font_size){ plot_out$data <- .calc_highlight_extendto(plot_out$data, layout) plot_out$data <- .calc_highlight_label_text_offset(plot_out$data, layout) if(show_highlights && nrow(plot_out$data) > 0L){ @@ -1330,38 +1296,31 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") } subset <- plot_out$data$highlight highlight_nodes <- plot_out$data[subset,"node",drop=TRUE] - hl_args <- .get_hightlight_args(highlight_nodes, - colour_highlights_by) + hl_args <- .get_hightlight_args( + highlight_nodes, colour_highlights_by) plot_out <- plot_out + do.call(geom_highlight, hl_args$args) if(!is.null(colour_highlights_by)){ - plot_out <- - .resolve_plot_colours(plot_out, - plot_out$data[subset, - "colour_highlights_by", - drop=TRUE], - colour_highlights_by, - fill = TRUE, - na.value = "grey70") - plot_out <- plot_out + + plot_out <- .resolve_plot_colours( + plot_out, + plot_out$data[subset, "colour_highlights_by", drop=TRUE], + colour_highlights_by, fill = TRUE, na.value = "grey70") + plot_out <- plot_out + new_scale_fill() + new_scale_colour() } if(show_highlight_label){ - subset <- plot_out$data$highlight & + subset <- plot_out$data$highlight & !is.na(plot_out$data$highlight_label) highlight_label_nodes <- plot_out$data[subset,"node",drop=TRUE] if(length(highlight_label_nodes) > 0L){ - subset_abbr <- - plot_out$data[,"highlight_label",drop=TRUE] %in% + subset_abbr <- plot_out$data[,"highlight_label",drop=TRUE] %in% abbr_label subset[!subset_abbr] <- FALSE - plot_out <- .add_label_abbreviations(plot_out, - "highlight_label", - which(subset)) - cl_args <- .get_cladelab_args(highlight_label_nodes, - layout, - highlight_font_size) + plot_out <- .add_label_abbreviations( + plot_out, "highlight_label", which(subset)) + cl_args <- .get_cladelab_args( + highlight_label_nodes, layout, highlight_font_size) plot_out <- plot_out + do.call(geom_cladelab, cl_args$args) ################################################################ @@ -1375,49 +1334,32 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") plot_out } -.plot_tree_edges <- function(plot_out, - edge_colour_by, - edge_size_by, - line_alpha, - line_width, - line_width_range, - layout){ +.plot_tree_edges <- function( + plot_out, edge_colour_by, edge_size_by, line_alpha, line_width, + line_width_range, layout){ # assemble arg list - edge_out <- .get_edge_args(edge_colour_by, - edge_size_by, - alpha = line_alpha, - size = line_width, - layout = layout) + edge_out <- .get_edge_args( + edge_colour_by, edge_size_by, alpha = line_alpha, size = line_width, + layout = layout) plot_out <- plot_out + - do.call(geom_tree, edge_out$args) + + do.call(geom_tree, edge_out$args) + theme_tree() - plot_out <- .add_extra_guide_tree(plot_out, - edge_size_by, - line_width_range) + plot_out <- .add_extra_guide_tree( + plot_out, edge_size_by, line_width_range) # adjust edge colours if(!is.null(edge_colour_by)){ - plot_out <- .resolve_plot_colours(plot_out, - plot_out$data$edge_colour_by, - edge_colour_by, - na.translate = FALSE) + plot_out <- .resolve_plot_colours( + plot_out, plot_out$data$edge_colour_by, edge_colour_by, + na.translate = FALSE) } plot_out } -.plot_tree_node_points <- function(plot_out, - show_tips, - show_nodes, - colour_by, - shape_by, - size_by, - point_alpha, - point_size, - point_size_range){ - point_out <- .get_point_args(colour_by, - shape_by, - size_by, - alpha = point_alpha, - size = point_size) +.plot_tree_node_points <- function( + plot_out, show_tips, show_nodes, colour_by, shape_by, size_by, + point_alpha, point_size, point_size_range){ + point_out <- .get_point_args( + colour_by, shape_by, size_by, alpha = point_alpha, size = point_size) tip_point_FUN <- geom_tippoint node_point_FUN <- geom_nodepoint if(show_tips){ @@ -1439,11 +1381,9 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") } # adjust point colours if(!is.null(colour_by)){ - plot_out <- .resolve_plot_colours(plot_out, - plot_out$data$colour_by, - colour_by, - fill = point_out$fill, - na.translate = FALSE) + plot_out <- .resolve_plot_colours( + plot_out, plot_out$data$colour_by, colour_by, fill = point_out$fill, + na.translate = FALSE) } plot_out } @@ -1457,32 +1397,25 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") # f_tip <- data$node %in% label_data$node & data$isTip f_node <- data$node %in% label_data$node & !data$isTip - # if("highlight_label" %in% colnames(plot_out$data) && - # any(!is.na(plot_out$data$highlight_label))){ - # plot_out <- .add_label_abbreviations(plot_out, - # "node_label") - # } subset <- !is.na(plot_out$data$node_label) subset_abbr <- plot_out$data[,"node_label",drop=TRUE] %in% abbr_label subset[!subset_abbr] <- FALSE - plot_out <- .add_label_abbreviations(plot_out, - "node_label", - which(subset)) + plot_out <- .add_label_abbreviations( + plot_out, "node_label", which(subset)) if(any(f_tip)){ # add tip labels plot_out <- plot_out + - geom_tiplab(mapping = aes_string(subset = f_tip, - label = "node_label"), - offset = 0.01, - size = label_font_size) + geom_tiplab( + mapping = aes_string(subset = f_tip, label = "node_label"), + offset = 0.01, size = label_font_size) } if(any(f_node)){ # add node labels plot_out <- plot_out + - geom_nodelab(mapping = aes_string(subset = f_node, - label = "node_label"), - size = label_font_size) + geom_nodelab( + mapping = aes_string(subset = f_node, label = "node_label"), + size = label_font_size) } } plot_out @@ -1504,27 +1437,31 @@ NODE_VARIABLES <- c("node_colour_by", "node_shape_by", "node_size_by") if(!is.null(abbr) && nrow(abbr) > 0L){ abbr <- abbr[order(abbr$text),] keywidth <- max(1.5,max(nchar(abbr$abbr)) * 0.2) - guide <- guide_legend(title = "Abbreviations", - keywidth = keywidth, - keyheight = 0.75, - label.theme = element_text(size = 8), - override.aes = list(fill = "transparent"), - ncol = 1) - plot_out <- plot_out + - scale_discrete_identity(aesthetics = "label", - name = "Abbreviations:", - breaks = abbr$abbr, - labels = abbr$text, - guide = guide) + guide <- guide_legend( + title = "Abbreviations", + keywidth = keywidth, + keyheight = 0.75, + label.theme = element_text(size = 8), + override.aes = list(fill = "transparent"), + ncol = 1) + plot_out <- plot_out + + scale_discrete_identity( + aesthetics = "label", + name = "Abbreviations:", + breaks = abbr$abbr, + labels = abbr$text, + guide = guide) } plot_out } .theme_plotTree <- function(plot){ - plot + - theme(legend.background = element_rect(fill = "transparent",colour = NA), - legend.box.background = element_rect(fill = "transparent",colour = NA), - panel.background = element_rect(fill = "transparent",colour = NA), - plot.background = element_rect(fill = "transparent",colour = NA), - legend.text = element_text(size = 8)) + plot + + theme( + legend.background = element_rect(fill = "transparent",colour = NA), + legend.box.background = element_rect( + fill = "transparent",colour = NA), + panel.background = element_rect(fill = "transparent",colour = NA), + plot.background = element_rect(fill = "transparent",colour = NA), + legend.text = element_text(size = 8)) } diff --git a/R/treeData.R b/R/treeData.R index 58933ca8..159aae4a 100644 --- a/R/treeData.R +++ b/R/treeData.R @@ -5,24 +5,24 @@ #' \code{colTreeData} can be used. #' #' @param x a -#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} -#' object. +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} +#' object. +#' +#' @param other.fields,value a \code{data.frame} or coercible to one, with at +#' least one type of id information. See details.(Default: \code{list()}) #' -#' @param other.fields,value a \code{data.frame} or coercible to one, with at least one type -#' of id information. See details.(Default: \code{list()}) -#' #' @param other_fields Deprecated. Use \code{other.fields} instead. -#' +#' #' @param tree.name \code{Character scalar}. Specifies a rowTree/colTree from #' \code{x}. (Default: \code{"phylo"}) -#' +#' #' @param tree_name Deprecated. Use \code{tree.name} instead. -#' +#' #' @param ... additional arguments, currently not used. #' #' @details -#' To match information to nodes, the id information in \code{other.fields} are used. -#' These can either be a column, named \sQuote{node} or \sQuote{label} +#' To match information to nodes, the id information in \code{other.fields} are +#' used. These can either be a column, named \sQuote{node} or \sQuote{label} #' (\sQuote{node} taking precedent), or rownames. If all rownames can be coerced #' to \code{integer}, they are considered as \sQuote{node} values, otherwise as #' \sQuote{label} values. The id information must be unique and match available @@ -32,8 +32,8 @@ #' contain at least a \sQuote{node} and \sQuote{label} column. #' #' @return a \code{data.frame} for the accessor and the modified -#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} -#' object +#' \code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} +#' object #' #' @name treeData #' @@ -47,36 +47,6 @@ #' combineTreeData(rowTree(GlobalPatterns), td) NULL -#' @rdname treeData -setGeneric("rowTreeData", signature = c("x"), - function(x, ...) - standardGeneric("rowTreeData")) - -#' @rdname treeData -setGeneric("colTreeData", signature = c("x"), - function(x, ...) - standardGeneric("colTreeData")) - -#' @rdname treeData -setGeneric("rowTreeData<-", signature = c("x"), - function(x, tree.name = tree_name, tree_name = "phylo", value) - standardGeneric("rowTreeData<-")) - -#' @rdname treeData -setGeneric("colTreeData<-", signature = c("x"), - function(x, tree.name = tree_name, tree_name = "phylo", value) - standardGeneric("colTreeData<-")) - -#' @rdname treeData -setGeneric("combineTreeData", signature = c("x"), - function(x, other.fields = other_fields, other_fields = list()) - standardGeneric("combineTreeData")) - -#' @rdname treeData -setGeneric("combineTreeData", signature = c("x"), - function(x, other.fields = other_fields, other_fields = list()) - standardGeneric("combineTreeData")) - #' @importFrom tidytree as_tibble .get_tree_data <- function(tree){ tree %>% @@ -91,11 +61,11 @@ setMethod("colTreeData", signature = c(x = "TreeSummarizedExperiment"), function(x, tree.name = tree_name, tree_name = "phylo"){ # Check tree.name if( !.is_a_string(tree.name) ){ - stop("'tree.name' must be a single character value specifying a colTree.", - call. = FALSE) + stop("'tree.name' must be a single character value specifying a ", + "colTree.", call. = FALSE) } if(is.null(colTree(x, tree.name))){ - return(NULL) + return(NULL) } .get_tree_data(colTree(x, tree.name)) %>% select(c("node","label":last_col())) @@ -109,8 +79,8 @@ setMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), function(x, tree.name = tree_name, tree_name = "phylo"){ # Check tree.name if( !.is_a_string(tree.name) ){ - stop("'tree.name' must be a single character value specifying a rowTree.", - call. = FALSE) + stop("'tree.name' must be a single character value specifying a ", + "rowTree.", call. = FALSE) } if(is.null(rowTree(x, tree.name))){ return(NULL) @@ -132,8 +102,8 @@ setReplaceMethod("colTreeData", signature = c(x = "TreeSummarizedExperiment"), function(x, tree.name = tree_name, tree_name = "phylo", value){ # Check tree.name if( !.is_a_string(tree.name) ){ - stop("'tree.name' must be a single character value specifying a colTree.", - call. = FALSE) + stop("'tree.name' must be a single character value specifying a ", + "colTree.", call. = FALSE) } tree <- colTree(x, tree.name) # input check @@ -141,7 +111,8 @@ setReplaceMethod("colTreeData", signature = c(x = "TreeSummarizedExperiment"), stop("'colTree(x, tree.name)' is NULL.", call. = FALSE) } # this is just temporary solution since phylo does not support data - x@colTree[[tree.name]] <- tidytree::as.phylo(combineTreeData(tree, value)) + tree <- tidytree::as.phylo(combineTreeData(tree, value)) + x@colTree[[tree.name]] <- tree return(x) } ) @@ -153,16 +124,17 @@ setReplaceMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), function(x, tree.name = tree_name, tree_name = "phylo", value){ # Check tree.name if( !.is_a_string(tree.name) ){ - stop("'tree.name' must be a single character value specifying a rowTree.", - call. = FALSE) + stop("'tree.name' must be a single character value specifying a ", + "rowTree.", call. = FALSE) } tree <- rowTree(x) # input check if(is.null(tree)){ - stop("'rowTree(x)' is NULL.", call. = FALSE) + stop("'rowTree(x)' is NULL.", call. = FALSE) } # this is just temporary solution since phylo does not support data - x@rowTree[[tree.name]] <- tidytree::as.phylo(combineTreeData(tree, value)) + tree <- tidytree::as.phylo(combineTreeData(tree, value)) + x@rowTree[[tree.name]] <- tree return(x) } ) @@ -178,7 +150,7 @@ setReplaceMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), } if(!is.data.frame(other_fields)){ stop("'other_fields' must be a data.frame or coercible to one.", - call. = FALSE) + call. = FALSE) } if(nrow(other_fields) == 0L){ return(NULL) @@ -191,7 +163,7 @@ setReplaceMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), # populate if necessary if(is.null(rn)){ stop("Neither one of the following columns 'node'/'label' nor ", - "rownames set for 'other_fields'.", call. = FALSE) + "rownames set for 'other_fields'.", call. = FALSE) } rn_i <- suppressWarnings(as.integer(rn)) if(!anyNA(rn_i)){ @@ -234,7 +206,7 @@ setReplaceMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), call. = FALSE) } else if(!any(other_fields[[by_col_name]] %in% tree_data[[by_col_name]])){ stop("No overlap between '",by_col_name,"'and tree data.", - call. = FALSE) + call. = FALSE) } other_fields } @@ -256,7 +228,8 @@ setReplaceMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), tree_data <- .clean_tree_data(tree_data) } else { other_fields <- .norm_id_col_of_other_fields(other_fields, tree_data) - tree_data <- .combine_tree_data_and_other_fields(tree_data, other_fields) + tree_data <- .combine_tree_data_and_other_fields( + tree_data, other_fields) } tidytree::as.treedata(tree_data) } @@ -264,17 +237,15 @@ setReplaceMethod("rowTreeData", signature = c(x = "TreeSummarizedExperiment"), #' @rdname treeData #' @export setMethod("combineTreeData", signature = c(x = "phylo"), - function(x, other.fields = other_fields, - other_fields = list()){ - .combine_tree_and_other_fields(x, other.fields) - } + function(x, other.fields = other_fields, other_fields = list()){ + .combine_tree_and_other_fields(x, other.fields) + } ) #' @rdname treeData #' @export setMethod("combineTreeData", signature = c(x = "treedata"), - function(x, other.fields = other_fields, - other_fields = list()){ - .combine_tree_and_other_fields(x, other.fields) - } + function(x, other.fields = other_fields, other_fields = list()){ + .combine_tree_and_other_fields(x, other.fields) + } ) diff --git a/R/utils.R b/R/utils.R index acddb1ae..17775316 100644 --- a/R/utils.R +++ b/R/utils.R @@ -17,7 +17,7 @@ .is_function <- mia:::.is_function .get_name_in_parent <- mia:::.get_name_in_parent .is_an_integer <- mia:::.is_an_integer - +TAXONOMY_RANKS <- mia:::TAXONOMY_RANKS .norm_label <- function(label, x){ if(!is.null(label)){ @@ -25,25 +25,22 @@ n_v <- seq_len(nrow(x)) if(!all(label %in% n_v)){ stop("If 'label' is numeric, all values must be between 1 ", - "and nrow(x). If rank is not NULL, the dimension might ", - "change.", - call. = FALSE) + "and nrow(x). If rank is not NULL, the dimension might ", + "change.", call. = FALSE) } label <- n_v %in% label } else if(is.character(label)){ if(!all(label %in% rownames(x))){ stop("If 'label' is character, all values must be in ", - "rownames(x). If rank is not NULL, the rownames might ", - "change.", - call. = FALSE) + "rownames(x). If rank is not NULL, the rownames might ", + "change.", call. = FALSE) } label <- rownames(x) %in% label } else if(is.logical(label)){ if(length(label) != nrow(x)){ stop("If 'label' is logical, length(label) == nrow(x) mut be ", - "TRUE. If rank is not NULL, the rownames might ", - "change.", - call. = FALSE) + "TRUE. If rank is not NULL, the rownames might ", + "change.", call. = FALSE) } } else { stop("'label' must be a vector.", call. = FALSE) diff --git a/R/utils_plotting.R b/R/utils_plotting.R index 1f9068e1..6371181e 100644 --- a/R/utils_plotting.R +++ b/R/utils_plotting.R @@ -1,135 +1,179 @@ #' Additional arguments for plotting -#' +#' #' To be able to fine tune plotting, several additional plotting arguments are #' available. These are described on this page. -#' +#' #' @section Tree plotting: -#' +#' #' \describe{ -#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}, Specifies the -#' transparency of the tree edges. (Default: \code{1})} -#' \item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default width of -#' an edge. (Default: \code{NULL}) to use default of the \code{ggtree} package.} -#' \item{\code{line.width.range}: }{\code{Numeric vector}. The range for plotting -#' dynamic edge widths in. (Default: \code{c(0.5,3)})} -#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the tips. (Defaults: \code{1})} -#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -#' default size of tips. (Defaults: \code{2.})} -#' \item{\code{point.size.range}: }{\code{Numeric vector}. Specifies the range for plotting -#' dynamic tip sizes in. (Defaults: \code{c(1,4)})} -#' \item{\code{label.font.size}: }{\code{Numeric scalar}. Font size for the tip and -#' node labels. (Default: \code{3})} -#' \item{\code{highlight.font.size}: }{\code{Numeric scalar}. Font size for the -#' highlight labels. (Default: \code{3})} +#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}, +#' Specifies the transparency of the tree edges. (Default: \code{1})} +#' +#' \item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default +#' width of an edge. (Default: \code{NULL}) to use default of the +#' \code{ggtree} package.} +#' +#' \item{\code{line.width.range}: }{\code{Numeric vector}. The range for +#' plotting dynamic edge widths in. (Default: \code{c(0.5,3)})} +#' +#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the tips. (Defaults: \code{1})} +#' +#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the +#' default size of tips. (Defaults: \code{2})} +#' +#' \item{\code{point.size.range}: }{\code{Numeric vector}. Specifies the range +#' for plotting dynamic tip sizes in. (Defaults: \code{c(1,4)})} +#' +#' \item{\code{label.font.size}: }{\code{Numeric scalar}. Font size for the +#' tip and node labels. (Default: \code{3})} +#' +#' \item{\code{highlight.font.size}: }{\code{Numeric scalar}. Font size for +#' the highlight labels. (Default: \code{3})} #' } -#' +#' #' @section {Graph plotting}: -#' +#' #' \describe{ -#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the tree edges. (Default: \code{1})} -#' \item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default width of -#' an edge. (Default: \code{NULL}) to use default of the \code{ggtree} package.} -#' \item{\code{line.width.range}: }{\code{Numeric vector}. The range for plotting -#' dynamic edge widths in. (Default: \code{c(0.5,3)})} -#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the tips. (Default: \code{1})} -#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -#' default size of tips. (Default: \code{2.})} -#' \item{\code{point.size.range}: }{\code{Numeric vector}. The range for plotting -#' dynamic tip sizes in. (Default: \code{c(1,4)})} +#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the tree edges. (Default: \code{1})} +#' +#' \item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default +#' width of an edge. (Default: \code{NULL}) to use default of the +#' \code{ggtree} package.} +#' +#' \item{\code{line.width.range}: }{\code{Numeric vector}. The range for +#' plotting dynamic edge widths in. (Default: \code{c(0.5,3)})} +#' +#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the tips. (Default: \code{1})} +#' +#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the +#' default size of tips. (Default: \code{2.})} +#' +#' \item{\code{point.size.range}: }{\code{Numeric vector}. The range for +#' plotting dynamic tip sizes in. (Default: \code{c(1,4)})} #' } -#' +#' #' @section {Abundance plotting}: -#' +#' #' \describe{ -#' \item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? (Default: -#' \code{FALSE})} -#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -#' (Default: \code{TRUE})} -#' \item{\code{add.x.text}: }{\code{Logical scalar}. Should x tick labels be plotted? -#' (Default: \code{FALSE})} -#' \item{\code{add.border}: }{\code{Logical scalar}. Should border of bars be plotted? -#' (Default: \code{FALSE})} -#' \item{\code{bar.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the bars. (Default: \code{1})} -#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the points. (Default: \code{1})} -#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -#' default size of points. (Default: \code{2.})} +#' \item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? +#' (Default: \code{FALSE})} +#' +#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +#' plotted? (Default: \code{TRUE})} +#' +#' \item{\code{add.x.text}: }{\code{Logical scalar}. Should x tick labels be +#' plotted? (Default: \code{FALSE})} +#' +#' \item{\code{add.border}: }{\code{Logical scalar}. Should border of bars be +#' plotted? (Default: \code{FALSE})} +#' +#' \item{\code{bar.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies +#' the transparency of the bars. (Default: \code{1})} +#' +#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the points. (Default: \code{1})} +#' +#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the +#' default size of points. (Default: \code{2})} #' } -#' +#' #' @section {Abundance density plotting}: -#' +#' #' \describe{ -#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -#' (Defaults: \code{TRUE})} -#' \item{\code{point.shape}: }{\code{Numeric scalar}. Sets the shape of points. -#' (Default: \code{21})} -#' \item{\code{point.colour}: }{\code{Character scalar}. Specifies the -#' default colour of points. (Default: \code{2.})} -#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -#' default size of points. (Default: \code{2.})} -#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the points. (Default: \code{1})} -#' \item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? (Default: -#' \code{FALSE})} -#' \item{\code{scales.free}: }{\code{Logical scalar}. Should \code{scales = "free"} be -#' set for faceted plots? (Default: \code{TRUE})} -#' \item{\code{angle.x.text}: }{\code{Logical scalar}. Should x tick labels be plotted? -#' (Default: \code{FALSE})} +#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +#' plotted? (Default: \code{TRUE})} +#' +#' \item{\code{point.shape}: }{\code{Numeric scalar}. Sets the shape of +#' points. (Default: \code{21})} +#' +#' \item{\code{point.colour}: }{\code{Character scalar}. Specifies the +#' default colour of points. (Default: \code{2})} +#' +#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the +#' default size of points. (Default: \code{2})} +#' +#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the points. (Default: \code{1})} +#' +#' \item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? +#' (Default: \code{FALSE})} +#' +#' \item{\code{scales.free}: }{\code{Logical scalar}. Should +#' \code{scales = "free"} be set for faceted plots? (Default: \code{TRUE})} +#' +#' \item{\code{angle.x.text}: }{\code{Logical scalar}. Should x tick labels be +#' plotted? (Default: \code{FALSE})} +#' #' } -#' +#' #' @section {Prevalence plotting}: -#' +#' #' \describe{ -#' \item{\code{flipped}: }{\code{Logical scalar}. Specifies whether the plot should -#' be flipped. (Default: \code{FALSE})} -#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -#' (Default: \code{TRUE})} -#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the tips. (Default: \code{1})} -#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -#' default size of tips. (Default: \code{2.})} -#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the tree edges. (Default: \code{1})} -#' \item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line type. -#' (Default: \code{NULL}) to use default of the \code{ggplot2} package.} -#' \item{\code{line.size}: }{\code{Numeric scalar}. Specifies the default width of -#' a line. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} +#' \item{\code{flipped}: }{\code{Logical scalar}. Specifies whether the plot +#' should be flipped. (Default: \code{FALSE})} +#' +#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +#' plotted? (Default: \code{TRUE})} +#' +#' \item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the tips. (Default: \code{1})} +#' +#' \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the +#' default size of tips. (Default: \code{2.})} +#' +#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the tree edges. (Default: \code{1})} +#' +#' \item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line +#' type. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} +#' +#' \item{\code{line.size}: }{\code{Numeric scalar}. Specifies the default +#' width of a line. (Default: \code{NULL}) to use default of the +#' \code{ggplot2} package.} #' } -#' +#' #' @section {Series plotting}: -#' +#' #' \describe{ -#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -#' (Default: \code{TRUE})} -#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the tree edges. (Default: \code{1})} -#' \item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line type. -#' (Default: \code{NULL}) to use default of the \code{ggplot2} package.} -#' \item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default width of -#' a line. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} -#' \item{\code{line.width.range}: }{\code{Numeric vector}. The range for plotting -#' dynamic line widths in. (Default: \code{c(0.5,3)})} -#' \item{\code{ribbon.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the ribbon. (Default: \code{0.3})} +#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +#' plotted? (Default: \code{TRUE})} +#' +#' \item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the tree edges. (Default: \code{1})} +#' +#' \item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line +#' type. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} +#' +#' \item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default +#' width of a line. (Default: \code{NULL}) to use default of the +#' \code{ggplot2} package.} +#' +#' \item{\code{line.width.range}: }{\code{Numeric vector}. The range for +#' plotting dynamic line widths in. (Default: \code{c(0.5,3)})} +#' +#' \item{\code{ribbon.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the ribbon. (Default: \code{0.3})} #' } -#' +#' #' @section {Tile plotting}: -#' +#' #' \describe{ -#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -#' (Default: \code{TRUE})} -#' \item{\code{rect.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -#' transparency of the areas. (Default: \code{1})} -#' \item{\code{rect.colour}: }{\code{Character scalar}. Specifies the colour to use -#' for colouring the borders of the areas. (Default: \code{"black"})} -#' \item{\code{na.value}: }{\code{Character scalar}. Specifies the colour to use -#' for \code{NA} values. (Default: \code{"grey80"})} +#' \item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +#' plotted? (Default: \code{TRUE})} +#' +#' \item{\code{rect.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +#' Specifies the transparency of the areas. (Default: \code{1})} +#' +#' \item{\code{rect.colour}: }{\code{Character scalar}. Specifies the colour +#' to use for colouring the borders of the areas. (Default: \code{"black"})} +#' +#' \item{\code{na.value}: }{\code{Character scalar}. Specifies the colour to +#' use for \code{NA} values. (Default: \code{"grey80"})} #' } -#' +#' #' @name mia-plot-args NULL @@ -137,13 +181,13 @@ NULL # Adjusted function originally developed for scater package by Aaron Lun #' @importFrom viridis scale_fill_viridis scale_colour_viridis #' @importFrom ggplot2 scale_fill_manual scale_colour_manual -.resolve_plot_colours <- function(plot_out, colour_by, colour_by_name, - fill = FALSE, - type = c("normal","edges"), - na.translate = TRUE, - na.value = NA, - ...) -{ +.resolve_plot_colours <- function( + plot_out, colour_by, colour_by_name, + fill = FALSE, + type = c("normal","edges"), + na.translate = TRUE, + na.value = NA, + ...){ if (is.null(colour_by)) { return(plot_out) } @@ -172,32 +216,33 @@ NULL stop("Unrecognized colour type") } if (is.numeric(colour_by)) { - plot_out <- plot_out + VIRIDFUN(name = colour_by_name, option = option, - na.value = na.value, - ... - ) + plot_out <- plot_out + VIRIDFUN( + name = colour_by_name, option = option, na.value = na.value, ...) } else { nlevs_colour_by <- nlevels(as.factor(colour_by)) if (nlevs_colour_by <= 10) { - plot_out <- plot_out + SCALEFUN(values = .get_palette("tableau10medium"), - name = colour_by_name, - na.translate = na.translate, - na.value = na.value) + plot_out <- plot_out + SCALEFUN( + values = .get_palette("tableau10medium"), + name = colour_by_name, + na.translate = na.translate, + na.value = na.value) } else { if (nlevs_colour_by > 10 && nlevs_colour_by <= 20) { - plot_out <- plot_out + SCALEFUN(values = .get_palette("tableau20"), - name = colour_by_name, - na.translate = na.translate, - na.value = na.value) + plot_out <- plot_out + SCALEFUN( + values = .get_palette("tableau20"), + name = colour_by_name, + na.translate = na.translate, + na.value = na.value) } else { - plot_out <- plot_out + VIRIDFUN(name = colour_by_name, - discrete = TRUE, - na.translate = na.translate, - option = option, - na.value = na.value) + plot_out <- plot_out + VIRIDFUN( + name = colour_by_name, + discrete = TRUE, + na.translate = na.translate, + option = option, + na.value = na.value) } } } @@ -210,7 +255,7 @@ NULL guide_args <- list() if (!is.null(edge_width_by)) { guide_args$edge_width <- guide_legend(title = edge_width_by) - plot_out <- plot_out + + plot_out <- plot_out + do.call(guides, guide_args) } plot_out @@ -224,20 +269,16 @@ NULL } else { SIZEFUN <- scale_size_discrete } - plot_out <- plot_out + + plot_out <- plot_out + SIZEFUN(name = edge_size_by, range = line_width_range) + new_scale("size") } plot_out } -.na_replace_from_plot_data <- function(object, - edge_size_by = NULL, - shape_by = NULL, - size_by = NULL, - default_shape = 21, - default_size = 0, - default_edge_size = 0){ +.na_replace_from_plot_data <- function( + object, edge_size_by = NULL, shape_by = NULL, size_by = NULL, + default_shape = 21, default_size = 0, default_edge_size = 0){ if(!is.null(shape_by)){ object$shape_by[is.na(object$shape_by)] <- default_shape } @@ -250,9 +291,7 @@ NULL object } -.get_bar_args <- function (colour_by, alpha = 0.65, add_border = NULL, - n = 0) -{ +.get_bar_args <- function(colour_by, alpha = 0.65, add_border = NULL, n = 0){ fill_colour <- TRUE border <- FALSE aes_args <- list() @@ -278,19 +317,17 @@ NULL # Adjusted function originally developed for scater package by Aaron Lun -.get_point_args <- function(colour_by, shape_by, size_by, - alpha = 0.65, - size = NULL, - shape = 21, - colour = "grey70") -{ +.get_point_args <- function( + colour_by, shape_by, size_by, alpha = 0.65, size = NULL, shape = 21, + colour = "grey70"){ aes_args <- list() fill_colour <- TRUE if (!is.null(shape_by)) { aes_args$shape <- "shape_by" } if (!is.null(colour_by)) { - # Only shapes 21 to 25 can be filled. Filling does not work in other shapes. + # Only shapes 21 to 25 can be filled. Filling does not work in other + # shapes. if(shape >= 21 && shape <= 25){ aes_args$fill <- "colour_by" } else { @@ -316,12 +353,9 @@ NULL return(list(args = geom_args, fill = fill_colour)) } -.get_line_args <- function(colour_by, linetype_by, size_by, - alpha = 0.65, - linetype = 1, - linewidth = NULL, - colour = "grey70") -{ +.get_line_args <- function( + colour_by, linetype_by, size_by, alpha = 0.65, linetype = 1, + linewidth = NULL, colour = "grey70"){ aes_args <- list() if (!is.null(linetype_by)) { aes_args$linetype <- "linetype_by" @@ -347,10 +381,10 @@ NULL return(list(args = geom_args)) } -.get_ribbon_args <- function(colour_by, - alpha = 0.3) -{ - aes_args <- aes(ymin = .data[["Y"]] - .data[["sd"]], ymax = .data[["Y"]] + .data[["sd"]]) +.get_ribbon_args <- function(colour_by, alpha = 0.3){ + aes_args <- aes( + ymin = .data[["Y"]] - .data[["sd"]], + ymax = .data[["Y"]] + .data[["sd"]]) if (!is.null(colour_by)) { aes_args$fill <- substitute(`colour_by`) } @@ -362,8 +396,8 @@ NULL return(list(args = geom_args)) } -.get_edge_args <- function(edge_colour_by, edge_size_by, alpha = 1, size = NULL, - layout = NULL){ +.get_edge_args <- function( + edge_colour_by, edge_size_by, alpha = 1, size = NULL, layout = NULL){ aes_args <- list() if (!is.null(edge_colour_by)) { aes_args$colour <- "edge_colour_by" @@ -382,13 +416,13 @@ NULL } # Add layout if specified if( !is.null(layout) ){ - geom_args$layout <- layout + geom_args$layout <- layout } return(list(args = geom_args)) } -.get_graph_edge_args <- function(edge_colour_by, edge_width_by, alpha = 1, - size = NULL, edge_type){ +.get_graph_edge_args <- function( + edge_colour_by, edge_width_by, alpha = 1, size = NULL, edge_type){ edge_args <- .get_edge_args(edge_colour_by, edge_width_by, alpha, size) if (!is.null(edge_width_by)) { edge_args$args$mapping$edge_width <- sym("edge_width_by") @@ -420,8 +454,7 @@ NULL } aes_args <- lapply(aes_args, function(x) if (!is.null(x)) sym(x)) new_aes <- do.call(aes, aes_args) - geom_args <- list(mapping = new_aes, - alpha = alpha) + geom_args <- list(mapping = new_aes, alpha = alpha) if (is.null(colour_by)) { geom_args$colour <- colour geom_args$fill <- "grey70" @@ -430,24 +463,23 @@ NULL } #' @importFrom ggplot2 coord_flip element_blank element_text -.flip_plot <- function(plot_out, flipped = FALSE, add_x_text = FALSE, - angle_x_text = TRUE){ +.flip_plot <- function( + plot_out, flipped = FALSE, add_x_text = FALSE, angle_x_text = TRUE){ if (flipped) { - plot_out <- plot_out + + plot_out <- plot_out + coord_flip() if(!add_x_text){ - plot_out <- plot_out + - theme(axis.text.y = element_blank(), - axis.ticks.y = element_blank()) + plot_out <- plot_out + theme( + axis.text.y = element_blank(), axis.ticks.y = element_blank()) } else if(angle_x_text) { plot_out <- plot_out + theme(axis.text.x = element_text(angle = 45, hjust = 1)) } } else { if(!add_x_text){ - plot_out <- plot_out + - theme(axis.text.x = element_blank(), - axis.ticks.x = element_blank()) + plot_out <- plot_out + theme( + axis.text.x = element_blank(), + axis.ticks.x = element_blank()) } } plot_out diff --git a/man/deprecate.Rd b/man/deprecate.Rd new file mode 100644 index 00000000..40782a48 --- /dev/null +++ b/man/deprecate.Rd @@ -0,0 +1,30 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/deprecate.R +\name{deprecate} +\alias{deprecate} +\alias{plotTaxaPrevalence} +\alias{plotTaxaPrevalence,ANY-method} +\alias{plotFeaturePrevalence} +\alias{plotFeaturePrevalence,ANY-method} +\title{These functions will be deprecated. Please use other functions instead.} +\usage{ +plotTaxaPrevalence(x, ...) + +\S4method{plotTaxaPrevalence}{ANY}(x, ...) + +plotFeaturePrevalence(x, ...) + +\S4method{plotFeaturePrevalence}{ANY}(x, ...) +} +\arguments{ +\item{x}{\itemize{ +\item +}} + +\item{...}{\itemize{ +\item +}} +} +\description{ +These functions will be deprecated. Please use other functions instead. +} diff --git a/man/getNeatOrder.Rd b/man/getNeatOrder.Rd index 77e64b7e..f76243e5 100644 --- a/man/getNeatOrder.Rd +++ b/man/getNeatOrder.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/getNeatOrder.R +% Please edit documentation in R/AllGenerics.R, R/getNeatOrder.R \name{getNeatOrder} \alias{getNeatOrder} \alias{getNeatOrder,matrix-method} @@ -53,7 +53,8 @@ That being said, the \code{getNeatOrder} function is more modular and separate to the plotting, and can be applied to any kind of ordinated data which can be valuable depending on the use case. -\href{https://doi.org/10.1186/1471-2105-11-45}{Rajaram & Oono (2010) NeatMap - non-clustering heat map alternatives in R} outlines this in more detail. +\href{https://doi.org/10.1186/1471-2105-11-45}{Rajaram & Oono (2010) NeatMap - non-clustering heat map alternatives in R} +outlines this in more detail. } \examples{ # Load the required libraries and dataset @@ -94,10 +95,10 @@ heatmap <- Heatmap(assay(tse, "standardize"), cluster_columns = FALSE, # Do not cluster columns show_row_dend = FALSE, show_column_dend = FALSE, - row_names_gp = gpar(fontsize = 4), - column_names_gp = gpar(fontsize = 6), - heatmap_width = unit(20, "cm"), - heatmap_height = unit(15, "cm") + row_names_gp = gpar(fontsize = 4), + column_names_gp = gpar(fontsize = 6), + heatmap_width = unit(20, "cm"), + heatmap_height = unit(15, "cm") ) } diff --git a/man/mia-plot-args.Rd b/man/mia-plot-args.Rd index dbddf11c..5c748910 100644 --- a/man/mia-plot-args.Rd +++ b/man/mia-plot-args.Rd @@ -11,22 +11,30 @@ available. These are described on this page. \describe{ -\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}, Specifies the -transparency of the tree edges. (Default: \code{1})} -\item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default width of -an edge. (Default: \code{NULL}) to use default of the \code{ggtree} package.} -\item{\code{line.width.range}: }{\code{Numeric vector}. The range for plotting -dynamic edge widths in. (Default: \code{c(0.5,3)})} -\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the tips. (Defaults: \code{1})} +\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}, +Specifies the transparency of the tree edges. (Default: \code{1})} + +\item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default +width of an edge. (Default: \code{NULL}) to use default of the +\code{ggtree} package.} + +\item{\code{line.width.range}: }{\code{Numeric vector}. The range for +plotting dynamic edge widths in. (Default: \code{c(0.5,3)})} + +\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the tips. (Defaults: \code{1})} + \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -default size of tips. (Defaults: \code{2.})} -\item{\code{point.size.range}: }{\code{Numeric vector}. Specifies the range for plotting -dynamic tip sizes in. (Defaults: \code{c(1,4)})} -\item{\code{label.font.size}: }{\code{Numeric scalar}. Font size for the tip and -node labels. (Default: \code{3})} -\item{\code{highlight.font.size}: }{\code{Numeric scalar}. Font size for the -highlight labels. (Default: \code{3})} +default size of tips. (Defaults: \code{2})} + +\item{\code{point.size.range}: }{\code{Numeric vector}. Specifies the range +for plotting dynamic tip sizes in. (Defaults: \code{c(1,4)})} + +\item{\code{label.font.size}: }{\code{Numeric scalar}. Font size for the +tip and node labels. (Default: \code{3})} + +\item{\code{highlight.font.size}: }{\code{Numeric scalar}. Font size for +the highlight labels. (Default: \code{3})} } } @@ -34,18 +42,24 @@ highlight labels. (Default: \code{3})} \describe{ -\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the tree edges. (Default: \code{1})} -\item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default width of -an edge. (Default: \code{NULL}) to use default of the \code{ggtree} package.} -\item{\code{line.width.range}: }{\code{Numeric vector}. The range for plotting -dynamic edge widths in. (Default: \code{c(0.5,3)})} -\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the tips. (Default: \code{1})} +\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the tree edges. (Default: \code{1})} + +\item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default +width of an edge. (Default: \code{NULL}) to use default of the +\code{ggtree} package.} + +\item{\code{line.width.range}: }{\code{Numeric vector}. The range for +plotting dynamic edge widths in. (Default: \code{c(0.5,3)})} + +\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the tips. (Default: \code{1})} + \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the default size of tips. (Default: \code{2.})} -\item{\code{point.size.range}: }{\code{Numeric vector}. The range for plotting -dynamic tip sizes in. (Default: \code{c(1,4)})} + +\item{\code{point.size.range}: }{\code{Numeric vector}. The range for +plotting dynamic tip sizes in. (Default: \code{c(1,4)})} } } @@ -53,20 +67,26 @@ dynamic tip sizes in. (Default: \code{c(1,4)})} \describe{ -\item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? (Default: -\code{FALSE})} -\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -(Default: \code{TRUE})} -\item{\code{add.x.text}: }{\code{Logical scalar}. Should x tick labels be plotted? -(Default: \code{FALSE})} -\item{\code{add.border}: }{\code{Logical scalar}. Should border of bars be plotted? +\item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? (Default: \code{FALSE})} -\item{\code{bar.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the bars. (Default: \code{1})} -\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the points. (Default: \code{1})} + +\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +plotted? (Default: \code{TRUE})} + +\item{\code{add.x.text}: }{\code{Logical scalar}. Should x tick labels be +plotted? (Default: \code{FALSE})} + +\item{\code{add.border}: }{\code{Logical scalar}. Should border of bars be +plotted? (Default: \code{FALSE})} + +\item{\code{bar.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies +the transparency of the bars. (Default: \code{1})} + +\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the points. (Default: \code{1})} + \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -default size of points. (Default: \code{2.})} +default size of points. (Default: \code{2})} } } @@ -74,22 +94,30 @@ default size of points. (Default: \code{2.})} \describe{ -\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -(Defaults: \code{TRUE})} -\item{\code{point.shape}: }{\code{Numeric scalar}. Sets the shape of points. -(Default: \code{21})} +\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +plotted? (Default: \code{TRUE})} + +\item{\code{point.shape}: }{\code{Numeric scalar}. Sets the shape of +points. (Default: \code{21})} + \item{\code{point.colour}: }{\code{Character scalar}. Specifies the -default colour of points. (Default: \code{2.})} +default colour of points. (Default: \code{2})} + \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the -default size of points. (Default: \code{2.})} -\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the points. (Default: \code{1})} -\item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? (Default: -\code{FALSE})} -\item{\code{scales.free}: }{\code{Logical scalar}. Should \code{scales = "free"} be -set for faceted plots? (Default: \code{TRUE})} -\item{\code{angle.x.text}: }{\code{Logical scalar}. Should x tick labels be plotted? +default size of points. (Default: \code{2})} + +\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the points. (Default: \code{1})} + +\item{\code{flipped}: }{\code{Logical scalar}. Should the plot be flipped? (Default: \code{FALSE})} + +\item{\code{scales.free}: }{\code{Logical scalar}. Should +\code{scales = "free"} be set for faceted plots? (Default: \code{TRUE})} + +\item{\code{angle.x.text}: }{\code{Logical scalar}. Should x tick labels be +plotted? (Default: \code{FALSE})} + } } @@ -97,20 +125,27 @@ set for faceted plots? (Default: \code{TRUE})} \describe{ -\item{\code{flipped}: }{\code{Logical scalar}. Specifies whether the plot should -be flipped. (Default: \code{FALSE})} -\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -(Default: \code{TRUE})} -\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the tips. (Default: \code{1})} +\item{\code{flipped}: }{\code{Logical scalar}. Specifies whether the plot +should be flipped. (Default: \code{FALSE})} + +\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +plotted? (Default: \code{TRUE})} + +\item{\code{point.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the tips. (Default: \code{1})} + \item{\code{point.size}: }{\code{Numeric scalar}. Specifies the default size of tips. (Default: \code{2.})} -\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the tree edges. (Default: \code{1})} -\item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line type. -(Default: \code{NULL}) to use default of the \code{ggplot2} package.} -\item{\code{line.size}: }{\code{Numeric scalar}. Specifies the default width of -a line. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} + +\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the tree edges. (Default: \code{1})} + +\item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line +type. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} + +\item{\code{line.size}: }{\code{Numeric scalar}. Specifies the default +width of a line. (Default: \code{NULL}) to use default of the +\code{ggplot2} package.} } } @@ -118,18 +153,24 @@ a line. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} \describe{ -\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -(Default: \code{TRUE})} -\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the tree edges. (Default: \code{1})} -\item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line type. -(Default: \code{NULL}) to use default of the \code{ggplot2} package.} -\item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default width of -a line. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} -\item{\code{line.width.range}: }{\code{Numeric vector}. The range for plotting -dynamic line widths in. (Default: \code{c(0.5,3)})} -\item{\code{ribbon.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the ribbon. (Default: \code{0.3})} +\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +plotted? (Default: \code{TRUE})} + +\item{\code{line.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the tree edges. (Default: \code{1})} + +\item{\code{line.type}: }{\code{Numeric scalar}. Specifies the default line +type. (Default: \code{NULL}) to use default of the \code{ggplot2} package.} + +\item{\code{line.width}: }{\code{Numeric scalar}. Specifies the default +width of a line. (Default: \code{NULL}) to use default of the +\code{ggplot2} package.} + +\item{\code{line.width.range}: }{\code{Numeric vector}. The range for +plotting dynamic line widths in. (Default: \code{c(0.5,3)})} + +\item{\code{ribbon.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the ribbon. (Default: \code{0.3})} } } @@ -137,14 +178,17 @@ transparency of the ribbon. (Default: \code{0.3})} \describe{ -\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be plotted? -(Default: \code{TRUE})} -\item{\code{rect.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. Specifies the -transparency of the areas. (Default: \code{1})} -\item{\code{rect.colour}: }{\code{Character scalar}. Specifies the colour to use -for colouring the borders of the areas. (Default: \code{"black"})} -\item{\code{na.value}: }{\code{Character scalar}. Specifies the colour to use -for \code{NA} values. (Default: \code{"grey80"})} +\item{\code{add.legend}: }{\code{Logical scalar}. Should legends be +plotted? (Default: \code{TRUE})} + +\item{\code{rect.alpha}: }{\code{Numeric scalar} in \code{[0, 1]}. +Specifies the transparency of the areas. (Default: \code{1})} + +\item{\code{rect.colour}: }{\code{Character scalar}. Specifies the colour +to use for colouring the borders of the areas. (Default: \code{"black"})} + +\item{\code{na.value}: }{\code{Character scalar}. Specifies the colour to +use for \code{NA} values. (Default: \code{"grey80"})} } } diff --git a/man/plotAbundance.Rd b/man/plotAbundance.Rd index 6d4d15b2..6a6444bf 100644 --- a/man/plotAbundance.Rd +++ b/man/plotAbundance.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotAbundance.R +% Please edit documentation in R/AllGenerics.R, R/plotAbundance.R \name{plotAbundance} \alias{plotAbundance} \alias{plotAbundance,SummarizedExperiment-method} diff --git a/man/plotAbundanceDensity.Rd b/man/plotAbundanceDensity.Rd index 736e7f47..f4bc980d 100644 --- a/man/plotAbundanceDensity.Rd +++ b/man/plotAbundanceDensity.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotAbundanceDensity.R +% Please edit documentation in R/AllGenerics.R, R/plotAbundanceDensity.R \name{plotAbundanceDensity} \alias{plotAbundanceDensity} \alias{plotAbundanceDensity,SummarizedExperiment-method} @@ -38,25 +38,30 @@ object.} \code{ylab} is disabled when \code{layout = "density"}. (Default: \code{"Taxa"}) -\item \code{point.alpha} \code{Numeric scalar}. From range 0 to 1. Selects the transparency of +\item \code{point.alpha} \code{Numeric scalar}. From range 0 to 1. Selects +the transparency of colour in \code{jitter} and \code{point} plot. (Default: \code{0.6}) -\item \code{point.shape} \code{Positive integer scalar}. Value selecting the shape of point in +\item \code{point.shape} \code{Positive integer scalar}. Value selecting +the shape of point in \code{jitter} and \code{point} plot. (Default: \code{21}) -\item \code{point.size} \code{Positive integer scalar}. Selects the size of point in +\item \code{point.size} \code{Positive integer scalar}. Selects the size of +point in \code{jitter} and \code{point} plot. (Default: \code{2}) -\item \code{add_legend} \code{Logical scalar}. Determines if legend is added. -(Default: \code{TRUE}) +\item \code{add_legend} \code{Logical scalar}. Determines if legend is +added. (Default: \code{TRUE}) -\item \code{flipped}: \code{Logical scalar}. Determines if the orientation of plot is changed -so that x-axis and y-axis are swapped. (Default: \code{FALSE}) +\item \code{flipped}: \code{Logical scalar}. Determines if the orientation +of plot is changed so that x-axis and y-axis are swapped. +(Default: \code{FALSE}) -\item \code{add_x_text} \code{Logical scalar}. Determines if text that represents values is included -in x-axis. (Default: \code{TRUE}) +\item \code{add_x_text} \code{Logical scalar}. Determines if text that +represents values is included in x-axis. (Default: \code{TRUE}) } -See \code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")}} +See \code{\link{mia-plot-args}} for more details i.e. call +\code{help("mia-plot-args")}} \item{layout}{\code{Character scalar}. Selects the layout of the plot. There are three different options: \code{jitter}, \code{density}, and @@ -67,8 +72,8 @@ use. (Default: \code{"relabundance"})} \item{assay_name}{Deprecate. Use \code{assay.type} instead.} -\item{n}{\code{Integer scalar}. Specifies the number of the most abundant taxa -to show. (Default: \code{min(nrow(x), 25L)})} +\item{n}{\code{Integer scalar}. Specifies the number of the most abundant +taxa to show. (Default: \code{min(nrow(x), 25L)})} \item{colour.by}{\code{Character scalar}. Defines a column from \code{colData}, that is used to color plot. Must be a value of @@ -90,8 +95,8 @@ disabled when \code{layout = "density"}. (Default: \code{NULL})} \item{size_by}{Deprecated. Use \code{size.by} instead.} -\item{decreasing}{\code{Logical scalar}. Indicates whether the results should be ordered -in a descending order or not. If \code{NA} is given the order +\item{decreasing}{\code{Logical scalar}. Indicates whether the results should +be ordered in a descending order or not. If \code{NA} is given the order as found in \code{x} for the \code{n} most abundant taxa is used. (Default: \code{TRUE})} @@ -104,46 +109,49 @@ A \code{ggplot2} object This function plots abundance of the most abundant taxa. } \details{ -This function plots abundance of the most abundant taxa. Abundance can be plotted as -a jitter plot, a density plot, or a point plot. By default, x-axis represents abundance -and y-axis taxa. In a jitter and point plot, each point represents abundance of -individual taxa in individual sample. Most common abundances are shown as a higher density. - -A density plot can be seen as a smoothened bar plot. It visualized distribution of -abundances where peaks represent most common abundances. +This function plots abundance of the most abundant taxa. Abundance can be +plotted as a jitter plot, a density plot, or a point plot. By default, x-axis +represents abundance and y-axis taxa. In a jitter and point plot, each point +represents abundance of individual taxa in individual sample. Most common +abundances are shown as a higher density. + +A density plot can be seen as a smoothened bar plot. It visualized +distribution of abundances where peaks represent most common abundances. } \examples{ data("peerj13075", package = "mia") tse <- peerj13075 -# Plots the abundances of 25 most abundant taxa. Jitter plot is the default option. +# Plots the abundances of 25 most abundant taxa. Jitter plot is the default +# option. plotAbundanceDensity(tse, assay.type = "counts") # Counts relative abundances tse <- transformAssay(tse, method = "relabundance") -# Plots the relative abundance of 10 most abundant taxa. -# "nationality" information is used to color the points. X-axis is log-scaled. +# Plots the relative abundance of 10 most abundant taxa. +# "nationality" information is used to color the points. X-axis is +# log-scaled. plotAbundanceDensity( tse, layout = "jitter", assay.type = "relabundance", n = 10, colour.by = "Geographical_location") + - scale_x_log10() - + scale_x_log10() + # Plots the relative abundance of 10 most abundant taxa as a density plot. # X-axis is log-scaled plotAbundanceDensity( tse, layout = "density", assay.type = "relabundance", n = 10 ) + scale_x_log10() - + # Plots the relative abundance of 10 most abundant taxa as a point plot. # Point shape is changed from default (21) to 41. plotAbundanceDensity( tse, layout = "point", assay.type = "relabundance", n = 10, point.shape = 41) - + # Plots the relative abundance of 10 most abundant taxa as a point plot. -# In addition to colour, groups can be visualized by size and shape in point plots, -# and adjusted for point size +# In addition to colour, groups can be visualized by size and shape in point +# plots, and adjusted for point size plotAbundanceDensity( tse, layout = "point", assay.type = "relabundance", n = 10, shape.by = "Geographical_location", size.by = "Age", point.size=1) @@ -157,14 +165,15 @@ plotAbundanceDensity( plotAbundanceDensity( tse, assay.type = "relabundance", decreasing = NA) -# Box plots and violin plots are supported by scater::plotExpression. +# Box plots and violin plots are supported by scater::plotExpression. # Plots the relative abundance of 5 most abundant taxa as a violin plot. library(scater) top <- getTop(tse, top = 5) -plotExpression(tse, features = top, assay.type = "relabundance") + ggplot2::coord_flip() +plotExpression(tse, features = top, assay.type = "relabundance") + + ggplot2::coord_flip() # Plots the relative abundance of 5 most abundant taxa as a box plot. -plotExpression(tse, features = top, assay.type = "relabundance", +plotExpression(tse, features = top, assay.type = "relabundance", show_violin = FALSE, show_box = TRUE) + ggplot2::coord_flip() } diff --git a/man/plotCCA.Rd b/man/plotCCA.Rd index d2900876..0e57d60f 100644 --- a/man/plotCCA.Rd +++ b/man/plotCCA.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotCCA.R +% Please edit documentation in R/AllGenerics.R, R/plotCCA.R \name{plotCCA} \alias{plotCCA} \alias{plotRDA} @@ -11,12 +11,12 @@ \usage{ plotCCA(x, ...) +plotRDA(x, ...) + \S4method{plotCCA}{SingleCellExperiment}(x, dimred, ...) \S4method{plotCCA}{matrix}(x, ...) -plotRDA(x, ...) - \S4method{plotRDA}{SingleCellExperiment}(x, dimred, ...) \S4method{plotRDA}{matrix}(x, ...) @@ -131,7 +131,7 @@ arguments inherited from \code{\link[scater:plotReducedDim]{plotReducedDim}}. library(miaViz) data("enterotype", package = "mia") tse <- enterotype - + # Run RDA and store results into TreeSE tse <- addRDA( tse, @@ -140,22 +140,22 @@ tse <- addRDA( distance = "bray", na.action = na.exclude ) - + # Create RDA plot coloured by variable plotRDA(tse, "RDA", colour.by = "ClinicalStatus") - + # Create RDA plot with empty ellipses plotRDA(tse, "RDA", colour.by = "ClinicalStatus", add.ellipse = "colour") - + # Create RDA plot with text encased in labels plotRDA(tse, "RDA", colour.by = "ClinicalStatus", vec.text = FALSE) - + # Create RDA plot without repelling text plotRDA(tse, "RDA", colour.by = "ClinicalStatus", repel.labels = FALSE) - + # Create RDA plot without vectors plotRDA(tse, "RDA", colour.by = "ClinicalStatus", add.vectors = FALSE) - + # Calculate RDA as a separate object rda_mat <- getRDA( tse, @@ -164,7 +164,7 @@ rda_mat <- getRDA( distance = "bray", na.action = na.exclude ) - + # Create RDA plot from RDA matrix plotRDA(rda_mat) } diff --git a/man/plotColTile.Rd b/man/plotColTile.Rd index 4ded9ca0..a4ac644f 100644 --- a/man/plotColTile.Rd +++ b/man/plotColTile.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotColTile.R +% Please edit documentation in R/AllGenerics.R, R/plotColTile.R \name{plotColTile} \alias{plotColTile} \alias{plotRowTile} @@ -20,18 +20,21 @@ plotRowTile(object, x, y, ...) \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} object.} -\item{x}{\code{Character scalar}. Specifies the column-level metadata field to show on the x-axis. +\item{x}{\code{Character scalar}. Specifies the column-level metadata field +to show on the x-axis. Alternatively, an \link{AsIs} vector or data.frame, see \code{?\link{retrieveFeatureInfo}} or \code{?\link{retrieveCellInfo}}. Must result in a returned \code{character} or \code{factor} vector.} -\item{y}{\code{Character scalar}. Specifies the column-level metadata to show on the y-axis. +\item{y}{\code{Character scalar}. Specifies the column-level metadata to +show on the y-axis. Alternatively, an \link{AsIs} vector or data.frame, see \code{?\link{retrieveFeatureInfo}} or \code{?\link{retrieveCellInfo}}. Must result in a returned \code{character} or \code{factor} vector.} \item{...}{additional arguments for plotting. See -\code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")}} +\code{\link{mia-plot-args}} for more details i.e. call +\code{help("mia-plot-args")}} } \value{ A \code{ggplot2} object or \code{plotly} object, if more than one diff --git a/man/plotDMN.Rd b/man/plotDMN.Rd index 8cc7b2e1..4e521e3b 100644 --- a/man/plotDMN.Rd +++ b/man/plotDMN.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotDMN.R -\name{plotDMN} -\alias{plotDMN} +% Please edit documentation in R/AllGenerics.R, R/plotDMN.R +\name{plotDMNFit} \alias{plotDMNFit} +\alias{plotDMN} \alias{plotDMNFit,SummarizedExperiment-method} \title{Plotting Dirichlet-Multinomial Mixture Model data} \usage{ @@ -19,8 +19,8 @@ object contain the DMN data in \code{metadata}.} \code{\link[SummarizedExperiment:RangedSummarizedExperiment-class]{metadata}} (Default: \code{"DMN"})} -\item{type}{\code{Character scalar}. The type of measure for access the goodness of fit. One of -\sQuote{laplace}, \sQuote{AIC} or \sQuote{BIC}.} +\item{type}{\code{Character scalar}. The type of measure for access the +goodness of fit. One of \sQuote{laplace}, \sQuote{AIC} or \sQuote{BIC}.} \item{...}{optional arguments not used.} } diff --git a/man/plotGraph.Rd b/man/plotGraph.Rd index 445d83de..60693c77 100644 --- a/man/plotGraph.Rd +++ b/man/plotGraph.Rd @@ -1,9 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotGraph.R -\name{plotGraph} -\alias{plotGraph} +% Please edit documentation in R/AllGenerics.R, R/plotGraph.R +\name{plotColGraph} \alias{plotColGraph} \alias{plotRowGraph} +\alias{plotGraph} \alias{plotColGraph,ANY,SummarizedExperiment-method} \alias{plotColGraph,SummarizedExperiment,missing-method} \alias{plotRowGraph,ANY,SummarizedExperiment-method} @@ -76,12 +76,15 @@ plotRowGraph(x, y, ...) \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} object or just a \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}}. -For the latter object a graph object must be stored in \code{metadata(x)$name}.} +For the latter object a graph object must be stored in +\code{metadata(x)$name}.} \item{...}{additional arguments for plotting. See -\code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")}} +\code{\link{mia-plot-args}} for more details i.e. call +\code{help("mia-plot-args")}} -\item{show.label}{\code{Logical scalar}, \code{integer vector} or \code{character vector} +\item{show.label}{\code{Logical scalar}, \code{integer vector} or +\code{character vector} If a \code{logical} scalar is given, should tip labels be plotted or if a logical vector is provided, which labels should be shown? If an \code{integer} or \code{character} vector is provided, it will be converted @@ -102,18 +105,20 @@ shown. (Default: \code{FALSE})} \item{layout}{\code{Character scalar}. Layout for the plotted graph. See \code{\link[ggraph:ggraph]{ggraph}} for details. (Default: \code{"kk"})} -\item{edge.type}{\code{Character scalar}. Type of edge plotted on the graph. See -\code{\link[ggraph:geom_edge_fan]{geom_edge_fan}} for details and other +\item{edge.type}{\code{Character scalar}. Type of edge plotted on the graph. +See \code{\link[ggraph:geom_edge_fan]{geom_edge_fan}} for details and other available geoms. (Default: \code{"fan"})} \item{edge_type}{Deprecated. Use \code{edge.type} instead.} \item{edge.colour.by}{\code{Character scalar}. Specification of an edge -metadata field to use for setting colours of the edges. (Default: \code{NULL})} +metadata field to use for setting colours of the edges. +(Default: \code{NULL})} \item{edge_colour_by}{Deprecated. Use \code{edge.colour.by} instead.} -\item{edge.width.by}{\code{Character scalar}. Specification of an edge metadata +\item{edge.width.by}{\code{Character scalar}. Specification of an edge +metadata field to use for setting width of the edges. (Default: \code{NULL})} \item{edge_width_by}{Deprecated. Use \code{edge.width.by} instead.} @@ -139,9 +144,10 @@ values. (Default: \code{NULL})} \item{size_by}{Deprecated. Use \code{size.by} instead.} -\item{assay.type}{\code{Character scalar}. or \code{integer scalar}. Specifies -which assay to obtain expression values from, for use in point aesthetics - see the -\code{exprs_values} argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. +\item{assay.type}{\code{Character scalar}. or \code{integer scalar}. +Specifies which assay to obtain expression values from, for use in point +aesthetics - see the \code{exprs_values} argument in +\code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. (Default: \code{"counts"})} \item{by_exprs_values}{Deprecated. Use \code{assay.type} instead.} @@ -153,7 +159,8 @@ without plotting them.} \item{name}{\code{Character scalar}. If \code{x} is a \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} -the key for subsetting the \code{metadata(x)} to a graph object. (Default: \code{"graph"})} +the key for subsetting the \code{metadata(x)} to a graph object. +(Default: \code{"graph"})} } \value{ a \code{\link{ggtree}} plot @@ -197,7 +204,7 @@ plotColGraph(genus, colour.by = "SampleType", edge.colour.by = "weight", edge.width.by = "weight") - + # plot a graph independently plotRowGraph(row_graph, @@ -213,7 +220,7 @@ plotRowGraph(genus, edge.colour.by = "weight", edge.width.by = "weight") - + # plot a graph independently plotRowGraph(row_graph_order, order, @@ -226,18 +233,18 @@ plotRowGraph(order, name = "row_graph", colour.by = "Phylum", edge.colour.by = "weight", - edge.width.by = "weight", + edge.width.by = "weight", show.label = c("Sulfolobales","Spirochaetales", "Verrucomicrobiales")) - + # labels can also be included via selecting specific rownames of x/y plotRowGraph(order, name = "row_graph", colour.by = "Phylum", edge.colour.by = "weight", - edge.width.by = "weight", + edge.width.by = "weight", show.label = c(1,10,50)) - + # labels can also be included via a logical vector, which has the same length # as nodes are present label_select <- rep(FALSE,nrow(order)) diff --git a/man/plotLoadings.Rd b/man/plotLoadings.Rd index 1250e424..243b8c7a 100644 --- a/man/plotLoadings.Rd +++ b/man/plotLoadings.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotLoadings.R +% Please edit documentation in R/AllGenerics.R, R/plotLoadings.R \name{plotLoadings} \alias{plotLoadings} \alias{plotLoadings,TreeSummarizedExperiment-method} @@ -27,8 +27,7 @@ plotLoadings(x, ...) } \arguments{ \item{x}{a -\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} -x.} +\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}}.} \item{...}{additional parameters for plotting. \itemize{ diff --git a/man/plotNMDS.Rd b/man/plotNMDS.Rd index 0f1455a5..564f4f39 100644 --- a/man/plotNMDS.Rd +++ b/man/plotNMDS.Rd @@ -13,9 +13,9 @@ object.} \item{...}{additional arguments passed to scater::plotReducedDim().} -\item{ncomponents}{\code{Numeric scalar}. indicating the number of dimensions to plot, starting from -the first dimension. Alternatively, a numeric vector specifying the -dimensions to be plotted. (Default: \code{2})} +\item{ncomponents}{\code{Numeric scalar}. indicating the number of dimensions +to plot, starting from the first dimension. Alternatively, a numeric vector +specifying the dimensions to be plotted. (Default: \code{2})} } \description{ Wrapper for scater::plotReducedDim() diff --git a/man/plotPrevalence.Rd b/man/plotPrevalence.Rd index 00a85cc5..bee53245 100644 --- a/man/plotPrevalence.Rd +++ b/man/plotPrevalence.Rd @@ -1,18 +1,18 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotPrevalence.R -\name{plotPrevalence} +% Please edit documentation in R/AllGenerics.R, R/plotPrevalence.R +\name{plotRowPrevalence} +\alias{plotRowPrevalence} +\alias{plotPrevalentAbundance} \alias{plotPrevalence} \alias{plotPrevalence,SummarizedExperiment-method} -\alias{plotPrevalentAbundance} \alias{plotPrevalentAbundance,SummarizedExperiment-method} -\alias{plotRowPrevalence} -\alias{plotTaxaPrevalence} \alias{plotRowPrevalence,SummarizedExperiment-method} -\alias{plotTaxaPrevalence,ANY-method} -\alias{plotFeaturePrevalence} -\alias{plotFeaturePrevalence,ANY-method} \title{Plot prevalence information} \usage{ +plotRowPrevalence(x, ...) + +plotPrevalentAbundance(x, ...) + plotPrevalence(x, ...) \S4method{plotPrevalence}{SummarizedExperiment}( @@ -28,8 +28,6 @@ plotPrevalence(x, ...) ... ) -plotPrevalentAbundance(x, ...) - \S4method{plotPrevalentAbundance}{SummarizedExperiment}( x, rank = NULL, @@ -48,8 +46,6 @@ plotPrevalentAbundance(x, ...) ... ) -plotRowPrevalence(x, ...) - \S4method{plotRowPrevalence}{SummarizedExperiment}( x, rank = NULL, @@ -62,28 +58,20 @@ plotRowPrevalence(x, ...) BPPARAM = BiocParallel::SerialParam(), ... ) - -plotTaxaPrevalence(x, ...) - -\S4method{plotTaxaPrevalence}{ANY}(x, ...) - -plotFeaturePrevalence(x, ...) - -\S4method{plotFeaturePrevalence}{ANY}(x, ...) } \arguments{ \item{x}{a \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} object.} -\item{detection}{\code{Numeric scalar}. Detection thresholds for absence/presence. Either an -absolutes value compared directly to the values of \code{x} or a relative -value between 0 and 1, if \code{TRUE}.} +\item{detection}{\code{Numeric scalar}. Detection thresholds for +absence/presence. Either an absolutes value compared directly to the values +of \code{x} or a relative value between 0 and 1, if \code{TRUE}.} \item{detections}{Deprecated. Use \code{detection} instead.} -\item{prevalence}{\code{Numeric scalar}. Prevalence thresholds (in 0 to 1). The -required prevalence is strictly greater by default. To include the +\item{prevalence}{\code{Numeric scalar}. Prevalence thresholds (in 0 to 1). +The required prevalence is strictly greater by default. To include the limit, set \code{include.lowest} to \code{TRUE}.} \item{prevalences}{Deprecated. Use \code{prevalence} instead.} @@ -117,27 +105,34 @@ calculated detection thresholds when \code{detection=NULL}. When \code{\link[BiocParallel:BiocParallelParam-class]{BiocParallelParam}} object specifying whether the UniFrac calculation should be parallelized.} -\item{colour.by}{\code{Character scalar}. Specification of a feature to colour points by, see the -\code{by} argument in \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for -possible values. Only used with \code{layout = "point"}. (Default: \code{NULL})} +\item{colour.by}{\code{Character scalar}. Specification of a feature to +colour points by, see the \code{by} argument in +\code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for +possible values. Only used with \code{layout = "point"}. +(Default: \code{NULL})} \item{colour_by}{Deprecated. Use \code{colour.by} instead.} -\item{size.by}{\code{Character scalar}. Specification of a feature to size points by, see the -\code{by} argument in \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for -possible values. Only used with \code{layout = "point"}. (Default: \code{NULL})} +\item{size.by}{\code{Character scalar}. Specification of a feature to size +points by, see the \code{by} argument in +\code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for +possible values. Only used with \code{layout = "point"}. +(Default: \code{NULL})} \item{size_by}{Deprecated. Use \code{size.by} instead.} -\item{shape.by}{\code{Character scalar}. Specification of a feature to shape points by, see the -\code{by} argument in \code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for -possible values. Only used with \code{layout = "point"}. (Default: \code{NULL})} +\item{shape.by}{\code{Character scalar}. Specification of a feature to shape +points by, see the \code{by} argument in +\code{\link[scater:retrieveFeatureInfo]{?retrieveFeatureInfo}} for +possible values. Only used with \code{layout = "point"}. +(Default: \code{NULL})} \item{shape_by}{Deprecated. Use \code{shape.by} instead.} -\item{show.label}{\code{Logical scalar}, \code{character scalar} or \code{integer vector} -for selecting labels from the rownames of \code{x}. If \code{rank} is not -\code{NULL} the rownames might change. (Default: \code{NULL})} +\item{show.label}{\code{Logical scalar}, \code{character scalar} or +\code{integer vector} for selecting labels from the rownames of \code{x}. +If \code{rank} is not \code{NULL} the rownames might change. +(Default: \code{NULL})} \item{label}{Deprecated. Use \code{show.label} instead.} @@ -185,12 +180,12 @@ plotPrevalence(GlobalPatterns, rank = "Phylum") + scale_x_log10() # plotting prevalence per taxa for different detection thresholds as heatmap plotRowPrevalence(GlobalPatterns, rank = "Phylum") -# by default a continuous scale is used for different detection levels, +# by default a continuous scale is used for different detection levels, # but this can be adjusted plotRowPrevalence( GlobalPatterns, rank = "Phylum", assay.type = "relabundance", detection = c(0, 0.001, 0.01, 0.1, 0.2)) - + # point layout for plotRowPrevalence can be used to visualize by additional # information plotPrevalentAbundance( diff --git a/man/plotScree.Rd b/man/plotScree.Rd index d68d6238..ef1cbe04 100644 --- a/man/plotScree.Rd +++ b/man/plotScree.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotScree.R +% Please edit documentation in R/AllGenerics.R, R/plotScree.R \name{plotScree} \alias{plotScree} \alias{plotScree,SingleCellExperiment-method} @@ -90,7 +90,7 @@ library(scater) data("enterotype", package = "mia") tse <- enterotype - + # Run PCA and store results into TreeSE tse <- transformAssay(tse, method = "clr", pseudocount = TRUE) tse <- runPCA(tse, assay.type = "clr") diff --git a/man/plotSeries.Rd b/man/plotSeries.Rd index 7662302b..d7813b7b 100644 --- a/man/plotSeries.Rd +++ b/man/plotSeries.Rd @@ -1,25 +1,11 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotSeries.R +% Please edit documentation in R/AllGenerics.R, R/plotSeries.R \name{plotSeries} \alias{plotSeries} \alias{plotSeries,SummarizedExperiment-method} \title{Plot Series} \usage{ -plotSeries( - object, - x, - y = NULL, - rank = NULL, - colour.by = colour_by, - colour_by = NULL, - size.by = size_by, - size_by = NULL, - linetype.by = linetype_by, - linetype_by = NULL, - assay.type = assay_name, - assay_name = "counts", - ... -) +plotSeries(object, ...) \S4method{plotSeries}{SummarizedExperiment}( object, @@ -42,6 +28,10 @@ plotSeries( \code{\link[SummarizedExperiment:SummarizedExperiment-class]{SummarizedExperiment}} object.} +\item{...}{additional parameters for plotting. See +\code{\link{mia-plot-args}} for more details i.e. call +\code{help("mia-plot-args")}} + \item{x}{\code{Character scalar}. selecting the column from \code{\link[SummarizedExperiment:SummarizedExperiment-class]{ColData}} that will specify values of x-axis.} @@ -55,7 +45,8 @@ to agglomerate the data. Must be a value of \code{taxonomicRanks()} function. (Default: \code{NULL})} \item{colour.by}{\code{Character scalar}. A taxonomic rank, that is used to -color plot. Must be a value of \code{taxonomicRanks()} function. (Default: \code{NULL})} +color plot. Must be a value of \code{taxonomicRanks()} function. +(Default: \code{NULL})} \item{colour_by}{Deprecated. Use \code{colour.by} instead.} @@ -76,9 +67,6 @@ is used to divide taxa to different line types. Must be a value of plotted. (Default: \code{"counts"})} \item{assay_name}{Deprecated. Use \code{assay.type} instead.} - -\item{...}{additional parameters for plotting. See -\code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")}} } \value{ A \code{ggplot2} object @@ -87,8 +75,8 @@ A \code{ggplot2} object This function plots series data. } \details{ -This function creates series plot, where x-axis includes e.g. time points, and -y-axis abundances of selected taxa. +This function creates series plot, where x-axis includes e.g. time points, +and y-axis abundances of selected taxa. } \examples{ \dontrun{ @@ -112,15 +100,16 @@ taxa <- c("seq_1", "seq_2", "seq_3", "seq_4", "seq_5") # Plots relative abundances of phylums plotSeries(object[taxa,], - x = "DAY_ORDER", + x = "DAY_ORDER", colour.by = "Family", linetype.by = "Phylum", assay.type = "relabundance") -# In addition to 'colour.by' and 'linetype.by', 'size.by' can also be used to group taxa. +# In addition to 'colour.by' and 'linetype.by', 'size.by' can also be used +# to group taxa. plotSeries(object, - x = "DAY_ORDER", - y = getTop(object, 5), + x = "DAY_ORDER", + y = getTop(object, 5), colour.by = "Family", size.by = "Phylum", assay.type = "counts") diff --git a/man/plotTree.Rd b/man/plotTree.Rd index 79428923..5054481a 100644 --- a/man/plotTree.Rd +++ b/man/plotTree.Rd @@ -1,9 +1,9 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/plotTree.R -\name{plotTree} -\alias{plotTree} +% Please edit documentation in R/AllGenerics.R, R/plotTree.R +\name{plotRowTree} \alias{plotRowTree} \alias{plotColTree} +\alias{plotTree} \alias{plotColTree,TreeSummarizedExperiment-method} \alias{plotRowTree,TreeSummarizedExperiment-method} \title{Plotting tree information enriched with information} @@ -106,19 +106,19 @@ plotColTree(x, ...) } \arguments{ \item{x}{a -\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}} -x.} +\code{\link[TreeSummarizedExperiment:TreeSummarizedExperiment-class]{TreeSummarizedExperiment}}.} \item{...}{additional arguments for plotting. See -\code{\link{mia-plot-args}} for more details i.e. call \code{help("mia-plot-args")}} +\code{\link{mia-plot-args}} for more details i.e. call +\code{help("mia-plot-args")}} \item{tree.name}{\code{Character scalar}. Specifies a rowTree/colTree from \code{x}. (Default: \code{tree.name = "phylo"})} \item{tree_name}{Deprecated. Use \code{tree.name} instead.} -\item{relabel.tree}{\code{Logical scalar}. Should the tip labels be relabeled using -the output of \code{getTaxonomyLabels(x, with_rank = TRUE)}? +\item{relabel.tree}{\code{Logical scalar}. Should the tip labels be relabeled +using the output of \code{getTaxonomyLabels(x, with_rank = TRUE)}? (Default: \code{FALSE})} \item{relabel_tree}{Deprecated. Use \code{relavel.tree} instead.} @@ -141,11 +141,12 @@ to a logical vector. The \code{integer} values must be in the range of 1 and number of nodes, whereas the values of a \code{character} vector must match values of the \code{label} column in the node data. In case of a \code{character} vector only values corresponding to actual labels will be -plotted and if no labels are provided no labels will be shown. (default: +plotted and if no labels are provided no labels will be shown. (Default: \code{FALSE})} \item{show_label, show_highlights, show_highlight_label, abbr_label}{Deprecated. -Use \code{show.label, show.highlights, show.highlight.label, abbr_label} instead.} +Use \code{show.label, show.highlights, show.highlight.label, abbr_label} +instead.} \item{add.legend}{\code{Logical scalar}. Should legends be plotted? (Default: \code{TRUE})} @@ -155,71 +156,77 @@ Use \code{show.label, show.highlights, show.highlight.label, abbr_label} instead \item{layout}{layout for the plotted tree. See \code{\link[ggtree:ggtree]{ggtree}} for details.} -\item{edge.colour.by}{\code{Character scalar}. Specification of a column metadata field or a feature -to colour tree edges by, see the by argument in +\item{edge.colour.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to colour tree edges by, see the by argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible values.} \item{edge_colour_by}{Deprecated. Use \code{edge.colour.by} instead.} -\item{edge.size.by}{\code{Character scalar}. Specification of a column metadata field or a feature -to size tree edges by, see the by argument in +\item{edge.size.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to size tree edges by, see the by argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible values. (Default: \code{NULL})} \item{edge_size_by}{Deprecated. Use \code{edge.size.by} instead.} -\item{tip.colour.by}{\code{Character scalar}. Specification of a column metadata field or a feature to -colour tree tips by, see the by argument in +\item{tip.colour.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to colour tree tips by, see the by argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible values. (Default: \code{NULL})} \item{tip_colour_by}{Deprecated. Use \code{tip.colour.by} instead.} -\item{tip.shape.by}{\code{Character scalar}. Specification of a column metadata field or a feature to -shape tree tips by, see the by argument in +\item{tip.shape.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to shape tree tips by, see the by argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible values. (Default: \code{NULL})} \item{tip_shape_by}{Deprecated. Use \code{tip.shape.by} isntead.} -\item{tip.size.by}{\code{Character scalar}. Specification of a column metadata field or a feature to -size tree tips by, see the by argument in +\item{tip.size.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to size tree tips by, see the by argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}} for possible values. (Default: \code{NULL})} \item{tip_size_by}{Deprecated. Use \code{tip.size.by} instead.} -\item{node.colour.by}{\code{Character scalar}. Specification of a column metadata field or a feature to -colour tree nodes by. Must be a field from \code{other.fields}. (Default: \code{NULL})} +\item{node.colour.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to colour tree nodes by. Must be a field from +\code{other.fields}. (Default: \code{NULL})} \item{node_colour_by}{Deprecated. Use \code{node.colour.by} instead.} -\item{node.shape.by}{\code{Character scalar}. Specification of a column metadata field or a feature to -shape tree nodes by. Must be a field from \code{other.fields}. (Default: \code{NULL})} +\item{node.shape.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to shape tree nodes by. Must be a field from +\code{other.fields}. (Default: \code{NULL})} \item{node_shape_by}{Deprecated. Use \code{node.shape.by} instead.} -\item{node.size.by}{\code{Character scalar}. Specification of a column metadata field or a feature to -size tree nodes by. Must be a field from \code{other.fields}. (Default: \code{NULL})} +\item{node.size.by}{\code{Character scalar}. Specification of a column +metadata field or a feature to size tree nodes by. Must be a field from +\code{other.fields}. (Default: \code{NULL})} \item{node_size_by}{Deprecated. Use \code{node.size.by} instead.} -\item{colour.highlights.by}{\code{Logical scalar}. Should the highlights be colour differently? -If \code{show.highlights = TRUE}, \code{colour_highlights} will be set to -\code{TRUE} as default. (Default: \code{FALSE})} +\item{colour.highlights.by}{\code{Logical scalar}. Should the highlights be +colour differently? If \code{show.highlights = TRUE}, +\code{colour_highlights} will be set to \code{TRUE} as default. +(Default: \code{FALSE})} -\item{colour_highlights_by}{Deprecated. Use \code{colour.highlights.by} instead.} +\item{colour_highlights_by}{Deprecated. Use \code{colour.highlights.by} +instead.} -\item{assay.type}{\code{Character scalar}. or \code{integer scalar}. Specifies which assay to -obtain expression values from, for use in point aesthetics - see the -\code{exprs_values} argument in \code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. +\item{assay.type}{\code{Character scalar}. or \code{integer scalar}. +Specifies which assay to obtain expression values from, for use in point +aesthetics - see the \code{exprs_values} argument in +\code{\link[scater:retrieveCellInfo]{?retrieveCellInfo}}. (Default: \code{"counts"})} \item{by_exprs_values}{Deprecated. Use \code{assay.type} instead.} -\item{other.fields}{\code{Character vector}. Additional fields to include in the node information -without plotting them. (Default: \code{list()})} +\item{other.fields}{\code{Character vector}. Additional fields to include in +the node information without plotting them. (Default: \code{list()})} \item{other_fields}{Deprecated. Use \code{other.fields} instead.} } @@ -242,7 +249,8 @@ library(mia) # preparation of some data data(GlobalPatterns) GlobalPatterns <- agglomerateByRanks(GlobalPatterns) -altExp(GlobalPatterns,"Genus") <- addPerFeatureQC(altExp(GlobalPatterns,"Genus")) +altExp(GlobalPatterns,"Genus") <- addPerFeatureQC( + altExp(GlobalPatterns,"Genus")) rowData(altExp(GlobalPatterns,"Genus"))$log_mean <- log(rowData(altExp(GlobalPatterns,"Genus"))$mean) rowData(altExp(GlobalPatterns,"Genus"))$detected <- diff --git a/man/treeData.Rd b/man/treeData.Rd index 7c3e8e9c..5a5214bf 100644 --- a/man/treeData.Rd +++ b/man/treeData.Rd @@ -1,12 +1,12 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/treeData.R -\name{treeData} -\alias{treeData} +% Please edit documentation in R/AllGenerics.R, R/treeData.R +\name{rowTreeData} \alias{rowTreeData} \alias{colTreeData} \alias{rowTreeData<-} \alias{colTreeData<-} \alias{combineTreeData} +\alias{treeData} \alias{colTreeData,TreeSummarizedExperiment-method} \alias{rowTreeData,TreeSummarizedExperiment-method} \alias{colTreeData<-,TreeSummarizedExperiment-method} @@ -51,8 +51,8 @@ object.} \item{tree_name}{Deprecated. Use \code{tree.name} instead.} -\item{other.fields, value}{a \code{data.frame} or coercible to one, with at least one type -of id information. See details.(Default: \code{list()})} +\item{other.fields, value}{a \code{data.frame} or coercible to one, with at +least one type of id information. See details.(Default: \code{list()})} \item{other_fields}{Deprecated. Use \code{other.fields} instead.} } @@ -67,8 +67,8 @@ To facilitate the dressing of the tree data stored in a \code{colTreeData} can be used. } \details{ -To match information to nodes, the id information in \code{other.fields} are used. -These can either be a column, named \sQuote{node} or \sQuote{label} +To match information to nodes, the id information in \code{other.fields} are +used. These can either be a column, named \sQuote{node} or \sQuote{label} (\sQuote{node} taking precedent), or rownames. If all rownames can be coerced to \code{integer}, they are considered as \sQuote{node} values, otherwise as \sQuote{label} values. The id information must be unique and match available diff --git a/miaViz.Rproj b/miaViz.Rproj deleted file mode 100644 index 7bb9a0c2..00000000 --- a/miaViz.Rproj +++ /dev/null @@ -1,19 +0,0 @@ -Version: 1.0 - -RestoreWorkspace: Default -SaveWorkspace: Default -AlwaysSaveHistory: Default - -EnableCodeIndexing: Yes -UseSpacesForTab: Yes -NumSpacesForTab: 4 -Encoding: UTF-8 - -RnwWeave: knitr -LaTeX: XeLaTeX - -AutoAppendNewline: Yes - -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source diff --git a/vignettes/miaViz.Rmd b/vignettes/miaViz.Rmd index fa254614..296f91f3 100644 --- a/vignettes/miaViz.Rmd +++ b/vignettes/miaViz.Rmd @@ -16,8 +16,8 @@ bibliography: references.bib ```{r, include = FALSE} knitr::opts_chunk$set( - collapse = TRUE, - comment = "#>" + collapse = TRUE, + comment = "#>" ) knitr::opts_chunk$set(dev = "png", dev.args = list(type = "cairo-png")) ``` @@ -50,15 +50,16 @@ In contrast to other fields of sequencing based fields of research for which expression of genes is usually studied, microbiome research uses the more term ~Abundance~ to described the numeric data measured and analyzed. Technically, especially in context of `SummarizedExperiment` objects, there is -no difference. Therefore `plotExpression` can be used to plot `Abundance` data of a particular feature. +no difference. Therefore `plotExpression` can be used to plot `Abundance` data +of a particular feature. ```{r} -plotExpression(GlobalPatterns, - features = "549322", assay.type = "counts") +plotExpression(GlobalPatterns, features = "549322", assay.type = "counts") ``` -On the other hand, plotAbundance can be used to plot abundance by `rank`. A bar plot is returned showing the relative abundance within each sample for a given `rank`. At the same -time the `features` argument can be set to `NULL` (default). +On the other hand, plotAbundance can be used to plot abundance by `rank`. A bar +plot is returned showing the relative abundance within each sample for a given +`rank`. At the same time the `features` argument can be set to `NULL` (default). ```{r} GlobalPatterns <- transformAssay(GlobalPatterns, method = "relabundance") @@ -80,14 +81,14 @@ plotAbundance(GlobalPatterns_king, assay.type = "relabundance") With subsetting to selected features the plot can be fine tuned. ```{r} -prev_phylum <- getPrevalent(GlobalPatterns, rank = "Phylum", - detection = 0.01, onRankOnly = TRUE) +prev_phylum <- getPrevalent(GlobalPatterns, rank = "Phylum", detection = 0.01) ``` ```{r} -plotAbundance(GlobalPatterns[rowData(GlobalPatterns)$Phylum %in% prev_phylum], - rank = "Phylum", - assay.type = "relabundance") +plotAbundance( + GlobalPatterns[rowData(GlobalPatterns)$Phylum %in% prev_phylum], + rank = "Phylum", + assay.type = "relabundance") ``` The `features` argument is reused for plotting data along the different samples. @@ -97,15 +98,16 @@ the result is a list, which can combined using external tools, for example ```{r} library(patchwork) -plots <- plotAbundance(GlobalPatterns[rowData(GlobalPatterns)$Phylum %in% prev_phylum], - features = "SampleType", - rank = "Phylum", - assay.type = "relabundance") -plots$abundance / plots$SampleType + - plot_layout(heights = c(9, 1)) +plots <- plotAbundance( + GlobalPatterns[rowData(GlobalPatterns)$Phylum %in% prev_phylum], + features = "SampleType", + rank = "Phylum", + assay.type = "relabundance") +plots$abundance / plots$SampleType + plot_layout(heights = c(9, 1)) ``` -Further example about composition barplot can be found at Orchestrating Microbiome Analysis [@OMA]. +Further example about composition barplot can be found at Orchestrating +Microbiome Analysis [@OMA]. # Prevalence plotting @@ -117,16 +119,15 @@ To visualize prevalence within the dataset, two functions are available, visualizes the prevalence of samples across abundance thresholds. ```{r} -plotFeaturePrevalence(GlobalPatterns, rank = "Phylum", - detections = c(0, 0.001, 0.01, 0.1, 0.2)) +plotFeaturePrevalence( + GlobalPatterns, rank = "Phylum", detections = c(0, 0.001, 0.01, 0.1, 0.2)) ``` `plotPrevalenceAbundance` plot the prevalence depending on the mean relative abundance on the chosen taxonomic level. ```{r} -plotPrevalentAbundance(GlobalPatterns, rank = "Family", - colour_by = "Phylum") + +plotPrevalentAbundance(GlobalPatterns, rank = "Family", colour_by = "Phylum") + scale_x_log10() ``` @@ -136,10 +137,10 @@ different abundance thresholds. Abundance steps can be adjusted using the `prevalences` argument. ```{r} -plotPrevalence(GlobalPatterns, - rank = "Phylum", - detections = c(0.01, 0.1, 1, 2, 5, 10, 20)/100, - prevalences = seq(0.1, 1, 0.1)) +plotPrevalence( + GlobalPatterns, rank = "Phylum", + detections = c(0.01, 0.1, 1, 2, 5, 10, 20)/100, + prevalences = seq(0.1, 1, 0.1)) ``` # Tree plotting @@ -155,17 +156,20 @@ by mean abundance on the genus level. library(scater) library(mia) ``` + ```{r} altExp(GlobalPatterns,"Genus") <- agglomerateByRank(GlobalPatterns,"Genus") -altExp(GlobalPatterns,"Genus") <- addPerFeatureQC(altExp(GlobalPatterns,"Genus")) -rowData(altExp(GlobalPatterns,"Genus"))$log_mean <- - log(rowData(altExp(GlobalPatterns,"Genus"))$mean) -rowData(altExp(GlobalPatterns,"Genus"))$detected <- - rowData(altExp(GlobalPatterns,"Genus"))$detected / 100 -top_taxa <- getTop(altExp(GlobalPatterns,"Genus"), - method="mean", - top=100L, - assay.type="counts") +altExp(GlobalPatterns,"Genus") <- addPerFeatureQC( + altExp(GlobalPatterns,"Genus")) +rowData(altExp(GlobalPatterns,"Genus"))$log_mean <- log( + rowData(altExp(GlobalPatterns,"Genus"))$mean) +rowData(altExp(GlobalPatterns,"Genus"))$detected <- rowData( + altExp(GlobalPatterns,"Genus"))$detected / 100 +top_taxa <- getTop( + altExp(GlobalPatterns,"Genus"), + method="mean", + top=100L, + assay.type="counts") ``` Colour, size and shape of tree tips and nodes can be decorated based on data @@ -177,19 +181,18 @@ Data will be matched via the `node` or `label` argument depending on which was provided. `label` takes precedent. ```{r plot1, fig.cap="Tree plot using ggtree with tip labels decorated by mean abundance (colour) and prevalence (size)"} -plotRowTree(altExp(GlobalPatterns,"Genus")[top_taxa,], - tip_colour_by = "log_mean", - tip_size_by = "detected") +plotRowTree( + altExp(GlobalPatterns,"Genus")[top_taxa,], tip_colour_by = "log_mean", + tip_size_by = "detected") ``` Tip and node labels can be shown as well. Setting `show_label = TRUE` shows the tip labels only ... ```{r plot2, fig.cap="Tree plot using ggtree with tip labels decorated by mean abundance (colour) and prevalence (size). Tip labels of the tree are shown as well."} -plotRowTree(altExp(GlobalPatterns,"Genus")[top_taxa,], - tip_colour_by = "log_mean", - tip_size_by = "detected", - show_label = TRUE) +plotRowTree( + altExp(GlobalPatterns,"Genus")[top_taxa,], + tip_colour_by = "log_mean", tip_size_by = "detected", show_label = TRUE) ``` ... whereas node labels can be selectively shown by providing a named logical @@ -200,19 +203,21 @@ layout. ```{r plot3, fig.cap="Tree plot using ggtree with tip labels decorated by mean abundance (colour) and prevalence (size). Selected node and tip labels are shown."} labels <- c("Genus:Providencia", "Genus:Morganella", "0.961.60") -plotRowTree(altExp(GlobalPatterns,"Genus")[top_taxa,], - tip_colour_by = "log_mean", - tip_size_by = "detected", - show_label = labels, - layout="rectangular") +plotRowTree( + altExp(GlobalPatterns,"Genus")[top_taxa,], + tip_colour_by = "log_mean", + tip_size_by = "detected", + show_label = labels, + layout="rectangular") ``` Information can also be visualized on the edges of the tree plot. ```{r plot4, fig.cap="Tree plot using ggtree with tip labels decorated by mean abundance (colour) and edges labeled Kingdom (colour) and prevalence (size)"} -plotRowTree(altExp(GlobalPatterns,"Genus")[top_taxa,], - edge_colour_by = "Phylum", - tip_colour_by = "log_mean") +plotRowTree( + altExp(GlobalPatterns,"Genus")[top_taxa,], + edge_colour_by = "Phylum", + tip_colour_by = "log_mean") ``` # Graph plotting @@ -235,12 +240,13 @@ rownames with the node names of the graph. Using this link the graph plot can incorporate data from the `SummarizedExperiment`. ```{r} -plotColGraph(col_graph, - altExp(GlobalPatterns,"Genus"), - colour_by = "SampleType", - edge_colour_by = "weight", - edge_width_by = "weight", - show_label = TRUE) +plotColGraph( + col_graph, + altExp(GlobalPatterns,"Genus"), + colour_by = "SampleType", + edge_colour_by = "weight", + edge_width_by = "weight", + show_label = TRUE) ``` As mentioned the graph data can be provided from the `metadata` of the @@ -253,12 +259,13 @@ metadata(altExp(GlobalPatterns,"Genus"))$graph <- col_graph This produces the same plot as shown above. ```{r include=FALSE} -plotColGraph(altExp(GlobalPatterns,"Genus"), - name = "graph", - colour_by = "SampleType", - edge_colour_by = "weight", - edge_width_by = "weight", - show_label = TRUE) +plotColGraph( + altExp(GlobalPatterns,"Genus"), + name = "graph", + colour_by = "SampleType", + edge_colour_by = "weight", + edge_width_by = "weight", + show_label = TRUE) ``` # Plotting of serial data @@ -283,34 +290,38 @@ The `x` argument is used to reference data from the `colData` to use as descriptor for ordering the data. The `y` argument selects the feature to show. Since plotting a lot of features is not advised a maximum of 20 features can plotted at the same time. - + ```{r, eval=FALSE} -plotSeries(tse, - x = "DAY_ORDER", - y = taxa, - colour_by = "Family") +plotSeries( + tse, + x = "DAY_ORDER", + y = taxa, + colour_by = "Family") ``` + If replicated data is present, data is automatically used for calculation of the `mean` and `sd` and plotted as a range. Data from different assays can be used for plotting via the `assay.type`. ```{r, eval=FALSE} -plotSeries(tse[taxa,], - x = "DAY_ORDER", - colour_by = "Family", - linetype_by = "Phylum", - assay.type = "relabundance") +plotSeries( + tse[taxa,], + x = "DAY_ORDER", + colour_by = "Family", + linetype_by = "Phylum", + assay.type = "relabundance") ``` Additional variables can be used to modify line type aesthetics. ```{r, eval=FALSE} -plotSeries(tse, - x = "DAY_ORDER", - y = getTop(tse, 5), - colour_by = "Family", - linetype_by = "Phylum", - assay.type = "counts") +plotSeries( + tse, + x = "DAY_ORDER", + y = getTop(tse, 5), + colour_by = "Family", + linetype_by = "Phylum", + assay.type = "counts") ``` # Plotting factor data @@ -322,16 +333,17 @@ two functions are available for the purpose; `plotColTile` and `plotRowTile`. data(GlobalPatterns, package="mia") se <- GlobalPatterns plotColTile(se,"SampleType","Primer") + - theme(axis.text.x.top = element_text(angle = 45, hjust = 0)) + theme(axis.text.x.top = element_text(angle = 45, hjust = 0)) ``` # DMN fit plotting Searching for groups that are similar to each other among the samples, could be approached with the Dirichlet Multinomial Mixtures [@DMM]. -After using `runDMN` from the `mia` package, several k values as a number of clusters -are used to observe the best fit (see also `getDMN` and `getBestDMNFit`). -To visualize the fit using e.g. "laplace" as a measure of goodness of fit: +After using `runDMN` from the `mia` package, several k values as a number of +clusters are used to observe the best fit (see also `getDMN` and +`getBestDMNFit`). To visualize the fit using e.g. "laplace" as a measure of +goodness of fit: ```{r} data(dmn_se, package = "mia") @@ -351,8 +363,9 @@ data(hitchip1006, package = "miaTime") tse <- hitchip1006 tse <- transformAssay(tse, method = "relabundance") ## Ordination with PCoA with Bray-Curtis dissimilarity -tse <- runMDS(tse, FUN = vegan::vegdist, method = "bray", name = "PCoA_BC", - assay.type = "relabundance", na.rm = TRUE) +tse <- runMDS( + tse, FUN = getDissimilarity, method = "bray", name = "PCoA_BC", + assay.type = "relabundance", na.rm = TRUE) # plot p <- plotReducedDim(tse, dimred = "PCoA_BC") p @@ -375,13 +388,15 @@ Lets look at all trajectories having two time points in the data: ```{r, eval=FALSE} # plot -p + geom_path(aes(x=X1, y=X2, group=subject), - arrow=arrow(length = unit(0.1, "inches")), - # combining ordination data and metadata then selecting the subjects - # Note, scuttle::makePerCellDF could also be used for the purpose. - data = subset(data.frame(reducedDim(tse), colData(tse)), - subject %in% selected.subjects) %>% arrange(time))+ - labs(title = "All trajectories with two time points")+ +p + geom_path( + aes(x=X1, y=X2, group=subject), + arrow=arrow(length = unit(0.1, "inches")), + # combining ordination data and metadata then selecting the subjects + # Note, scuttle::makePerCellDF could also be used for the purpose. + data = subset( + data.frame(reducedDim(tse), colData(tse)), + subject %in% selected.subjects) %>% arrange(time)) + + labs(title = "All trajectories with two time points") + theme(plot.title = element_text(hjust = 0.5)) ``` @@ -392,23 +407,25 @@ library(miaTime) # calculating step wise divergence based on the microbial profiles tse <- getStepwiseDivergence(tse, group = "subject", time_field = "time") # retrieving the top 10% divergent subjects having two time points -top.selected.subjects <- subset(data.frame(reducedDim(tse), colData(tse)), - subject %in% selected.subjects) %>% +top.selected.subjects <- subset( + data.frame(reducedDim(tse), colData(tse)), + subject %in% selected.subjects) %>% top_frac(0.1, time_divergence) %>% select(subject) %>% .[[1]] # plot -p + geom_path(aes(x=X1, y=X2, - color=time_divergence, group=subject), - # the data is sorted in descending order in terms of time - # since geom_path will use the first occurring observation - # to color the corresponding segment. Without the sorting - # geom_path will pick up NA values (corresponding to initial time - # points); breaking the example. - data = subset(data.frame(reducedDim(tse), colData(tse)), - subject %in% top.selected.subjects) %>% - arrange(desc(time)), - # arrow end is reversed, due to the earlier sorting. - arrow=arrow(length = unit(0.1, "inches"), ends = "first"))+ - labs(title = "Top 10% divergent trajectories from time point one to two")+ +p + geom_path( + aes(x=X1, y=X2, color=time_divergence, group=subject), + # the data is sorted in descending order in terms of time + # since geom_path will use the first occurring observation + # to color the corresponding segment. Without the sorting + # geom_path will pick up NA values (corresponding to initial time + # points); breaking the example. + data = subset( + data.frame(reducedDim(tse), colData(tse)), + subject %in% top.selected.subjects) %>% + arrange(desc(time)), + # arrow end is reversed, due to the earlier sorting. + arrow=arrow(length = unit(0.1, "inches"), ends = "first")) + + labs(title = "Top 10% divergent trajectories from time point one to two") + scale_color_gradient2(low="white", high="red")+ theme(plot.title = element_text(hjust = 0.5)) ``` @@ -420,18 +437,21 @@ Plotting an example of the trajectory with the maximum total divergence: selected.subject <- data.frame(reducedDim(tse), colData(tse)) %>% group_by(subject) %>% summarise(total_divergence = sum(time_divergence, na.rm = TRUE)) %>% - filter(total_divergence==max(total_divergence)) %>% select(subject) %>% .[[1]] + filter(total_divergence==max(total_divergence)) %>% select(subject) %>% + .[[1]] # plot -p + geom_path(aes(x=X1, y=X2, group=subject), - data = subset(data.frame(reducedDim(tse), colData(tse)), - subject %in% selected.subject) %>% arrange(time), - arrow=arrow(length = unit(0.1, "inches")))+ - labs(title = "Longest trajectory by divergence")+ +p + geom_path( + aes(x=X1, y=X2, group=subject), + data = subset( + data.frame(reducedDim(tse), colData(tse)), + subject %in% selected.subject) %>% arrange(time), + arrow=arrow(length = unit(0.1, "inches"))) + + labs(title = "Longest trajectory by divergence") + theme(plot.title = element_text(hjust = 0.5)) ``` - -More examples and materials are available at Orchestrating Microbiome Analysis [@OMA]. +More examples and materials are available at Orchestrating Microbiome Analysis +[@OMA]. # Session info