Fix to empty datelife search; get_taxon_summary deals with an empty d…

…atelife_result.

NEWS.md

@@ -9,6 +9,7 @@ DONE:
 - use spaces instead of "_" to run tnrs, avoids bug from `rotl::tnrs_match_names()` v3.0.14
 - faster and more accurate way to get study ids and tree ids from opentree API on `get_opentree_chronograms()` that have branch lengths in Myrs, no relative time.
 - update to chronogram database, now with 292 chronograms.
+- `get_taxon_summary()` now manages case when `datelife_result` is empty; throws warning instead of criptic error.
 
 
 # datelife v0.6.8

R/datelife_result.R

@@ -36,7 +36,7 @@ get_datelife_result_datelifequery <- function(datelife_query = NULL,
     stop("'datelife_query' must be a 'datelifeQuery' object.")
   }
   if (length(datelife_query$cleaned_names) == 1) {
-    message("Can't get divergence times from just one taxon in 'datelife_query$cleaned_names'.")
+    message("Can't get divergence times from just one taxon available in 'datelife_query$cleaned_names'.")
     message("Making a 'datelifeQuery' again, setting 'get_spp_from_taxon = TRUE'.")
     datelife_query <- make_datelife_query(input = datelife_query$cleaned_names,
                                           get_spp_from_taxon = TRUE,
@@ -46,16 +46,17 @@ get_datelife_result_datelifequery <- function(datelife_query = NULL,
   # do that later in summarizing steps
   results_list <- lapply(cache$trees,
     get_subset_array_dispatch,
-    taxa = datelife_query$cleaned_names,
+    taxa = gsub(" ", "_", datelife_query$cleaned_names),
     phy = NULL
   )
+  # length(results_list) is always the same size as the number of chronograms in the database
   datelife_result <- results_list_process(results_list,
     datelife_query$cleaned_names,
     partial = partial
   )
   message("Search done!")
   message("\nInput taxon names were found in ", length(datelife_result), " chronograms.")
-  class(datelife_result) <- c("datelifeResult")
+  class(datelife_result) <- c(class(datelife_result), "datelifeResult")
   attr(datelife_result, "datelife_query") <- datelife_query
   return(datelife_result)
 }

R/datelife_search.R

@@ -93,12 +93,8 @@ datelife_search <- function(input = c("Rhea americana", "Pterocnemia pennata", "
   datelife_result.here <- get_datelife_result_datelifequery(
     datelife_query = datelife_query,
     partial = partial,
-    # approximate_match = approximate_match,
     cache = cache)
-  # print.datelife(datelife_result = datelife_result.here)
-  # datelife <- list(datelife_query = datelife_query, datelife_result = datelife_result.here)
-  # class(datelife) <- "datelife"
-  # return(datelife)
+
   res <- summarize_datelife_result(
     datelife_result = datelife_result.here,
     datelife_query = datelife_query,

R/datelife_summary.R

@@ -22,17 +22,27 @@ get_taxon_summary <- function(datelife_result = NULL,
                               datelife_query = NULL) {
 
   # datelife_result <- check_datelife_result(datelife_result)
-  if (is.null(datelife_result) | !inherits(datelife_result, "datelifeResult")) {
+  if (is.null(datelife_result) | !inherits(datelife_result, "list")) {
     warning("'datelife_result' argument must be a list of patristic matrices (you can get one with get_datelife_result()).")
+    message("Taxon summary can not be generated.")
+    return(NA)
+  }
+  if (any(!sapply(datelife_result, inherits, "array"))) {
+    warning("Some (or all) elements of 'datelife_result' list are not of class 'array' (you can get the correct format from get_datelife_result()).")
+    message("Taxon summary can not be generated.")
+    return(NA)
+  }
+  if (length(datelife_result == 0)) {
+    warning("'datelife_result' is empty (length == 0).")
+    message("Taxon summary can not be generated.")
     return(NA)
   }
-
   if (suppressMessages(is_datelife_query(input = datelife_query))) {
     if (is.null(attributes(datelife_result)$datelife_query)) {
-      cleaned_names <- datelife_query$cleaned_names
+      cleaned_names <- gsub(" ", "_", datelife_query$cleaned_names)
     } else {
       input <- attributes(datelife_result)$datelife_query
-      cleaned_names <- attributes(datelife_result)$datelife_query$cleaned_names
+      cleaned_names <- gsub(" ", "_", input$cleaned_names)
     }
   } else {
     message("'datelife_query' argument was not provided.")

tests/testthat/test_main.R

@@ -1,3 +1,35 @@
+
+test_that("a known datelife_search run works as it should", {
+  datelife_query <- make_datelife_query(input = c("Delphinus_delphis",
+                                               "Gallus gallus",
+                                               "elephas Maximus",
+                                               "felis_catus",
+                                               "homo-sapiens"))
+
+  datelifeSearch <- datelife_search(datelife_query, 
+                                    summary_format = "phylo_median")
+
+  datelife_result <- get_datelife_result_datelifequery(
+    datelife_query = datelife_query,
+    partial = TRUE,
+    cache = "opentree_chronograms")
+
+  expect_true(length(datelife_result) > 0)
+
+  res <- summarize_datelife_result(
+              datelife_result = datelife_result,
+              datelife_query = datelife_query,
+              summary_format = "phylo_median",
+              na_rm = FALSE,
+              summary_print = c("citations", "taxa"),
+              taxon_summary = c("none", "summary", "matrix"),
+              criterion = "taxa")
+
+  taxon_summ <- get_taxon_summary(
+      datelife_result = datelife_result,
+      datelife_query = datelife_query)
+}) 
+
 test_that("datelife_use workflows work", {
   du <- datelife_use(
     input = "Rhea americana, Struthio camelus, Gallus gallus",

tests/testthat/test_opentree_chronograms.R

@@ -1,3 +1,4 @@
-test_that("opentree_chronograms works", {
+test_that("get_opentree_chronograms function runs", {
   xx <- update_datelife_cache(write = TRUE, max_tree_count = 2) # runs in 2 minutes
+  # expect_true(inherits(xx$trees), "multiPhylo")
 })