Merge pull request 'fix proportion ci calc and theme' (#2) from feature-prop_int into master

Reviewed-on: #2

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: civilytics
 Type: Package
 Title: Utilities Functions for Civilytics
-Version: 0.1.0
+Version: 0.2.0
 Author: Jared E. Knowles <jared@civilytics.com>
 Maintainer: Jared E. Knowles <jared@civilytics.com>
 Description: House R functions for Civilytics Consulting LLC
@@ -23,4 +23,4 @@ Encoding: UTF-8
 LazyData: true
 Suggests: 
     testthat
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2

Jenkinsfile

@@ -24,11 +24,11 @@ pipeline {
         stage('Check') {
           steps {
             sh '''
-            R CMD check --no-manual civilytics_0.1.0.tar.gz
+            R CMD check --no-manual civilytics_0.2.0.tar.gz
             '''
 
             sh '''
-            R CMD INSTALL civilytics_0.1.0.tar.gz
+            R CMD INSTALL civilytics_0.2.0.tar.gz
             '''
           }
         }
@@ -50,7 +50,7 @@ pipeline {
         steps {
 
           sh '''
-          rm -rf civilytics_0.1.0.tar.gz civilytics.Rcheck
+          rm -rf civilytics_0.2.0.tar.gz civilytics.Rcheck
           '''
       }
     }

NAMESPACE

@@ -2,6 +2,7 @@
 
 export(add_logo)
 export(add_logo_ga)
+export(clopper_pearson)
 export(countCleanr)
 export(countDots)
 export(countNA)
@@ -26,11 +27,15 @@ export(pretty_count)
 export(pretty_per)
 export(race_short_names)
 export(random_round)
+export(rnh)
+export(round_to_nearest_half)
 export(safe_max)
 export(safe_ratio)
 export(simpleCap)
 export(star_subs)
 export(theme_civilytics)
+export(trim_max)
+export(waldInterval)
 export(z_gap_test)
 export(z_univariate)
 import(ggplot2)
@@ -43,6 +48,8 @@ importFrom(grid,rasterGrob)
 importFrom(gridExtra,arrangeGrob)
 importFrom(jpeg,readJPEG)
 importFrom(png,readPNG)
+importFrom(stats,qbeta)
+importFrom(stats,qnorm)
 importFrom(stats,runif)
 importFrom(stringdist,stringsim)
 importFrom(stringr,str_count)

R/civilytics-package.R

@@ -0,0 +1,10 @@
+#' @keywords internal
+#' @importFrom stats qbeta
+#' @importFrom stats qnorm
+"_PACKAGE"
+
+## usethis namespace: start
+## usethis namespace: end
+NULL
+
+

R/prop_conf.R

@@ -0,0 +1,85 @@
+
+
+# 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 number of successes
+#' @param den number of trials
+#' @param conf.level default 0.95, set the confidence interval to return
+#'
+#' @return three values forming the upper and lower bounds of the confidence region and the true value
+#' @export
+clopper_pearson <- function(num, den, conf.level = 0.95) {
+  # Same results as binom.test in base R
+  quant <- (1 - conf.level) / 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))
+}
+
+
+# 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)
+
+}
+
+#' Calculate a Wald interval
+#'
+#' @param x the numerator, number of times the event occurs
+#' @param n the denominator, the number of trials
+#' @param conf.level default 0.95, set the confidence interval to return
+#'
+#' @return two values forming the upper and lower bounds of the confidence region
+#' @export
+#'
+#' @examples
+#' waldInterval(x = 20, n =40) #this will return 0.345 and 0.655
+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)
+}
+
+#' Calculate the Agresti-Coull interval
+#'
+#' @param num a number of successes
+#' @param den a number of trials
+#' @param conf.level default 0.95, set the confidence interval to return
+#'
+#' @return an interval
+agresti_coull_interval <- function(num, den, conf.level) {
+  num <- num + 2
+  den <- den + 4
+  return(num/den)
+
+}

R/theme.R

@@ -22,14 +22,14 @@ theme_civilytics <-
       theme(
         line = element_line(
           color = "black",
-          size = line_size,
+          linewidth = line_size,
           linetype = 1,
           lineend = "butt"
         ),
         rect = element_rect(
           fill = NA,
           color = NA,
-          size = line_size,
+          linewidth = line_size,
           linetype = 1
         ),
         text = element_text(
@@ -46,7 +46,7 @@ theme_civilytics <-
         ),
         axis.line = element_line(
           color = "black",
-          size = line_size,
+          linewidth = line_size,
           lineend = "square"
         ),
         axis.line.x = NULL,
@@ -62,7 +62,7 @@ theme_civilytics <-
         axis.text.y.right = element_text(margin = margin(l = small_size / 4),
                                          hjust = 0),
         axis.ticks = element_line(color = "black",
-                                  size = line_size),
+                                  linewidth = line_size),
         axis.ticks.length = unit(half_line / 2,
                                  "pt"),
         axis.title.x = element_text(margin = margin(t = half_line / 2),

R/utils.R

@@ -158,7 +158,7 @@ race_short_names <- function(x) {
 #' na_sum(x) # 15
 na_sum <- function(x) {
   stopifnot(is.numeric(x))
-  message("Taking a sum with missing values equal to 0, be careful! \u1F601")
+  message("Taking a sum with missing values equal to 0, be careful!")
   x <- na_zero(x)
   return(sum(x))
 }
@@ -308,35 +308,8 @@ z_gap_test <- function(a_prop, a_count, b_prop, b_count) {
   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
 #z_univariate_v <- Vectorize(z_univariate, SIMPLIFY = TRUE)
 
@@ -403,3 +376,72 @@ safe_ratio <- function(num, denom) {
   y <- num / denom
   return(y)
 }
+
+
+
+#' Take the maximum of a number after trimming values
+#'
+#' @param vec a numeric vector
+#' @param n integer, the number of maximum values to trim before taking the maximum
+#'
+#' @return the highest value after removing the highest n values
+#' @export
+#'
+#' @examples
+#' trim_max(c(10, 10, 10, 9, 8, 7), n = 2)
+#' trim_max(c(10, 10, 10, 9, 8, 7), n = 3)
+#' trim_max(c(10, 10, 10, 9, 8, 7), n = 4)
+trim_max <- function(vec, n) {
+  # Sort vector ascending
+  sorted_vec <- sort(vec)
+  end_point <- length(vec) - n
+  if (end_point <= 0) {
+    return(1)
+  }
+  # Exclude n largest (most extreme) values
+  filtered_vec <- sorted_vec[(1:(length(vec)-n))]
+  # Find the maximum value among excluded values if any exist
+  max_value <- max(filtered_vec, na.rm = TRUE)
+  return(max_value)
+}
+
+
+#' Round values to the nearest 0.5
+#'
+#' @param x a numeric vector to round
+#'
+#' @return a numeric vector with all elements rounded to 0, 0.5, or 1
+#' @export
+#'
+#' @examples
+#' round_to_nearest_half(0.9)
+#' round_to_nearest_half(0.7)
+#' round_to_nearest_half(0.4)
+round_to_nearest_half <- function(x) {
+  if (x %% 1 == 0) {  # If x is already an integer, no change needed
+    return(as.integer(x))
+  } else {
+    decimal_part <- x - floor(x)
+    if (decimal_part >= 0.25 & decimal_part < 0.75) {
+      rounded_x <- floor(x) + 0.5
+    } else {
+      rounded_x <- round(x, 0)
+    }
+    return(rounded_x)
+  }
+}
+
+
+#'  Round values to the nearest 0.5
+#'
+#' @inheritParams round_to_nearest_half
+#'
+#' @return a numeric vector with all elements rounded to 0, 0.5, or 1
+#' @export
+#'
+#' @examples
+#' rnh(c(0.2, 0.3, 0.4, 0.8, 0.09, 0.9))
+rnh <- function(x) {
+  tmp <- Vectorize(civilytics::round_to_nearest_half)
+  tmp(x)
+}

man/agresti_coull_interval.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/prop_conf.R
+\name{agresti_coull_interval}
+\alias{agresti_coull_interval}
+\title{Calculate the Agresti-Coull interval}
+\usage{
+agresti_coull_interval(num, den, conf.level)
+}
+\arguments{
+\item{num}{a number of successes}
+
+\item{den}{a number of trials}
+
+\item{conf.level}{default 0.95, set the confidence interval to return}
+}
+\value{
+an interval
+}
+\description{
+Calculate the Agresti-Coull interval
+}

man/civilytics-package.Rd

@@ -0,0 +1,11 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/civilytics-package.R
+\docType{package}
+\name{civilytics-package}
+\alias{civilytics}
+\alias{civilytics-package}
+\title{civilytics: Utilities Functions for Civilytics}
+\description{
+House R functions for Civilytics Consulting LLC This package implements a variety of useful functions for creating and branding analyses produced by Civilytics Consulting LLC.
+}
+\keyword{internal}

man/clopper_pearson.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/prop_conf.R
+\name{clopper_pearson}
+\alias{clopper_pearson}
+\title{Get a simple Clopper Pearson interval}
+\usage{
+clopper_pearson(num, den, conf.level = 0.95)
+}
+\arguments{
+\item{num}{number of successes}
+
+\item{den}{number of trials}
+
+\item{conf.level}{default 0.95, set the confidence interval to return}
+}
+\value{
+three values forming the upper and lower bounds of the confidence region and the true value
+}
+\description{
+Get a simple Clopper Pearson interval
+}

man/rnh.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{rnh}
+\alias{rnh}
+\title{Round values to the nearest 0.5}
+\usage{
+rnh(x)
+}
+\arguments{
+\item{x}{a numeric vector to round}
+}
+\value{
+a numeric vector with all elements rounded to 0, 0.5, or 1
+}
+\description{
+Round values to the nearest 0.5
+}
+\examples{
+rnh(c(0.2, 0.3, 0.4, 0.8, 0.09, 0.9))
+}

man/round_to_nearest_half.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{round_to_nearest_half}
+\alias{round_to_nearest_half}
+\title{Round values to the nearest 0.5}
+\usage{
+round_to_nearest_half(x)
+}
+\arguments{
+\item{x}{a numeric vector to round}
+}
+\value{
+a numeric vector with all elements rounded to 0, 0.5, or 1
+}
+\description{
+Round values to the nearest 0.5
+}
+\examples{
+round_to_nearest_half(0.9)
+round_to_nearest_half(0.7)
+round_to_nearest_half(0.4)
+}

man/trim_max.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{trim_max}
+\alias{trim_max}
+\title{Take the maximum of a number after trimming values}
+\usage{
+trim_max(vec, n)
+}
+\arguments{
+\item{vec}{a numeric vector}
+
+\item{n}{integer, the number of maximum values to trim before taking the maximum}
+}
+\value{
+the highest value after removing the highest n values
+}
+\description{
+Take the maximum of a number after trimming values
+}
+\examples{
+trim_max(c(10, 10, 10, 9, 8, 7), n = 2)
+trim_max(c(10, 10, 10, 9, 8, 7), n = 3)
+trim_max(c(10, 10, 10, 9, 8, 7), n = 4)
+}

man/waldInterval.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/prop_conf.R
+\name{waldInterval}
+\alias{waldInterval}
+\title{Calculate a Wald interval}
+\usage{
+waldInterval(x, n, conf.level = 0.95)
+}
+\arguments{
+\item{x}{the numerator, number of times the event occurs}
+
+\item{n}{the denominator, the number of trials}
+
+\item{conf.level}{default 0.95, set the confidence interval to return}
+}
+\value{
+two values forming the upper and lower bounds of the confidence region
+}
+\description{
+Calculate a Wald interval
+}
+\examples{
+waldInterval(x = 20, n =40) #this will return 0.345 and 0.655
+}

man/z_univariate.Rd

@@ -1,5 +1,5 @@
 % Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/utils.R
+% Please edit documentation in R/prop_conf.R
 \name{z_univariate}
 \alias{z_univariate}
 \title{Calculate a univariate z score by comparing to a population}

tests/testthat/test_propint.R

@@ -0,0 +1,2 @@
+# test prop intervals
+

tests/testthat/test_utils.R

@@ -50,7 +50,7 @@ test_that("Function subs out NAs in numeric vectors with 0", {
 # Test that na_sum works
 test_that("NA Sum takes sum setting NA values to 0", {
   expect_equivalent(na_sum(c(1:10, NA)), sum(1:10, 0))
-  expect_message(na_sum(c(1:10, NA)), "Taking a sum with missing values equal to 0, be careful! \u1F601")
+  expect_message(na_sum(c(1:10, NA)), "Taking a sum with missing values equal to 0, be careful!")
 })
 
 test_that("na_sum fails with non-numerics", {