Power Calculations for Exact Test of a simple null hypothesis in a Bernoulli experiment

Share:

Description

Compute power of test, or determine parameters to obtain target power.

Usage

1
2
power.binom.test(n = NULL, p0 = NULL, pa = NULL, sig.level = 0.05,
  power = NULL, alternative = c("two.sided", "less", "greater"))

Arguments

n

Number of observations

p0

Probability under the null

pa

Probability under the alternative

sig.level

Significance level (Type I error probability)

power

Power of test (1 minus Type II error probability)

alternative

One- or two-sided test

Details

The procedure uses uniroot to find the root of a discontinuous function so some errors may pop up due to the given setup that causes the root-finding procedure to fail. Also, since exact binomial tests are used we have discontinuities in the function that we use to find the root of but despite this the function is usually quite stable.

Value

Object of class power.htest, a list of the arguments (including the computed one) augmented with method and note elements.

Author(s)

Claus Ekstrom claus@rprimer.dk

See Also

binom.test

Examples

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--	or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function (n = NULL, p0 = NULL, pa = NULL, sig.level = 0.05, power = NULL, 
    alternative = c("two.sided", "less", "greater")) 
{
    if (sum(sapply(list(n, p0, pa, power, sig.level), is.null)) != 
        1) 
        stop("exactly one of 'n', 'p0', 'pa', 'power', and 'sig.level' must be NULL")
    if (!is.null(sig.level) && !is.numeric(sig.level) || any(0 > 
        sig.level | sig.level > 1)) 
        stop("'sig.level' must be numeric in [0, 1]")
    alternative <- match.arg(alternative)
    pfun <- function(n, p0, pa, sig.level, alternative) {
        n <- ceiling(n)
        power <- switch(alternative, less = {
            pbinom(qbinom(1 - sig.level, size = n, prob = p0, 
                lower.tail = FALSE) - 1, size = n, prob = pa)
        }, greater = {
            pbinom(qbinom(1 - sig.level, size = n, prob = p0), 
                size = n, prob = pa, lower.tail = FALSE)
        }, two.sided = {
            lx <- qbinom(sig.level, size = n, prob = p0)
            ux <- qbinom(sig.level, size = n, prob = p0, lower.tail = FALSE)
            x <- c(seq(0, lx), seq(ux, n))
            d <- dbinom(x, size = n, prob = p0)
            ordd <- order(d)
            cs <- cumsum(sort(d))
            xval <- which.min(cs < sig.level) - 1
            ssh <- d[ordd[xval]]
            relErr <- 1 + 1e-07
            m <- n * p0
            if (xval == 0) return(0)
            if (x[ordd[xval]] < m) {
                i <- seq.int(from = ux, to = n)
                y <- sum(dbinom(i, n, p0) <= ssh * relErr)
                pbinom(x[ordd[xval]], size = n, prob = pa) + 
                  pbinom(n - y, size = n, prob = pa, lower.tail = FALSE)
            } else {
                i <- seq.int(from = 0, to = lx)
                y <- sum(dbinom(i, n, p0) <= ssh * relErr)
                pbinom(y - 1, size = n, prob = pa) + pbinom(x[ordd[xval]] - 
                  1, n, pa, lower.tail = FALSE)
            }
        })
        power
    }
    p.body <- Vectorize(pfun)
    ppp <- body(p.body)
    qqq <- quote({
        do.call("mapply", c(FUN = pfun, list(n, p0, pa, sig.level, 
            alternative), SIMPLIFY = TRUE, USE.NAMES = TRUE))
    })
    if (is.null(power)) 
        power <- eval(qqq)
    else if (is.null(n)) {
        ans <- uniroot(function(n) eval(qqq) - power, c(2, 1e+06))
        n <- ans$root + (ans$f.root < 0)
    }
    else if (is.null(p0)) 
        p0 <- uniroot(function(p0) eval(p.body) - power, c(1e-07, 
            1 - 1e-07))$root
    else if (is.null(pa)) 
        pa <- uniroot(function(pa) eval(p.body) - power, c(1e-07, 
            1 - 1e-07))$root
    else if (is.null(sig.level)) 
        sig.level <- uniroot(function(sig.level) eval(p.body) - 
            power, c(1e-10, 1 - 1e-10))$root
    else stop("internal error", domain = NA)
    NOTE <- NULL
    METHOD <- "One-sample exact binomial power calculation"
    structure(list(n = n, p0 = p0, pa = pa, sig.level = sig.level, 
        power = power, alternative = alternative, note = NOTE, 
        method = METHOD), class = "power.htest")
  }

Want to suggest features or report bugs for rdrr.io? Use the GitHub issue tracker.