fix proportion ci calc and theme
Gitea Organization/civilyticsR/pipeline/head There was a failure building this commit

This commit is contained in:
2024-08-09 15:05:59 -04:00
parent 4f49ae6d5a
commit 82b8db7f84
18 changed files with 481 additions and 436 deletions
+70
View File
@@ -0,0 +1,70 @@
# https://github.com/cran/binom/blob/master/R/binom.confint.R
# Consider importing and crediting this code ^^
# https://towardsdatascience.com/five-confidence-intervals-for-proportions-that-you-should-know-about-7ff5484c024f
# https://andrewpwheeler.com/2020/11/30/confidence-intervals-around-proportions/
#' Get a simple Clopper Pearson interval
#'
#' @param num
#' @param den
#' @param confint
#'
#' @return
#' @export
#'
#' @examples
clopper_pearson <- function(num, den, confint = 0.95) {
# Same results as binom.test in base R
quant <- (1 - confint) / 2
low <- qbeta(quant, num, den-num+1)
hi <- qbeta(1-quant, num+1, den-num)
obs <- num/den
return(c("low" = low, "observed" = obs,"high" = hi))
}
# TODO consider making a vectorized version
# z_gap_test_v <- Vectorize(z_gap_test,
# SIMPLIFY = TRUE)# we only want to return a scalar
#z_gap_test(a_prop = 0.051, a_count = 2000, b_prop = 0.11, b_count = 100)
#' Calculate a univariate z score by comparing to a population
#'
#' @param unit_prop proportion for the group we are comparing
#' @param global_prop the global proportion
#' @param unit_denom the population size for the group we are comparing
#'
#' @return a z-score
#' @export
#'
#' @examples
#' z_univariate(unit_prop = 0.13, global_prop = 0.11, unit_denom = 2500)
z_univariate <- function(unit_prop, global_prop, unit_denom) {
num <- unit_prop - global_prop
denom <- sqrt(
(global_prop * (1-global_prop))/unit_denom
)
z = num / denom
return(z)
}
waldInterval <- function(x, n, conf.level = 0.95){
p <- x/n
sd <- sqrt(p*((1-p)/n))
z <- qnorm(c( (1 - conf.level)/2, 1 - (1-conf.level)/2)) #returns the value of thresholds at which conf.level has to be cut at. for 95% CI, this is -1.96 and +1.96
ci <- p + z*sd
names(ci) <- c('lwr', 'upr')
return(ci)
}#example
#waldInterval(x = 20, n =40) #this will return 0.345 and 0.655
agresti_coull_interval <- function(num, den, conf.level) {
num <- num + 2
den <- den + 4
}