tests/testthat/test_rSSP.R

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)
})

Try the rSSP package in your browser

Any scripts or data that you put into this service are public.

rSSP documentation built on Sept. 15, 2026, 1:09 a.m.