Merge pull request #84 from LunaSare/master

fix various bugs

DESCRIPTION

@@ -19,7 +19,7 @@ Authors@R: c(
 Description: Methods and workflows to get chronograms (i.e., phylogenetic trees with branch lengths
     proportional to time), using open, peer-reviewed, state-of-the-art scientific data on time of lineage divergence.
     This package constitutes the main underlying code of the DateLife web service
-    at <https:www.datelife.org>. To obtain a single summary chronogram from a group of
+    at <https://www.datelife.org>. To obtain a single summary chronogram from a group of
     relevant chronograms, we implement the Super Distance Matrix (SDM) method
     described in Criscuolo et al. (2006) <doi:10.1080/10635150600969872>.
     To find the grove of chronograms with a sufficiently overlapping set of taxa

NEWS.md

@@ -4,7 +4,11 @@
 DONE:
 -->
 # datelife v0.6.8
-- fixed bug in function `extract_calibrations_phylo`
+- fix bug in function `extract_calibrations_phylo()`
+- update messages in `calibrations_match()`
+- add faster function to retrieve descendants
+- updates for new rotl version
+- fix uri in DESCRIPTION
 
 # datelife v0.6.7
   - added vignette for bold data workflow

R/calibrations_extract.R

@@ -92,19 +92,19 @@ extract_calibrations_phylo <- function(input = NULL,
     # 		Warning message:
     # In if (class(stock) == "phylo") { :
     # the condition has length > 1 and only the first element will be used
-    if (!inherits(local_df, "data.frame")) {
-      warning("Congruification failed")
-      return(NA)
-    }
-    local_df$reference <- names(chronograms)[i]
-    if (each) {
-      calibrations <- c(calibrations, list(local_df))
-    } else {
-      if (i == 1) {
-        calibrations <- local_df
+    if (inherits(local_df, "data.frame")) {
+      local_df$reference <- names(chronograms)[i]
+      if (each) {
+        calibrations <- c(calibrations, list(local_df))
       } else {
-        calibrations <- rbind(calibrations, local_df)
+        if (i == 1) {
+          calibrations <- local_df
+        } else {
+          calibrations <- rbind(calibrations, local_df)
+        }
       }
+    } else {
+      warning("Congruification of chronogram ", i, " failed.")
     }
   }
   ##############################################################################

R/calibrations_match.R

@@ -131,22 +131,21 @@ summary.matchedCalibrations <- function(object, ...) {
   if (length(not_in_phy_rows) > 0) {
     not_in_phy <- object[not_in_phy_rows, ]
     in_phy <- object[-not_in_phy_rows, ]
-    message1 <- c(message1, "Not all taxon name pairs are in 'phy'.")
+    message1 <- "Not all taxon name pairs are in 'phy'."
   } else {
-    message1 <- c(message1, "All taxon name pairs are in 'phy'.")
+    message1 <- "All taxon name pairs are in 'phy'."
     not_in_phy <- NULL
     in_phy <- object
   }
   in_phy$mrca_node_name <- as.factor(in_phy$mrca_node_name)
   in_phy$reference <- as.factor(in_phy$reference)
   # is MaxAge and MinAge the same value?
   if (all(in_phy$MaxAge == in_phy$MinAge)) {
-    message1 <- c(message1,
-                  "\n'MaxAge' and 'MinAge' columns in input 'matchedCalibrations' /
-                   have the same values.")
+    message1 <- paste(message1,
+                      "\n'MaxAge' and 'MinAge' columns from matched",
+                      "calibrations have the same values.")
   }
-  message("Success!")
-  message(message1)
+  message(paste("Success!", message1))
   return(structure(list(not_in_phy = not_in_phy, in_phy = in_phy),
                    class = c("list", "summaryMatchedCalibrations")))
 }

R/opentree_taxonomy_general.R

@@ -50,7 +50,7 @@ tnrs_match.default <- function(input, reference_taxonomy = "ott", ...) { # enhan
     # cat("\n") # just to make the progress bar look better
     # hardcoding Mus:
     if (sum("mus" == tolower(input)) > 0) {
-      if (packageVersion("rotl") >= 3.1.0) {
+      if (utils::packageVersion("rotl") >= "3.1.0") {
         df["mus" == tolower(input), ] <- list("mus", "Mus (genus in Deuterostomia)", FALSE, 1, 1068778, FALSE, "SIBLING_HIGHER", 3)
       } else {
         df["mus" == tolower(input), ] <- list("mus", "Mus (genus in Deuterostomia)", FALSE, 1068778, FALSE, "SIBLING_HIGHER", 3)

R/to_phylo_all.R

@@ -98,6 +98,8 @@ summary_matrix_to_phylo_all <- function(summ_matrix,
     target_tree <- suppressMessages(get_otol_synthetic_tree(input = colnames(summ_matrix), ...))
     if (!inherits(target_tree, "phylo")) {
       # enhance: we should find a better way to do this, but it should be ok for now:
+      message(paste("Obtaining a topology from Open Tree failed."))
+      message(paste("... Converting patristic matrix to phylo."))
       target_tree <- suppressWarnings(suppressMessages(patristic_matrix_to_phylo(summ_matrix, ultrametric = TRUE)))
       # target_tree <- consensus(phyloall, p = 0.5) # can't use consensus here: bc not all trees have the same number of tips
     }

tests/testthat/test_calibrations_extract.R

@@ -0,0 +1,6 @@
+test_that("extract_calibrations_phylo works", {
+  utils::data(felid_gdr_phylo_all)
+  class(felid_gdr_phylo_all$phylo_all) <- "multiPhylo"
+  xx <- extract_calibrations_phylo(input = felid_gdr_phylo_all$phylo_all)
+  expect_true(inherits(xx, "data.frame"))
+}