tests/testthat/test-99-regression.R

In portalr: Create Useful Summaries of the Portal Data

context("Regression tests for rodent, ant, and plant output")

portal_data_path <- tempdir()

test_that("data generated by default setting is same", {
  skip_on_cran()
  data <- abundance(portal_data_path, level = 'Site',
                    type = "Rodents", plots = "all", unknowns = FALSE,
                    min_plots = 24, shape = "crosstab", time = "period") %>%
    dplyr::filter(period < 434)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "fd405b2b90")
})

test_that("data generated by level = treatment, plots = longterm is same", {
  skip_on_cran()
  data <- abundance(portal_data_path, level = 'treatment', plots = "longterm") %>%
    dplyr::filter(period < 434)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "4381ec519f")
})

test_that("data generated by level = plot, time = newmoon, type = granivore, shape = flat is same", {
  skip_on_cran()
  data <- abundance(portal_data_path, level = 'plot', type = "granivores",
                    shape = "flat", time = "newmoon", na_drop = FALSE) %>%
    dplyr::filter(newmoonnumber < 465)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "20d3d2287c")

  sampled_newmoons <- abundance(portal_data_path, time = "all",
                                na_drop = FALSE, min_plots = 1) %>%
    dplyr::pull(newmoonnumber)
  data <- data %>%
    dplyr::filter(newmoonnumber %in% sampled_newmoons)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_equal(dim(data), c(155880, 5))
  expect_known_hash(data, "efbecf7764")
})

test_that("data generated by na_drop = FALSE, zero_drop = FALSE is same", {
  skip_on_cran()
  data <- abundance(portal_data_path, time = "date", na_drop = FALSE,
                    zero_drop = FALSE, min_plots = 1) %>%
    dplyr::filter(censusdate < as.Date("2015-01-01"))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_equal(dim(data), c(464, 22))
  expect_known_hash(is.na(data), "0294bfffde")
  data[is.na(data)] <- -999
  expect_known_hash(data, "638d5588ce")
  abundances <- data %>% dplyr::select(-censusdate)

  data <- abundance(portal_data_path, time = "newmoon", min_plots = 1,
                    include_unsampled = TRUE) %>%
    dplyr::filter(newmoonnumber < 465)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_equal(dim(data), c(464, 22))
  expect_known_hash(is.na(data), "b2d5abb360")
  data[is.na(data)] <- -999
  expect_known_hash(data, "59b85b7415")
  expect_equal(data %>% dplyr::select(-newmoonnumber),
               abundances)
})

test_that("data generated by unknowns = T, min_plots = 1 is same", {
  skip_on_cran()
  data <- abundance(portal_data_path, min_plots = 1, unknowns = TRUE) %>%
    dplyr::filter(period < 434) %>%
    dplyr::select(period, BA, DM, DO, DS, "NA", OL, OT, other, PB,
                  PE, PF, PH, PI, PL, PM, PP, RF, RM, RO, SF, SH, SO)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "1cff79dd5e")
})

test_that("data generated by plots = c(4, 8, 10, 12) is same", {
  skip_on_cran()
  data <- summarize_rodent_data(path = portal_data_path, plots = c(4, 8, 10, 12),
                                na_drop = TRUE, zero_drop = FALSE) %>%
    dplyr::filter(period < 450)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "0c87bf6bd3")
})

test_that("biomass data generated by level = plot is same", {
  skip_on_cran()
  data <- biomass(portal_data_path, type = "rodents", level = "plot", na_drop = FALSE) %>%
    dplyr::filter(period < 434) %>%
    dplyr::mutate_if(is.numeric, round, 1)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "0db04ad878")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "0f32687de5")
})

test_that("biomass data generated by min_plots = 1 is same", {
  skip_on_cran()
  data <- biomass(portal_data_path, type = "rodents", min_plots = 1) %>%
    dplyr::filter(period < 434) %>%
    dplyr::mutate_if(is.numeric, round, 3)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "e3f9c1e6cb")
})

test_that("rates data generated by plots crosstab is same", {
  skip_on_cran()
  data <- rates(portal_data_path, type = "rodents", level = "plot") %>%
    dplyr::filter(period < 434) %>%
    dplyr::mutate_if(is.numeric, round, 3)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "d767d12d07")
})

test_that("data generated by default setting is same (plants)", {
  skip_on_cran()
  data <- plant_abundance(portal_data_path, level = 'Site',
                          type = "All", plots = "all", unknowns = FALSE,
                          correct_sp = TRUE, shape = "flat", na_drop = TRUE,
                          zero_drop = TRUE, min_quads = 1, effort = TRUE) %>%
    dplyr::filter(year < 2015) %>%
    dplyr::mutate(species = as.character(species))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "d39185a041")
})

test_that("data generated by type = Shrubs, unknowns = T, correct_sp = F is same (plants)", {
  skip_on_cran()
  data <- plant_abundance(portal_data_path, level = 'Site',
                          type = "Shrubs", plots = "all", unknowns = TRUE,
                          correct_sp = FALSE, shape = "flat", na_drop = TRUE,
                          zero_drop = TRUE, min_quads = 1, effort = TRUE) %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "b18499873c")
})

test_that("data generated by level = Plot, type = Annuals, plots = longterm is same (plants)", {
  skip_on_cran()
  data <- plant_abundance(portal_data_path, level = 'Plot',
                          type = "Annuals", plots = "longterm",
                          unknowns = TRUE, correct_sp = TRUE, shape = "flat",
                          na_drop = TRUE, zero_drop = TRUE, min_quads = 1, effort = TRUE) %>%
    dplyr::filter(year < 2015) %>%
    dplyr::mutate(species = as.character(species))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "873fb9836c")
})

test_that("data generated by level = quadrat is same (plants)", {
  skip_on_cran()
  data <- plant_abundance(portal_data_path, level = 'quadrat') %>%
    dplyr::filter(year < 2015) %>%
    dplyr::mutate(species = as.character(species))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "ec4496f813")
})

test_that("data generated by level = quadrat, shape = crosstab, output = cover is same (plants)", {
  skip_on_cran()
  data <- summarize_plant_data(portal_data_path, level = 'quadrat', shape = "crosstab",
                               output = "cover") %>%
    dplyr::filter(year == 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "bd5fad7119")
})

test_that("data generated by shape = crosstab is same (plants)", {
  skip_on_cran()
  selected_plants <- sort(c("carl line", "tria port", "amar palm", "atri acan", "atri cane", "atri eleg", "atri wrig", "chen frem", "chen sp", "bray dens", "sals kali", "euro lana", "tide lanu", "tide sp", "sper echi", "funa hart", "dich pulc", "yucc elat", "ambr arte", "ambr conf", "ambr sals", "bahi absi", "bahi bite", "bail mult", "bric eupa", "caly wrig", "chae stev", "chae eric", "cirs neom", "erig conc", "erig dive", "erig sp", "flou cern", "guti saro", "hapl sp", "hapl spin", "heli annu", "hete suba", "hapl tenu", "laen coul", "hapl grac", "mach tanr", "mala fend", "mala sp", "part inca", "pect papp", "pere nana", "pseu cane", "rafi neom", "sanv aber", "step exig", "dyss pent", "micr lene", "micr sp", "verb ence", "xant spin", "zinn pumi", "zinn gran", "zinn sp", "amsi inte", "amsi sp", "amsi tess", "cryp cras", "cryp micr", "cryp sp", "cryp sp2", "lapp redo", "nama hisp", "pect recu", "pect sp", "phac ariz", "plag ariz", "chor tene", "desc obtu", "desc pinn", "desc sp", "dith wisl", "lepi lasi", "lepi sp", "lesq gord", "sisy irio", "unkn must", "cyli fulg", "cyli sp", "opun basi", "opun poly", "opun sp", "comm erec", "cusc mitr", "cusc sp", "cusc tube", "ipom cost", "apod undu", "ephe trif", "crot cory", "euph exst", "euph fend", "euph micr", "euph serp", "euph serr", "euph sp", "erod cicu", "erod texa", "acac cons", "acac greg", "astr allo", "astr nutt", "astr sp", "cass lept", "crot pumi", "dale brac", "dale nana", "dale pogo", "dale sp", "hoff dens", "lupi brev",  "lupi conc", "lupi sp", "lupi sp2", "mimo acul", "pros glan", "pros sp", "pros velu", "cass bauh", "abut parv", "sida phys", "sida proc", "sida neom", "sida sp", "sida spin", "spha angu", "spha coul", "spha hast", "spha inca", "spha laxa", "spha sp", "prob parv", "moll cerv", "moll sp", "moll vert", "tali angu", "tali aura", "tali sp", "alli inca", "alli sp", "ammo chen", "boer cocc", "boer coul", "boer inte", "boer sp", "boer torr", "oeno prim", "oeno sp", "esch mexi", "lina texa", "plan purs", "aris adsc", "aris long", "aris sp", "aris hamu", "both barb", "bout aris", "bout sp", "pani ariz", "brom rube", "bout dact", "chlo virg", "bout barb", "bout erio", "tric cali", "sita hyst", "enne desv", "erag cili", "erag inte", "erag lehm", "erag arid", "erag sp", "erio lemm", "trid pulc", "hila muti", "lycu phle", "muhl port", "muhl sp", "pani hirt", "pani mili", "pani sp", "schi barb", "seta leuc", "seta macr", "spor cont", "trag bert", "annu gras", "annu gras1", "annu gras2", "unkn gras", "unkn gras2", "pere gras", "vulp octo", "eria diff", "gili mexi", "gili sinu", "lina bige", "lina sp", "poly twee", "erio aber", "erio poly", "rume alti", "rume angu", "rume hyme", "port parv", "port sp", "port suff", "andr occi", "delp sp", "lyci ande", "lyci torr", "sola elea", "sola rost", "papp vagi", "annu forb", "annu forb2", "annu forb3", "annu forb4", "annu forb5", "unkn forb", "unkn forb2", "pere forb", "unkn", "unkn shrb", "tetr coul", "kall cali", "kall gran", "kall hirs", "kall sp", "larr trid"))
  data <- plant_abundance(portal_data_path, shape = "crosstab") %>%
    dplyr::filter(year < 2015) %>%
    dplyr::select(tidyselect::any_of(c("year", "season", "quads", selected_plants)))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "6efcd425ce")
})

test_that("data generated by default setting is same (shrub_cover)", {
  skip_on_cran()
  data <- shrub_cover(path = portal_data_path, type = "Shrubs",
                      plots = "all", unknowns = FALSE,
                      correct_sp = TRUE) %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "77da4ca0e3")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "673511d126")
})

test_that("data generated by default setting is same (ant colony_presence_absence)", {
  skip_on_cran()
  data <- colony_presence_absence(portal_data_path, level = "site") %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "512fa0d867")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "87516c0dc1")
})

test_that("data generated by default setting is same (ant bait_presence_absence)", {
  skip_on_cran()
  data <- bait_presence_absence(portal_data_path, level = "Site") %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "ce6e82c038")
})

test_that("data generated by level = 'stake' is same (ant colony_presence_absence)", {
  skip_on_cran()
  data <- colony_presence_absence(portal_data_path, level = "stake") %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "2beb6917b2")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "3a1051a3f1")
})

test_that("data generated by level = 'stake' is same (ant bait_presence_absence)", {
  skip_on_cran()
  data <- bait_presence_absence(portal_data_path, level = "stake") %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "f000d5f642")
})

test_that("data generated by level = 'plot' is same (ant colony_presence_absence)", {
  skip_on_cran()
  data <- colony_presence_absence(portal_data_path, level = "plot") %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "f9d41f2593")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "c7bd7a7686")
})

test_that("data generated by level = 'plot' is same (ant bait_presence_absence)", {
  skip_on_cran()
  data <- bait_presence_absence(portal_data_path, level = "plot") %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "807ea0fdbe")
})

test_that("data generated by default setting is same (weather)", {
  skip_on_cran()
  data <- weather(path = portal_data_path) %>%
    dplyr::filter(year < 2015)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "8648ecf05f")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "fcc6dc4ca0")
})

test_that("data generated by fill = TRUE is same (weather)", {
  skip_on_cran()
  data <- weather(fill = TRUE, path = portal_data_path) %>%
    dplyr::filter(year < 2015)

  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "ab7f91f465")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "b302f95927")
})

test_that("data generated by default setting is same (NDVI)", {
  skip_on_cran()
  data <- ndvi(path = portal_data_path) %>%
    dplyr::filter(date < as.Date("2015-01-01")) %>%
    dplyr::mutate(across(where(is.double), \(x) round(x,  4)))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  expect_known_hash(data, "da80b7fd19")
})

test_that("data generated by fill = TRUE is same (NDVI)", {
  skip_on_cran()
  data <- ndvi(path = portal_data_path, fill = TRUE) %>%
    dplyr::filter(date < as.Date("2015-01-01")) %>%
    dplyr::mutate(across(where(is.double), \(x) round(x,  4)))
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  expect_known_hash(data, "d0f9cfa8c6")
})

test_that("get_future_newmoons returns identical table using sample input", {
  skip_on_cran()
  moons <- data.frame(newmoonnumber = c(1, 2),
                      newmoondate = c("1977-07-16", "1977-08-14"),
                      period = c(1, 2),
                      censusdate = c("1977-07-16", "1977-08-19"))

  newmoons <- get_future_newmoons(moons, nfuture_newmoons = 10)
  attributes(newmoons) <- attributes(newmoons)[sort(names(attributes(newmoons)))]

  # correct for NAs in output
  expect_known_hash(is.na(newmoons), "1d6e5a1db8")
  newmoons$newmoondate[is.na(newmoons$newmoondate)] <- as.Date("0000-01-01")
  newmoons$period[is.na(newmoons$period)] <- -999999
  newmoons$censusdate[is.na(newmoons$censusdate)] <- as.Date("0000-01-01")
  expect_known_hash(newmoons, "aa0ddfd4ee")
})

test_that("data generated by default setting is same (phenocam)", {
  skip_on_cran()
  data <- phenocam(path = portal_data_path) %>%
    dplyr::filter(year < 2019)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]

  # correct for NAs in output
  expect_known_hash(is.na(data), "4c798df02b")
  data[is.na(data)] <- -999999
  expect_known_hash(data, "040fa9c6b1")
})

test_that("seasonal summaries generated by default setting is same", {
  skip_on_cran()
  data <- abundance(portal_data_path, level = 'Site',
                    type = "Rodents", plots = "all", unknowns = FALSE,
                    min_plots = 24, shape = "crosstab", time = "period") %>%
    dplyr::filter(period < 434) %>%
    add_seasons(date_column = "period", path = portal_data_path)
  attributes(data) <- attributes(data)[sort(names(attributes(data)))]
  expect_known_hash(data, "9a6056726d")
})