Nothing
context("Outcome Rates")
# vector with all possible classifications
x1 <- c(
"I", "P", "I", "NC", "UH", "I", "R", "UO",
"I", "O", "P", "I", "R", "O", "P", "NE"
)
# expected rates if e = 0.5
res1 <- c(
RR1 = 1 / 3, RR2 = 8 / 15, RR3 = 5 / 14, RR4 = 4 / 7,
RR5 = 5 / 13, RR6 = 8 / 13, COOP1 = 5 / 12, COOP2 = 2 / 3,
COOP3 = 1 / 2, COOP4 = 4 / 5, REF1 = 2 / 15, REF2 = 1 / 7,
REF3 = 2 / 13, CON1 = 4 / 5, CON2 = 6 / 7, CON3 = 12 / 13,
LOC1 = 13 / 15, LOC2 = 39 / 42
)
# vectors with missing classifications
x2 <- c("P", "NC", "UH", "R", "UO")
e <- 13 / 14
test_that("Outcome rates produce known expected results", {
expect_equal(outcomerate(x1, e = 0.5), res1)
})
# test_that("Outcome rates produce known expected results", {
# e <- eligibility_rate(x1)
# expect_equal(outcomerate(x1, e = e), res1["RR2"])
# })
test_that("Weighted rates produce known expected results", {
# test with equal weighting
w <- rep(3, length(x1))
res1w <- stats::setNames(res1, paste0(names(res1), "w"))
expect_equal(outcomerate(x1, weight = w, e = 0.5), res1w)
# test with unequal weights
w1 <- w2 <- c(
3.2, 0.4, 4.9, 3.8, 1.6, 3.3, 1.3, 2.2, 3.5,
3.6, 0.1, 1.6, 1.1, 4.3, 2.3, 0.6
)
expect_equal(outcomerate(x1, weight = w1, rate = "RR2"),
expected = c(RR2w = 19.3 / 37.2)
)
# '0' weights
w2[5] <- 0
expect_warning(outcomerate(x1, weight = w2), regexp = "zero")
})
test_that("Should return numerator and denominator if asked", {
res <- structure(c(12, 15), .Dim = 1:2, .Dimnames = structure(list(
rate = "CON1", side = c("NUM", "DEN")
), .Names = c("rate", "side")))
expect_equal(outcomerate(x1, rate = "CON1", return_nd = TRUE),
expected = res
)
})
test_that("Scrambling input vector should not alter the output", {
# character input
r1 <- outcomerate(x1, e = 0.3)
r2 <- outcomerate(sample(x1), e = 0.3)
expect_equal(r1, r2)
# numeric input
freq <- c(I = 3, P = 4, NC = 8, R = 7, O = 11, UO = 3, UH = 1)
r3 <- outcomerate(freq, e = 0.3)
r4 <- outcomerate(sample(freq), e = 0.3)
expect_equal(r3, r4)
})
test_that("Low-count outcome cases should return 0's and NaNs", {
res <- c(
RR1 = 0, RR2 = 0, RR3 = 0, RR4 = 0, RR5 = NaN,
RR6 = NaN, COOP1 = NaN, COOP2 = NaN, COOP3 = NaN, COOP4 = NaN,
REF1 = 0, REF2 = 0, REF3 = NaN, CON1 = 0, CON2 = 0, CON3 = NaN,
LOC1 = 0, LOC2 = 0
)
expect_equal(outcomerate("UO", e = 0.3), res)
})
test_that("outcomerate should work on a table object", {
tab <- table(x1)
expect_equal(outcomerate(tab, e = 0.5), res1)
})
test_that("outcomerate should work on factors", {
# set-up factors
levs <- c("I", "P", "R", "NC", "O", "UH", "UO", "NE")
f1 <- as.factor(x1)
f2 <- factor(x1, levels = levs)
f3 <- factor(x1, levels = rev(levs), ordered = TRUE)
expect_equal(outcomerate(f1, e = 0.5), res1)
expect_equal(outcomerate(f2, e = 0.5), res1)
expect_equal(outcomerate(f3, e = 0.5), res1)
})
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.