tests/testthat/test-conditionalQuantile.R

In openair: Tools for the Analysis of Air Pollution Data

# conditionalQuantile tests — plot = FALSE throughout
#
# Build a small synthetic obs/mod data frame with known properties.
# Using a near-perfect model (mod ≈ obs + noise) gives well-behaved quantiles.

set.seed(42)
n <- 500L
obs <- runif(n, 5, 100)
syn <- data.frame(
  date = seq(as.POSIXct("2023-01-01", tz = "GMT"), by = "hour", length.out = n),
  obs = obs,
  mod = obs + rnorm(n, 0, 5) # near-perfect predictor
)

# Shared result — covers most tests
cq <- conditionalQuantile(
  syn,
  obs = "obs",
  mod = "mod",
  bins = 15,
  plot = FALSE
)

# --- Return value structure --------------------------------------------------

test_that("conditionalQuantile returns an openair object with expected components", {
  expect_s3_class(cq, "openair")
  expect_named(cq, c("plot", "data", "call"))
  expect_s3_class(cq$plot, "ggplot")
})

test_that("$data is a data frame with a cq list-column", {
  expect_s3_class(cq$data, "data.frame")
  expect_true("cq" %in% names(cq$data))
})

test_that("each cq element contains quant, hist, and obs_range sub-frames", {
  inner <- cq$data$cq[[1]]
  expect_named(inner, c("quant", "hist", "obs_range"))
  expect_s3_class(inner$quant, "data.frame")
  expect_s3_class(inner$hist, "data.frame")
})

# --- Quantile data values ----------------------------------------------------

test_that("quant$x values are within the data range", {
  q <- cq$data$cq[[1]]$quant
  range <- range(c(syn$obs, syn$mod))
  expect_true(all(q$x >= range[1]))
  expect_true(all(q$x <= range[2]))
})

test_that("q1 (25th pct) <= med <= q2 (75th pct) where all non-NA", {
  q <- cq$data$cq[[1]]$quant
  ok <- !is.na(q$q1) & !is.na(q$med) & !is.na(q$q2)
  expect_true(all(q$q1[ok] <= q$med[ok]))
  expect_true(all(q$med[ok] <= q$q2[ok]))
})

test_that("q3 (10th pct) <= q1 (25th pct) and q2 (75th pct) <= q4 (90th pct) where non-NA", {
  q <- cq$data$cq[[1]]$quant
  ok_lo <- !is.na(q$q3) & !is.na(q$q1)
  ok_hi <- !is.na(q$q2) & !is.na(q$q4)
  expect_true(all(q$q3[ok_lo] <= q$q1[ok_lo]))
  expect_true(all(q$q2[ok_hi] <= q$q4[ok_hi]))
})

test_that("a near-perfect model has median close to the 1:1 line", {
  q <- cq$data$cq[[1]]$quant
  non_na <- !is.na(q$med)
  resid <- abs(q$med[non_na] - q$x[non_na])
  # For a near-perfect predictor the median should be within ~15 units of x
  expect_true(all(resid < 15))
})

# --- Histogram data ----------------------------------------------------------

test_that("hist data has x, count, and hist_type columns", {
  h <- cq$data$cq[[1]]$hist
  expect_true(all(c("x", "count", "hist_type") %in% names(h)))
})

test_that("hist_type contains only 'predicted' and 'observed'", {
  h <- cq$data$cq[[1]]$hist
  expect_setequal(unique(h$hist_type), c("predicted", "observed"))
})

test_that("histogram counts are non-negative integers", {
  h <- cq$data$cq[[1]]$hist
  expect_true(all(h$count >= 0))
  expect_true(all(h$count == floor(h$count)))
})

# --- bins and min.bin --------------------------------------------------------

test_that("more bins produces more rows in quant", {
  cq_coarse <- conditionalQuantile(
    syn,
    obs = "obs",
    mod = "mod",
    bins = 10,
    plot = FALSE
  )
  cq_fine <- conditionalQuantile(
    syn,
    obs = "obs",
    mod = "mod",
    bins = 20,
    plot = FALSE
  )
  expect_lt(
    nrow(cq_coarse$data$cq[[1]]$quant),
    nrow(cq_fine$data$cq[[1]]$quant)
  )
})

test_that("higher min.bin produces more NAs in the outer quantile columns", {
  cq_strict <- conditionalQuantile(
    syn,
    obs = "obs",
    mod = "mod",
    bins = 15,
    min.bin = c(200, 400),
    plot = FALSE
  )
  q_strict <- cq_strict$data$cq[[1]]$quant
  q_loose <- cq$data$cq[[1]]$quant
  expect_gte(sum(is.na(q_strict$q1)), sum(is.na(q_loose$q1)))
})

# --- type conditioning -------------------------------------------------------

test_that("type = 'daylight' produces two rows in $data", {
  cq_season <- conditionalQuantile(
    syn,
    obs = "obs",
    mod = "mod",
    bins = 10,
    type = "daylight",
    plot = FALSE
  )
  expect_true("daylight" %in% names(cq_season$data))
  expect_equal(length(cq_season$data$daylight), 2L)
})

# --- Input validation --------------------------------------------------------

test_that("more than two types raises an error", {
  expect_error(
    conditionalQuantile(
      syn,
      obs = "obs",
      mod = "mod",
      type = c("season", "weekend", "year"),
      plot = FALSE
    ),
    regexp = "two types"
  )
})