R/ratio.prop.ps.R

In cwendorf/DGB: DGB

# DGB
## Ratio of Proportions from Paired Samples

ci.ratio.prop.ps <- function(alpha, f1, f2, f12) {
 # Computes Bonett-Price confidence interval for a ratio of
 # population proportions in a within-subjects design
 # Arguments:
 #   alpha:  alpha level for 1-alpha confidence
 #   f12:    number of participants who have attribute
 #           in condition 1 and condition 2     
 #   f1:     number of participants who have attribute
 #           in condition 1
 #   f2:     number of participants who have attribute
 #           in condition 2
 # Values:
 #   lower limit, upper limit
 z <- qnorm(1 - alpha/2)
 n0 <- f1 + f2 - f12
 p1 <- f1/n0
 p2 <- f2/n0
 f12 <- f1 - f12
 f21 <- f2 - f12
 p1a <- (f1 + 1)/(n0 + 2)
 p2a <- (f2 + 1)/(n0 + 2)
 se.lnp1 <- sqrt((1 - p1a)/((n0 + 2)*p1a)) 
 se.lnp2 <- sqrt((1 - p2a)/((n0 + 2)*p2a))
 se.diff <- sqrt((f12 + f21 + 2)/((f1 + 1)*(f2 + 1)))
 k <- se.diff/(se.lnp1 + se.lnp2)
 z0 <- k*z
 b = 2*(n0 + z0^2)
 LL1 <- (2*f1 + z0^2 - z0*sqrt(z0^2 + 4*f1*(1 - p1)))/b
 UL1 <- (2*f1 + z0^2 + z0*sqrt(z0^2 + 4*f1*(1 - p1)))/b
 LL2 <- (2*f2 + z0^2 - z0*sqrt(z0^2 + 4*f2*(1 - p2)))/b
 UL2 <- (2*f2 + z0^2 + z0*sqrt(z0^2 + 4*f2*(1 - p2)))/b
 LL <- exp(log(LL1) - log(UL2))
 UL <- exp(log(UL1) - log(LL2))
 CI <- c(LL, UL)
 return(CI)
}

size.ci.ratio.prop.ps <- function(alpha, p1, p2, phi, r) {
 # Computes sample size per group required to estimate a difference
 # of proportions in 2-group design with desired precision
 # Arguments: 
 #   alpha:  alpha level for 1-alpha confidence 
 #   p1:     planning value of proportion for group 1
 #   p2:     planning value of proportion for group 2
 #   phi:    planning value of phi coefficient
 #   r:      desired upper to lower interval endpoint ratio
 # Values:
 #   required sample size
 z <- qnorm(1 - alpha/2)
 cov <- phi*sqrt((1 - p1)*(1 - p2)/(p1*p2))
 n <- ceiling(4*((1 - p1)/p1 + (1 - p2)/p2 - 2*cov)*(z/log(r))^2)
 return(n)
}