context("Dissolution Profile Tolerance Intervals")
# The tests use the values published in the SAS/QC(R) 13.1: User's Guide,
# Chapter 5 (The Capability Procedure), details on pp 421-424. The data set is
# described on page 199: The fluid weights of 100 drink cans are measured in
# ounces. The filling process is assumed to be in statistical control. The
# measurements are saved in a SAS data set named Cans. The tolerance intervals
# calculated by the capability procedure are presented on page 416 in
# Figure 5.25. The data are put into a data frame so that the can be used for
# analysis by the mztia function.
test_that("mztia_succeeds_CAPABILITY", {
m_alpha_pp <- matrix(c(rep(c(0.01, 0.05, 0.1), each = 3),
1 - rep(c(0.1, 0.05, 0.01), times = 3)),
ncol = 2, byrow = FALSE)
ll <-
apply(m_alpha_pp, MARGIN = 1, FUN = function(x) {
mztia(data = dip5, shape = "long", tcol = 1, grouping = "type",
reference = "reference", response = "weight", na_rm = FALSE,
alpha = x[1], pp = x[2], cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)
)[["Data"]][102, "weight"]
})
ul <-
apply(m_alpha_pp, MARGIN = 1, FUN = function(x) {
mztia(data = dip5, shape = "long", tcol = 1, grouping = "type",
reference = "reference", response = "weight", na_rm = FALSE,
alpha = x[1], pp = x[2], cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)
)[["Data"]][103, "weight"]
})
# <-><-><-><->
expect_equal(signif(ll, 4), c(11.92, 11.90, 11.86, 11.92, 11.90, 11.87,
11.92, 11.91, 11.88))
expect_equal(signif(ul, 4), c(12.10, 12.12, 12.15, 12.10, 12.11, 12.15,
12.09, 12.11, 12.14))
# Results presented in SAS/QC(R) 13.1: User's Guide, Chapter 5 (The
# CAPABILITY procedure), sub-chapter INTERVALS statement: CAPABILITY
# procedure
# Figure 5.25 Statistical Intervals for Weight (pp. 415-417)
# Approximate Tolerance Interval Containing At Least Proportion p of the
# Population (p. 416)
# Confidence pp Tolerance Limits
# 99.00% 0.900 11.92 12.10
# 99.00% 0.950 11.90 12.12
# 99.00% 0.990 11.86 12.15
# 95.00% 0.900 11.92 12.10
# 95.00% 0.950 11.90 12.11
# 95.00% 0.990 11.87 12.15
# 90.00% 0.900 11.92 12.09
# 90.00% 0.950 11.91 12.11
# 90.00% 0.990 11.88 12.14
})
test_that("mztia_succeeds_with_df_shape_long", {
tmp <-
mztia(data = dip5, shape = "long", tcol = 1, grouping = "type",
reference = "reference", response = "weight", na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15))[["Data"]]
# <-><-><-><->
expect_equal(signif(tmp[101, "weight"], 9), 12.0093000)
expect_equal(signif(tmp[102, "weight"], 9), 11.8715203)
expect_equal(signif(tmp[103, "weight"], 9), 12.1470797)
expect_equal(signif(tmp[104, "weight"], 9), 6.871520286)
expect_equal(signif(tmp[105, "weight"], 9), 17.1470797)
expect_equal(signif(tmp[106, "weight"], 9), -3.1284797)
expect_equal(signif(tmp[107, "weight"], 9), 27.1470797)
})
test_that("mztia_succeeds_with_df_shape_wide", {
tmp1 <- mztia(data = dip1, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = FALSE, alpha = 0.05,
pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15))[["Data"]]
tmp2 <- mztia(data = dip1, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = FALSE, alpha = 0.05,
pp = 0.99, cap = TRUE, bounds = c(0, 100),
qs = c(5, 15))[["Data"]]
# <-><-><-><->
expect_equal(
signif(tmp1[tmp1$type1 == "Mean" & tmp1$type2 == "Mean", "response"], 9),
c(46.7716667, 60.1333333, 67.2750000, 71.9866667, 78.0700000,
84.8166667, 89.0933333, 91.4383333))
expect_equal(
signif(tmp1[tmp1$type1 == "TL" & tmp1$type2 == "LTL", "response"], 9),
c(27.2264050, 46.1548274, 56.9041726, 65.4435423, 69.5425900, 77.2027513,
76.2458801, 80.2932086))
expect_equal(
signif(tmp1[tmp1$type1 == "TL" & tmp1$type2 == "UTL", "response"], 9),
c(66.3169283, 74.1118393, 77.6458274, 78.5297910, 86.5974100, 92.4305820,
101.940787, 102.583458))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S1" & tmp1$type2 == "LTL", "response"], 9),
c(22.2264050, 41.1548274, 51.9041726, 60.4435423, 64.5425900, 72.2027513,
71.2458801, 75.2932086))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S1" & tmp1$type2 == "UTL", "response"], 9),
c(71.3169283, 79.1118393, 82.6458274, 83.5297910, 91.5974100, 97.4305820,
106.940787, 107.583458))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S2" & tmp1$type2 == "LTL", "response"], 9),
c(12.2264050, 31.1548274, 41.9041726, 50.4435423, 54.5425900, 62.2027513,
61.2458801, 65.2932086))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S2" & tmp1$type2 == "UTL", "response"], 9),
c(81.3169283, 89.1118393, 92.6458274, 93.5297910, 101.5974100, 107.430582,
116.940787, 117.583458))
expect_equal(
signif(tmp2[tmp2$type1 == "TL" & tmp2$type2 == "UTL", "response"], 9),
c(66.3169283, 74.1118393, 77.6458274, 78.5297910, 86.5974100, 92.4305820,
100.000000, 100.000000))
expect_equal(
signif(tmp2[tmp2$type1 == "TL.S1" & tmp2$type2 == "UTL", "response"], 9),
c(71.3169283, 79.1118393, 82.6458274, 83.5297910, 91.5974100, 97.4305820,
105.000000, 105.000000))
expect_equal(
signif(tmp2[tmp2$type1 == "TL.S2" & tmp2$type2 == "UTL", "response"], 9),
c(81.3169283, 89.1118393, 92.6458274, 93.5297910, 101.5974100, 107.430582,
115.000000, 115.000000))
})
test_that("mztia_sends_copes_with_NAs", {
t_dat <- dip1
t_dat[1, "t.5"] <- NA
t_dat[6, "t.10"] <- NA
t_dat[7, "t.90"] <- NaN
t_dat[12, "t.120"] <- NaN
# <-><-><-><->
tmp1 <- mztia(data = t_dat, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = TRUE, alpha = 0.05,
pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15))[["Data"]]
tmp2 <- mztia(data = t_dat, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = TRUE, alpha = 0.05,
pp = 0.99, cap = TRUE, bounds = c(0, 100),
qs = c(5, 15))[["Data"]]
# <-><-><-><->
expect_equal(
signif(tmp1[tmp1$type1 == "Mean" & tmp1$type2 == "Mean", "response"], 9),
c(47.2000000, 59.5400000, 67.0750000, 71.8075000, 77.6175000, 84.7575000,
88.1350000, 90.9825000))
expect_equal(
signif(tmp1[tmp1$type1 == "TL" & tmp1$type2 == "LTL", "response"], 9),
c(23.1311786, 37.3973672, 54.5589451, 60.5179948, 66.3326466, 71.4630750,
78.1396525, 76.5643669))
expect_equal(
signif(tmp1[tmp1$type1 == "TL" & tmp1$type2 == "UTL", "response"], 9),
c(71.2688214, 81.6826328, 79.5910549, 83.0970052, 88.9023534, 98.0519250,
98.1303475, 105.400633))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S1" & tmp1$type2 == "LTL", "response"], 9),
c(18.1311786, 32.3973672, 49.5589451, 55.5179948, 61.3326466, 66.4630750,
73.1396525, 71.5643669))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S1" & tmp1$type2 == "UTL", "response"], 9),
c(76.2688214, 86.6826328, 84.5910549, 88.0970052, 93.9023534, 103.051925,
103.130347, 110.400633))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S2" & tmp1$type2 == "LTL", "response"], 9),
c(8.13117857, 22.3973672, 39.5589451, 45.5179948, 51.3326466, 56.4630750,
63.1396525, 61.5643669))
expect_equal(
signif(tmp1[tmp1$type1 == "TL.S2" & tmp1$type2 == "UTL", "response"], 9),
c(86.2688214, 96.6826328, 94.5910549, 98.0970052, 103.9023534, 113.051925,
113.130347, 120.400633))
expect_equal(
signif(tmp2[tmp2$type1 == "TL" & tmp2$type2 == "UTL", "response"], 9),
c(71.2688214, 81.6826328, 79.5910549, 83.0970052, 88.9023534, 98.0519250,
98.1303475, 100.000000))
expect_equal(
signif(tmp2[tmp2$type1 == "TL.S1" & tmp2$type2 == "UTL", "response"], 9),
c(76.2688214, 86.6826328, 84.5910549, 88.0970052, 93.9023534, 103.0519250,
103.130347, 105.000000))
expect_equal(
signif(tmp2[tmp2$type1 == "TL.S2" & tmp2$type2 == "UTL", "response"], 9),
c(86.2688214, 96.6826328, 94.5910549, 98.0970052, 103.9023533, 113.051925,
113.130347, 115.000000))
})
test_that("mztia_sends_message", {
t_dat <- dip1
t_dat[1, "t.5"] <- NA
t_dat[6, "t.10"] <- NA
t_dat[7, "t.90"] <- NaN
t_dat[12, "t.120"] <- NaN
# <-><-><-><->
res <- expect_message(
mztia(data = t_dat, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = FALSE, alpha = 0.05,
pp = 0.99, cap = FALSE, bounds = c(0, 100), qs = c(5, 15)))
expect_equal(as.numeric(res[["Limits"]][1, ]), c(5, rep(NA_real_, 7)))
expect_equal(as.numeric(res[["Limits"]][2, ]), c(10, rep(NA_real_, 7)))
})
test_that("mztia_fails", {
tmp0 <- dip1
tmp0$t.5 <- as.factor(tmp0$t.5)
tmp1 <- dip1
tmp1$type <- as.character(tmp1$type)
# <-><-><->
expect_error(
mztia(data = as.matrix(dip1[, 3:10]), shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"data must be provided as data frame")
expect_error(
mztia(data = dip1, shape = 1, tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"shape must be a string")
expect_error(
mztia(data = dip1, shape = "weit", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"specify shape")
expect_error(
mztia(data = dip1, shape = "wide", tcol = "tico",
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"tcol must be an integer")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10 + 0.1,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"tcol must be an integer")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 7:11,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"Some columns specified by tcol were not found")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 7,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"Did you provide a data frame")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 2:6,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"Some names of columns specified by tcol")
expect_error(
mztia(data = tmp0, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"Some columns specified by tcol are not numeric")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = 5, reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"grouping must be a string")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "lot", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"grouping variable was not found")
expect_error(
mztia(data = tmp1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"grouping variable's column in data")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = 1, response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"reference must be a string")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "REF", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"The reference variable was not found")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "type", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"The reference variable was not found")
expect_error(
mztia(data = dip5, shape = "long", tcol = 3, grouping = "type",
reference = "reference", response = NULL, na_rm = FALSE, alpha = 0.05,
pp = 0.99, cap = FALSE, bounds = c(0, 100), qs = c(5, 15)),
"data frame provided via data is in long format"
)
expect_error(
mztia(data = dip5, shape = "long", tcol = 3, grouping = "type",
reference = "reference", response = 5, na_rm = FALSE, alpha = 0.05,
pp = 0.99, cap = FALSE, bounds = c(0, 100), qs = c(5, 15)),
"response must be a string of length 1"
)
expect_error(
mztia(data = dip5, shape = "long", tcol = 3, grouping = "type",
reference = "reference", response = c("type", "batch"), na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"response must be a string of length 1"
)
expect_error(
mztia(data = dip5, shape = "long", tcol = 3, grouping = "type",
reference = "reference", response = "assay", na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"response variable was not found"
)
expect_error(
mztia(data = dip5, shape = "long", tcol = 3, grouping = "type",
reference = "reference", response = "type", na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"column specified by response is not numeric"
)
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = 1,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"na_rm must be a logical"
)
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10, grouping = "type",
reference = "R", response = NULL, na_rm = c(TRUE, FALSE),
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"na_rm must be a logical"
)
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = -1, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"specify alpha")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 9, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"specify alpha")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = -1, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"specify pp")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 9, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15)),
"specify pp")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, alpha = 0.05,
pp = 0.99, cap = 0, bounds = c(0, 100), qs = c(5, 15)),
"cap must be a logical")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, alpha = 0.05,
pp = 0.99, cap = FALSE, bounds = c("l", "u"), qs = c(5, 15)),
"bounds must be a numeric vector")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(5, 50, 90),
qs = c(5, 15)),
"bounds must be a numeric vector")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(100, 0),
qs = c(5, 15)),
"specify bounds in the form")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c("l", "u")),
"qs must be a numeric vector")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 15, 30)),
"qs must be a numeric vector")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(-5, 15)),
"specify qs in the range")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(5, 105)),
"specify qs in the range")
expect_error(
mztia(data = dip1, shape = "wide", tcol = 3:10,
grouping = "type", reference = "R", response = NULL, na_rm = FALSE,
alpha = 0.05, pp = 0.99, cap = FALSE, bounds = c(0, 100),
qs = c(15, 5)),
"Q S1 must be smaller Q S2")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.