Fixed a bug in calculation functions that would name columns incorrectly in some data sets when the groups option was used.

relates to #233

Author: zachary-foster

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: metacoder
 Title: Tools for Parsing, Manipulating, and Graphing Taxonomic Abundance Data
-Version: 0.3.1.9001
+Version: 0.3.1.9002
 Authors@R: c(person("Zachary", "Foster", email =
         "zacharyfoster1989@gmail.com", role = c("aut", "cre")),
         person("Niklaus", "Grunwald", email =

NAMESPACE

@@ -16,6 +16,7 @@ export(complement)
 export(contains)
 export(counts_to_presence)
 export(diverging_palette)
+export(edge_shape_functions)
 export(ends_with)
 export(everything)
 export(filter_ambiguous_taxa)
@@ -27,6 +28,7 @@ export(make_dada2_asv_table)
 export(make_dada2_tax_table)
 export(matches)
 export(ncbi_taxon_sample)
+export(node_shape_functions)
 export(num_range)
 export(one_of)
 export(parse_dada2)

NEWS.md

@@ -3,6 +3,7 @@
 ## Development version
 
 * calculation functions that use the `groups` option now warn if `groups` is used without `cols`.
+* Fixed a bug in calculation functions that would name columns incorrectly in some data sets when the `groups` option was used. (issue [#233](https://github.com/grunwaldlab/metacoder/issues/233)).
 
 ##  metacoder 0.3.1
 

R/calculations--internal.R

@@ -76,7 +76,7 @@ get_numeric_cols <- function(obj, data, cols = NULL) {
 #'   \item{Numeric vector:}{The indexes of columns to preserve}
 #'   \item{Vector of TRUE/FALSE of length equal to the number of columns:}{Preserve the columns corresponding to \code{TRUE} values.}}
 #' @param out_names The names of count columns in the output. Must be the same
-#'   length as \code{cols} (or \code{unique(groups)}, if \code{groups} is used).
+#'   length and order as \code{cols} (or \code{unique(groups)}, if \code{groups} is used).
 #'
 #' @return A tibble
 #'
@@ -142,6 +142,7 @@ do_calc_on_num_cols <- function(obj, data, func, cols = NULL, groups = NULL,
     result <- NULL
   } else {
     result <- func(input[, cols], cols = cols, groups = groups)
+    result <- result[, as.character(unique(groups)), drop = FALSE] 
     colnames(result) <- out_names
   }
 

R/calculations.R

@@ -249,7 +249,7 @@ calc_group_stat <- function(obj, data, func, groups = NULL, cols = NULL,
   do_calc_on_num_cols(obj, data, cols = cols, groups = groups,
                       other_cols = other_cols, out_names = out_names,
                       func =  function(count_table, cols = cols, groups = groups) {
-                        as.data.frame(lapply(split(cols, groups), function(col_index) {
+                        tibble::as.tibble(lapply(split(cols, groups), function(col_index) {
                           apply(count_table[, col_index], MARGIN = 1, FUN = func)
                         }))
                       }
@@ -418,6 +418,7 @@ zero_low_counts <- function(obj, data, min_count = 2, use_total = FALSE,
       }
       count_table[to_zero] <- 0
     }
+    names(count_table) <- groups # needed because do_calc_on_num_cols assumes column named by groups even though this function does not use groups currently
     return(count_table)
   }
 
@@ -488,7 +489,9 @@ rarefy_obs <- function(obj, data, sample_size = NULL, cols = NULL,
                           sample_size <- min(colSums(count_table)) # Calculate minimum count if no sample size is given
                           my_print("Rarefying to ", sample_size, " since that is the lowest sample total.")
                         }
-                        as.data.frame(t(vegan::rrarefy(t(count_table), sample = sample_size)))
+                        output <- tibble::as.tibble(t(vegan::rrarefy(t(count_table), sample = sample_size)))
+                        names(output) <- groups # needed because do_calc_on_num_cols assumes column named by groups even though this function does not use groups currently
+                        return(output)
                       }
   )
 }
@@ -771,7 +774,7 @@ calc_taxon_abund <- function(obj, data, cols = NULL, groups = NULL,
         }
       }, numeric(1))
     })
-    output <- as.data.frame(output, stringsAsFactors = FALSE)
+    output <- tibble::as.tibble(output, stringsAsFactors = FALSE)
 
     return(output)
   }