add additional functions

DESCRIPTION

@@ -16,6 +16,7 @@ Imports:
     png,
     stringr,
     gridExtra,
+    tidycensus,
     grid
 Encoding: UTF-8
 LazyData: true

NAMESPACE

@@ -7,7 +7,9 @@ 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)
@@ -16,14 +18,20 @@ export(measure_caption)
 export(na_sum)
 export(na_zero)
 export(nvals)
+export(outersect)
+export(perturb_count)
 export(plot_jpeg)
 export(pretty_count)
 export(pretty_per)
 export(race_short_names)
+export(random_round)
 export(safe_max)
+export(safe_ratio)
 export(simpleCap)
 export(star_subs)
 export(theme_civilytics)
+export(z_gap_test)
+export(z_univariate)
 import(ggplot2)
 importFrom(ggplot2,theme)
 importFrom(graphics,plot)
@@ -34,3 +42,4 @@ importFrom(gridExtra,arrangeGrob)
 importFrom(jpeg,readJPEG)
 importFrom(png,readPNG)
 importFrom(stringr,str_count)
+importFrom(tidycensus,fips_codes)

R/utils.R

@@ -163,3 +163,232 @@ na_sum <- function(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.
+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
+#'
+#' @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
+#' @export
+#' @importFrom tidycensus fips_codes
+#'
+#' @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
+#' @export
+#' @importFrom tidycensus fips_codes
+#'
+#' @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 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)
+
+
+#' 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
+#' @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
+#'
+#' @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)
+}

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_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/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,23 @@
+% 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}
+}
+\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/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/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/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/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/utils.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)
+}