Adding more tests

.github/workflows/R-CMD-check.yaml

@@ -49,5 +49,6 @@ jobs:
           upload-snapshots: true
 
       - name: Test coverage
+        if: matrix.config.os == 'ubuntu-latest' && matrix.config.r == 'release'
         run: covr::codecov(quiet = FALSE)
         shell: Rscript {0}

tests/testthat/test_helper_functions.R

@@ -0,0 +1,135 @@
+## ---- has.vars ----
+
+test_that("has.vars returns TRUE for existing columns", {
+  df <- data.frame(datetime = Sys.time(), wtr = 20, wnd = 5)
+  expect_true(has.vars(df, "wtr"))
+  expect_true(has.vars(df, "wnd"))
+})
+
+test_that("has.vars returns FALSE for missing columns", {
+  df <- data.frame(datetime = Sys.time(), wtr = 20)
+  expect_false(has.vars(df, "wnd"))
+})
+
+test_that("has.vars is case-insensitive", {
+  df <- data.frame(datetime = Sys.time(), WTR = 20)
+  expect_true(has.vars(df, "wtr"))
+})
+
+test_that("has.vars handles multiple variable names", {
+  df <- data.frame(datetime = Sys.time(), wtr = 20, wnd = 5)
+  result <- has.vars(df, c("wtr", "wnd", "par"))
+  expect_equal(result, c(TRUE, TRUE, FALSE))
+})
+
+test_that("has.vars errors when input is not a data.frame", {
+  expect_error(has.vars(c(1, 2, 3), "x"))
+})
+
+## ---- get.vars ----
+
+test_that("get.vars returns data.frame with datetime and matched columns", {
+  df <- data.frame(
+    datetime = as.POSIXct(c("2020-01-01", "2020-01-02"), tz = "UTC"),
+    wtr = c(15, 16),
+    wnd = c(3, 4))
+  result <- get.vars(df, "wtr")
+  expect_s3_class(result, "data.frame")
+  expect_true("datetime" %in% names(result))
+  expect_true("wtr" %in% names(result))
+  expect_false("wnd" %in% names(result))
+})
+
+test_that("get.vars errors when no variable pattern matches", {
+  df <- data.frame(
+    datetime = as.POSIXct("2020-01-01", tz = "UTC"),
+    wtr = 20)
+  expect_error(get.vars(df, "nonexistent_var"))
+})
+
+test_that("get.vars errors when no datetime column is present", {
+  df <- data.frame(wtr = 20, wnd = 5)
+  expect_error(get.vars(df, "wtr"))
+})
+
+## ---- rmv.vars ----
+
+test_that("rmv.vars removes named column", {
+  df <- data.frame(datetime = Sys.time(), wtr = 20, wnd = 5)
+  result <- rmv.vars(df, "wnd")
+  expect_false("wnd" %in% names(result))
+  expect_true("wtr" %in% names(result))
+})
+
+test_that("rmv.vars with ignore.missing=TRUE does not error on absent column", {
+  df <- data.frame(datetime = Sys.time(), wtr = 20)
+  expect_null(rmv.vars(df, "nonexistent", ignore.missing = TRUE))
+})
+
+test_that("rmv.vars with ignore.missing=FALSE errors on absent column", {
+  df <- data.frame(datetime = Sys.time(), wtr = 20)
+  expect_error(rmv.vars(df, "nonexistent", ignore.missing = FALSE))
+})
+
+## ---- get.offsets (from rLakeAnalyzer) ----
+
+test_that("get.offsets parses numeric suffix from column name", {
+  df <- data.frame(
+    datetime = as.POSIXct("2020-01-01", tz = "UTC"),
+    wtr_1.5 = 20)
+  wtr_df <- get.vars(df, "wtr")
+  offsets <- get.offsets(wtr_df)
+  expect_equal(offsets, 1.5)
+})
+
+test_that("get.offsets returns NA for column without numeric suffix", {
+  df <- data.frame(
+    datetime = as.POSIXct("2020-01-01", tz = "UTC"),
+    wtr = 20)
+  wtr_df <- get.vars(df, "wtr")
+  offsets <- suppressWarnings(get.offsets(wtr_df))
+  expect_true(is.na(offsets))
+})
+
+## ---- date2doy ----
+
+test_that("date2doy returns 1.5 for Jan 1 at noon UTC", {
+  dt <- as.POSIXct("2020-01-01 12:00:00", tz = "UTC")
+  result <- LakeMetabolizer:::date2doy(dt)
+  expect_equal(result, 1.5)
+})
+
+test_that("date2doy returns 1.0 for Jan 1 at midnight UTC", {
+  dt <- as.POSIXct("2020-01-01 00:00:00", tz = "UTC")
+  result <- LakeMetabolizer:::date2doy(dt)
+  expect_equal(result, 1.0)
+})
+
+test_that("date2doy handles vector input", {
+  dts <- as.POSIXct(c("2019-01-01 00:00:00", "2019-01-01 12:00:00"), tz = "UTC")
+  result <- LakeMetabolizer:::date2doy(dts)
+  expect_length(result, 2)
+  expect_equal(result, c(1.0, 1.5))
+})
+
+test_that("date2doy Dec 31 returns ~365 for non-leap year", {
+  dt <- as.POSIXct("2019-12-31 00:00:00", tz = "UTC")
+  result <- LakeMetabolizer:::date2doy(dt)
+  expect_equal(result, 365)
+})
+
+## ---- calc.freq ----
+
+test_that("calc.freq returns 144 for 10-minute interval data", {
+  start <- as.POSIXct("2020-01-01 00:00:00", tz = "UTC")
+  dt <- start + seq(0, 143 * 600, by = 600)  # 144 obs, 10-min apart
+  result <- LakeMetabolizer:::calc.freq(dt)
+  expect_equal(result, 144)
+})
+
+test_that("calc.freq returns 48 for 30-minute interval data", {
+  start <- as.POSIXct("2020-01-01 00:00:00", tz = "UTC")
+  dt <- start + seq(0, 47 * 1800, by = 1800)  # 48 obs, 30-min apart
+  result <- LakeMetabolizer:::calc.freq(dt)
+  expect_equal(result, 48)
+})

tests/testthat/test_k600.2.kGAS.R

@@ -0,0 +1,55 @@
+test_that("k600.2.kGAS.base formula: kGAS = k600 * (Sc/600)^-0.5", {
+  k600 <- 2.0
+  temp  <- 20
+  Sc    <- getSchmidt(temp, "O2")
+  expected <- k600 * (Sc / 600)^(-0.5)
+  result   <- k600.2.kGAS.base(k600, temp, "O2")
+  expect_equal(result, expected, tolerance = 1e-10)
+})
+
+test_that("k600.2.kGAS.base: kGAS > k600 at warm water where Sc(O2) < 600", {
+  # At 20°C, Sc(O2) ≈ 531 < 600, so (Sc/600)^-0.5 > 1
+  k600 <- 2.0
+  kGAS <- k600.2.kGAS.base(k600, 20, "O2")
+  expect_true(kGAS > k600)
+})
+
+test_that("k600.2.kGAS.base: kGAS ≈ k600 at temperature where Sc(O2) ≈ 600", {
+  # Sc(O2) ≈ 600 when temp ≈ 17.55°C
+  k600 <- 2.0
+  temp_approx <- 17.55
+  Sc <- getSchmidt(temp_approx, "O2")
+  kGAS <- k600.2.kGAS.base(k600, temp_approx, "O2")
+  # kGAS should be close to k600 (within ~1%)
+  expect_equal(kGAS, k600, tolerance = 0.01)
+})
+
+test_that("k600.2.kGAS.base: larger gas molecules (higher Sc) yield smaller kGAS", {
+  # CO2 has higher Sc than O2 at same temperature, so kGAS should be smaller
+  k600 <- 2.0
+  kO2  <- k600.2.kGAS.base(k600, 20, "O2")
+  kCO2 <- k600.2.kGAS.base(k600, 20, "CO2")
+  expect_true(kCO2 < kO2)
+})
+
+test_that("k600.2.kGAS.base handles vector inputs", {
+  k600  <- c(1, 2, 3)
+  temps <- c(10, 15, 20)
+  result <- k600.2.kGAS.base(k600, temps, "O2")
+  expected <- k600 * (getSchmidt(temps, "O2") / 600)^(-0.5)
+  expect_equal(result, expected, tolerance = 1e-10)
+})
+
+test_that("k600.2.kGAS wrapper returns data.frame with k.gas column", {
+  ts <- data.frame(
+    datetime = as.POSIXct(c("2020-01-01 00:00", "2020-01-01 01:00"), tz = "UTC"),
+    k600 = c(1.0, 2.0),
+    wtr  = c(15, 20))
+  result <- k600.2.kGAS(ts, gas = "O2")
+  expect_s3_class(result, "data.frame")
+  expect_true("k.gas" %in% names(result))
+  expect_true("datetime" %in% names(result))
+  expect_equal(result$k.gas,
+               k600.2.kGAS.base(ts$k600, ts$wtr, "O2"),
+               tolerance = 1e-10)
+})

tests/testthat/test_k_models.R

@@ -0,0 +1,117 @@
+## ---- k.cole ----
+
+test_that("k.cole.base known value at U10=4 m/s", {
+  # k600 = (2.07 + 0.215 * 4^1.7) * 24/100 in m/day
+  expected <- (2.07 + 0.215 * 4^1.7) * 24 / 100
+  result <- k.cole.base(4)
+  expect_equal(result, expected, tolerance = 1e-10)
+})
+
+test_that("k.cole.base returns positive k600 at zero wind (intercept)", {
+  result <- k.cole.base(0)
+  expected <- 2.07 * 24 / 100
+  expect_equal(result, expected, tolerance = 1e-10)
+  expect_true(result > 0)
+})
+
+test_that("k.cole.base k600 increases with wind speed", {
+  expect_true(k.cole.base(5) > k.cole.base(3))
+  expect_true(k.cole.base(3) > k.cole.base(1))
+})
+
+test_that("k.cole wrapper returns data.frame with datetime and k600 columns", {
+  ts <- data.frame(
+    datetime = as.POSIXct(c("2020-01-01 00:00", "2020-01-01 01:00"), tz = "UTC"),
+    wnd = c(3, 5))
+  result <- k.cole(ts)
+  expect_s3_class(result, "data.frame")
+  expect_true(all(c("datetime", "k600") %in% names(result)))
+  expect_equal(result$k600, k.cole.base(ts$wnd))
+})
+
+test_that("k.cole errors when wnd column is missing", {
+  ts_bad <- data.frame(
+    datetime = as.POSIXct("2020-01-01", tz = "UTC"),
+    wind = 5)
+  expect_error(k.cole(ts_bad))
+})
+
+## ---- k.crusius ----
+
+test_that("k.crusius.base power method returns numeric vector", {
+  result <- k.crusius.base(c(2, 4, 6), method = "power")
+  expect_type(result, "double")
+  expect_length(result, 3)
+  expect_true(all(is.finite(result)))
+})
+
+test_that("k.crusius.base constant method: all values below threshold equal same k600", {
+  # Below 3.7 m/s threshold → constant 1 cm/h = 0.24 m/day
+  result <- k.crusius.base(c(1, 2, 3), method = "constant")
+  expect_equal(result, rep(1 * 24 / 100, 3))
+})
+
+test_that("k.crusius.base constant method: value at threshold uses second formula", {
+  # At exactly 3.7, ifelse(3.7 < 3.7, ...) is FALSE → uses 5.14*3.7 - 17.9
+  expected <- (5.14 * 3.7 - 17.9) * 24 / 100
+  result <- k.crusius.base(3.7, method = "constant")
+  expect_equal(result, expected, tolerance = 1e-10)
+  expect_true(result > 1 * 24 / 100)  # higher than the below-threshold value
+})
+
+test_that("k.crusius.base bilinear method returns numeric vector", {
+  result <- k.crusius.base(c(2, 5), method = "bilinear")
+  expect_type(result, "double")
+  expect_length(result, 2)
+  # Below threshold
+  expect_equal(result[1], 0.72 * 2 * 24 / 100, tolerance = 1e-10)
+  # Above threshold
+  expect_equal(result[2], (4.33 * 5 - 13.3) * 24 / 100, tolerance = 1e-10)
+})
+
+test_that("k.crusius.base errors on invalid method", {
+  expect_error(k.crusius.base(5, method = "invalid"))
+})
+
+test_that("k.crusius wrapper returns data.frame with datetime and k600", {
+  ts <- data.frame(
+    datetime = as.POSIXct(c("2020-01-01 00:00", "2020-01-01 01:00"), tz = "UTC"),
+    wnd = c(3, 5))
+  result <- k.crusius(ts, method = "power")
+  expect_s3_class(result, "data.frame")
+  expect_true(all(c("datetime", "k600") %in% names(result)))
+  expect_equal(result$k600, k.crusius.base(ts$wnd, method = "power"))
+})
+
+## ---- k.vachon ----
+
+test_that("k.vachon.base known value at U10=3, lake.area=1e6 m2", {
+  # At 1e6 m^2, log10(1e6/1e6) = 0, so third term drops out
+  # k600 = (2.51 + 1.48*3 + 0) * 24/100
+  expected <- (2.51 + 1.48 * 3 + 0.39 * 3 * log10(1e6 / 1e6)) * 24 / 100
+  result <- k.vachon.base(3, 1e6)
+  expect_equal(result, expected, tolerance = 1e-10)
+})
+
+test_that("k.vachon.base k600 increases with lake area", {
+  # log10(area/1e6) > 0 for area > 1e6 → adds to k600
+  expect_true(k.vachon.base(3, 1e7) > k.vachon.base(3, 1e6))
+  expect_true(k.vachon.base(3, 1e6) > k.vachon.base(3, 1e5))
+})
+
+test_that("k.vachon wrapper returns data.frame with datetime and k600", {
+  ts <- data.frame(
+    datetime = as.POSIXct(c("2020-01-01 00:00", "2020-01-01 01:00"), tz = "UTC"),
+    wnd = c(3, 5))
+  result <- k.vachon(ts, lake.area = 1e6)
+  expect_s3_class(result, "data.frame")
+  expect_true(all(c("datetime", "k600") %in% names(result)))
+  expect_equal(result$k600, k.vachon.base(ts$wnd, 1e6))
+})
+
+test_that("k.vachon errors when wnd column is missing", {
+  ts_bad <- data.frame(
+    datetime = as.POSIXct("2020-01-01", tz = "UTC"),
+    wind = 5)
+  expect_error(k.vachon(ts_bad, lake.area = 1e6))
+})