tests/testthat/test-adjust_rate.ft.R

In respR: Import, Process, Analyse, and Calculate Rates from Respirometry Data

# library(testthat)
# rm(list=ls())
# testthat::test_file("tests/testthat/test-adjust_rate.ft.R")
# covr::file_coverage("R/calc_rate.ft.R", "tests/testthat/test-adjust_rate.ft.R")
# cvr <- covr::package_coverage()
# covr::report(cvr)

capture.output({  ## stops printing outputs on assigning

  if (!identical(Sys.getenv("NOT_CRAN"), "true")) return()
  skip_on_cran()

  # Create testing objects --------------------------------------------------

  insp.ft_obj <- inspect.ft(flowthrough.rd, delta.oxy = 4, plot = FALSE)
  ## oxygen production data
  insp.ft_obj_prod <- inspect.ft(cbind(flowthrough.rd[,1], -1*(flowthrough.rd[,4])),
                                 time = 1, delta.oxy = 2, plot = FALSE)

  # x objects
  x1 <- calc_rate.ft(insp.ft_obj,
                     flowrate = 2, from = 200, to = 500,
                     by = NULL, width = NULL, plot = FALSE
  )
  xmany <- calc_rate.ft(insp.ft_obj,
                        flowrate = 2, from = 200:300, to = 500:600,
                        by = NULL, width = NULL, plot = FALSE
  )
  xwidth <- calc_rate.ft(insp.ft_obj,
                         flowrate = 2,
                         by = "row", width = 300, plot = FALSE
  )
  xprod <- calc_rate.ft(insp.ft_obj_prod,
                        flowrate = 2, from = 200, to = 500,
                        by = NULL, width = NULL, plot = FALSE
  )

  # by objects

  by_val <- -0.7
  by_vec <- seq(-0.75, -0.85, -0.01)
  by_crft <- calc_rate.ft(suppressWarnings(inspect.ft(flowthrough_mult.rd, out.oxy = 4, in.oxy = 8, plot = FALSE)),
                          flowrate = 2, plot = FALSE)
  by_crft_mult <- calc_rate.ft(suppressWarnings(inspect.ft(flowthrough_mult.rd, out.oxy = 4, in.oxy = 8, plot = FALSE)),
                               from = c(2000, 2500), to = c(2400, 2900), by = "row",
                               flowrate = 2, plot = FALSE)
  # by_crft_nl <- calc_rate.ft(inspect.ft(flowthrough_sim.rd, out.oxy = 2, in.oxy = 3, plot = FALSE),
  #                         flowrate = 2, plot = FALSE)

  adj.ft_obj.insp.1 <- adjust_rate.ft(x1, by = by_val)
  adj.ft_obj.insp.many <- adjust_rate.ft(xmany, by = by_val)
  adj.ft_obj.insp.width <- adjust_rate.ft(xwidth, by = by_val)
  adj.ft_obj.insp.prod <- adjust_rate.ft(xprod, by = 0.7)
  adj.ft_obj.vec <- adjust_rate.ft(xmany$rate, by = by_val)
  adj.ft_obj.val <- adjust_rate.ft(-1.5, by = by_val)


  # validate 'x' inputs -----------------------------------------------------

  test_that("adjust_rate.ft - stops if 'x' input not numeric or 'calc_rate.ft'", {
    expect_error(adjust_rate.ft("string",
                                by = -0.7),
                 regexp = "adjust_rate.ft: 'x' must be numeric or 'calc_rate.ft' object.")
    expect_error(adjust_rate.ft(as.data.frame(flowthrough.rd),
                                by = -0.7),
                 regexp = "adjust_rate.ft: 'x' must be numeric or 'calc_rate.ft' object.")
    expect_error(adjust_rate.ft(inspect(flowthrough.rd, plot = FALSE),
                                by = -0.7),
                 regexp = "adjust_rate.ft: 'x' must be numeric or 'calc_rate.ft' object.")
  })



  # validate 'by' inputs ----------------------------------------------------

  test_that("adjust_rate.ft - stops if 'by' input not numeric or 'calc_rate.ft'", {
    expect_error(adjust_rate.ft(x1,
                                by = "string"),
                 regexp = "adjust_rate.ft: 'by' must be numeric or 'calc_rate.ft' object.")
    expect_error(adjust_rate.ft(x1,
                                by = as.data.frame(flowthrough.rd)),
                 regexp = "adjust_rate.ft: 'by' must be numeric or 'calc_rate.ft' object.")
    expect_error(adjust_rate.ft(x1,
                                by = inspect(flowthrough.rd, plot = FALSE)),
                 regexp = "adjust_rate.ft: 'by' must be numeric or 'calc_rate.ft' object.")
  })

  test_that("adjust_rate.ft - message if 'by' contains multiple rates", {
    expect_message(adjust_rate.ft(x1,
                                  by = c(23,34)),
                   regexp = "adjust_rate.ft: the 'by' input contains multiple background rates. The mean value will be used to perform adjustments.")
    expect_message(adjust_rate.ft(x1,
                                  by = xmany),
                   regexp = "adjust_rate.ft: the 'by' input contains multiple background rates. The mean value will be used to perform adjustments.")
  })

  test_that("adjust_rate.ft - stops if 'x' and 'by' are calc_rate.ft and have been determined using different 'flowrates'", {
    expect_error(adjust_rate.ft(calc_rate.ft(insp.ft_obj,
                                             flowrate = 2,
                                             from = 200, to = 500, plot = FALSE),
                                by = calc_rate.ft(suppressWarnings(inspect.ft(flowthrough_mult.rd, out.oxy = 12, in.oxy = 13, plot = FALSE)),
                                                  flowrate = 1.5, plot = FALSE)),
                 regexp = "adjust_rate.ft: 'x' and by' input rates have been calculated using different 'flowrates'!")
  })


  # Verify adjustment -------------------------------------------------------

  test_that("adjust_rate.ft - adjustment value correctly extracted from 'by'", {
    expect_equal(adjust_rate.ft(x1,
                                by = by_val)$adjustment,
                 by_val)
    expect_equal(suppressWarnings(adjust_rate.ft(x1,
                                                 by = by_vec))$adjustment,
                 mean(by_vec))
    expect_equal(adjust_rate.ft(x1,
                                by = by_crft)$adjustment,
                 by_crft$rate)
    expect_equal(suppressWarnings(adjust_rate.ft(x1,
                                                 by = by_crft_mult))$adjustment,
                 mean(by_crft_mult$rate))
  })

  test_that("adjust_rate.ft - adjustment value correctly applied", {
    expect_equal(adjust_rate.ft(x1,
                                by = by_val)$rate.adjusted,
                 x1$rate - by_val)
    expect_equal(suppressWarnings(adjust_rate.ft(x1,
                                                 by = by_vec))$rate.adjusted,
                 x1$rate - mean(by_vec))
    expect_equal(adjust_rate.ft(x1,
                                by = by_crft)$rate.adjusted,
                 x1$rate - mean(by_crft$rate))
    expect_equal(suppressWarnings(adjust_rate.ft(x1,
                                                 by = by_crft_mult))$rate.adjusted,
                 x1$rate - mean(by_crft_mult$rate))

    expect_equal(adjust_rate.ft(xmany,
                                by = by_val)$rate.adjusted,
                 xmany$rate - by_val)
    expect_equal(suppressWarnings(adjust_rate.ft(xmany,
                                                 by = by_vec))$rate.adjusted,
                 xmany$rate - mean(by_vec))
    expect_equal(adjust_rate.ft(xmany,
                                by = by_crft)$rate.adjusted,
                 xmany$rate - mean(by_crft$rate))
    expect_equal(suppressWarnings(adjust_rate.ft(xmany,
                                                 by = by_crft_mult))$rate.adjusted,
                 xmany$rate - mean(by_crft_mult$rate))

    expect_equal(adjust_rate.ft(xwidth,
                                by = by_val)$rate.adjusted,
                 xwidth$rate - by_val)
    expect_equal(suppressWarnings(adjust_rate.ft(xwidth,
                                                 by = by_vec))$rate.adjusted,
                 xwidth$rate - mean(by_vec))
    expect_equal(adjust_rate.ft(xwidth,
                                by = by_crft)$rate.adjusted,
                 xwidth$rate - mean(by_crft$rate))
    expect_equal(suppressWarnings(adjust_rate.ft(xwidth,
                                                 by = by_crft_mult))$rate.adjusted,
                 xwidth$rate - mean(by_crft_mult$rate))
  })

  test_that("adjust_rate.ft - adjustment value correctly applied with oxygen production rates", {
    expect_equal(adjust_rate.ft(xprod,
                                by = -1*by_val)$rate.adjusted,
                 xprod$rate - (-1*by_val))
    expect_equal(suppressWarnings(adjust_rate.ft(xprod,
                                                 by = -1*by_vec))$rate.adjusted,
                 xprod$rate -(-1*mean(by_vec)))
  })

  test_that("adjust_rate.ft - if multiple rates in 'by' the mean value is correctly applied", {
    expect_equal(suppressWarnings(adjust_rate.ft(x1,
                                                 by = by_vec))$rate.adjusted,
                 x1$rate - mean(by_vec))
    expect_equal(suppressWarnings(adjust_rate.ft(x1,
                                                 by = by_crft_mult))$rate.adjusted,
                 x1$rate - mean(by_crft_mult$rate))

    expect_equal(suppressWarnings(adjust_rate.ft(xmany,
                                                 by = by_vec))$rate.adjusted,
                 xmany$rate - mean(by_vec))
    expect_equal(suppressWarnings(adjust_rate.ft(xmany,
                                                 by = by_crft_mult))$rate.adjusted,
                 xmany$rate - mean(by_crft_mult$rate))

    expect_equal(suppressWarnings(adjust_rate.ft(xwidth,
                                                 by = by_vec))$rate.adjusted,
                 xwidth$rate - mean(by_vec))
    expect_equal(suppressWarnings(adjust_rate.ft(xwidth,
                                                 by = by_crft_mult))$rate.adjusted,
                 xwidth$rate - mean(by_crft_mult$rate))

  })



  # S3 Generics tests -------------------------------------------------------

  test_that("adjust_rate.ft - objects can be printed.", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(print(adj.ft_obj.insp.1),
                 regexp = NA)
    expect_output(print(adj.ft_obj.insp.1),
                  regexp = "Adjusted Rate :")

    expect_error(print(adj.ft_obj.insp.many),
                 regexp = NA)
    expect_output(print(adj.ft_obj.insp.many),
                  regexp = "Adjusted Rate :")

    expect_error(print(adj.ft_obj.insp.width),
                 regexp = NA)
    expect_output(print(adj.ft_obj.insp.width),
                  regexp = "Adjusted Rate :")

    expect_error(print(adj.ft_obj.insp.prod),
                 regexp = NA)
    expect_output(print(adj.ft_obj.insp.prod),
                  regexp = "Adjusted Rate :")

    expect_error(print(adj.ft_obj.vec),
                 regexp = NA)
    expect_output(print(adj.ft_obj.vec),
                  regexp = "Adjusted Rate :")

    expect_error(print(adj.ft_obj.val),
                 regexp = NA)
    expect_output(print(adj.ft_obj.val),
                  regexp = "Adjusted Rate :")

  })

  test_that("adjust_rate.ft - objects can be printed with 'pos' input.", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(print(adj.ft_obj.insp.many, pos = 2),
                 regexp = NA)
    expect_output(print(adj.ft_obj.insp.many, pos = 2),
                  regexp = "Rank 2 of 101 adjusted")

    expect_error(print(adj.ft_obj.insp.width, pos = 100),
                 regexp = NA)
    expect_output(print(adj.ft_obj.insp.width, pos = 100),
                  regexp = "Rank 100 of 636 adjusted")

    expect_error(print(adj.ft_obj.vec, pos = 20),
                 regexp = NA)
    expect_output(print(adj.ft_obj.vec, pos = 20),
                  regexp = "Rank 20 of 101 adjusted")

    ## to check Adjustment value is properly included in output
    ## previously caught some failures to do this when pos was > 1
    expect_failure(expect_output(print(adj.ft_obj.vec, pos = 20),
                                 regexp = "Adjustment    : NA"))

  })

  test_that("adjust_rate.ft - print() stops with invalid 'pos' input.", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(print(adj.ft_obj.insp.1, pos = 2),
                 regexp = "print.adjust_rate.ft: Invalid 'pos' rank: only 1 adjusted rates found.")
    expect_error(print(adj.ft_obj.insp.many, pos = 2000),
                 regexp = "print.adjust_rate.ft: Invalid 'pos' rank: only 101 adjusted rates found.")
    expect_error(print(adj.ft_obj.insp.many, pos = 20:30),
                 regexp = "print.adjust_rate.ft: 'pos' must be a single value. To examine multiple results use summary().")

  })

  test_that("adjust_rate.ft - objects work with summary()", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(summary(adj.ft_obj.insp.1),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.insp.1),
                  regexp = "rate.adjusted")

    expect_error(summary(adj.ft_obj.insp.many),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.insp.many),
                  regexp = "rate.adjusted")

    expect_error(summary(adj.ft_obj.insp.width),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.insp.width),
                  regexp = "rate.adjusted")

    expect_error(summary(adj.ft_obj.insp.prod),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.insp.prod),
                  regexp = "rate.adjusted")

    expect_error(summary(adj.ft_obj.vec),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.vec),
                  regexp = "rate.adjusted")

    expect_error(summary(adj.ft_obj.val),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.val),
                  regexp = "rate.adjusted")
  })

  test_that("adjust_rate.ft - objects work with summary() and 'pos' input", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(summary(adj.ft_obj.insp.many, pos = 2),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.insp.many, pos = 2),
                  regexp = "rate.adjusted")
    expect_equal(nrow(summary(adj.ft_obj.insp.many, pos = 2, export = TRUE)),
                 1)
    expect_error(summary(adj.ft_obj.insp.many, pos = 2:10),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.insp.many, pos = 2:10),
                  regexp = "rate.adjusted")
    expect_equal(nrow(summary(adj.ft_obj.insp.many, pos = 2:10, export = TRUE)),
                 9)
    expect_error(summary(adj.ft_obj.vec, pos = c(2,4,6,8)),
                 regexp = NA)
    expect_output(summary(adj.ft_obj.vec, pos = c(2,4,6,8)),
                  regexp = "rate.adjusted")
    expect_equal(nrow(summary(adj.ft_obj.vec, pos = c(2,4,6,8), export = TRUE)),
                 4)
    expect_equal(summary(adj.ft_obj.vec, pos = c(2,4,6,8), export = TRUE)$rank,
                 c(2,4,6,8))
  })

  test_that("adjust_rate.ft - summary() stops with invalid 'pos' input", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(summary(adj.ft_obj.insp.many, pos = 102),
                 regexp = "summary.adjust_rate.ft: Invalid 'pos' rank: only 101 rates found.")
  })

  test_that("adjust_rate.ft - objects work with summary() and 'export' input", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(summary(adj.ft_obj.insp.many, export = TRUE),
                 regexp = NA)
    expect_equal(nrow(summary(adj.ft_obj.insp.many, export = TRUE)),
                 nrow(adj.ft_obj.insp.many$summary))
  })

  test_that("adjust_rate.ft - objects work with mean()", {

    # # objects
    # adj.ft_obj.insp.1
    # adj.ft_obj.insp.many
    # adj.ft_obj.insp.width
    # adj.ft_obj.insp.prod
    # adj.ft_obj.vec
    # adj.ft_obj.val

    expect_error(mean(adj.ft_obj.insp.1),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.insp.1),
                  regexp = "Mean of 1 adjusted rates:")
    expect_equal(mean(adj.ft_obj.insp.1, export = TRUE),
                 mean(adj.ft_obj.insp.1$rate.adjusted))
    expect_message(mean(adj.ft_obj.insp.1),
                   regexp = "Only 1 rate found. Returning mean rate anyway")

    expect_error(mean(adj.ft_obj.insp.many),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.insp.many),
                  regexp = "Mean of 101 adjusted rates:")
    expect_equal(mean(adj.ft_obj.insp.many, export = TRUE),
                 mean(adj.ft_obj.insp.many$rate.adjusted))

    expect_error(mean(adj.ft_obj.insp.width),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.insp.width),
                  regexp = "Mean of 636 adjusted rates:")
    expect_equal(mean(adj.ft_obj.insp.width, export = TRUE),
                 mean(adj.ft_obj.insp.width$rate.adjusted))

    expect_error(mean(adj.ft_obj.insp.prod),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.insp.prod),
                  regexp = "Mean of 1 adjusted rates:")
    expect_equal(mean(adj.ft_obj.insp.prod, export = TRUE),
                 mean(adj.ft_obj.insp.prod$rate.adjusted))

    expect_error(mean(adj.ft_obj.vec),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.vec),
                  regexp = "Mean of 101 adjusted rates:")
    expect_equal(mean(adj.ft_obj.vec, export = TRUE),
                 mean(adj.ft_obj.vec$rate.adjusted))

    expect_error(mean(adj.ft_obj.val),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.val),
                  regexp = "Mean of 1 adjusted rates:")
    expect_equal(mean(adj.ft_obj.val, export = TRUE),
                 mean(adj.ft_obj.val$rate.adjusted))
  })

  test_that("adjust_rate.ft - objects work with mean() and 'pos' input", {

    expect_error(mean(adj.ft_obj.insp.many, pos = 1:10),
                 regexp = NA)
    expect_output(mean(adj.ft_obj.insp.many, pos = 1:10),
                  regexp = "Mean of adjusted rate results from entered 'pos' ranks:")
    expect_equal(mean(adj.ft_obj.insp.many, pos = 1:10, export = TRUE),
                 mean(adj.ft_obj.insp.many$rate.adjusted[1:10]))
  })

  test_that("adjust_rate.ft - stops with mean() if 'pos' too high", {
    expect_error(mean(adj.ft_obj.insp.many, pos = 200),
                 regexp = "mean.adjust_rate.ft: Invalid 'pos' rank: only 101 adjusted rates found.")
  })

  test_that("adjust_rate.ft - stops with plot()", {
    expect_message(plot(adj.ft_obj.insp.many),
                   regexp = "adjust_rate.ft: plot\\(\\) is not available for 'adjust_rate.ft' objects.")
  })

}) ## end capture.output