Added warning for bad class_regex

resolves #123

NEWS.md

@@ -10,15 +10,19 @@
 
 ### Minor changes
 
-* Increased lengend text size and reduced number of labels
+* `extract_taxonomy`: There is now a warning message if class regex does not match ([issue #123](https://github.com/grunwaldlab/metacoder/issues/123))
+* `heat_tree`: Increased lengend text size and reduced number of labels
 * `extract_taxonomy`: added `batch_size` option to help deal with invalid IDs better
+* Added CITATION file
+
 
 ### Breaking changes
 
 * The `heat_tree` option `margin_size` funcion now takes four values instead of 2.
 
 ### Bug fixes
 
+* `heat_tree`: Fixed bug when color is set explicitly (e.g. "grey") instead of raw numbers and the legend is not removed. Now a mixure of raw numbers and color names can be used. 
 * Fixed bugs caused by dplyr version update
 * Fixed bug in `heat_tree` that made values not in the input taxmap object not associate with the right taxa. See [this post](https://groups.google.com/d/msgid/metacoder-discussions/c9d8ecc2-1efa-4baf-946e-0f105575da2e%40googlegroups.com).
 * `extract_taxonomy`: Fixed an error that occured when not all inputs could be classified and sequences were supplied

R/extract_taxonomy--parsers.R

@@ -110,6 +110,22 @@ class_from_class <- function(class, class_key, class_regex, class_sep, class_rev
     })
   }
 
+  # Check that the regex matched something
+  not_matched <- vapply(result, function(x) any(is.na(x)), logical(1))
+  if (any(not_matched)) {
+    max_to_display <- 10
+    input_to_display <- class[1:min(c(length(class), max_to_display))]
+    names(input_to_display) <- which(not_matched)[1:min(c(length(class), max_to_display))]
+    error_msg <- paste0('The classification regex "', class_regex,
+                        '" does not match the following ', sum(not_matched),
+                        ' of ', length(not_matched), ' inputs:\n', 
+                        paste0("  ", names(input_to_display), ": ", input_to_display, collapse = "\n"))
+    if (length(class) > max_to_display) {
+      error_msg <- paste(error_msg, "\n   ...")
+    }
+    warning(error_msg)
+  }
+
   # Name columns in each classification according to the key
   result <- lapply(result, function(x) stats::setNames(x, names(class_key)))
 

tests/testthat/test--extract_taxonomy.R

@@ -166,6 +166,18 @@ test_that("Invalid keys give warnings", {
                'Invalid key value "invalid" given.')
 
 })
+
+#|
+#| ### Invalid regex give warnings
+test_that("Invalid regex give warnings", {
+  expect_warning(extract_taxonomy(test_data,
+                                key = c("obs_info", "obs_info", "class", "obs_info"),
+                                regex = "obs_id: (.*?) - name.* taxon_id: (.*?) - class_name: (.*) - class_id: (.*)", 
+                                class_key = "name", class_regex = "(not_valid)", class_sep = ";"))
+
+})
+
+
 #|
 #| ### Only specified keys can be duplicated
 test_that("Only specified keys can be duplicated", {