fix failing tests

Author: zachary-foster

R/apg.R

@@ -10,7 +10,6 @@
 #' get_apg_orders()
 #' get_apg_families()
 #' }
-
 #' @export
 #' @rdname apg
 get_apg_orders <- function(...) {

R/class2tree.R

@@ -231,10 +231,10 @@ mainTaxonomyRank <- function() {
 #' @noRd
 #' @author Vinh Tran {tran@bio.uni-frankfurt.de}
 get_rank <- function (x) {
-  rank_df <- x[, 'rank']
-  names(rank_df) <- x[, 'rank']
+  rank_df <- x$rank
+  names(rank_df) <- x$rank
 
-  id_df <- x[, 'id']
+  id_df <- x$id
   joined_df <- cbind(
     data.frame(rank_df, stringsAsFactors = FALSE),
     data.frame(id_df, stringsAsFactors = FALSE)
@@ -247,19 +247,19 @@ get_rank <- function (x) {
   df <- data.frame(
     t(data.frame(rev(joined_df$rank_df))), stringsAsFactors = FALSE
   )
-  outDf <- data.frame(tip = x[nrow(x), "name"], df, stringsAsFactors = FALSE)
+  outDf <- data.frame(tip = x$name[nrow(x)], df, stringsAsFactors = FALSE)
   return(outDf)
 }
 
 #' Get taxonomy names and IDs for all ranks
 #' @noRd
 #' @author Vinh Tran {tran@bio.uni-frankfurt.de}
 get_name <- function (x) {
-  rank_df <- x[, 'rank']
-  names(rank_df) <- x[, 'rank']
+  rank_df <- x$rank
+  names(rank_df) <- x$rank
 
-  nameDf <- x[, 'name']
-  id_df <- x[, 'id']
+  nameDf <- x$name
+  id_df <- x$id
 
   joined_df <- cbind(
     data.frame(rank_df,stringsAsFactors=FALSE),
@@ -273,7 +273,7 @@ get_name <- function (x) {
   joined_df$name <- paste0(joined_df$nameDf, "##", joined_df$rank_df)
 
   df <- data.frame(t(data.frame(rev(joined_df$name))), stringsAsFactors = FALSE)
-  outDf <- data.frame(tip = x[nrow(x), "name"], df, stringsAsFactors = FALSE)
+  outDf <- data.frame(tip = x$name[nrow(x)], df, stringsAsFactors = FALSE)
   return(outDf)
 }
 

R/classification.R

@@ -321,7 +321,8 @@ process_ids <- function(input, db, fxn, ...){
            pow = as_pow)
     as_fxn(input, check = FALSE)
   } else {
-    eval(fxn)(input, ...)
+    out <- rep(taxa::taxon(NA), length(input))
+    out[!is.na(input)] <- eval(fxn)(input[!is.na(input)], ...)
   }
 }
 

R/downstream-utils.R

@@ -15,9 +15,7 @@ prune_too_low <- function(x, rank, ignore_no_rank = FALSE, zoo = FALSE,
   # the pruning
   rr <- if (zoo) taxize_ds$rank_ref_zoo else taxize_ds$rank_ref
   rank_target_no <- as.numeric(rr[which_rank(rank, zoo = zoo), "rankid"])
-  rank_nos <- as.numeric(
-    rr[vapply(x$rank, function(z) which_rank(z, zoo = zoo), 1),
-    "rankid"])
+  rank_nos <- as.numeric(rr$rankid[vapply(x$rank, function(z) which_rank(z, zoo = zoo), 1)])
   if (ignore_no_rank) rank_nos[rank_nos %in% c(300, 400)] <- 0
   x[!rank_nos > rank_target_no, ]
 }

tests/fixtures/apgFamilies.yml renamed to tests/fixtures/get_apg_families.yml

@@ -25,7 +25,7 @@ http_interactions:
       vary: Accept-Encoding
       server: Microsoft-IIS/7.5
       x-powered-by: ASP.NET
-      date: Wed, 15 Sep 2021 22:40:50 GMT
+      date: Tue, 26 Oct 2021 08:37:56 GMT
       content-length: '42693'
     body:
       encoding: UTF-8
@@ -2088,5 +2088,5 @@ http_interactions:
         : \"http://www.\");\r\ndocument.write(unescape(\"%3Cscript src='\" + gaJsHost
         + \"google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E\"));\r\n</script>\r\n<script
         type=\"text/javascript\">\r\nvar pageTracker = _gat._getTracker(\"UA-3783322-4\");\r\npageTracker._trackPageview();\r\n</script>\r\n\r\n</body>\r\n</html>\r\n"
-  recorded_at: 2021-09-15 22:40:50 GMT
+  recorded_at: 2021-10-26 08:37:56 GMT
   recorded_with: vcr/1.0.2, webmockr/0.8.0

tests/fixtures/apgOrders.yml renamed to tests/fixtures/get_apg_orders.yml

@@ -25,7 +25,7 @@ http_interactions:
       vary: Accept-Encoding
       server: Microsoft-IIS/7.5
       x-powered-by: ASP.NET
-      date: Wed, 15 Sep 2021 22:40:49 GMT
+      date: Tue, 26 Oct 2021 08:37:55 GMT
       content-length: '10700'
     body:
       encoding: UTF-8
@@ -652,5 +652,5 @@ http_interactions:
         : \"http://www.\");\r\ndocument.write(unescape(\"%3Cscript src='\" + gaJsHost
         + \"google-analytics.com/ga.js' type='text/javascript'%3E%3C/script%3E\"));\r\n</script>\r\n<script
         type=\"text/javascript\">\r\nvar pageTracker = _gat._getTracker(\"UA-3783322-4\");\r\npageTracker._trackPageview();\r\n</script>\r\n\r\n</body>\r\n</html>\r\n"
-  recorded_at: 2021-09-15 22:40:50 GMT
+  recorded_at: 2021-10-26 08:37:55 GMT
   recorded_with: vcr/1.0.2, webmockr/0.8.0

tests/testthat/test-apgscraping.R

@@ -1,9 +1,9 @@
 context("apg* functions")
 
-test_that("apgOrders works", {
+test_that("get_apg_orders works", {
   skip_on_cran()
-  vcr::use_cassette("apgOrders", {
-    orders <- apgOrders()
+  vcr::use_cassette("get_apg_orders", {
+    orders <- get_apg_orders()
   })
 
   expect_is(orders, "data.frame")
@@ -12,10 +12,10 @@ test_that("apgOrders works", {
   expect_equal(NCOL(orders), 4)
 })
 
-test_that("apgFamilies works", {
+test_that("get_apg_families works", {
   skip_on_cran()
-  vcr::use_cassette("apgFamilies", {
-    families <- apgFamilies()
+  vcr::use_cassette("get_apg_families", {
+    families <- get_apg_families()
   })
 
   expect_is(families, "data.frame")

tests/testthat/test-classification-gbif.R

@@ -8,7 +8,7 @@ test_that("classification works for GBIF data", {
     names(clas_gbif) <- NULL
   })
 
-  expect_that(clas_gbif[[2]], equals(NA))
+  expect_null(clas_gbif[[2]])
   expect_is(clas_gbif, "classification")
   expect_is(clas_gbif[[1]], "data.frame")
   expect_equal(length(clas_gbif), 2)