Skip to content

Commit

Permalink
Improve unit tests
Browse files Browse the repository at this point in the history
  • Loading branch information
zsteinmetz committed Sep 12, 2023
1 parent 6070f0f commit 74c54e0
Show file tree
Hide file tree
Showing 14 changed files with 262 additions and 173 deletions.
19 changes: 8 additions & 11 deletions R/calibration.R
Expand Up @@ -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)
Expand Down
11 changes: 7 additions & 4 deletions R/texture.R
Expand Up @@ -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.
#'
Expand All @@ -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
Expand Down Expand Up @@ -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, ...) {
Expand Down
11 changes: 7 additions & 4 deletions man/texture.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion tests/testthat/_snaps/calibration.md
@@ -1,4 +1,4 @@
# Snapshot output consistent
# snapshot output consistent


Call:
Expand Down
2 changes: 1 addition & 1 deletion 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
Expand Down
2 changes: 1 addition & 1 deletion 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
Expand Down
137 changes: 86 additions & 51 deletions tests/testthat/test-calibration.R
Expand Up @@ -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])
})
22 changes: 12 additions & 10 deletions 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()
})
1 change: 0 additions & 1 deletion tests/testthat/test-input-classes.R
Expand Up @@ -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"))
})

18 changes: 12 additions & 6 deletions 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)
})

0 comments on commit 74c54e0

Please sign in to comment.