tests/testthat/test-rollingQuantile.R

In openair: Tools for the Analysis of Air Pollution Data

# Small slice for speed
dat <- selectByDate(mydata, year = 2003, month = 1:3)

# --- Output structure --------------------------------------------------------

test_that("rollingQuantile returns a data frame with the same number of rows", {
  result <- rollingQuantile(dat, pollutant = "o3", width = 8, probs = 0.5)

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), nrow(dat))
})

test_that("rollingQuantile adds one column per quantile with correct naming", {
  result <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = c(0.05, 0.95)
  )

  expect_true("q_o3_0.05" %in% names(result))
  expect_true("q_o3_0.95" %in% names(result))
})

test_that("rollingQuantile single prob produces exactly one new quantile column", {
  before <- names(dat)
  result <- rollingQuantile(dat, pollutant = "o3", width = 8, probs = 0.5)
  new_cols <- setdiff(names(result), before)

  expect_true("q_o3_0.5" %in% new_cols)
})

# --- Numerical sanity --------------------------------------------------------

test_that("rolling median (p=0.5) is numeric with no NaN", {
  result <- rollingQuantile(dat, pollutant = "o3", width = 8, probs = 0.5)

  expect_true(is.numeric(result$q_o3_0.5))
  expect_false(any(is.nan(result$q_o3_0.5)))
})

test_that("rolling quantile values stay within the observed range", {
  result <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = c(0.05, 0.95),
    data.thresh = 0
  )

  obs_range <- range(dat$o3, na.rm = TRUE)
  non_na_lo <- result$q_o3_0.05[!is.na(result$q_o3_0.05)]
  non_na_hi <- result$q_o3_0.95[!is.na(result$q_o3_0.95)]

  expect_true(all(non_na_lo >= obs_range[1]))
  expect_true(all(non_na_hi <= obs_range[2]))
})

test_that("upper quantile >= lower quantile at every row", {
  result <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = c(0.1, 0.9),
    data.thresh = 0
  )

  both_non_na <- !is.na(result$q_o3_0.1) & !is.na(result$q_o3_0.9)
  expect_true(all(result$q_o3_0.9[both_non_na] >= result$q_o3_0.1[both_non_na]))
})

test_that("wider window produces a smoother series (lower variance)", {
  narrow <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 4,
    probs = 0.5,
    data.thresh = 0
  )$q_o3_0.5
  wide <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 48,
    probs = 0.5,
    data.thresh = 0
  )$q_o3_0.5

  expect_lt(var(wide, na.rm = TRUE), var(narrow, na.rm = TRUE))
})

test_that("data.thresh = 100 produces more NAs than data.thresh = 0", {
  res_low <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = 0.5,
    data.thresh = 0
  )
  res_high <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = 0.5,
    data.thresh = 100
  )

  expect_gte(sum(is.na(res_high$q_o3_0.5)), sum(is.na(res_low$q_o3_0.5)))
})

# --- Alignment ---------------------------------------------------------------

test_that("align = 'right' and align = 'left' produce different results", {
  right <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 24,
    probs = 0.5,
    align = "right"
  )$q_o3_0.5
  left <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 24,
    probs = 0.5,
    align = "left"
  )$q_o3_0.5

  expect_false(isTRUE(all.equal(right, left)))
})

test_that("align = 'right' has NAs at the start, not the end", {
  result <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 24,
    probs = 0.5,
    align = "right",
    data.thresh = 100
  )

  expect_true(all(is.na(result$q_o3_0.5[1:23])))
  expect_false(is.na(result$q_o3_0.5[nrow(result)]))
})

test_that("align = 'left' has NAs at the end, not the start", {
  result <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 24,
    probs = 0.5,
    align = "left",
    data.thresh = 100
  )

  n <- nrow(result)
  expect_true(all(is.na(result$q_o3_0.5[(n - 22):n])))
  expect_false(is.na(result$q_o3_0.5[1]))
})

test_that("align = 'center' is silently treated as 'centre'", {
  res_center <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = 0.5,
    align = "center"
  )
  res_centre <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 8,
    probs = 0.5,
    align = "centre"
  )

  expect_equal(res_center$q_o3_0.5, res_centre$q_o3_0.5)
})

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

test_that("rollingQuantile errors when data.thresh is out of range", {
  expect_error(
    rollingQuantile(dat, pollutant = "o3", width = 8, data.thresh = -1),
    regexp = "data.thresh"
  )
  expect_error(
    rollingQuantile(dat, pollutant = "o3", width = 8, data.thresh = 101),
    regexp = "data.thresh"
  )
})

test_that("rollingQuantile errors when probs is out of range", {
  expect_error(
    rollingQuantile(dat, pollutant = "o3", width = 8, probs = -0.1),
    regexp = "probs"
  )
  expect_error(
    rollingQuantile(dat, pollutant = "o3", width = 8, probs = 1.1),
    regexp = "probs"
  )
})

test_that("rollingQuantile errors on non-numeric pollutant column", {
  bad <- dat
  bad$o3 <- as.character(bad$o3)

  expect_error(
    rollingQuantile(bad, pollutant = "o3", width = 8),
    regexp = "not numeric"
  )
})

test_that("rollingQuantile errors on invalid align argument", {
  expect_error(
    rollingQuantile(dat, pollutant = "o3", width = 8, align = "diagonal"),
    regexp = "align"
  )
})

# --- Edge cases --------------------------------------------------------------

test_that("width = 1 returns the original values (window is a single point)", {
  result <- rollingQuantile(
    dat,
    pollutant = "o3",
    width = 1,
    probs = 0.5,
    data.thresh = 0
  )

  non_na <- !is.na(dat$o3)
  expect_equal(result$q_o3_0.5[non_na], dat$o3[non_na], tolerance = 1e-6)
})

test_that("rollingQuantile handles all-NA input without erroring", {
  dat_na <- dat
  dat_na$o3 <- NA_real_

  expect_no_error(
    rollingQuantile(dat_na, pollutant = "o3", width = 8, probs = 0.5)
  )
})

test_that("rollingQuantile with date.pad = TRUE still returns original row count", {
  dat_gap <- dat[!lubridate::month(dat$date) %in% 2, ]

  result <- rollingQuantile(
    dat_gap,
    pollutant = "o3",
    width = 8,
    probs = 0.5,
    date.pad = TRUE
  )

  expect_equal(nrow(result), nrow(dat_gap))
})