### error handling ### error handling test_that("proptesti() throws error for improper data types", { expect_error(proptesti(c(1,1), 10), "'x1' and 'n1' must be nonnegative integers") expect_error(proptesti(1, "10"), "'x1' and 'n1' must be nonnegative integers") expect_error(proptesti(-1, 10), "'x1' and 'n1' must be nonnegative integers") expect_error(proptesti(1, 10, c(1,1), 10), "'x2' and 'n2' must be nonnegative integers") expect_error(proptesti(1, 10, 1, "10"), "'x2' and 'n2' must be nonnegative integers") expect_error(proptesti(1, 10, -1, 10), "'x2' and 'n2' must be nonnegative integers") expect_error(proptesti(10, 1), "Number of trials must be at least as large as number of succeses.") expect_error(proptesti(1, 10, 10, 1), "Number of trials must be at least as large as number of succeses.") expect_error(proptesti(1, 10, 1), "A second number of trials must be entered for two sample test") expect_error(proptesti(1, 10, n2 = 1), "Number of successes for the second sample must be entered for two sample test") }) x1 <- rbinom(100, 1, 0.5) x2 <- rbinom(100, 1, 0.5) test_that("proptesti() throws error if alternative is not 'two.sided', 'less', or 'greater", { expect_error(proptesti(sum(x1), length(x1), alternative = "blah"), "'alternative' must be either 'less', 'two.sided', or 'greater'") }) test_that("proptesti() throws error if exact is not logical", { expect_error(proptesti(sum(x1), length(x1), exact = 2), "'exact' must be a logical.") }) test_that("proptesti() throws error for invalid conf.level", { expect_error(proptesti(sum(x1), length(x1), conf.level = 1.1), "'conf.level' must a scalar between 0 and 1.") expect_error(proptesti(sum(x1), length(x1), conf.level = TRUE), "'conf.level' must a scalar between 0 and 1.") }) test_that("proptesti() throws error for non-numeric more.digits argument", { expect_error(proptesti(sum(x1), length(x1), more.digits = TRUE), "Argument 'more.digits' must be numeric") }) test_that("proptesti() throws error for non-scalar null", { expect_error(proptesti(sum(x1), length(x1), null.hypoth = c(0.5, 0.6)), "Null must be a scalar") expect_error(proptesti(sum(x1), length(x1), null.hypoth = TRUE), "Null must be a scalar") }) test_that("proptesit() throws error for exact test on 2 samples", { expect_error(proptesti(sum(x1), length(x1), sum(x2), length(x2), exact = TRUE), "Exact binomial test not available for two samples.") }) ### one-sample test, approximate set.seed(1) a <- rbinom(100, 1, 0.5) p1 <- proptesti(sum(a), length(a)) p2 <- prop.test(sum(a), length(a), correct = FALSE) test_that("proptesti() returns correct numbers for one-sample test", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), c(p2$estimate[[1]] - 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), alternative = "less") p2 <- prop.test(sum(a), length(a), correct = FALSE, alternative = "less") test_that("proptesti() returns correct numbers for one-sample test, left-sided", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), c(0, #p2$estimate[[1]] - 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), alternative = "greater") p2 <- prop.test(sum(a), length(a), correct = FALSE, alternative = "greater") test_that("proptesti() returns correct numbers for one-sample test, right-sided", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), c(p2$estimate[[1]] - 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), 1), #p2$estimate[[1]] + 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), conf.level = 0.9) p2 <- prop.test(sum(a), length(a), correct = FALSE, conf.level = 0.9) test_that("proptesti() returns correct numbers for one-sample test, non 0.95-level", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), c(p2$estimate[[1]] - qnorm(0.95)*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + qnorm(0.95)*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) ### one-sample test, exact p1 <- proptesti(sum(a), length(a), exact = TRUE) p2 <- binom.test(sum(a), length(a)) test_that("proptesti() returns correct numbers for one-sample test, exact", { expect_s3_class(p1, "proptesti") expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), p2$conf.int[1:2], tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_true(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), exact = TRUE, alternative = "less") p2 <- binom.test(sum(a), length(a), alternative = "less") test_that("proptesti() returns correct numbers for one-sample test, exact, left-sided", { expect_s3_class(p1, "proptesti") expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), p2$conf.int[1:2], tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_true(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), exact = TRUE, alternative = "greater") p2 <- binom.test(sum(a), length(a), alternative = "greater") test_that("proptesti() returns correct numbers for one-sample test, exact, right-sided", { expect_s3_class(p1, "proptesti") expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), p2$conf.int[1:2], tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_true(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), exact = TRUE, conf.level = 0.9) p2 <- binom.test(sum(a), length(a), conf.level = 0.9) test_that("proptesti() returns correct numbers for one-sample test, exact, non-0.95 conf", { expect_s3_class(p1, "proptesti") expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[[5]], start = 2, stop = nchar(p1$tab[[5]])-1), ", ")[[1]]), p2$conf.int[1:2], tolerance = 1e-2) # conf int expect_equal(p1$tab[[1]], "var1") # var name expect_equal(as.numeric(p1$tab[[2]]), length(a)) # n obs expect_equal(as.numeric(p1$tab[[3]]), p2$estimate[[1]], tolerance = 3) # estimate of mean expect_equal(as.numeric(p1$tab[[4]]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 3) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), p2$null.value[[1]]) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_true(as.logical(p1$par[[4]])) expect_false(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) ### two-sample test, approximate b <- rbinom(100, 1, 0.5) p1 <- proptesti(sum(a), length(a), sum(b), length(b)) p2 <- prop.test(c(sum(a), sum(b)), c(length(a), length(b)), correct = FALSE) test_that("proptesti() returns correct numbers for two-sample test", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[1,5], start = 2, stop = nchar(p1$tab[1,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[2,5], start = 2, stop = nchar(p1$tab[2,5])-1), ", ")[[1]]), c(p2$estimate[[2]] - 1.96*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[2]] + 1.96*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[3,5], start = 2, stop = nchar(p1$tab[3,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - p2$estimate[[2]] - 1.96* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[1]] - p2$estimate[[2]] + 1.96* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(p1$tab[1,1], "var1") # var name expect_equal(p1$tab[2,1], "var2") # var name expect_equal(p1$tab[3,1], "Difference") # var name expect_equal(as.numeric(p1$tab[1,2]), length(a)) # n obs expect_equal(as.numeric(p1$tab[2,2]), length(b)) # n obs expect_equal(as.numeric(p1$tab[3,2]), length(a) + length(b)) # n obs expect_equal(as.numeric(p1$tab[1,3]), p2$estimate[[1]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[2,3]), p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[3,3]), p2$estimate[[1]] - p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[1,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[2,4]), sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[3,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), 0) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_true(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), sum(b), length(b), alternative = "less") p2 <- prop.test(c(sum(a), sum(b)), c(length(a), length(b)), correct = FALSE, alternative = "less") test_that("proptesti() returns correct numbers for two-sample test, left-sided", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[1,5], start = 2, stop = nchar(p1$tab[1,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[2,5], start = 2, stop = nchar(p1$tab[2,5])-1), ", ")[[1]]), c(p2$estimate[[2]] - 1.96*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[2]] + 1.96*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[3,5], start = 2, stop = nchar(p1$tab[3,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - p2$estimate[[2]] - 1.96* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[1]] - p2$estimate[[2]] + 1.96* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(p1$tab[1,1], "var1") # var name expect_equal(p1$tab[2,1], "var2") # var name expect_equal(p1$tab[3,1], "Difference") # var name expect_equal(as.numeric(p1$tab[1,2]), length(a)) # n obs expect_equal(as.numeric(p1$tab[2,2]), length(b)) # n obs expect_equal(as.numeric(p1$tab[3,2]), length(a) + length(b)) # n obs expect_equal(as.numeric(p1$tab[1,3]), p2$estimate[[1]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[2,3]), p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[3,3]), p2$estimate[[1]] - p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[1,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[2,4]), sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[3,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), 0) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_true(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), sum(b), length(b), alternative = "greater") p2 <- prop.test(c(sum(a), sum(b)), c(length(a), length(b)), correct = FALSE, alternative = "greater") test_that("proptesti() returns correct numbers for two-sample test, right-sided", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[1,5], start = 2, stop = nchar(p1$tab[1,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + 1.96*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[2,5], start = 2, stop = nchar(p1$tab[2,5])-1), ", ")[[1]]), c(p2$estimate[[2]] - 1.96*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[2]] + 1.96*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[3,5], start = 2, stop = nchar(p1$tab[3,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - p2$estimate[[2]] - 1.96* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[1]] - p2$estimate[[2]] + 1.96* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(p1$tab[1,1], "var1") # var name expect_equal(p1$tab[2,1], "var2") # var name expect_equal(p1$tab[3,1], "Difference") # var name expect_equal(as.numeric(p1$tab[1,2]), length(a)) # n obs expect_equal(as.numeric(p1$tab[2,2]), length(b)) # n obs expect_equal(as.numeric(p1$tab[3,2]), length(a) + length(b)) # n obs expect_equal(as.numeric(p1$tab[1,3]), p2$estimate[[1]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[2,3]), p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[3,3]), p2$estimate[[1]] - p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[1,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[2,4]), sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[3,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), 0) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_true(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) p1 <- proptesti(sum(a), length(a), sum(b), length(b), conf.level = 0.9) p2 <- prop.test(c(sum(a), sum(b)), c(length(a), length(b)), correct = FALSE, conf.level = 0.9) test_that("proptesti() returns correct numbers for two-sample test, right-sided", { expect_s3_class(p1, "proptesti") expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) # test statistic expect_equal(p1$pval, p2$p.value, tolerance = 1e-2) # p-value expect_equal(as.numeric(strsplit(substr(p1$tab[1,5], start = 2, stop = nchar(p1$tab[1,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - qnorm(0.95)*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), p2$estimate[[1]] + qnorm(0.95)*sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[2,5], start = 2, stop = nchar(p1$tab[2,5])-1), ", ")[[1]]), c(p2$estimate[[2]] - qnorm(0.95)*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[2]] + qnorm(0.95)*sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(as.numeric(strsplit(substr(p1$tab[3,5], start = 2, stop = nchar(p1$tab[3,5])-1), ", ")[[1]]), c(p2$estimate[[1]] - p2$estimate[[2]] - qnorm(0.95)* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), p2$estimate[[1]] - p2$estimate[[2]] + qnorm(0.95)* sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b))), tolerance = 1e-2) # conf int expect_equal(p1$tab[1,1], "var1") # var name expect_equal(p1$tab[2,1], "var2") # var name expect_equal(p1$tab[3,1], "Difference") # var name expect_equal(as.numeric(p1$tab[1,2]), length(a)) # n obs expect_equal(as.numeric(p1$tab[2,2]), length(b)) # n obs expect_equal(as.numeric(p1$tab[3,2]), length(a) + length(b)) # n obs expect_equal(as.numeric(p1$tab[1,3]), p2$estimate[[1]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[2,3]), p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[3,3]), p2$estimate[[1]] - p2$estimate[[2]], tolerance = 1e-2) # estimate of mean expect_equal(as.numeric(p1$tab[1,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[2,4]), sqrt(p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$tab[3,4]), sqrt(p2$estimate[[1]]*(1-p2$estimate[[1]])/length(a) + p2$estimate[[2]]*(1-p2$estimate[[2]])/length(b)), tolerance = 1e-2) # standard error of mean est expect_equal(as.numeric(p1$par[[1]]), 0) # null expect_equal(p1$par[[2]], p2$alternative) # alternative expect_equal(as.numeric(p1$par[[3]]), attr(p2$conf.int, "conf.level")) # conf level expect_false(as.logical(p1$par[[4]])) expect_true(as.logical(p1$par[[5]])) expect_equal(as.numeric(p1$par[[7]]), 3) # digits }) # p1 <- proptesti(sum(a), length(a), sum(b), length(b), null.hypoth = 0.6) # p2 <- proptest(a,b, null.hypoth = 0.6) # test_that("proptesti() returns correct numbers for two-sample test, nonzero null", { # expect_equal(p1$zstat, p1$zstat, tolerance = 1e-3) # test statistic # expect_equal(p1$pval, p2$pval, tolerance = 1e-3) # p-value # expect_equal(as.numeric(p1$par[[1]]), 0.6) # null # # }) ### continuity correction p1 <- proptesti(16, 20, null.hypoth = 0.6, correct = TRUE, alternative = "two.sided") p2 <- prop.test(16, 20, correct = TRUE, p = 0.6, alternative = "two.sided") test_that("proptesti() continuity correction works, one sample, two-sided", { expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) expect_equal(abs(p1$pval), p2$p.value, tolerance = 1e-2) }) p1 <- proptesti(16, 20, null.hypoth = 0.6, correct = TRUE, alternative = "less") p2 <- prop.test(16, 20, correct = TRUE, p = 0.6, alternative = "less") test_that("proptesti() continuity correction works, one sample, left-sided", { expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) expect_equal(abs(p1$pval), p2$p.value, tolerance = 1e-2) }) p1 <- proptesti(16, 20, null.hypoth = 0.6, correct = TRUE, alternative = "greater") p2 <- prop.test(16, 20, correct = TRUE, p = 0.6, alternative = "greater") test_that("proptesti() continuity correction works, one sample, right-sided", { expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) expect_equal(abs(p1$pval), p2$p.value, tolerance = 1e-2) }) p1 <- proptesti(160, 200, 150, 200, correct = TRUE, alternative = "two.sided") p2 <- prop.test(c(160, 150), c(200, 200), correct = TRUE, alternative = "two.sided") test_that("proptesti() continuity correction works, one sample, two-sided", { expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) expect_equal(abs(p1$pval), p2$p.value, tolerance = 1e-2) }) p1 <- proptesti(160, 200, 150, 200, correct = TRUE, alternative = "less") p2 <- prop.test(c(160, 150), c(200, 200), correct = TRUE, alternative = "less") test_that("proptesti() continuity correction works, one sample, left-sided", { expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) expect_equal(abs(p1$pval), p2$p.value, tolerance = 1e-2) }) p1 <- proptesti(160, 200, 150, 200, correct = TRUE, alternative = "greater") p2 <- prop.test(c(160, 150), c(200, 200), correct = TRUE, alternative = "greater") test_that("proptesti() continuity correction works, one sample, right-sided", { expect_equal(abs(p1$zstat), sqrt(p2$statistic[[1]]), tolerance = 1e-2) expect_equal(abs(p1$pval), p2$p.value, tolerance = 1e-2) })