make sure that all the different tests are running

R/select_traits_tax_dist.R

@@ -215,7 +215,9 @@ select_traits_tax_dist <- function(data,
 
       })
 
-  } 
+  } else {
+    output_spec <- NULL
+  }
 
   # get a data.frame without special names
   data <- dplyr::filter(data, db != "special")
@@ -338,12 +340,14 @@ select_traits_tax_dist <- function(data,
 
     })
 
+  } else {
+    output <- NULL
   }
 
   # bind the list of regular names and the list of special names
-  if( exists(x = "output_spec") && exists(x = "output")) {
+  if( (length(output_spec) > 0) && (length(output) > 0) ) {
     output <- c(output, output_spec)
-  } else if( exists(x = "output_spec") && !exists(x = "output") ) {
+  } else if( (length(output_spec) > 0) && (length(output) == 0) ) {
     output <- output_spec
   }
 

tests/testthat/setup_db.R

@@ -4,4 +4,4 @@
 # them for the tests. Downloading them every time a test execute
 # would be super wasteful - so let's grab them.
 #
-download_database(appdata_subdir)
+download_database(appdata_subdir)

tests/testthat/test_get_trait_from_taxon.R

@@ -38,11 +38,11 @@ test_that("given a bad workflow,
 test_that("if all taxon_names are not present in output,
            when get_trait_from_taxon,
            then error", {
-  input <- make_test_input()
+  x <- make_test_input()
 
   # when
-  output <- get_trait_from_taxon(
-    data = input,
+  y <- get_trait_from_taxon(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     latitude_dd = "lat",
@@ -54,17 +54,17 @@ test_that("if all taxon_names are not present in output,
   )
 
   # test if all the relevant taxon names are present in the output
-  expect_true(all(output[["data"]][["taxon_name"]] == input[["taxon_name"]]))
+  expect_true(all(y[["data"]][["taxon_name"]] == x[["taxon_name"]]))
 })
 
 test_that("given the equation, body_size_mm or id columns are NA,
            when get_trait_from_taxon,
            then dry_biomass_mg should be NA", {
-  input <- make_test_input()
+  x <- make_test_input()
 
   # when
-  output <- get_trait_from_taxon(
-    data = input,
+  y <- get_trait_from_taxon(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     latitude_dd = "lat",
@@ -79,26 +79,26 @@ test_that("given the equation, body_size_mm or id columns are NA,
   # then dry_biomass_mg should be NA
 
   # equation column
-  expect_true(all(is.na(output[["data"]][["equation"]]) == is.na(output[["data"]][["dry_biomass_mg"]])))
+  expect_true(all(is.na(y[["data"]][["equation"]]) == is.na(y[["data"]][["dry_biomass_mg"]])))
 
   # body_size_mm
-  x <- is.na(output[["data"]][["body_size_mm"]])
-  expect_true(all(is.na(output[["data"]][["body_size_mm"]][x]) == is.na(output[["data"]][["dry_biomass_mg"]][x])))
+  z <- is.na(y[["data"]][["body_size_mm"]])
+  expect_true(all(is.na(y[["data"]][["body_size_mm"]][z]) == is.na(y[["data"]][["dry_biomass_mg"]][z])))
 
   # id
-  y <- is.na(output[["data"]][["id"]])
-  expect_true(all(is.na(c(output[["data"]][["dry_biomass_mg"]][y]))))
+  u <- is.na(y[["data"]][["id"]])
+  expect_true(all(is.na(c(y[["data"]][["dry_biomass_mg"]][u]))))
 })
 
 test_that("given some of the outputted taxonomic distance values
              are greater than the max_tax_distance argument,
            when get_trait_from_taxon,
            then error", {
-  input <- make_test_input()
+  x <- make_test_input()
 
   # when
-  output <- get_trait_from_taxon(
-    data = input,
+  y <- get_trait_from_taxon(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     latitude_dd = "lat",
@@ -110,19 +110,19 @@ test_that("given some of the outputted taxonomic distance values
   )
 
   # test if the outputted taxonomic distances are less than the max tax distance
-  expect_true(all(output[["data"]][["tax_distance"]][!is.na(output[["data"]][["tax_distance"]])] <= 3))
+  expect_true(all(y[["data"]][["tax_distance"]][!is.na(y[["data"]][["tax_distance"]])] <= 3))
 })
 
 test_that("does the get_trait_from_taxon() function output the correct
           additional identifier columns?", {
-  input <- make_test_input()
+  x <- make_test_input()
 
   # add additional columns
-  input$sex <- "male"
+  x$sex <- "male"
 
   # when
-  output <- get_trait_from_taxon(
-    data = input,
+  y <- get_trait_from_taxon(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     latitude_dd = "lat",
@@ -134,13 +134,13 @@ test_that("does the get_trait_from_taxon() function output the correct
   )
 
   # test if the sex column is in the output
-  expect_true("sex" %in% names(output[["data"]]))
+  expect_true("sex" %in% names(y[["data"]]))
 })
 
 test_that("test a highly marginal case where
             there are no matches for the life-stages", {
 
-    input <- 
+    x <- 
       data.frame(
         taxon_name = c("Gammarus", "Daphnia"),
         Life_stage = c("larva", "none"),
@@ -149,9 +149,9 @@ test_that("test a highly marginal case where
         body_size_mm = rnorm(2, 10, 2)
       )
 
-  x <- 
+  y <- 
     get_trait_from_taxon(
-      data = input,
+      data = x,
       target_taxon = "taxon_name",
       life_stage = "Life_stage",
       latitude_dd = "lat",
@@ -162,22 +162,22 @@ test_that("test a highly marginal case where
       gen_sp_dist = 0.5
     )
 
-  expect_true(all(x[["decision_data"]][["workflow2_choice"]] == FALSE))
+  expect_true(all(y[["decision_data"]][["workflow2_choice"]] == FALSE))
 
 })
 
 test_that("test the case where there are only special names", {
 
-  input <- data.frame(
+  x <- data.frame(
     taxon_name = c("Oligochaeta", "Oligochaeta", "Turbellaria"),
     Life_stage = c("none", "none", "none"),
     lat = rep(50.5, 1),
     lon = rep(4.98, 1),
     body_size_mm = rnorm(3, 10, 2)
   )
 
-  x <- get_trait_from_taxon(
-    data = input,
+  y <- get_trait_from_taxon(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     latitude_dd = "lat",
@@ -188,11 +188,32 @@ test_that("test the case where there are only special names", {
     gen_sp_dist = 0.5
   )
 
-  expect_equal(input[["taxon_name"]], x[["data"]][["taxon_name"]])
+  expect_equal(x[["taxon_name"]], y[["data"]][["taxon_name"]])
 
 })
 
 # test if the decision df matches the output df
-
-
+test_that("does the decision data match the output data", {
+
+  x <- make_test_input()
+
+  y <- get_trait_from_taxon(
+    data = x,
+    target_taxon = "taxon_name",
+    life_stage = "Life_stage",
+    latitude_dd = "lat",
+    longitude_dd = "lon",
+    body_size = "body_size_mm",
+    max_tax_dist = 3,
+    trait = "equation",
+    gen_sp_dist = 0.5
+  )
+
+  # get the samples for which equations were given
+  u <- dplyr::filter(y[["data"]], !is.na(dry_biomass_mg))
+  z <- dplyr::filter(y[["decision_data"]], workflow2_choice == TRUE)
+
+  expect_true(all(unique(u$taxon_name) == unique(z$taxon_name)))
+
+})
 

tests/testthat/test_select_traits_tax_dist.R

@@ -133,15 +133,15 @@ test_that("given an unsupported trait,
 test_that("test if select_traits_tax_dist() the column
             names that are outputted are correct", {
   # when
-  output <- select_traits_tax_dist(
+  x <- select_traits_tax_dist(
     data = make_test_input(),
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     body_size = "length_mm"
   )
 
   # extract names from each element of the output list
-  expect_true( all(names(output) == c(
+  expect_true( all(names(x) == c(
       c("row", "taxon_name", "Life_stage", "lat", "lon", "length_mm", 
         "clean_taxon_name", "db", "scientificName", "taxonRank", 
         "acceptedNameUsageID", "taxon_order", "taxon_family", 
@@ -160,22 +160,22 @@ test_that("test if select_traits_tax_dist() outputs entries that should
             have scientific names do have a non-missing
             scientificName column", {
   # when
-  output <- select_traits_tax_dist(
+  x <- select_traits_tax_dist(
     data = make_test_input(),
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     body_size = "length_mm"
   )
 
   # extract unique expected names
-  x <- 
-    output |>
+  y <- 
+    x |>
     dplyr::group_by(row) |>
     dplyr::summarise(scientificName = unique(scientificName)) |>
     dplyr::pull(scientificName)
 
   # set the correct answers
-  y <- c(
+  z <- c(
     "Gammarus",
     "Daphnia",
     NA,
@@ -186,19 +186,19 @@ test_that("test if select_traits_tax_dist() outputs entries that should
   )
 
   # test if these are equal
-  z <- mapply(function(x, y){
+  u <- mapply(function(x, y){
     (x == y) | (is.na(x) && is.na(y))
-  }, x, y, SIMPLIFY = TRUE, USE.NAMES = FALSE)
+  }, y, z, SIMPLIFY = TRUE, USE.NAMES = FALSE)
 
   # make sure the outputted scientific names are correct
-  expect_true(all(z))
+  expect_true(all(u))
 
 })
 
 test_that("test if select_traits_tax_dist() outputs
             the taxonomic distances properly", {
   # when
-  output <- select_traits_tax_dist(
+  x <- select_traits_tax_dist(
     data = make_test_input(),
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
@@ -207,68 +207,68 @@ test_that("test if select_traits_tax_dist() outputs
 
   # all taxonomic distances should be numeric or NA
   expect_true( 
-    all( is.numeric(output[["tax_distance"]]) | is.na(output[["tax_distance"]]) )
+    all( is.numeric(x[["tax_distance"]]) | is.na(x[["tax_distance"]]) )
     )
 
 })
 
 test_that("test if select_traits_tax_dist() works
             correctly with only special names", {
 
-  test_input <- make_test_input()   
+  x <- make_test_input()   
 
   # run the select_traits_tax_dist() function with only special names
-  output1 <- select_traits_tax_dist(
-    data = test_input[c(6, 7), ],
+  y1 <- select_traits_tax_dist(
+    data = x[c(6, 7), ],
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     body_size = "length_mm"
   )
 
   # run the select_traits_tax_dist() function with all names
-  output2 <- select_traits_tax_dist(
-    data = test_input,
+  y2 <- select_traits_tax_dist(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     body_size = "length_mm"
   )
 
   # make sure output is correct
-  spec <- output1[, names(output1) != "row"]
-  all <- output2[c(27:30),][, names(output2[c(27:30),]) != "row"]
-  x <- (spec == all)
+  spec <- y1[, names(y1) != "row"]
+  all <- y2[c(27:30),][, names(y2[c(27:30),]) != "row"]
+  z <- (spec == all)
 
-  expect_true(all( all(is.na(x) | (x == TRUE)) ))
+  expect_true(all( all(is.na(z) | (z == TRUE)) ))
 
 })
 
 test_that("test if select_traits_tax_dist() works
             correctly without any special names", {
 
-  test_input <- make_test_input()             
+  x <- make_test_input()             
 
   # run the select_traits_tax_dist() function without special names
-  output1 <- select_traits_tax_dist(
-    data = test_input[-c(6, 7), ],
+  y1 <- select_traits_tax_dist(
+    data = x[-c(6, 7), ],
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     body_size = "length_mm"
   )
 
   # run the select_traits_tax_dist() function with all names
-  output2 <- select_traits_tax_dist(
-    data = test_input,
+  y2 <- select_traits_tax_dist(
+    data = x,
     target_taxon = "taxon_name",
     life_stage = "Life_stage",
     body_size = "length_mm"
   )
 
   # make sure output is correct
-  spec <- output1[, names(output1) != "row"]
-  all <- output2[-c(27:30),][, names(output2[-c(27:30),]) != "row"]
-  x <- (spec == all)
+  spec <- y1[, names(y1) != "row"]
+  all <- y2[-c(27:30),][, names(y2[-c(27:30),]) != "row"]
+  z <- (spec == all)
 
-  expect_true(all( all(is.na(x) | (x == TRUE)) ))
+  expect_true(all( all(is.na(z) | (z == TRUE)) ))
 
 })