fix message unicode

.Rbuildignore

@@ -4,3 +4,5 @@
 ^README\.Rmd$
 ^Makefile$
 ^Jenkinsfile$
+^Dockerfile$
+^LICENSE\.md$

DESCRIPTION

@@ -1,13 +1,13 @@
 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
     This package implements a variety of useful functions for creating and 
     branding analyses produced by Civilytics Consulting LLC. 
-License: LICENSE
+License: LGPL (>= 3)
 Depends:
     R (>= 2.15.1)
 Imports:
@@ -16,9 +16,11 @@ Imports:
     png,
     stringr,
     gridExtra,
-    grid
+    tidycensus,
+    grid,
+    stringdist
 Encoding: UTF-8
 LazyData: true
 Suggests: 
     testthat
-RoxygenNote: 7.2.1
+RoxygenNote: 7.3.2

Dockerfile

@@ -16,7 +16,12 @@ RUN apt-get update && apt-get install -y --no-install-recommends \
   openjdk-11-jdk \
   libssl-dev \
   libssh2-1-dev \
+  libudunits2-dev \
+  libgdal-dev \
+  libgeos-dev \
+  libproj-dev \
   && rm -rf /var/lib/apt/lists/* \
   && mkdir -p /var/lib/shiny-server/bookmarks/shiny
 
-RUN install2.r ggplot2 jpeg png stringr gridExtra grid testthat
+
+RUN install2.r ggplot2 jpeg png stringr gridExtra grid testthat covr tidycensus stringdist

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
             '''
           }
         }
@@ -39,11 +39,18 @@ pipeline {
          '''
          }
       }
+       stage('test coverage') {
+        steps {
+         sh '''
+         R -e 'covr::package_coverage(".")'
+         '''
+         }
+        }
       stage('Clean') {
         steps {
 
           sh '''
-          @rm -rf civilytics_0.1.0.tar.gz civilytics.Rcheck
+          rm -rf civilytics_0.2.0.tar.gz civilytics.Rcheck
           '''
       }
     }

LICENSE.md

@@ -0,0 +1,163 @@
+GNU Lesser General Public License
+=================================
+
+_Version 3, 29 June 2007_  
+_Copyright © 2007 Free Software Foundation, Inc. &lt;<http://fsf.org/>&gt;_
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+
+
+This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+### 0. Additional Definitions
+
+As used herein, “this License” refers to version 3 of the GNU Lesser
+General Public License, and the “GNU GPL” refers to version 3 of the GNU
+General Public License.
+
+“The Library” refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+An “Application” is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+A “Combined Work” is a work produced by combining or linking an
+Application with the Library.  The particular version of the Library
+with which the Combined Work was made is also called the “Linked
+Version”.
+
+The “Minimal Corresponding Source” for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+The “Corresponding Application Code” for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+### 1. Exception to Section 3 of the GNU GPL
+
+You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+### 2. Conveying Modified Versions
+
+If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+* **a)** under this License, provided that you make a good faith effort to
+ensure that, in the event an Application does not supply the
+function or data, the facility still operates, and performs
+whatever part of its purpose remains meaningful, or
+
+* **b)** under the GNU GPL, with none of the additional permissions of
+this License applicable to that copy.
+
+### 3. Object Code Incorporating Material from Library Header Files
+
+The object code form of an Application may incorporate material from
+a header file that is part of the Library.  You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+* **a)** Give prominent notice with each copy of the object code that the
+Library is used in it and that the Library and its use are
+covered by this License.
+* **b)** Accompany the object code with a copy of the GNU GPL and this license
+document.
+
+### 4. Combined Works
+
+You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+* **a)** Give prominent notice with each copy of the Combined Work that
+the Library is used in it and that the Library and its use are
+covered by this License.
+
+* **b)** Accompany the Combined Work with a copy of the GNU GPL and this license
+document.
+
+* **c)** For a Combined Work that displays copyright notices during
+execution, include the copyright notice for the Library among
+these notices, as well as a reference directing the user to the
+copies of the GNU GPL and this license document.
+
+* **d)** Do one of the following:
+    - **0)** Convey the Minimal Corresponding Source under the terms of this
+License, and the Corresponding Application Code in a form
+suitable for, and under terms that permit, the user to
+recombine or relink the Application with a modified version of
+the Linked Version to produce a modified Combined Work, in the
+manner specified by section 6 of the GNU GPL for conveying
+Corresponding Source.
+    - **1)** Use a suitable shared library mechanism for linking with the
+Library.  A suitable mechanism is one that **(a)** uses at run time
+a copy of the Library already present on the user's computer
+system, and **(b)** will operate properly with a modified version
+of the Library that is interface-compatible with the Linked
+Version.
+
+* **e)** Provide Installation Information, but only if you would otherwise
+be required to provide such information under section 6 of the
+GNU GPL, and only to the extent that such information is
+necessary to install and execute a modified version of the
+Combined Work produced by recombining or relinking the
+Application with a modified version of the Linked Version. (If
+you use option **4d0**, the Installation Information must accompany
+the Minimal Corresponding Source and Corresponding Application
+Code. If you use option **4d1**, you must provide the Installation
+Information in the manner specified by section 6 of the GNU GPL
+for conveying Corresponding Source.)
+
+### 5. Combined Libraries
+
+You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+* **a)** Accompany the combined library with a copy of the same work based
+on the Library, uncombined with any other library facilities,
+conveyed under the terms of this License.
+* **b)** Give prominent notice with the combined library that part of it
+is a work based on the Library, and explaining where to find the
+accompanying uncombined form of the same work.
+
+### 6. Revised Versions of the GNU Lesser General Public License
+
+The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License “or any later version”
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.

NAMESPACE

@@ -2,27 +2,44 @@
 
 export(add_logo)
 export(add_logo_ga)
+export(clopper_pearson)
 export(countCleanr)
 export(countDots)
 export(countNA)
 export(dbSafeNames)
 export(findDots)
+export(get_fips)
 export(get_png)
+export(get_stabbr)
 export(grade_level_to_num)
 export(has_caption)
 export(make_logo_grob)
+export(match_test)
 export(measure_caption)
+export(na_sum)
 export(na_zero)
 export(nvals)
+export(outersect)
+export(perturb_count)
 export(plot_jpeg)
+export(postcode_lookup)
 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)
+import(tidycensus)
 importFrom(ggplot2,theme)
 importFrom(graphics,plot)
 importFrom(graphics,rasterImage)
@@ -31,4 +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/db.R

@@ -37,8 +37,6 @@ countCleanr <- function(x){
 #'
 #' @return the names of columns in the dataframe with one or more entries equal to "."
 #' @export
-#'
-#' @examples
 findDots <- function(data){
   return(names(data)[lapply(data, countDots) > 0])
 
@@ -49,9 +47,8 @@ findDots <- function(data){
 #' @param x a character vector
 #'
 #' @return
+#' An integer counting the number of "." occurences in a vector
 #' @export
-#'
-#' @examples
 countDots <- function(x){
   len <- length(x[x == "." & !is.na(x)])
   totlen <- length(x)
@@ -65,8 +62,6 @@ countDots <- function(x){
 #'
 #' @return a vector the same length as the input vector with clean names
 #' @export
-#'
-#' @examples
 dbSafeNames <- function(names) {
   names = gsub('[^a-z0-9]+','_',tolower(names))
   names = make.names(names, unique = TRUE, allow_ = TRUE)

R/join_utilities.R

@@ -0,0 +1,48 @@
+# Join utilities
+#' Test the join between two sets of identifiers
+#'
+#' @param x a vector of identifiers to check against y
+#' @param y a vector of identifiers to check against x
+#' @param distinct logical, should duplicate values of x and y be removed before testing
+#'
+#' @return nothing, print a summary of match statistics to the console
+#' @export
+#'
+#' @examples
+#' x <- LETTERS
+#' y <- c(letters, LETTERS)
+#' match_test(x, y)
+match_test <- function(x, y, distinct = TRUE) {
+  if (distinct) {
+    x <- unique(x)
+    y <- unique(y)
+    cat("**** Distinct Matches ****")
+    cat("\n")
+
+  }
+
+  # TODO: DO not report 100% if there is even 1 mismatch
+
+  xiny <- sum(x %in% y)
+  total_x <- length(x)
+
+  yinx <- sum(y %in% x)
+  total_y <- length(y)
+
+  cat("**** Match Summary ****")
+  cat("\n")
+  cat("X in Y")
+  cat("\n")
+  cat(paste0("Of the ", total_x, " X values, ", xiny, " (",
+             100*round(xiny/total_x, 2), "%) were matched."))
+  cat("\n")
+  cat("********************************************")
+  cat("\n")
+  cat("Y in X")
+  cat("\n")
+  cat(paste0("Of the ", total_y, " Y values, ", yinx, " (",
+             100*round(yinx/total_y, 2), "%) were matched."))
+  cat("\n")
+  cat("******************************************")
+
+}

R/logo.R

@@ -9,7 +9,7 @@
 #' @importFrom jpeg readJPEG
 #' @importFrom graphics rasterImage
 #' @examples
-#' img <- system.file("img","Civilytics Consulting Logo.jpg",package="civilytics")
+#' img <- system.file("img","civilytics_logo.jpg",package="civilytics")
 #' plot_jpeg(img)
 plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
 {
@@ -30,13 +30,10 @@ plot_jpeg <- function(path, add=FALSE, upscale = TRUE)
 #'
 #' @param filename a character with file path to a png file
 #'
-#' @return
+#' @return a plotted rasteGrob of a png image
 #' @export
 #' @importFrom png readPNG
 #' @importFrom grid rasterGrob
-#'
-#' @examples
-#'
 get_png <- function(filename) {
   grid::rasterGrob(png::readPNG(filename), interpolate = TRUE)
 }
@@ -48,12 +45,10 @@ get_png <- function(filename) {
 #' @param logo a logo grob created by make_logo_grob()
 #' @param margin_param a numeric specifying what margin to add or subtract to align the logo
 #'
-#' @return
+#' @return a grob with a logo attached to it ready to plot
 #' @importFrom ggplot2 theme
 #' @importFrom gridExtra arrangeGrob
 #' @export
-#'
-#' @examples
 add_logo <- function(plot, logo, margin_param = NULL) {
   if(has_caption(plot)) {
     # convert the caption size to a negative number and on the "pt" scale
@@ -118,7 +113,7 @@ has_caption <- function(gg) {
 #' @param widths an optional vector the same length as plot_list with the widths for each plot
 #' @param margin_param a number giving the adjustment up or down to help manually align logo and captions
 #'
-#' @return
+#' @return a grid object
 #' @note The resulting object needs to be drawn to the screen using grid.draw()
 #' @importFrom gridExtra arrangeGrob
 #' @importFrom ggplot2 theme

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

@@ -78,7 +78,7 @@ pretty_count <- function(x) {
 
 #' Unsuppress data using sampling
 #'
-#' @param x
+#' @param x a vector
 #' @param replace_char the character you want to replace in the vector
 #' @param zeros the number of zeroes to oversample when replacing replace_char
 #' @param max_value the numeric maximum value the replacement for the "*" can be
@@ -103,10 +103,11 @@ star_subs <- function(x, replace_char = "*",
 #'
 #' @param x character description of grade levels from NCES style data
 #'
-#' @return
+#' @return a numeric vector
 #' @export
 #'
 #' @examples
+#' grade_level_to_num(c("KG", "Pre-K", "12", "10", "09"))
 grade_level_to_num <- function(x) {
   # Cannot generate new levels if it is a factor so we coerce to character first
   x <- as.character(x)
@@ -122,10 +123,11 @@ grade_level_to_num <- function(x) {
 #'
 #' @param x a character vector with NCES race codes, often from Urban Institute
 #'
-#' @return
+#' @return recoded race categories following NCES race codes
 #' @export
 #'
 #' @examples
+#' race_short_names(c("Black", "Hispanic Or Latino", "Two Or More Races"))
 race_short_names <- function(x) {
   x <- as.character(x)
   x[x %in% c("Black", "Black Or African American", "Black or African American",
@@ -144,4 +146,302 @@ race_short_names <- function(x) {
   return(x)
 }
 
+#' Sum a numeric that contains missing values and ignore missing values
+#'
+#' @param x a numeric vector
+#'
+#' @return the sum, ignoring any missing values
+#' @export
+#'
+#' @examples
+#' x <- c(2, NA, 4, 9)
+#' na_sum(x) # 15
+na_sum <- function(x) {
+  stopifnot(is.numeric(x))
+  message("Taking a sum with missing values equal to 0, be careful!")
+  x <- na_zero(x)
+  return(sum(x))
+}
 
+# This function looks up the appropriate postal code for states from the
+# state name.
+# It also substitutes in PR and DC for Puerto Rico and District of Columbia
+# which are not included in the lookup table of states and state abbreviations
+# that comes with R.
+#' Title
+#'
+#' @param x a vector of state names
+## #' @importFrom datasets state.abb state.name
+#' @return state abbreviations matching state naems provided in X
+#' @export
+#'
+#' @examples
+#' postcode_lookup("Montana")
+postcode_lookup <- function(x) {
+  modify_name <- c(state.name, "District of Columbia", "Puerto Rico")
+  modify_abb <- c(state.abb, "DC", "PR")
+  abb <- modify_abb[match(x, modify_name)]
+  return(abb)
+}
+
+
+#' Truncated matching function
+#'
+#' @param x, the character value to match
+#' @param y, a vector of multiple character values to look for a match in
+#' @param n, an integer, how many matches to return
+#' @importFrom stringdist stringsim
+#'
+#' @return an integer giving the position of the table with the most characters
+trunc_match <- function(x, y, n) {
+  out <- y[order(stringdist::stringsim(x, y, method = "lv"),
+                 decreasing = TRUE)]
+  if (length(out) < n) {
+    n <- length(out)
+  }
+  out <- out[1:n]
+  return(out)
+}
+
+
+
+#' Compute the outersection of two fectors
+#'
+#' @param x first vector, of any type
+#' @param y second vector, same type as x
+#' @param ... additional vectors to be checked
+#'
+#' @return unique values across all of the vectors
+#' @export
+#'
+#' @examples
+#' # desired result is c(1, 2, 3, 6, 9, 10)
+#' outersect(1:5, 4:8, 7:10)
+outersect <- function(x, y, ...) {
+  big.vec <- c(x, y, ...)
+  duplicates <- big.vec[duplicated(big.vec)]
+  setdiff(big.vec, unique(duplicates))
+}
+
+# desired result is c(1, 2, 3, 6, 9, 10)
+#outersect(1:5, 4:8, 7:10)
+#[1] 1 2 3 6 9 10
+
+
+
+#' Get the FIPS code for a given state abbreviation
+#'
+#' @param stabbr a two letter abbreviation for a US state
+#'
+#' @return FIPS codes that match the abbreviation
+#' @import tidycensus
+#' @export
+#'
+#' @examples
+#' get_fips("MT")
+#' get_fips("PR")
+#' get_fips("CC")
+get_fips <- function(stabbr) {
+  fips <- tidycensus::fips_codes[, 1:2]
+  fips <- fips[!duplicated(fips),]
+  out <- fips[fips$state == stabbr, 2]
+  return(out)
+}
+
+#' Get the state abbreviation from a given FIPS Code
+#'
+#' @param fips a character value that captures the FIPS code with leading 0
+#'
+#' @return a character value, length 2, with the state abbreviation
+#' @import tidycensus
+#' @export
+#'
+#' @examples
+#' get_stabbr("06")
+get_stabbr <- function(fips) {
+  fips_codes <- tidycensus::fips_codes[, 1:2]
+  fips_codes <- fips_codes[!duplicated(fips_codes),]
+  if (length(fips) != 1) {
+    out <- rep(NA, length(fips))
+    for (i in length(fips)) {
+      out[i] <- fips_codes[fips_codes$state_code == fips, 1]
+
+    }
+    return(out)
+
+  } else {
+    out <- fips_codes[fips_codes$state_code == fips, 1]
+    return(out)
+  }
+
+}
+
+
+## Let's calculate the z-score for the gap as well
+# Test statistic needs 4 values
+# Proporation A, Numerator A
+# Proportion B, Numerator B
+
+#' Calculate a Z-Score for a comparison between two proportions
+#'
+#' @param a_prop the proportion for group a
+#' @param a_count the count of the population in group a
+#' @param b_prop the proportion for group b
+#' @param b_count the count of the population in group b
+#'
+#' @return a numeric z score
+#' @export
+#'
+#' @examples
+#' z_gap_test(0.0002, 1e4, 0.0003, 1e4)
+z_gap_test <- function(a_prop, a_count, b_prop, b_count) {
+  num <- (a_prop - b_prop) - 0
+
+  denom_a <- (a_prop * (1-a_prop)) / a_count
+  denom_b <- (b_prop * (1-b_prop)) / b_count
+
+  denom <- sqrt(denom_a + denom_b)
+
+
+  z = num / denom
+  #if (is.nan)
+  return(z)
+}
+
+
+
+# TODO: Consider vectorizing
+#z_univariate_v <- Vectorize(z_univariate, SIMPLIFY = TRUE)
+
+
+#' Add a random jitter to a count variable to mask its true value
+#'
+#' @param x the vector of numerics
+#' @param fac the range of values to add or subtract to perturb the count
+#'
+#' @details The count in the name means that this function enforces a floor of
+#' 0 on values, so values perturbed to have less than 0 will be capped at 0.
+#'
+#' @return a numeric vector
+#' @export
+#'
+#' @examples
+#' perturb_count(20:30, fac = 3)
+perturb_count <- function(x, fac = 3) {
+  x <- sapply(x, function(x) x + sample(-fac:fac, 1))
+  x[x < 0] <- 0
+  return(x)
+
+
+}
+
+
+
+#' Add random noise to a variable before rounding
+#'
+#' @param x a numeric we want to round
+#'
+#' @return rounded values
+#' @export
+#' @details Credit to Jens von Bergmann for this algo https://github.com/mountainMath/dotdensity/blob/master/R/dot-density.R
+#' @importFrom stats runif
+#'
+#' @examples
+#' random_round(1.93)
+random_round <- function(x) {
+  v = as.integer(x)
+  r = x-v
+  test = runif(length(r), 0.0, 1.0)
+  add = rep(as.integer(0),length(r))
+  add[r>test] <- as.integer(1)
+  value = v + add
+  ifelse(is.na(value) | value<0, 0, value)
+  return(value)
+}
+
+
+#' Safely take a ratio and do not fail if 0 is in the denominator
+#'
+#' @param num numerator, a numeric
+#' @param denom denominator, a numeric
+#'
+#' @return The proportion, safely calculated with 0.1 substituting for 0
+#' @export
+#'
+#' @examples
+#' safe_ratio(100, 1)
+#' safe_ratio(100, 0)
+safe_ratio <- function(num, denom) {
+  denom <- ifelse(denom == 0, 0.1, 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/add_logo.Rd

@@ -13,6 +13,9 @@ add_logo(plot, logo, margin_param = NULL)
 
 \item{margin_param}{a numeric specifying what margin to add or subtract to align the logo}
 }
+\value{
+a grob with a logo attached to it ready to plot
+}
 \description{
 Add a logo to a ggplot2 object
 }

man/add_logo_ga.Rd

@@ -17,6 +17,9 @@ add_logo_ga(plot_list, logo, nrow = 1, widths = NULL, margin_param = NULL)
 
 \item{margin_param}{a number giving the adjustment up or down to help manually align logo and captions}
 }
+\value{
+a grid object
+}
 \description{
 Add a logo to a ggplot2 object
 }

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/countDots.Rd

@@ -9,6 +9,9 @@ countDots(x)
 \arguments{
 \item{x}{a character vector}
 }
+\value{
+An integer counting the number of "." occurences in a vector
+}
 \description{
 Count the number of single period entries in a vector
 }

man/get_fips.Rd

@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{get_fips}
+\alias{get_fips}
+\title{Get the FIPS code for a given state abbreviation}
+\usage{
+get_fips(stabbr)
+}
+\arguments{
+\item{stabbr}{a two letter abbreviation for a US state}
+}
+\value{
+FIPS codes that match the abbreviation
+}
+\description{
+Get the FIPS code for a given state abbreviation
+}
+\examples{
+get_fips("MT")
+get_fips("PR")
+get_fips("CC")
+}

man/get_png.Rd

@@ -9,6 +9,9 @@ get_png(filename)
 \arguments{
 \item{filename}{a character with file path to a png file}
 }
+\value{
+a plotted rasteGrob of a png image
+}
 \description{
 Plot a PNG file as a rasterGrob for inclusion in ggplot2
 }

man/get_stabbr.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{get_stabbr}
+\alias{get_stabbr}
+\title{Get the state abbreviation from a given FIPS Code}
+\usage{
+get_stabbr(fips)
+}
+\arguments{
+\item{fips}{a character value that captures the FIPS code with leading 0}
+}
+\value{
+a character value, length 2, with the state abbreviation
+}
+\description{
+Get the state abbreviation from a given FIPS Code
+}
+\examples{
+get_stabbr("06")
+}

man/grade_level_to_num.Rd

@@ -9,6 +9,12 @@ grade_level_to_num(x)
 \arguments{
 \item{x}{character description of grade levels from NCES style data}
 }
+\value{
+a numeric vector
+}
 \description{
 Recode grade level from character to numeric
 }
+\examples{
+grade_level_to_num(c("KG", "Pre-K", "12", "10", "09"))
+}

man/match_test.Rd

@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/join_utilities.R
+\name{match_test}
+\alias{match_test}
+\title{Test the join between two sets of identifiers}
+\usage{
+match_test(x, y, distinct = TRUE)
+}
+\arguments{
+\item{x}{a vector of identifiers to check against y}
+
+\item{y}{a vector of identifiers to check against x}
+
+\item{distinct}{logical, should duplicate values of x and y be removed before testing}
+}
+\value{
+nothing, print a summary of match statistics to the console
+}
+\description{
+Test the join between two sets of identifiers
+}
+\examples{
+x <- LETTERS
+y <- c(letters, LETTERS)
+match_test(x, y)
+}

man/na_sum.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{na_sum}
+\alias{na_sum}
+\title{Sum a numeric that contains missing values and ignore missing values}
+\usage{
+na_sum(x)
+}
+\arguments{
+\item{x}{a numeric vector}
+}
+\value{
+the sum, ignoring any missing values
+}
+\description{
+Sum a numeric that contains missing values and ignore missing values
+}
+\examples{
+x <- c(2, NA, 4, 9)
+na_sum(x) # 15
+}

man/outersect.Rd

@@ -0,0 +1,25 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{outersect}
+\alias{outersect}
+\title{Compute the outersection of two fectors}
+\usage{
+outersect(x, y, ...)
+}
+\arguments{
+\item{x}{first vector, of any type}
+
+\item{y}{second vector, same type as x}
+
+\item{...}{additional vectors to be checked}
+}
+\value{
+unique values across all of the vectors
+}
+\description{
+Compute the outersection of two fectors
+}
+\examples{
+# desired result is c(1, 2, 3, 6, 9, 10)
+outersect(1:5, 4:8, 7:10)
+}

man/perturb_count.Rd

@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{perturb_count}
+\alias{perturb_count}
+\title{Add a random jitter to a count variable to mask its true value}
+\usage{
+perturb_count(x, fac = 3)
+}
+\arguments{
+\item{x}{the vector of numerics}
+
+\item{fac}{the range of values to add or subtract to perturb the count}
+}
+\value{
+a numeric vector
+}
+\description{
+Add a random jitter to a count variable to mask its true value
+}
+\details{
+The count in the name means that this function enforces a floor of
+0 on values, so values perturbed to have less than 0 will be capped at 0.
+}
+\examples{
+perturb_count(20:30, fac = 3)
+}

man/plot_jpeg.Rd

@@ -21,6 +21,6 @@ a rasterImage
 Plot a jpeg image as a raster
 }
 \examples{
-img <- system.file("img","Civilytics Consulting Logo.jpg",package="civilytics")
+img <- system.file("img","civilytics_logo.jpg",package="civilytics")
 plot_jpeg(img)
 }

man/postcode_lookup.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{postcode_lookup}
+\alias{postcode_lookup}
+\title{Title}
+\usage{
+postcode_lookup(x)
+}
+\arguments{
+\item{x}{a vector of state names}
+}
+\value{
+state abbreviations matching state naems provided in X
+}
+\description{
+Title
+}
+\examples{
+postcode_lookup("Montana")
+}

man/race_short_names.Rd

@@ -9,6 +9,12 @@ race_short_names(x)
 \arguments{
 \item{x}{a character vector with NCES race codes, often from Urban Institute}
 }
+\value{
+recoded race categories following NCES race codes
+}
 \description{
 Recode NCES race categories to shorter names
 }
+\examples{
+race_short_names(c("Black", "Hispanic Or Latino", "Two Or More Races"))
+}

man/random_round.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{random_round}
+\alias{random_round}
+\title{Add random noise to a variable before rounding}
+\usage{
+random_round(x)
+}
+\arguments{
+\item{x}{a numeric we want to round}
+}
+\value{
+rounded values
+}
+\description{
+Add random noise to a variable before rounding
+}
+\details{
+Credit to Jens von Bergmann for this algo https://github.com/mountainMath/dotdensity/blob/master/R/dot-density.R
+}
+\examples{
+random_round(1.93)
+}

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/safe_ratio.Rd

@@ -0,0 +1,23 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{safe_ratio}
+\alias{safe_ratio}
+\title{Safely take a ratio and do not fail if 0 is in the denominator}
+\usage{
+safe_ratio(num, denom)
+}
+\arguments{
+\item{num}{numerator, a numeric}
+
+\item{denom}{denominator, a numeric}
+}
+\value{
+The proportion, safely calculated with 0.1 substituting for 0
+}
+\description{
+Safely take a ratio and do not fail if 0 is in the denominator
+}
+\examples{
+safe_ratio(100, 1)
+safe_ratio(100, 0)
+}

man/star_subs.Rd

@@ -7,6 +7,8 @@
 star_subs(x, replace_char = "*", zeros = 15, max_value = 20)
 }
 \arguments{
+\item{x}{a vector}
+
 \item{replace_char}{the character you want to replace in the vector}
 
 \item{zeros}{the number of zeroes to oversample when replacing replace_char}

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/trunc_match.Rd

@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{trunc_match}
+\alias{trunc_match}
+\title{Truncated matching function}
+\usage{
+trunc_match(x, y, n)
+}
+\arguments{
+\item{x, }{the character value to match}
+
+\item{y, }{a vector of multiple character values to look for a match in}
+
+\item{n, }{an integer, how many matches to return}
+}
+\value{
+an integer giving the position of the table with the most characters
+}
+\description{
+Truncated matching function
+}

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_gap_test.Rd

@@ -0,0 +1,26 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{z_gap_test}
+\alias{z_gap_test}
+\title{Calculate a Z-Score for a comparison between two proportions}
+\usage{
+z_gap_test(a_prop, a_count, b_prop, b_count)
+}
+\arguments{
+\item{a_prop}{the proportion for group a}
+
+\item{a_count}{the count of the population in group a}
+
+\item{b_prop}{the proportion for group b}
+
+\item{b_count}{the count of the population in group b}
+}
+\value{
+a numeric z score
+}
+\description{
+Calculate a Z-Score for a comparison between two proportions
+}
+\examples{
+z_gap_test(0.0002, 1e4, 0.0003, 1e4)
+}

man/z_univariate.Rd

@@ -0,0 +1,24 @@
+% Generated by roxygen2: do not edit by hand
+% 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}
+\usage{
+z_univariate(unit_prop, global_prop, unit_denom)
+}
+\arguments{
+\item{unit_prop}{proportion for the group we are comparing}
+
+\item{global_prop}{the global proportion}
+
+\item{unit_denom}{the population size for the group we are comparing}
+}
+\value{
+a z-score
+}
+\description{
+Calculate a univariate z score by comparing to a population
+}
+\examples{
+z_univariate(unit_prop = 0.13, global_prop = 0.11, unit_denom = 2500)
+}

tests/testthat/test_joins.R

@@ -0,0 +1,15 @@
+
+
+#' x <- LETTERS
+#' y <- c(letters, LETTERS)
+#' match_test(x, y)
+#'
+#'
+context("Test Basic Output for match_test")
+
+test_that("pretty_per respects rounding", {
+  x <- LETTERS
+  y <- c(letters, LETTERS)
+  testthat::expect_output(match_test(x, y))
+
+})

tests/testthat/test_propint.R

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

tests/testthat/test_utils.R

@@ -47,6 +47,18 @@ test_that("Function subs out NAs in numeric vectors with 0", {
   expect_equivalent(na_zero(c(1:10, NA)), c(1:10, 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!")
+})
+
+test_that("na_sum fails with non-numerics", {
+  expect_error(na_sum(LETTERS))
+  expect_error(na_sum(as.factor(1:10)))
+})
+
+
 context("Test Utilities - Pretty Count")