tests/testthat/test-variationPlot.R

In openair: Tools for the Analysis of Air Pollution Data

# Small, fixed slices — subsample heavily to keep bootstrap fast
dat <- selectByDate(mydata, year = 2003, month = 1:3)
dat1 <- selectByDate(mydata, year = 2003, month = 1)

# Run the most-used configurations once and reuse
vp_mean <- variationPlot(
  dat,
  pollutant = "nox",
  x = "hour",
  B = 20,
  plot = FALSE
)
vp_median <- variationPlot(
  dat,
  pollutant = "nox",
  x = "hour",
  statistic = "median",
  plot = FALSE
)
tv <- timeVariation(dat, pollutant = "nox", B = 20, plot = FALSE)

# =============================================================================
# variationPlot
# =============================================================================

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

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

test_that("variationPlot$data has required columns", {
  expect_true(all(
    c("x", "group", "mid", "min", "max", "ci", "statistic") %in%
      names(vp_mean$data)
  ))
})

# --- Data values -------------------------------------------------------------

test_that("variationPlot mean: mid is between min and max", {
  d <- vp_mean$data
  ok <- !is.na(d$mid) & !is.na(d$min) & !is.na(d$max)
  expect_true(all(d$mid[ok] >= d$min[ok]))
  expect_true(all(d$mid[ok] <= d$max[ok]))
})

test_that("variationPlot median: mid is between min and max", {
  d <- vp_median$data
  ok <- !is.na(d$mid) & !is.na(d$min) & !is.na(d$max)
  expect_true(all(d$mid[ok] >= d$min[ok]))
  expect_true(all(d$mid[ok] <= d$max[ok]))
})

test_that("variationPlot statistic column records the statistic used", {
  expect_true(all(vp_mean$data$statistic == "mean"))
  expect_true(all(vp_median$data$statistic == "median"))
})

test_that("variationPlot x = 'hour' produces 24 x levels", {
  expect_equal(length(unique(stats::na.omit(vp_mean$data$x))), 24L)
})

# --- normalise ---------------------------------------------------------------

test_that("normalise = TRUE scales mid values to be centred near 1", {
  vp_norm <- variationPlot(
    dat,
    pollutant = "nox",
    x = "hour",
    normalise = TRUE,
    B = 20,
    plot = FALSE
  )
  expect_equal(mean(vp_norm$data$mid, na.rm = TRUE), 1, tolerance = 0.1)
})

# --- multiple pollutants -----------------------------------------------------

test_that("multiple pollutants appear as separate group levels", {
  vp_multi <- variationPlot(
    dat,
    pollutant = c("nox", "no2"),
    x = "hour",
    B = 20,
    plot = FALSE
  )
  expect_setequal(levels(vp_multi$data$group), c("nox", "no2"))
})

# --- conf.int ----------------------------------------------------------------

test_that("multiple conf.int values produce multiple ci rows per x", {
  vp_ci <- variationPlot(
    dat,
    pollutant = "nox",
    x = "hour",
    conf.int = c(0.5, 0.95),
    B = 20,
    plot = FALSE
  )
  expect_setequal(unique(vp_ci$data$ci), c(0.5, 0.95))
})

# --- difference --------------------------------------------------------------

test_that("difference = TRUE adds a difference group level", {
  vp_diff <- variationPlot(
    dat,
    pollutant = c("nox", "no2"),
    x = "hour",
    difference = TRUE,
    B = 20,
    plot = FALSE
  )
  groups <- as.character(levels(vp_diff$data$group))
  expect_true(any(grepl("-", groups, fixed = TRUE)))
})

# --- input validation --------------------------------------------------------

test_that("variationPlot errors with more than two types", {
  expect_error(
    variationPlot(
      dat,
      pollutant = "nox",
      x = "hour",
      type = c("season", "year", "weekday"),
      plot = FALSE
    ),
    regexp = "type"
  )
})

test_that("variationPlot errors when group and multiple pollutants are both set", {
  expect_error(
    variationPlot(
      dat,
      pollutant = c("nox", "no2"),
      x = "hour",
      group = "season",
      plot = FALSE
    ),
    regexp = "pollutant"
  )
})

test_that("variationPlot errors when type duplicates pollutant", {
  expect_error(
    variationPlot(
      dat,
      pollutant = "nox",
      x = "hour",
      type = "nox",
      plot = FALSE
    ),
    regexp = "type"
  )
})

test_that("variationPlot errors on invalid statistic", {
  expect_error(
    variationPlot(
      dat,
      pollutant = "nox",
      x = "hour",
      statistic = "mode",
      plot = FALSE
    ),
    regexp = "statistic"
  )
})

# =============================================================================
# timeVariation
# =============================================================================

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

test_that("timeVariation returns an openair object with expected components", {
  expect_s3_class(tv, "openair")
  expect_true(all(c("plot", "data", "call") %in% names(tv)))
})

test_that("timeVariation$plot is a list named after panels", {
  default_panels <- c("hour.weekday", "hour", "month", "weekday")
  expect_true(all(default_panels %in% names(tv$plot)))
})

test_that("timeVariation$data is a list of tibbles named after panels", {
  default_panels <- c("hour.weekday", "hour", "month", "weekday")
  expect_true(all(default_panels %in% names(tv$data)))
  expect_true(all(purrr::map_lgl(tv$data[default_panels], is.data.frame)))
})

test_that("timeVariation$main.plot is a patchwork object", {
  expect_true(inherits(tv$main.plot, "patchwork"))
})

# --- Panel content -----------------------------------------------------------

test_that("timeVariation hour panel has 24 x levels", {
  expect_equal(length(unique(stats::na.omit(tv$data$hour$x))), 24L)
})

test_that("timeVariation month panel has 12 x levels", {
  expect_equal(dplyr::n_distinct(stats::na.omit(tv$data$month$x)), 12L)
})

test_that("timeVariation mid is between min and max in all panels", {
  for (panel in c("hour", "month", "weekday")) {
    d <- tv$data[[panel]]
    ok <- !is.na(d$mid) & !is.na(d$min) & !is.na(d$max)
    expect_true(all(d$mid[ok] >= d$min[ok]), label = paste(panel, "mid >= min"))
    expect_true(all(d$mid[ok] <= d$max[ok]), label = paste(panel, "mid <= max"))
  }
})

# --- Custom panels -----------------------------------------------------------

test_that("custom panels argument produces output keyed by those panel names", {
  tv_custom <- timeVariation(
    dat1,
    pollutant = "nox",
    panels = c("hour", "month"),
    B = 20,
    plot = FALSE
  )
  expect_true(all(c("hour", "month") %in% names(tv_custom$data)))
  expect_false("weekday" %in% names(tv_custom$data))
})

# --- input validation --------------------------------------------------------

test_that("timeVariation errors with more than one type", {
  expect_error(
    timeVariation(
      dat,
      pollutant = "nox",
      type = c("season", "year"),
      B = 20,
      plot = FALSE
    ),
    regexp = "type"
  )
})