tests/testthat/test-rcs.R

vp <- example_vp
vp_list <- c(example_vp, example_vp)
vp_list_mixed <- list(example_vp, "not_a_vp")
vpts <- example_vpts
vpi <- integrate_profile(example_vpts)

test_that("rcs() returns error on incorrect parameters", {
  expect_error(
    rcs("not_a_vp"),
    regexp = "no applicable method for 'rcs' applied to an object of class \"character\"",
    fixed = TRUE)
  expect_error(
    rcs(vp_list_mixed),
    "`x` must be list of `vp` objects.",
    fixed = TRUE)
})
# TODO: IMPROVE THIS ERROR MESSAGING, NOT DESCRIPTIVE
test_that("rcs()<- returns error on incorrect parameters", {
  expect_error(rcs(vp) <- "not_numeric",
               regexp = "value is not a numeric or integer vector",
               fixed = TRUE)
  expect_error(rcs(vp) <- NULL,
               regexp = "value is not a numeric or integer vector",
               fixed = TRUE)
  expect_error(rcs(vp) <- c(2, 2))
  expect_error(rcs("not_a_vp") <- 5)
  expect_error(rcs(vp_list_mixed) <- 5,
               "`x` must be list of `vp` objects.",
               fixed = TRUE)
  expect_error(rcs(vp) <- -11,
               regexp = "value not greater than 0",
               fixed = TRUE)
})

test_that("rcs() returns the correct rcs", {
  expect_equal(rcs(vp), vp$attributes$how$rcs)
  expect_equal(rcs(vp_list), c(vp$attributes$how$rcs, vp$attributes$how$rcs))
  expect_equal(rcs(vpts), vpts$attributes$how$rcs)
  expect_equal(rcs(vpi), attributes(vpi)$rcs)
})

test_that("rcs()<- updates rcs", {
  rcs(vp) <- 5.5
  rcs(vp_list) <- 5.5
  rcs(vpts) <- 5.5
  rcs(vpi) <- 5.5

  expect_equal(vp$attributes$how$rcs_bird, 5.5)
  expect_equal(c(vp$attributes$how$rcs_bird, vp$attributes$how$rcs_bird), c(5.5, 5.5))
  expect_equal(vpts$attributes$how$rcs_bird, 5.5)
  expect_equal(attributes(vpi)$rcs, 5.5)
})

test_that("rcs()<- updates density", {
  # Not tested for vp_list as that is a repetition of vp method

  # rcs()<- should set none-NA densities to 0 if below sd_vvp_threshold.
  # In the example_vp, all densities are NA below its sd_vvp_threshold of 2, so
  # we set a higher sd_vvp_threshold to have some none-NA values:
  vp$attributes$how$sd_vvp_thresh <- 4
  vpts$attributes$how$sd_vvp_thresh <- 4

  # Set rcs
  rcs(vp) <- 6
  rcs(vpts) <- 6

  # If above sd_vvp_threshold: dens = eta/rcs
  expect_equal(
    vp$data$dens[vp$data$sd_vvp >= 4], vp$data$eta[vp$data$sd_vvp >= 4] / 6
  )
  expect_equal(
    vpts$data$dens[vpts$data$sd_vvp >= 4], vpts$data$eta[vpts$data$sd_vvp >= 4] / 6
  )
  # If below sd_vvp_threshold and not NA: dens = 0
  expect_true(all(vp$data$dens[vp$data$sd_vvp < 4] == 0, na.rm = TRUE))
  expect_true(all(vpts$data$dens[vpts$data$sd_vvp < 4] == 0, na.rm = TRUE))
})

test_that("rcs()<- sets sd_vvp_threshold to 2 when NULL", {
  # Not tested for vp_list as that is a repetition of vp method

  vp$attributes$how$sd_vvp_thresh <- NULL
  vpts$attributes$how$sd_vvp_thresh <- NULL
  expect_warning(rcs(vp) <- 6, "Threshold for `sd_vvp` not set, defaulting to 2 m/s.")
  expect_warning(rcs(vpts) <- 6, "Threshold for `sd_vvp` not set, defaulting to 2 m/s.")
  expect_equal(sd_vvp_threshold(vp), 2)
  expect_equal(sd_vvp_threshold(vpts), 2)
})

test_that("rcs()<- updates mtr and vid in vpi", {
  rcs(vpi) <- 5.5
  expect_equal(vpi$mtr, vpi$rtr / 5.5)
  expect_equal(vpi$vid, vpi$vir / 5.5)
})

Try the bioRad package in your browser

Any scripts or data that you put into this service are public.

bioRad documentation built on Oct. 20, 2023, 5:06 p.m.