fix proportion ci calc and theme #2
@@ -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
|
||||||
|
|
||||||
|
}
|
||||||
@@ -22,14 +22,14 @@ theme_civilytics <-
|
|||||||
theme(
|
theme(
|
||||||
line = element_line(
|
line = element_line(
|
||||||
color = "black",
|
color = "black",
|
||||||
size = line_size,
|
linewidth = line_size,
|
||||||
linetype = 1,
|
linetype = 1,
|
||||||
lineend = "butt"
|
lineend = "butt"
|
||||||
),
|
),
|
||||||
rect = element_rect(
|
rect = element_rect(
|
||||||
fill = NA,
|
fill = NA,
|
||||||
color = NA,
|
color = NA,
|
||||||
size = line_size,
|
linewidth = line_size,
|
||||||
linetype = 1
|
linetype = 1
|
||||||
),
|
),
|
||||||
text = element_text(
|
text = element_text(
|
||||||
@@ -46,7 +46,7 @@ theme_civilytics <-
|
|||||||
),
|
),
|
||||||
axis.line = element_line(
|
axis.line = element_line(
|
||||||
color = "black",
|
color = "black",
|
||||||
size = line_size,
|
linewidth = line_size,
|
||||||
lineend = "square"
|
lineend = "square"
|
||||||
),
|
),
|
||||||
axis.line.x = NULL,
|
axis.line.x = NULL,
|
||||||
@@ -62,7 +62,7 @@ theme_civilytics <-
|
|||||||
axis.text.y.right = element_text(margin = margin(l = small_size / 4),
|
axis.text.y.right = element_text(margin = margin(l = small_size / 4),
|
||||||
hjust = 0),
|
hjust = 0),
|
||||||
axis.ticks = element_line(color = "black",
|
axis.ticks = element_line(color = "black",
|
||||||
size = line_size),
|
linewidth = line_size),
|
||||||
axis.ticks.length = unit(half_line / 2,
|
axis.ticks.length = unit(half_line / 2,
|
||||||
"pt"),
|
"pt"),
|
||||||
axis.title.x = element_text(margin = margin(t = half_line / 2),
|
axis.title.x = element_text(margin = margin(t = half_line / 2),
|
||||||
|
|||||||
@@ -308,35 +308,8 @@ z_gap_test <- function(a_prop, a_count, b_prop, b_count) {
|
|||||||
return(z)
|
return(z)
|
||||||
}
|
}
|
||||||
|
|
||||||
# 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)
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
# TODO: Consider vectorizing
|
# TODO: Consider vectorizing
|
||||||
#z_univariate_v <- Vectorize(z_univariate, SIMPLIFY = TRUE)
|
#z_univariate_v <- Vectorize(z_univariate, SIMPLIFY = TRUE)
|
||||||
|
|
||||||
|
|||||||
@@ -0,0 +1,2 @@
|
|||||||
|
# test prop intervals
|
||||||
|
|
||||||
Reference in New Issue
Block a user