resolves #328

Author: zachary-foster

NEWS.md

@@ -5,6 +5,7 @@
 * When an ordered factor is supplied to the `groups` argument of `compare_groups`, the order of levels is used to arrange the results. This can be used to change the order of groups when the output is used with `heat_tree_matrix` (issue [#323](https://github.com/grunwaldlab/metacoder/issues/323)).
 * Added `calc_diff_abund_deseq2` function to use DESeq2 to produce output like `compare_group` useful for `heat_tree_matrix`
 * Fixed error with `primersearch` and `primersearch_raw` when there is a single match to a single query (issue [#326](https://github.com/grunwaldlab/metacoder/issues/326))
+* Fixed `Error in grid.Call.graphics(C_setviewport, vp, TRUE) : non-finite location and/or size for viewport` when using `heat_tree_matrix` with only a single comparison. Now a single differential heat tree is made instead of a matrix [#328](https://github.com/grunwaldlab/metacoder/issues/328)).
 
 ## metacoder 0.3.5 
 

R/heat_tree_matrix.R

@@ -110,6 +110,43 @@ heat_tree_matrix <- function(obj, data, label_small_trees =  FALSE,
 
   }
 
+  # If there is only one comparison, just plot it with a single graph
+  if (length(treatments) == 2) {
+    plot <- obj %>%
+      filter_obs(data,
+                 (treat_1 == treatments[combinations[index, 1]] &
+                    treat_2 == treatments[combinations[index, 2]]) |
+                   (treat_1 == treatments[combinations[index, 2]] &
+                      treat_2 == treatments[combinations[index, 1]])) %>%
+      metacoder::heat_tree(...)
+    
+    out_plot <- cowplot::ggdraw() + 
+      cowplot::draw_plot(plot, x = 0, y = 0, width = 1, height = 1) +
+      cowplot::draw_text(gsub("_", " ", treatments[2]), 
+                         x = 0.87, y = 0.8, 
+                         size = col_label_size, colour = col_label_color,
+                         hjust = "center", vjust = "bottom") +
+      cowplot::draw_text("vs", 
+                         x = 0.87, y = 0.75,
+                         size = mean(c(row_label_size, col_label_size)),
+                         colour = '#000000',
+                         hjust = "center", vjust = "bottom") +
+      cowplot::draw_text(gsub("_", " ", treatments[1]), 
+                         x = 0.87, y = 0.7,
+                         size = row_label_size, colour = row_label_color,
+                         hjust = "center", vjust = "bottom") +
+      ggplot2::theme(aspect.ratio = 1)
+    
+    if (!is.null(output_file)) {
+      for (path in output_file) {
+        ggplot2::ggsave(path, out_plot, bg = "transparent", width = 10, height = 10)
+      }
+    }
+    
+    return(out_plot)
+  }
+  
+  
   # Make individual plots
   plot_sub_plot <- ifelse(label_small_trees, # This odd thing is used to overwrite options without evaluation
     function(..., make_node_legend = FALSE, make_edge_legend = FALSE, output_file = NULL) {
@@ -128,10 +165,10 @@ heat_tree_matrix <- function(obj, data, label_small_trees =  FALSE,
                           set.seed(seed)
                           obj %>%
                             filter_obs(data,
-                                             (treat_1 == treatments[combinations[index, 1]] &
-                                                treat_2 == treatments[combinations[index, 2]]) |
-                                               (treat_1 == treatments[combinations[index, 2]] &
-                                                  treat_2 == treatments[combinations[index, 1]])) %>%
+                                       (treat_1 == treatments[combinations[index, 1]] &
+                                          treat_2 == treatments[combinations[index, 2]]) |
+                                         (treat_1 == treatments[combinations[index, 2]] &
+                                            treat_2 == treatments[combinations[index, 1]])) %>%
                             plot_sub_plot(...) %>%
                             return()
                         }
@@ -171,8 +208,12 @@ heat_tree_matrix <- function(obj, data, label_small_trees =  FALSE,
   named_col <- which(apply(layout_matrix, MARGIN = 2, function(x) all(!is.na(x))))
   horz_label_data <- matrix_data[match(layout_matrix[named_row, ], matrix_data$plot_index), ]
   vert_label_data <- matrix_data[match(layout_matrix[, named_col], matrix_data$plot_index), ]
-  subgraph_width <- abs(horz_label_data$x[1] - horz_label_data$x[2])
-  subgraph_height <- abs(vert_label_data$y[1] - vert_label_data$y[2])
+  subgraph_width <- ifelse(nrow(horz_label_data) == 1,
+                           key_size,
+                           abs(horz_label_data$x[1] - horz_label_data$x[2]))
+  subgraph_height <- ifelse(nrow(vert_label_data) == 1,
+                            key_size,
+                            abs(vert_label_data$y[1] - vert_label_data$y[2]))
   horz_label_data$label_x <- horz_label_data$x + subgraph_width / 2 # center of label
   horz_label_data$label_y <- 0.96 # bottom of label
   vert_label_data$label_x <- 0.96 # bottom of rotated label 

scratch/issue_328.R

@@ -0,0 +1,32 @@
+library(metacoder)
+
+x <- parse_tax_data(hmp_otus, class_cols = "lineage", class_sep = ";",
+                    class_key = c(tax_rank = "taxon_rank", tax_name = "taxon_name"),
+                    class_regex = "^(.+)__(.+)$")
+
+meta <- hmp_samples[hmp_samples$body_site %in% c('Nose', 'Throat'), ]
+# meta <- hmp_samples
+
+# Convert counts to proportions
+x$data$otu_table <- calc_obs_props(x, data = "tax_data", cols = meta$sample_id)
+
+# Get per-taxon counts
+x$data$tax_table <- calc_taxon_abund(x, data = "otu_table", cols = meta$sample_id)
+
+# Calculate difference between treatments
+x$data$diff_table <- compare_groups(x, data = "tax_table",
+                                    cols = meta$sample_id,
+                                    groups = meta$body_site)
+
+# Plot results (might take a few minutes)
+heat_tree_matrix(x,
+                 data = "diff_table",
+                 node_size = n_obs,
+                 node_label = taxon_names,
+                 node_color = log2_median_ratio,
+                 node_color_range = diverging_palette(),
+                 node_color_trans = "linear",
+                 node_color_interval = c(-3, 3),
+                 edge_color_interval = c(-3, 3),
+                 node_size_axis_label = "Number of OTUs",
+                 node_color_axis_label = "Log2 ratio median proportions")