Merge pull request 'fix proportion ci calc and theme' (#2) from feature-prop_int into master
Gitea Organization/civilyticsR/pipeline/head This commit looks good

Reviewed-on: #2
This commit was merged in pull request #2.
This commit is contained in:
2024-09-19 16:17:32 -04:00
29 changed files with 754 additions and 465 deletions
+26 -26
View File
@@ -1,26 +1,26 @@
Package: civilytics Package: civilytics
Type: Package Type: Package
Title: Utilities Functions for Civilytics Title: Utilities Functions for Civilytics
Version: 0.1.0 Version: 0.2.0
Author: Jared E. Knowles <jared@civilytics.com> Author: Jared E. Knowles <jared@civilytics.com>
Maintainer: Jared E. Knowles <jared@civilytics.com> Maintainer: Jared E. Knowles <jared@civilytics.com>
Description: House R functions for Civilytics Consulting LLC Description: House R functions for Civilytics Consulting LLC
This package implements a variety of useful functions for creating and This package implements a variety of useful functions for creating and
branding analyses produced by Civilytics Consulting LLC. branding analyses produced by Civilytics Consulting LLC.
License: LGPL (>= 3) License: LGPL (>= 3)
Depends: Depends:
R (>= 2.15.1) R (>= 2.15.1)
Imports: Imports:
ggplot2, ggplot2,
jpeg, jpeg,
png, png,
stringr, stringr,
gridExtra, gridExtra,
tidycensus, tidycensus,
grid, grid,
stringdist stringdist
Encoding: UTF-8 Encoding: UTF-8
LazyData: true LazyData: true
Suggests: Suggests:
testthat testthat
RoxygenNote: 7.2.3 RoxygenNote: 7.3.2
+27 -27
View File
@@ -1,27 +1,27 @@
# [Choice] R version: 4, 4.2, 4.1, 4.0 # [Choice] R version: 4, 4.2, 4.1, 4.0
ARG VARIANT=4.2 ARG VARIANT=4.2
# [Choice] Base image. Minimal (r-ver), tidyverse installed (tidyverse), or full image (binder): rocker/r-ver, rocker/tidyverse, rocker/binder # [Choice] Base image. Minimal (r-ver), tidyverse installed (tidyverse), or full image (binder): rocker/r-ver, rocker/tidyverse, rocker/binder
ARG BASE_IMAGE=rocker/r-ver ARG BASE_IMAGE=rocker/r-ver
FROM ${BASE_IMAGE}:${VARIANT} FROM ${BASE_IMAGE}:${VARIANT}
RUN apt-get update && apt-get install -y --no-install-recommends \ RUN apt-get update && apt-get install -y --no-install-recommends \
sudo \ sudo \
libcurl4-gnutls-dev \ libcurl4-gnutls-dev \
libxml2-dev \ libxml2-dev \
libcairo2-dev \ libcairo2-dev \
libxt-dev \ libxt-dev \
libjpeg-dev \ libjpeg-dev \
libpng-dev \ libpng-dev \
openjdk-11-jdk \ openjdk-11-jdk \
libssl-dev \ libssl-dev \
libssh2-1-dev \ libssh2-1-dev \
libudunits2-dev \ libudunits2-dev \
libgdal-dev \ libgdal-dev \
libgeos-dev \ libgeos-dev \
libproj-dev \ libproj-dev \
&& rm -rf /var/lib/apt/lists/* \ && rm -rf /var/lib/apt/lists/* \
&& mkdir -p /var/lib/shiny-server/bookmarks/shiny && mkdir -p /var/lib/shiny-server/bookmarks/shiny
RUN install2.r ggplot2 jpeg png stringr gridExtra grid testthat covr tidycensus stringdist RUN install2.r ggplot2 jpeg png stringr gridExtra grid testthat covr tidycensus stringdist
Vendored
+60 -60
View File
@@ -1,60 +1,60 @@
pipeline { pipeline {
agent { agent {
dockerfile true dockerfile true
} }
stages { stages {
stage('Docker setup') { stage('Docker setup') {
steps { steps {
sh ''' sh '''
R --version R --version
java --version java --version
''' '''
} }
} }
stage('Build and test') { stage('Build and test') {
stages { stages {
stage("Build package") { stage("Build package") {
steps { steps {
sh ''' sh '''
R CMD build . R CMD build .
''' '''
} }
} }
stage('Check') { stage('Check') {
steps { steps {
sh ''' sh '''
R CMD check --no-manual civilytics_0.1.0.tar.gz R CMD check --no-manual civilytics_0.2.0.tar.gz
''' '''
sh ''' sh '''
R CMD INSTALL civilytics_0.1.0.tar.gz R CMD INSTALL civilytics_0.2.0.tar.gz
''' '''
} }
} }
stage('testthat'){ stage('testthat'){
steps { steps {
sh ''' sh '''
R -e 'testthat::test_local(".")' R -e 'testthat::test_local(".")'
''' '''
} }
} }
stage('test coverage') { stage('test coverage') {
steps { steps {
sh ''' sh '''
R -e 'covr::package_coverage(".")' R -e 'covr::package_coverage(".")'
''' '''
} }
} }
stage('Clean') { stage('Clean') {
steps { steps {
sh ''' sh '''
rm -rf civilytics_0.1.0.tar.gz civilytics.Rcheck rm -rf civilytics_0.2.0.tar.gz civilytics.Rcheck
''' '''
} }
} }
} }
} }
} }
} }
+26 -26
View File
@@ -1,26 +1,26 @@
# h/t to @jimhester and @yihui for this parse block: # h/t to @jimhester and @yihui for this parse block:
# https://github.com/yihui/knitr/blob/dc5ead7bcfc0ebd2789fe99c527c7d91afb3de4a/Makefile#L1-L4 # https://github.com/yihui/knitr/blob/dc5ead7bcfc0ebd2789fe99c527c7d91afb3de4a/Makefile#L1-L4
# Note the portability change as suggested in the manual: # Note the portability change as suggested in the manual:
# https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Writing-portable-packages # https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Writing-portable-packages
PKGNAME = `sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION` PKGNAME = `sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION`
PKGVERS = `sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION` PKGVERS = `sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION`
all: check all: check
build: install_deps build: install_deps
R CMD build . R CMD build .
check: build check: build
R CMD check --no-manual $(PKGNAME)_$(PKGVERS).tar.gz R CMD check --no-manual $(PKGNAME)_$(PKGVERS).tar.gz
install_deps: install_deps:
Rscript \ Rscript \
-e 'if (!requireNamespace("remotes")) install.packages("remotes")' \ -e 'if (!requireNamespace("remotes")) install.packages("remotes")' \
-e 'remotes::install_deps(dependencies = TRUE)' -e 'remotes::install_deps(dependencies = TRUE)'
install: build install: build
R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz
clean: clean:
@rm -rf $(PKGNAME)_$(PKGVERS).tar.gz $(PKGNAME).Rcheck @rm -rf $(PKGNAME)_$(PKGVERS).tar.gz $(PKGNAME).Rcheck
+55 -48
View File
@@ -1,48 +1,55 @@
# Generated by roxygen2: do not edit by hand # Generated by roxygen2: do not edit by hand
export(add_logo) export(add_logo)
export(add_logo_ga) export(add_logo_ga)
export(countCleanr) export(clopper_pearson)
export(countDots) export(countCleanr)
export(countNA) export(countDots)
export(dbSafeNames) export(countNA)
export(findDots) export(dbSafeNames)
export(get_fips) export(findDots)
export(get_png) export(get_fips)
export(get_stabbr) export(get_png)
export(grade_level_to_num) export(get_stabbr)
export(has_caption) export(grade_level_to_num)
export(make_logo_grob) export(has_caption)
export(match_test) export(make_logo_grob)
export(measure_caption) export(match_test)
export(na_sum) export(measure_caption)
export(na_zero) export(na_sum)
export(nvals) export(na_zero)
export(outersect) export(nvals)
export(perturb_count) export(outersect)
export(plot_jpeg) export(perturb_count)
export(postcode_lookup) export(plot_jpeg)
export(pretty_count) export(postcode_lookup)
export(pretty_per) export(pretty_count)
export(race_short_names) export(pretty_per)
export(random_round) export(race_short_names)
export(safe_max) export(random_round)
export(safe_ratio) export(rnh)
export(simpleCap) export(round_to_nearest_half)
export(star_subs) export(safe_max)
export(theme_civilytics) export(safe_ratio)
export(z_gap_test) export(simpleCap)
export(z_univariate) export(star_subs)
import(ggplot2) export(theme_civilytics)
import(tidycensus) export(trim_max)
importFrom(ggplot2,theme) export(waldInterval)
importFrom(graphics,plot) export(z_gap_test)
importFrom(graphics,rasterImage) export(z_univariate)
importFrom(grid,grid.draw) import(ggplot2)
importFrom(grid,rasterGrob) import(tidycensus)
importFrom(gridExtra,arrangeGrob) importFrom(ggplot2,theme)
importFrom(jpeg,readJPEG) importFrom(graphics,plot)
importFrom(png,readPNG) importFrom(graphics,rasterImage)
importFrom(stats,runif) importFrom(grid,grid.draw)
importFrom(stringdist,stringsim) importFrom(grid,rasterGrob)
importFrom(stringr,str_count) 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)
+10
View File
@@ -0,0 +1,10 @@
#' @keywords internal
#' @importFrom stats qbeta
#' @importFrom stats qnorm
"_PACKAGE"
## usethis namespace: start
## usethis namespace: end
NULL
+48 -48
View File
@@ -1,48 +1,48 @@
# Join utilities # Join utilities
#' Test the join between two sets of identifiers #' Test the join between two sets of identifiers
#' #'
#' @param x a vector of identifiers to check against y #' @param x a vector of identifiers to check against y
#' @param y a vector of identifiers to check against x #' @param y a vector of identifiers to check against x
#' @param distinct logical, should duplicate values of x and y be removed before testing #' @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 #' @return nothing, print a summary of match statistics to the console
#' @export #' @export
#' #'
#' @examples #' @examples
#' x <- LETTERS #' x <- LETTERS
#' y <- c(letters, LETTERS) #' y <- c(letters, LETTERS)
#' match_test(x, y) #' match_test(x, y)
match_test <- function(x, y, distinct = TRUE) { match_test <- function(x, y, distinct = TRUE) {
if (distinct) { if (distinct) {
x <- unique(x) x <- unique(x)
y <- unique(y) y <- unique(y)
cat("**** Distinct Matches ****") cat("**** Distinct Matches ****")
cat("\n") cat("\n")
} }
# TODO: DO not report 100% if there is even 1 mismatch # TODO: DO not report 100% if there is even 1 mismatch
xiny <- sum(x %in% y) xiny <- sum(x %in% y)
total_x <- length(x) total_x <- length(x)
yinx <- sum(y %in% x) yinx <- sum(y %in% x)
total_y <- length(y) total_y <- length(y)
cat("**** Match Summary ****") cat("**** Match Summary ****")
cat("\n") cat("\n")
cat("X in Y") cat("X in Y")
cat("\n") cat("\n")
cat(paste0("Of the ", total_x, " X values, ", xiny, " (", cat(paste0("Of the ", total_x, " X values, ", xiny, " (",
100*round(xiny/total_x, 2), "%) were matched.")) 100*round(xiny/total_x, 2), "%) were matched."))
cat("\n") cat("\n")
cat("********************************************") cat("********************************************")
cat("\n") cat("\n")
cat("Y in X") cat("Y in X")
cat("\n") cat("\n")
cat(paste0("Of the ", total_y, " Y values, ", yinx, " (", cat(paste0("Of the ", total_y, " Y values, ", yinx, " (",
100*round(yinx/total_y, 2), "%) were matched.")) 100*round(yinx/total_y, 2), "%) were matched."))
cat("\n") cat("\n")
cat("******************************************") cat("******************************************")
} }
+85
View File
@@ -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)
}
+4 -4
View File
@@ -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),
+70 -28
View File
@@ -158,7 +158,7 @@ race_short_names <- function(x) {
#' na_sum(x) # 15 #' na_sum(x) # 15
na_sum <- function(x) { na_sum <- function(x) {
stopifnot(is.numeric(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) x <- na_zero(x)
return(sum(x)) return(sum(x))
} }
@@ -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)
@@ -403,3 +376,72 @@ safe_ratio <- function(num, denom) {
y <- num / denom y <- num / denom
return(y) 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)
}
+21 -21
View File
@@ -1,21 +1,21 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/logo.R % Please edit documentation in R/logo.R
\name{add_logo} \name{add_logo}
\alias{add_logo} \alias{add_logo}
\title{Add a logo to a ggplot2 object} \title{Add a logo to a ggplot2 object}
\usage{ \usage{
add_logo(plot, logo, margin_param = NULL) add_logo(plot, logo, margin_param = NULL)
} }
\arguments{ \arguments{
\item{plot}{a ggplot2 grob} \item{plot}{a ggplot2 grob}
\item{logo}{a logo grob created by make_logo_grob()} \item{logo}{a logo grob created by make_logo_grob()}
\item{margin_param}{a numeric specifying what margin to add or subtract to align the logo} \item{margin_param}{a numeric specifying what margin to add or subtract to align the logo}
} }
\value{ \value{
a grob with a logo attached to it ready to plot a grob with a logo attached to it ready to plot
} }
\description{ \description{
Add a logo to a ggplot2 object Add a logo to a ggplot2 object
} }
+36 -36
View File
@@ -1,36 +1,36 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/logo.R % Please edit documentation in R/logo.R
\name{add_logo_ga} \name{add_logo_ga}
\alias{add_logo_ga} \alias{add_logo_ga}
\title{Add a logo to a ggplot2 object} \title{Add a logo to a ggplot2 object}
\usage{ \usage{
add_logo_ga(plot_list, logo, nrow = 1, widths = NULL, margin_param = NULL) add_logo_ga(plot_list, logo, nrow = 1, widths = NULL, margin_param = NULL)
} }
\arguments{ \arguments{
\item{plot_list}{a list containing ggplot2 objects} \item{plot_list}{a list containing ggplot2 objects}
\item{logo}{a grob containing the logo created with `make_logo_grob`} \item{logo}{a grob containing the logo created with `make_logo_grob`}
\item{nrow}{an integer, default = 1, for the number of rows to align the plots in} \item{nrow}{an integer, default = 1, for the number of rows to align the plots in}
\item{widths}{an optional vector the same length as plot_list with the widths for each plot} \item{widths}{an optional vector the same length as plot_list with the widths for each plot}
\item{margin_param}{a number giving the adjustment up or down to help manually align logo and captions} \item{margin_param}{a number giving the adjustment up or down to help manually align logo and captions}
} }
\value{ \value{
a grid object a grid object
} }
\description{ \description{
Add a logo to a ggplot2 object Add a logo to a ggplot2 object
} }
\note{ \note{
The resulting object needs to be drawn to the screen using grid.draw() The resulting object needs to be drawn to the screen using grid.draw()
} }
\examples{ \examples{
library(ggplot2); library(grid) library(ggplot2); library(grid)
tmp_plot <- ggplot(mtcars) + aes(x = hp, y = disp) + geom_point() + theme_civilytics() tmp_plot <- ggplot(mtcars) + aes(x = hp, y = disp) + geom_point() + theme_civilytics()
tmp_logo <- make_logo_grob() tmp_logo <- make_logo_grob()
plot_and_logo <- add_logo(tmp_plot, tmp_logo) plot_and_logo <- add_logo(tmp_plot, tmp_logo)
grid.draw(plot_and_logo) grid.draw(plot_and_logo)
dev.off() dev.off()
} }
+21
View File
@@ -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
}
+11
View File
@@ -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}
+21
View File
@@ -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
}
+17 -17
View File
@@ -1,17 +1,17 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/db.R % Please edit documentation in R/db.R
\name{countDots} \name{countDots}
\alias{countDots} \alias{countDots}
\title{Count the number of single period entries in a vector} \title{Count the number of single period entries in a vector}
\usage{ \usage{
countDots(x) countDots(x)
} }
\arguments{ \arguments{
\item{x}{a character vector} \item{x}{a character vector}
} }
\value{ \value{
An integer counting the number of "." occurences in a vector An integer counting the number of "." occurences in a vector
} }
\description{ \description{
Count the number of single period entries in a vector Count the number of single period entries in a vector
} }
+17 -17
View File
@@ -1,17 +1,17 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/logo.R % Please edit documentation in R/logo.R
\name{get_png} \name{get_png}
\alias{get_png} \alias{get_png}
\title{Plot a PNG file as a rasterGrob for inclusion in ggplot2} \title{Plot a PNG file as a rasterGrob for inclusion in ggplot2}
\usage{ \usage{
get_png(filename) get_png(filename)
} }
\arguments{ \arguments{
\item{filename}{a character with file path to a png file} \item{filename}{a character with file path to a png file}
} }
\value{ \value{
a plotted rasteGrob of a png image a plotted rasteGrob of a png image
} }
\description{ \description{
Plot a PNG file as a rasterGrob for inclusion in ggplot2 Plot a PNG file as a rasterGrob for inclusion in ggplot2
} }
+20 -20
View File
@@ -1,20 +1,20 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R % Please edit documentation in R/utils.R
\name{grade_level_to_num} \name{grade_level_to_num}
\alias{grade_level_to_num} \alias{grade_level_to_num}
\title{Recode grade level from character to numeric} \title{Recode grade level from character to numeric}
\usage{ \usage{
grade_level_to_num(x) grade_level_to_num(x)
} }
\arguments{ \arguments{
\item{x}{character description of grade levels from NCES style data} \item{x}{character description of grade levels from NCES style data}
} }
\value{ \value{
a numeric vector a numeric vector
} }
\description{ \description{
Recode grade level from character to numeric Recode grade level from character to numeric
} }
\examples{ \examples{
grade_level_to_num(c("KG", "Pre-K", "12", "10", "09")) grade_level_to_num(c("KG", "Pre-K", "12", "10", "09"))
} }
+22 -22
View File
@@ -1,22 +1,22 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/logo.R % Please edit documentation in R/logo.R
\name{measure_caption} \name{measure_caption}
\alias{measure_caption} \alias{measure_caption}
\title{Measure a ggplot2 object caption} \title{Measure a ggplot2 object caption}
\usage{ \usage{
measure_caption(gg) measure_caption(gg)
} }
\arguments{ \arguments{
\item{gg}{a ggplot object} \item{gg}{a ggplot object}
} }
\value{ \value{
a numeric value stating the number of lines to be added or subtracted to align a logo with a numeric value stating the number of lines to be added or subtracted to align a logo with
the caption the caption
} }
\description{ \description{
Measure a ggplot2 object caption Measure a ggplot2 object caption
} }
\examples{ \examples{
p1 <- ggplot2::qplot(mpg, wt, data = mtcars) p1 <- ggplot2::qplot(mpg, wt, data = mtcars)
measure_caption(p1) # Should equal 1 since no caption is required measure_caption(p1) # Should equal 1 since no caption is required
} }
+20 -20
View File
@@ -1,20 +1,20 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R % Please edit documentation in R/utils.R
\name{race_short_names} \name{race_short_names}
\alias{race_short_names} \alias{race_short_names}
\title{Recode NCES race categories to shorter names} \title{Recode NCES race categories to shorter names}
\usage{ \usage{
race_short_names(x) race_short_names(x)
} }
\arguments{ \arguments{
\item{x}{a character vector with NCES race codes, often from Urban Institute} \item{x}{a character vector with NCES race codes, often from Urban Institute}
} }
\value{ \value{
recoded race categories following NCES race codes recoded race categories following NCES race codes
} }
\description{ \description{
Recode NCES race categories to shorter names Recode NCES race categories to shorter names
} }
\examples{ \examples{
race_short_names(c("Black", "Hispanic Or Latino", "Two Or More Races")) race_short_names(c("Black", "Hispanic Or Latino", "Two Or More Races"))
} }
+20
View File
@@ -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))
}
+22
View File
@@ -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)
}
+28 -28
View File
@@ -1,28 +1,28 @@
% Generated by roxygen2: do not edit by hand % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/utils.R % Please edit documentation in R/utils.R
\name{star_subs} \name{star_subs}
\alias{star_subs} \alias{star_subs}
\title{Unsuppress data using sampling} \title{Unsuppress data using sampling}
\usage{ \usage{
star_subs(x, replace_char = "*", zeros = 15, max_value = 20) star_subs(x, replace_char = "*", zeros = 15, max_value = 20)
} }
\arguments{ \arguments{
\item{x}{a vector} \item{x}{a vector}
\item{replace_char}{the character you want to replace in the 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} \item{zeros}{the number of zeroes to oversample when replacing replace_char}
\item{max_value}{the numeric maximum value the replacement for the "*" can be} \item{max_value}{the numeric maximum value the replacement for the "*" can be}
} }
\value{ \value{
a numeric vector with no characters representing suppressed values a numeric vector with no characters representing suppressed values
} }
\description{ \description{
Unsuppress data using sampling Unsuppress data using sampling
} }
\examples{ \examples{
suppr_data <- c("2", "8", "*", "*", "7", "9", "100") suppr_data <- c("2", "8", "*", "*", "7", "9", "100")
star_subs(suppr_data, zeros = 1, max_value = 10) star_subs(suppr_data, zeros = 1, max_value = 10)
star_subs(suppr_data, zeros = 1, max_value = 200) star_subs(suppr_data, zeros = 1, max_value = 200)
} }
+24
View File
@@ -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)
}
+24
View File
@@ -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
}
+1 -1
View File
@@ -1,5 +1,5 @@
% Generated by roxygen2: do not edit by hand % 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} \name{z_univariate}
\alias{z_univariate} \alias{z_univariate}
\title{Calculate a univariate z score by comparing to a population} \title{Calculate a univariate z score by comparing to a population}
+15 -15
View File
@@ -1,15 +1,15 @@
#' x <- LETTERS #' x <- LETTERS
#' y <- c(letters, LETTERS) #' y <- c(letters, LETTERS)
#' match_test(x, y) #' match_test(x, y)
#' #'
#' #'
context("Test Basic Output for match_test") context("Test Basic Output for match_test")
test_that("pretty_per respects rounding", { test_that("pretty_per respects rounding", {
x <- LETTERS x <- LETTERS
y <- c(letters, LETTERS) y <- c(letters, LETTERS)
testthat::expect_output(match_test(x, y)) testthat::expect_output(match_test(x, y))
}) })
+2
View File
@@ -0,0 +1,2 @@
# test prop intervals
+1 -1
View File
@@ -50,7 +50,7 @@ test_that("Function subs out NAs in numeric vectors with 0", {
# Test that na_sum works # Test that na_sum works
test_that("NA Sum takes sum setting NA values to 0", { test_that("NA Sum takes sum setting NA values to 0", {
expect_equivalent(na_sum(c(1:10, NA)), sum(1:10, 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", { test_that("na_sum fails with non-numerics", {