Improve unit tests

R/calibration.R

@@ -250,27 +250,24 @@ lod.calibration <- function(object, blanks = NULL, alpha = 0.01, level = 0.05,
   m <- mean(table(conc))
   digs <- max(nchar(gsub("(.*\\.)|([0]*$)", "", as.character(conc)))) + 1
 
-  if (m != round(m)) warning("measurement replicates of unequal size; ",
+  if(m != round(m)) warning("measurement replicates of unequal size; ",
                              "LOD estimation might be incorrect")
-  if (n <= model$rank) stop("data points less than degrees of freedom")
+  if(n <= model$rank) stop("data points less than degrees of freedom")
 
   b <- coef(model)[2]
 
-  if (is.null(blanks)) blanks <- object$blanks
+  if(is.null(blanks)) blanks <- object$blanks
 
-  if (length(blanks) > 1) {
+  if(length(blanks) > 1) {
     # Direct method (LOD from blanks)
     sl <- sd(blanks) / b
     val <- sl * -qt(alpha, n - 1) * sqrt(1/n + 1/m)
   } else {
     # Indirect method (LOD from calibration curve)
-    if (length(blanks) == 1) {
-      message("only one blank value supplied; LOD is estimated from the ",
-              "calibration curve")
-    } else {
-      message("no blanks provided; LOD is estimated from the calibration curve") 
-    }
-    sx0 <- summary(model)$sigma / b
+    message("number of blank values <= 1; LOD is estimated from the ",
+            "calibration curve")
+
+        sx0 <- summary(model)$sigma / b
     Qx <- sum((conc - mean(conc))^2) / m
     val <- sx0 * -qt(alpha, n - model$rank) * sqrt(1/n + 1/m + (mean(conc))^2 /
                                                      Qx)

R/texture.R

@@ -28,7 +28,7 @@
 #' @param plot logical; if \code{TRUE} the particle size distribution is plotted.
 #' 
 #' @return
-#' \code{texture} returns an object of \code{\link[base]{class}} '\code{texture}.
+#' \code{texture} returns an object of \code{\link[base]{class}} '\code{texture}'.
 #' The functions \code{print}() and \code{plot}() are available to retrieve the
 #' soil texture classes and the particle size distribution, respectively.
 #' 
@@ -44,12 +44,15 @@
 #' \code{usda} \tab Main USDA texture classes\cr
 #' }
 #' 
+#' \code{as_tridata} converts '\code{texture}' to data.frames of a specific
+#' structure require for \code{\link[soiltexture]{soiltexture-package}}.
+#' 
 #' @author
 #' Zacharias Steinmetz
 #' 
 #' @examples
 #' data(clayloam)
-#' texture(reading ~ blank + time + temperature, clayloam)
+#' texture(reading ~ blank + time + temperature, data = clayloam)
 #'
 #' @references
 #' ASTM D422-63 (2007). \emph{Standard Test Method for Particle-Size Analysis
@@ -150,8 +153,8 @@ texture.default <- function(reading, blank, time, temp, conc = 50, Gs = 2.65,
 #' @rdname texture
 #' 
 #' @param x an object of class '\code{texture}'.
-#' @param \dots further arguments to be passed to \code{texture}() (currently not
-#' used), \code{print}(), or \code{plot}().
+#' @param \dots further arguments to be passed to \code{texture}() (currently
+#' not used), \code{print}(), or \code{plot}().
 #' 
 #' @export
 print.texture <- function(x, ...) {

tests/testthat/_snaps/calibration.md

@@ -1,4 +1,4 @@
-# Snapshot output consistent
+# snapshot output consistent
 
 
     Call:

tests/testthat/_snaps/texture.md

@@ -1,4 +1,4 @@
-# Snapshot output consistent
+# print() and plot() produce consistent output
 
     Soil particle estimation according to ASTM D422-63
     Hydrometer model: 152H

tests/testthat/_snaps/weight_select.md

@@ -1,4 +1,4 @@
-# Weight selection works and produces consistent output
+# weight_select() produces consistent output
 
                Sum relative error Adj. R-squared
     1/Conc^2.0          0.6109420      0.9841021

tests/testthat/test-calibration.R

@@ -5,82 +5,117 @@ save_png <- function(code, width = 600, height = 400) {
   on.exit(dev.off())
   code
 
-  path
+  return(path)
 }
 
 data(din32645)
+
 din <- calibration(Area ~ Conc, data = din32645)
 din_woa <- calibration(Area ~ Conc, data = din32645, check_assumptions = F)
 
 data(neitzel2003)
 neitzel <- calibration(Meas ~ Conc, data = neitzel2003)
 
-test_that("print(), summary(), and plot() work", {
-  expect_output(print(din))
-  expect_output(print(summary(din)))
-  expect_silent(plot(din))
+test_that("calibration() handles input errors correctly", {
+  calibration( ~ Conc, data = din32645) |> expect_error()
+
+  calibration(Area ~ Conc, data = rbind(din32645, din32645[15,]),
+              check_assumptions = F) |> 
+    expect_warning() |> 
+    expect_warning() |> 
+    expect_warning()
+
+  calibration(Area ~ Conc, data = din32645[din32645$Conc != 0,]) |> 
+    expect_message() |> expect_message()
+  calibration(Area ~ Conc, data = din32645) |> expect_silent()
 })
 
-test_that("Snapshot output consistent", {
-  expect_snapshot_output(print(din))
-  expect_snapshot_output(print(din_woa))
-  expect_snapshot_output(print(neitzel))
-  skip_on_ci()
-  expect_snapshot_file(save_png(plot(din)), "plot.png")
+test_that("calibration() produces correct output", {
+  expect_s3_class(din, "calibration")
+
+  round(din$lod[1], 3) |> expect_equal(0.053)
+  round(din$loq[1], 3) |> expect_equal(0.212)
+
+  round(din$adj.r.squared, 3) |> expect_equal(0.983)
+  round(din$relerr, 3) |> expect_contains(c(0.199, 0.067, -0.036))
+  expect_contains(din$blanks, c(2003, 1943))
 })
 
-test_that("Correct R squared computed correctly", {
-  expect_equal(round(din$adj.r.squared, 3), 0.983)
-})
+alt <- calibration(Area ~ Conc, data = din32645[din32645$Conc != 0,])
+lm <- lm(Area ~ Conc, data = din32645[din32645$Conc != 0,])
 
-test_that("LOD calculation computed correctly", {
-  expect_equal(round(lod(din)[1], 3), 0.053)
-  expect_equal(round(lod(neitzel)[1], 3), 0.009)
+test_that("calibration() gives correct result for non-zero concentrations", {
+  expect_false(identical(din, alt))
+  expect_equal(loq(din), loq(alt))
+  expect_equal(coef(alt$model), coef(lm))
 })
 
-test_that("LOQ calculation computed correctly", {
-  expect_equal(round(loq(din)[1], 3), 0.212)
-  expect_equal(round(loq(neitzel, k = 3, alpha = 0.05)[1], 3), 0.060)
-  expect_equal(round(loq(neitzel, k = 2, alpha = 0.05)[1], 3), 0.041)
-  expect_equal(round(loq(neitzel, k = 3, alpha = 0.01)[1], 3), 0.086)
-  expect_equal(round(loq(neitzel, k = 2, alpha = 0.01)[1], 3), 0.059)
+test_that("weights work correctly", {
+  w1 <- calibration(Area ~ Conc, data = din32645, weights = "1/Area^2") |> 
+    expect_silent()
+  w2 <- calibration(Area ~ Conc, data = din32645,
+                    weights = 1/din32645[din32645$Conc != 0, ]$Area^2) |> 
+    expect_silent()
+  wlm <- lm(Area ~ Conc, data = din32645[din32645$Conc != 0,],
+            weights = 1/din32645[din32645$Conc != 0, ]$Area^2)
+
+  expect_error(calibration(Area ~ Conc, data = din32645,
+                           weights = 1/din32645$Area^2))
+
+  expect_equal(coef(w1$model), coef(w2$model))
+  expect_equal(coef(w2$model), coef(wlm))
+  expect_false(isTRUE(all.equal(coef(alt$model), coef(w1$model))))
 })
 
-cal <- calibration(Area ~ Conc, data = din32645[din32645$Conc != 0,])
-lm <- lm(Area ~ Conc, data = din32645[din32645$Conc != 0,])
-
-test_that("calibration() and lm() give equal results for non-zero concentrations", {
-  expect_equal(coef(cal$model), coef(lm))
+test_that("print(), summary(), and plot() work", {
+  print(din) |> expect_output()
+  print(summary(din)) |> expect_output()
+  plot(din) |> expect_silent()
 })
 
-test_that("Difference between blank method and estimation from calibration curve", {
-  expect_message(alt <- calibration(Area ~ Conc,
-                                    data = din32645[din32645$Conc != 0, ]))
-  expect_false(identical(din, alt))
-  expect_equal(loq(din), loq(alt))
+test_that("snapshot output consistent", {
+  print(din) |> expect_snapshot_output()
+  print(din_woa) |> expect_snapshot_output()
+  print(neitzel) |> expect_snapshot_output()
+
+  skip_on_ci()
+  plot(din) |> save_png() |> expect_snapshot_file("plot.png")
 })
 
-test_that("Unbalanced design gives warning", {
-  suppressWarnings(
-    ublcd <- calibration(Area ~ Conc, data = rbind(din32645, din32645[15,]),
-                       check_assumptions = F)
-    )
-  expect_warning(lod(ublcd))
-  expect_warning(loq(ublcd))
+test_that("lod() and loq() handle input errors correctly", {
+  lod(1) |> expect_error()
+  loq(2) |> expect_error()
+
+  lod(din) |> expect_silent()
+  loq(din) |> expect_silent()
 })
 
-w1 <- calibration(Area ~ Conc, data = din32645, weights = "1/Area^2")
-w2 <- calibration(Area ~ Conc, data = din32645,
-                  weights = 1/din32645[din32645$Conc != 0, ]$Area^2)
-wlm <- lm(Area ~ Conc, data = din32645[din32645$Conc != 0,],
-          weights = 1/din32645[din32645$Conc != 0, ]$Area^2)
+test_that("lod() and loq() are calculated correctly", {
+  expect_equal(din$lod, lod(din))
+  expect_equal(din$loq, loq(din))
+  
+  lod(neitzel)[1] |> round(3) |> expect_equal(0.009)
 
-test_that("Weights work correctly", {
-  expect_error(calibration(Area ~ Conc, data = din32645,
-                           weights = 1/din32645$Area^2))
+  loq(neitzel, k = 3, alpha = 0.05)[1] |> round(3) |> expect_equal(0.060)
+  loq(neitzel, k = 2, alpha = 0.05)[1] |> round(3) |> expect_equal(0.041)
+  loq(neitzel, k = 3, alpha = 0.01)[1] |> round(3) |> expect_equal(0.086)
+  loq(neitzel, k = 2, alpha = 0.01)[1] |> round(3) |> expect_equal(0.059)
+})
+
+test_that("inv_predict() works as expected", {
+  inv_predict(1) |> expect_error()
+  inv_predict(din) |> expect_error()
+  ip <- inv_predict(din, 5210) |> expect_silent()
 
-  expect_equal(coef(w1$model), coef(w2$model))
-  expect_equal(coef(w2$model), coef(wlm))
-  expect_false(isTRUE(all.equal(coef(cal$model), coef(w1$model))))
+  round(ip$estimate, 3) |> expect_equal(0.282)
 })
 
+test_that("as.list() works as expected", {
+  lst <- as.list(din) |> expect_silent()
+
+  inherits(lst, "list") |> expect_true()
+
+  names(lst) |> expect_contains(c("Conc", "lod", "loq"))
+  expect_equal(lst$lod, din$lod[,1])
+  expect_equal(lst$loq, din$loq[,1])
+})

tests/testthat/test-helper-functions.R

@@ -1,17 +1,19 @@
-test_that("Bisdom scaled WDPTs work as expected", {
-  expect_equal(bisdom(c(2,6,20,3,385)), c(1, 2, 2, 1, 3))
-  expect_warning(bisdom("a string"))
-  expect_true(is.na(bisdom(NA)))
+test_that("bisdom() works as expected", {
+  bisdom(c(2,6,20,3,385)) |> expect_equal(c(1, 2, 2, 1, 3))
+  bisdom("a string") |> expect_warning()
+  bisdom(NA) |> is.na() |> expect_true()
 
   expect_identical(bisdom(3600), bisdom(4000))
 })
 
-test_that("Confidence intervals work as expected", {
-  expect_equal(round(CI(1:5), 2), 1.39)
-  expect_warning(CI(NA))
+test_that("CI() works as expected", {
+  CI(1:5) |> round(2) |> expect_equal(1.39)
+  CI(NA) |> expect_warning()
 })
 
-test_that("Root mean square errors (RMSE) work as expected", {
-  expect_equal(round(rmse(c(0.12,0.59,NA), c(0.15,0.63,1.2)), 4), 0.0354)
-  expect_true(is.na(rmse(NA, NA)))
+test_that("rmse() works as expected", {
+  rmse(c(0.12,0.59,NA), c(0.15,0.63,1.2)) |> round(4) |> expect_equal(0.0354)
+  rmse(c(0.12,0.59,NA), c(0.15,0.63,1.2), rel = T) |> round(4) |>
+    expect_equal(0.0996)
+  rmse(NA, NA) |> is.na() |> expect_true()
 })

tests/testthat/test-input-classes.R

@@ -16,4 +16,3 @@ test_that("texture() handles data.tables and tibbles well", {
   expect_silent(texture(reading ~ blank + time + temperature, data.frame(clayloam),
                         model = "W1.2"))
 })
-

tests/testthat/test-matrix_effect.R

@@ -1,16 +1,22 @@
-mlp <- runif(10, -2, 2)
-
 data(din32645)
 din <- calibration(Area ~ Conc, data = din32645)
 
-mm <- sapply(mlp, function(x){
+mlp <- runif(10, -2, 2)
+me <- sapply(mlp, function(x) {
   conc <- din32645$Conc
   area <- din32645$Area * x
   mm <- calibration(area ~ conc, check_assumptions = F)
   matrix_effect(din, mm)
-  })
+})
 
+test_that("matrix_effect() handles input errors correctly", {
+  matrix_effect(1:10) |> expect_error()
+  matrix_effect(din, 1:10) |> expect_error()
+
+  matrix_effect(din, din) |> expect_silent()
+})
 
-test_that("Matrix effect/SSE computed correctly", {
-  expect_equal(mm - mlp + 1, rep(0, 10), ignore_attr = T)
+test_that("matrix_effect() is calculated correctly", {
+  matrix_effect(din, din) |> expect_equal(0, ignore_attr = T)
+  expect_equal(me - mlp + 1, rep(0, 10), ignore_attr = T)
 })