Nothing
library(testthat)
# ============================================================
# Tests for single_asip()
# ============================================================
test_that("single_asip returns correct output", {
p <- c(0.3067, 0.6251, 0.8818, 0.9756)
a <- c(0.628, 0.942, 1.250, 1.500)
b <- 1
result <- single_asip(
p = p,
a = a,
b = b,
be = 0.25,
c = 0
)
expect_s3_class(result, "data.frame")
expect_equal(nrow(result), 4)
expect_true(
all(c("a", "b", "p", "be", "c", "n", "Pa") %in%
names(result))
)
expect_true(all(result$n > 0))
expect_true(all(result$n == floor(result$n)))
expect_true(all(result$Pa >= 0 & result$Pa <= 1))
# Main producer's risk condition
expect_true(all(result$Pa <= result$be))
})
# ============================================================
# Test minimum sample size condition
# ============================================================
test_that("single_asip satisfies producer's risk condition", {
p <- c(0.20, 0.40, 0.60)
result <- single_asip(
p = p,
a = 1,
b = 1,
be = 0.25,
c = 0
)
expect_true(all(result$n >= 1))
expect_true(all(result$n == floor(result$n)))
expect_true(all(result$Pa <= 0.25))
})
# ============================================================
# Test scalar a and b
# ============================================================
test_that("single_asip handles scalar a and b", {
p <- c(0.30, 0.60, 0.90)
result <- single_asip(
p = p,
a = 1,
b = 1,
be = 0.25,
c = 0
)
expect_equal(nrow(result), 3)
expect_equal(result$a, rep(1, 3))
expect_equal(result$b, rep(1, 3))
})
# ============================================================
# Test vector a and scalar b
# ============================================================
test_that("single_asip handles vector a and scalar b", {
p <- c(0.30, 0.50, 0.70)
a <- c(0.5, 1, 1.5)
result <- single_asip(
p = p,
a = a,
b = 1,
be = 0.25,
c = 0
)
expect_equal(result$a, a)
expect_equal(result$b, rep(1, 3))
expect_equal(result$p, p)
expect_equal(nrow(result), 3)
})
# ============================================================
# Test vector a and vector b
# ============================================================
test_that("single_asip handles vector a and b", {
p <- c(0.30, 0.50, 0.70)
a <- c(0.5, 1, 1.5)
b <- c(1, 2, 3)
result <- single_asip(
p = p,
a = a,
b = b,
be = 0.25,
c = 0
)
expect_equal(result$a, a)
expect_equal(result$b, b)
expect_equal(result$p, p)
expect_equal(nrow(result), 3)
})
# ============================================================
# Test invalid p
# ============================================================
test_that("single_asip rejects invalid p", {
expect_error(
single_asip(
p = c(-0.1, 0.5),
a = 1,
b = 1
)
)
expect_error(
single_asip(
p = c(0.5, 1.1),
a = 1,
b = 1
)
)
})
# ============================================================
# Test invalid a
# ============================================================
test_that("single_asip rejects invalid a", {
expect_error(
single_asip(
p = 0.5,
a = 0,
b = 1
)
)
expect_error(
single_asip(
p = 0.5,
a = -1,
b = 1
)
)
})
# ============================================================
# Test invalid b
# ============================================================
test_that("single_asip rejects invalid b", {
expect_error(
single_asip(
p = 0.5,
a = 1,
b = 0
)
)
expect_error(
single_asip(
p = 0.5,
a = 1,
b = -1
)
)
})
# ============================================================
# Test invalid producer's risk
# ============================================================
test_that("single_asip rejects invalid be", {
expect_error(
single_asip(
p = 0.5,
a = 1,
b = 1,
be = 0
)
)
expect_error(
single_asip(
p = 0.5,
a = 1,
b = 1,
be = 1
)
)
})
# ============================================================
# Test invalid acceptance number
# ============================================================
test_that("single_asip rejects invalid c", {
expect_error(
single_asip(
p = 0.5,
a = 1,
b = 1,
c = -1
)
)
expect_error(
single_asip(
p = 0.5,
a = 1,
b = 1,
c = 1.5
)
)
})
# ============================================================
# Test incompatible lengths
# ============================================================
test_that("single_asip rejects incompatible lengths", {
expect_error(
single_asip(
p = c(0.3, 0.5, 0.7),
a = c(0.5, 1),
b = 1,
be = 0.25,
c = 0
)
)
expect_error(
single_asip(
p = c(0.3, 0.5, 0.7),
a = 1,
b = c(1, 2),
be = 0.25,
c = 0
)
)
})
# ============================================================
# Tests for plot_single_asip()
# ============================================================
test_that("plot_single_asip returns correct output", {
p <- c(0.30, 0.60, 0.90)
a <- c(0.5, 1, 1.5)
result <- plot_single_asip(
p = p,
a = a,
b = 1,
be = 0.25,
c = 0
)
expect_s3_class(result, "data.frame")
expect_equal(nrow(result), 3)
expect_true(
all(c("a", "b", "p", "be", "c", "n", "Pa") %in%
names(result))
)
expect_true(all(result$n > 0))
expect_true(all(result$n == floor(result$n)))
expect_true(all(result$Pa >= 0 & result$Pa <= 1))
expect_true(all(result$Pa <= result$be))
})
# ============================================================
# Test plot_single_asip with user-supplied ylim
# ============================================================
test_that("plot_single_asip accepts user supplied ylim", {
p <- c(0.05, 0.10, 0.15, 0.20)
result <- plot_single_asip(
p = p,
a = c(0.5, 1, 1.5, 2),
b = 1,
be = 0.25,
c = 0,
ylim = c(0, 50)
)
expect_s3_class(result, "data.frame")
expect_equal(nrow(result), 4)
expect_true(
all(c("a", "b", "p", "be", "c", "n", "Pa") %in%
names(result))
)
expect_true(all(result$n > 0))
expect_true(all(result$n == floor(result$n)))
expect_true(all(result$Pa >= 0 & result$Pa <= 1))
expect_true(all(result$Pa <= result$be))
})
# ============================================================
# Test plot_single_asip gives same calculation as single_asip
# ============================================================
test_that("plot_single_asip gives same results as single_asip", {
p <- c(0.20, 0.40, 0.60)
a <- c(0.5, 1, 1.5)
result1 <- single_asip(
p = p,
a = a,
b = 1,
be = 0.25,
c = 0
)
result2 <- plot_single_asip(
p = p,
a = a,
b = 1,
be = 0.25,
c = 0,
ylim = c(0, 50)
)
expect_equal(result2$a, result1$a)
expect_equal(result2$b, result1$b)
expect_equal(result2$p, result1$p)
expect_equal(result2$n, result1$n)
expect_equal(result2$Pa, result1$Pa)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.