From 884c08a97bb8b9725b3c299562b73a9c23e28158 Mon Sep 17 00:00:00 2001 From: Sean Hackett Date: Thu, 15 Aug 2024 22:10:28 -0700 Subject: [PATCH 1/3] updated missing value plotting --- R/dim_reduction.R | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/R/dim_reduction.R b/R/dim_reduction.R index 84271c9..fdb9ffb 100644 --- a/R/dim_reduction.R +++ b/R/dim_reduction.R @@ -199,7 +199,7 @@ remove_missing_values <- function( } if (nrow(triple_omic$measurement) == 0) { - plot_missing_values(triple_omic, value_var) + plot_missing_values(tomic %>% tomic_to("triple_omic"), value_var) stop( "All measurements were filtered using missing_val_method = ", missing_val_method, "\na missing value plot was printed" @@ -342,13 +342,18 @@ impute_missing_values <- function( return(tomic_to(updated_triple, class(tomic)[1])) } -plot_missing_values <- function(triple_omic, value_var) { - cast_formula <- stats::as.formula(paste0(feature_pk, " ~ ", sample_pk)) +plot_missing_values <- function(triple_omic, value_var = NULL) { + + checkmate::assertClass(triple_omic, "triple_omic") + design <- triple_omic$design + value_var = value_var_handler(value_var, design) + + cast_formula <- stats::as.formula(paste0(design$feature_pk, " ~ ", design$sample_pk)) omic_matrix <- triple_omic$measurements %>% reshape2::acast(formula = cast_formula, value.var = value_var) - graphics::image(t(omic_matrix)) + graphics::image(t(is.na(omic_matrix))) } value_var_handler <- function(value_var = NULL, design) { From ba2cd298018426ee20693405b746cf783212f857 Mon Sep 17 00:00:00 2001 From: Sean Hackett Date: Tue, 27 Aug 2024 10:13:17 -0700 Subject: [PATCH 2/3] added transpose option in plot_heatmap --- NAMESPACE | 1 + R/app_heatmap.R | 109 +++++++++++++++++++++++++------------ R/dim_reduction.R | 21 +++++-- man/plot_heatmap.Rd | 19 ++++--- man/plot_missing_values.Rd | 22 ++++++++ 5 files changed, 126 insertions(+), 46 deletions(-) create mode 100644 man/plot_missing_values.Rd diff --git a/NAMESPACE b/NAMESPACE index 75bfd64..d7ac5e7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -33,6 +33,7 @@ export(organizeInput) export(organizeServer) export(plot_bivariate) export(plot_heatmap) +export(plot_missing_values) export(plot_univariate) export(plotsaverInput) export(plotsaverServer) diff --git a/R/app_heatmap.R b/R/app_heatmap.R index 97c9d37..9673ac0 100644 --- a/R/app_heatmap.R +++ b/R/app_heatmap.R @@ -271,9 +271,11 @@ app_heatmap <- function(tomic) { #' thresholded to this value. #' @param plot_type plotly (for interactivity) or grob (for a static ggplot) #' @inheritParams downsample_heatmap -#' @param x_label label for x-axis (if NULL then use \code{feature_var}) -#' @param y_label label for y-axis (if NULL then use \code{sample_var}) -#' @param colorbar_label label for color-bar; default is log2 abundance +#' @param x_title label for x-axis (if NULL then use \code{feature_var}) +#' @param y_title label for y-axis (if NULL then use \code{sample_var}) +#' @param colorbar_title label for color-bar; default is log2 abundance +#' @param transpose if TRUE then samples will be rows and features will be columns. +#' Set all other variables as if transpose was FALSE. #' #' @returns a ggplot2 grob #' @@ -298,7 +300,8 @@ app_heatmap <- function(tomic) { #' change_threshold = 5, #' cluster_dim = "rows", #' plot_type = "grob", -#' distance_measure = "corr" +#' distance_measure = "corr", +#' transpose = FALSE #' ) #' @export plot_heatmap <- function( @@ -312,9 +315,10 @@ plot_heatmap <- function( change_threshold = Inf, plot_type = "grob", max_display_features = 800, - x_label = NULL, - y_label = NULL, - colorbar_label = NULL + x_title = NULL, + y_title = NULL, + colorbar_title = NULL, + transpose = FALSE ) { checkmate::assertClass(tomic, "tomic") @@ -336,21 +340,22 @@ plot_heatmap <- function( checkmate::assertNumber(change_threshold, lower = 0) checkmate::assertChoice(plot_type, c("plotly", "grob")) checkmate::assertNumber(max_display_features) + checkmate::assertLogical(transpose, len = 1) - if ("NULL" %in% class(x_label)) { - x_label <- sample_var + if ("NULL" %in% class(x_title)) { + x_title <- sample_var } - checkmate::assertMultiClass(x_label, c("character", "expression")) + checkmate::assertMultiClass(x_title, c("character", "expression")) - if ("NULL" %in% class(y_label)) { - y_label <- feature_var + if ("NULL" %in% class(y_title)) { + y_title <- feature_var } - checkmate::assertMultiClass(y_label, c("character", "expression")) + checkmate::assertMultiClass(y_title, c("character", "expression")) - if ("NULL" %in% class(colorbar_label)) { - colorbar_label <- expression(log[2] ~ abundance) + if ("NULL" %in% class(colorbar_title)) { + colorbar_title <- expression(log[2] ~ abundance) } - checkmate::assertMultiClass(colorbar_label, c("character", "expression")) + checkmate::assertMultiClass(colorbar_title, c("character", "expression")) # format convert tomic to tidy format if needed @@ -418,49 +423,83 @@ plot_heatmap <- function( strip.background = element_rect(fill = "gray80") ) - if (n_features > 200) { + distinct_features <- augmented_tidy_omic_data %>% + dplyr::distinct(ordered_featureId, feature_label) + + distinct_samples <- augmented_tidy_omic_data %>% + dplyr::distinct(ordered_sampleId, sample_label) + + if (transpose) { + x_features = n_features + x_ordered_by = "ordered_featureId" + x_breaks <- distinct_features$ordered_featureId + x_labels <- distinct_features$feature_label + + y_features = n_samples + y_ordered_by = "ordered_sampleId" + y_breaks <- distinct_samples$ordered_sampleId + y_labels <- distinct_samples$sample_label + + tmp <- x_title + x_title <- y_title + y_title <- tmp + } else { + y_features = n_features + y_ordered_by = "ordered_featureId" + y_breaks <- distinct_features$ordered_featureId + y_labels <- distinct_features$feature_label + + x_features = n_samples + x_ordered_by = "ordered_sampleId" + x_breaks <- distinct_samples$ordered_sampleId + x_labels <- distinct_samples$sample_label + } + + if (x_features > 200) { heatmap_theme <- heatmap_theme + - theme(axis.text.y = element_blank()) + theme(axis.text.x = element_blank()) } else { heatmap_theme <- heatmap_theme + - theme(axis.text.y = element_text(size = pmin(20, 60 * sqrt(1 / n_features)))) + theme(axis.text.x = element_text( + size = pmin(20, 60 * sqrt(1 / y_features)), + angle = 90, + hjust = 1 + )) } - if (n_samples > 200) { - heatmap_theme <- heatmap_theme + theme(axis.text.x = element_blank()) + if (y_features > 200) { + heatmap_theme <- heatmap_theme + + theme(axis.text.y = element_blank()) } else { - heatmap_theme <- heatmap_theme + theme(axis.text.x = element_text( - size = pmin(20, 60 * sqrt(1 / n_samples)), - angle = 90, - hjust = 1 - )) + heatmap_theme <- heatmap_theme + + theme(axis.text.y = element_text(size = pmin(20, 60 * sqrt(1 / x_features)))) } heatmap_plot <- ggplot( augmented_tidy_omic_data, aes( - x = !!rlang::sym("ordered_sampleId"), - y = !!rlang::sym("ordered_featureId"), + x = !!rlang::sym(x_ordered_by), + y = !!rlang::sym(y_ordered_by), fill = !!rlang::sym(value_var) ) ) + geom_raster() + scale_fill_gradient2( - colorbar_label, + colorbar_title, low = "steelblue1", mid = "black", high = "yellow", midpoint = 0 ) + scale_x_discrete( - x_label, - breaks = augmented_tidy_omic_data$ordered_sampleId, - labels = augmented_tidy_omic_data$sample_label + x_title, + breaks = x_breaks, + labels = x_labels ) + scale_y_discrete( - y_label, - breaks = augmented_tidy_omic_data$ordered_featureId, - labels = augmented_tidy_omic_data$feature_label, + y_title, + breaks = y_breaks, + labels = y_labels, position = "right" ) + expand_limits(fill = c(-1 * change_threshold, change_threshold)) + diff --git a/R/dim_reduction.R b/R/dim_reduction.R index fdb9ffb..8d6f9ee 100644 --- a/R/dim_reduction.R +++ b/R/dim_reduction.R @@ -342,15 +342,28 @@ impute_missing_values <- function( return(tomic_to(updated_triple, class(tomic)[1])) } -plot_missing_values <- function(triple_omic, value_var = NULL) { +#' Plot Missing Values +#' +#' Create a simple plot of missing values. +#' +#' @inheritParams tomic_to +#' @param value_var the measurement variable to check for missingness (NA or no entry) +#' +#' @returns a ggplot2 grob +#' +#' @export +#' +#' @examples +#' plot_missing_values(brauer_2008_triple) +plot_missing_values <- function(tomic, value_var = NULL) { - checkmate::assertClass(triple_omic, "triple_omic") - design <- triple_omic$design + checkmate::assertClass(tomic, "tomic") + design <- tomic$design value_var = value_var_handler(value_var, design) cast_formula <- stats::as.formula(paste0(design$feature_pk, " ~ ", design$sample_pk)) - omic_matrix <- triple_omic$measurements %>% + omic_matrix <- get_tomic_table(tomic, "measurements") %>% reshape2::acast(formula = cast_formula, value.var = value_var) graphics::image(t(is.na(omic_matrix))) diff --git a/man/plot_heatmap.Rd b/man/plot_heatmap.Rd index 4e86319..789dcf3 100644 --- a/man/plot_heatmap.Rd +++ b/man/plot_heatmap.Rd @@ -15,9 +15,10 @@ plot_heatmap( change_threshold = Inf, plot_type = "grob", max_display_features = 800, - x_label = NULL, - y_label = NULL, - colorbar_label = NULL + x_title = NULL, + y_title = NULL, + colorbar_title = NULL, + transpose = FALSE ) } \arguments{ @@ -48,11 +49,14 @@ thresholded to this value.} \item{max_display_features}{aggregate and downsample distinct feature to this number to speed to up heatmap rendering.} -\item{x_label}{label for x-axis (if NULL then use \code{feature_var})} +\item{x_title}{label for x-axis (if NULL then use \code{feature_var})} -\item{y_label}{label for y-axis (if NULL then use \code{sample_var})} +\item{y_title}{label for y-axis (if NULL then use \code{sample_var})} -\item{colorbar_label}{label for color-bar; default is log2 abundance} +\item{colorbar_title}{label for color-bar; default is log2 abundance} + +\item{transpose}{if TRUE then samples will be rows and features will be columns. +Set all other variables as if transpose was FALSE.} } \value{ a ggplot2 grob @@ -82,6 +86,7 @@ plot_heatmap( change_threshold = 5, cluster_dim = "rows", plot_type = "grob", - distance_measure = "corr" + distance_measure = "corr", + transpose = FALSE ) } diff --git a/man/plot_missing_values.Rd b/man/plot_missing_values.Rd new file mode 100644 index 0000000..768c564 --- /dev/null +++ b/man/plot_missing_values.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/dim_reduction.R +\name{plot_missing_values} +\alias{plot_missing_values} +\title{Plot Missing Values} +\usage{ +plot_missing_values(tomic, value_var = NULL) +} +\arguments{ +\item{tomic}{Either a \code{tidy_omic} or \code{triple_omic} object} + +\item{value_var}{the measurement variable to check for missingness (NA or no entry)} +} +\value{ +a ggplot2 grob +} +\description{ +Create a simple plot of missing values. +} +\examples{ +plot_missing_values(brauer_2008_triple) +} From 26bd6e346205ea1ef9edf1cae1ae56a467c545ca Mon Sep 17 00:00:00 2001 From: Sean Hackett Date: Tue, 27 Aug 2024 10:14:25 -0700 Subject: [PATCH 3/3] increment version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3ff14d3..3cf63ae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: romic Type: Package Title: R for High-Dimensional Omic Data -Version: 1.2.1 +Version: 1.2.2 Authors@R: c( person( given = "Sean",