Issue 80 - transpose arg in plot_heatmap

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",

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)

R/app_heatmap.R

@@ -105,7 +105,7 @@
       observe({
         # need double parenthesis since its a reactive of a reactive
         print(glue::glue(
           "Filtering results: tidy_filtered_samples is {nrow(tidy_filtered_samples()()$data)} rows"
         ))
       })
 
@@ -271,9 +271,11 @@
 #'   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,11 +300,12 @@
 #'   change_threshold = 5,
 #'   cluster_dim = "rows",
 #'   plot_type = "grob",
-#'   distance_measure = "corr"
+#'   distance_measure = "corr",
+#'   transpose = FALSE
 #' )
 #' @export
 plot_heatmap <- function(
     tomic,
     feature_var = NULL,
     sample_var = NULL,
     value_var = NULL,
@@ -312,10 +315,11 @@
     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")
 
   if ("NULL" %in% class(feature_var)) {
@@ -336,21 +340,22 @@
   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
 
@@ -410,7 +415,7 @@
     nrow()
 
   heatmap_theme <- theme_minimal() +
      theme(
        text = element_text(size = 16, color = "black"),
        title = element_text(size = 20, color = "black"),
        strip.text = element_text(size = 18),
@@ -418,49 +423,83 @@
        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)) +

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,31 @@ 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
+#'
+#' 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) {
 
-  omic_matrix <- triple_omic$measurements %>%
+  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 <- get_tomic_table(tomic, "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) {