cleanup tests and build

.Rbuildignore

@@ -2,3 +2,6 @@
 ^\.Rproj\.user$
 ^\.github$
 ^README\.Rmd$
+^Makefile$
+^Jenkinsfile$
+^Dockerfile$

DESCRIPTION

@@ -1,24 +1,24 @@
-Package: civilytics
-Type: Package
-Title: Utilities Functions for Civilytics
-Version: 0.1.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
-Depends:
-    R (>= 2.15.1)
-Imports:
-    ggplot2,
-    jpeg,
-    png,
-    stringr,
-    gridExtra,
-    grid
-Encoding: UTF-8
-LazyData: true
-Suggests: 
-    testthat
-RoxygenNote: 7.1.0
+Package: civilytics
+Type: Package
+Title: Utilities Functions for Civilytics
+Version: 0.1.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
+Depends:
+    R (>= 2.15.1)
+Imports:
+    ggplot2,
+    jpeg,
+    png,
+    stringr,
+    gridExtra,
+    grid
+Encoding: UTF-8
+LazyData: true
+Suggests: 
+    testthat
+RoxygenNote: 7.2.1

Dockerfile

@@ -0,0 +1,22 @@
+# [Choice] R version: 4, 4.2, 4.1, 4.0
+ARG VARIANT=4.2
+# [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
+FROM ${BASE_IMAGE}:${VARIANT}
+
+
+RUN apt-get update && apt-get install -y --no-install-recommends \
+  sudo \
+  libcurl4-gnutls-dev \
+  libxml2-dev \
+  libcairo2-dev \
+  libxt-dev \
+  libjpeg-dev \
+  libpng-dev \
+  openjdk-11-jdk \
+  libssl-dev \
+  libssh2-1-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

Jenkinsfile

@@ -0,0 +1,53 @@
+pipeline {
+  agent {
+    dockerfile true
+  }
+    stages {
+      stage('Docker setup') {
+        steps {
+         sh '''
+          R --version
+          java --version
+          '''
+        }
+
+      }
+      stage('Build and test') {
+        stages {
+          stage("Build package") {
+           steps {
+                sh '''
+                R CMD build .
+                '''
+            }
+          }
+        stage('Check') {
+          steps {
+            sh '''
+            R CMD check --no-manual civilytics_0.1.0.tar.gz
+            '''
+
+            sh '''
+            R CMD INSTALL civilytics_0.1.0.tar.gz
+            '''
+          }
+        }
+        stage('testthat'){
+         steps {
+         sh '''
+         R -e 'testthat::test_local(".")'
+         '''
+         }
+      }
+      stage('Clean') {
+        steps {
+
+          sh '''
+          @rm -rf civilytics_0.1.0.tar.gz civilytics.Rcheck
+          '''
+      }
+    }
+  }
+}
+}
+}

Makefile

@@ -0,0 +1,26 @@
+# h/t to @jimhester and @yihui for this parse block:
+# https://github.com/yihui/knitr/blob/dc5ead7bcfc0ebd2789fe99c527c7d91afb3de4a/Makefile#L1-L4
+# Note the portability change as suggested in the manual:
+# https://cran.r-project.org/doc/manuals/r-release/R-exts.html#Writing-portable-packages
+PKGNAME = `sed -n "s/Package: *\([^ ]*\)/\1/p" DESCRIPTION`
+PKGVERS = `sed -n "s/Version: *\([^ ]*\)/\1/p" DESCRIPTION`
+
+
+all: check
+
+build: install_deps
+	R CMD build .
+
+check: build
+	R CMD check --no-manual $(PKGNAME)_$(PKGVERS).tar.gz
+
+install_deps:
+	Rscript \
+	-e 'if (!requireNamespace("remotes")) install.packages("remotes")' \
+	-e 'remotes::install_deps(dependencies = TRUE)'
+
+install: build
+	R CMD INSTALL $(PKGNAME)_$(PKGVERS).tar.gz
+
+clean:
+	@rm -rf $(PKGNAME)_$(PKGVERS).tar.gz $(PKGNAME).Rcheck

NAMESPACE

@@ -8,6 +8,7 @@ export(countNA)
 export(dbSafeNames)
 export(findDots)
 export(get_png)
+export(grade_level_to_num)
 export(has_caption)
 export(make_logo_grob)
 export(measure_caption)
@@ -16,8 +17,10 @@ export(nvals)
 export(plot_jpeg)
 export(pretty_count)
 export(pretty_per)
+export(race_short_names)
 export(safe_max)
 export(simpleCap)
+export(star_subs)
 export(theme_civilytics)
 import(ggplot2)
 importFrom(ggplot2,theme)

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/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
@@ -84,7 +79,7 @@ add_logo <- function(plot, logo, margin_param = NULL) {
 #' @export
 #'
 #' @examples
-#' p1 <- 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 <- function(gg) {
   if (has_caption(gg)) {
@@ -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/utils.R

@@ -73,3 +73,77 @@ pretty_count <- function(x) {
   x <- prettyNum(x, big.mark = ",")
   return(x)
 }
+
+
+
+#' Unsuppress data using sampling
+#'
+#' @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
+#' @return a numeric vector with no characters representing suppressed values
+#' @export
+#'
+#' @examples
+#' 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 = 200)
+star_subs <- function(x, replace_char = "*",
+                      zeros = 15, max_value = 20) {
+  x[x == "*"] <- sample(c(rep("0", zeros), as.character(0:max_value)),
+                        sum(x==replace_char), replace = TRUE)
+  x <- as.numeric(x)
+  return(x)
+}
+
+
+
+#' Recode grade level from character to numeric
+#'
+#' @param x character description of grade levels from NCES style data
+#'
+#' @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)
+  x[x %in% c("KG", "Kindergarten")] <- "0"
+  x[x %in% c("Pre-K", "Pre-k", "Preschool", "Pre-Kindergarten")] <- "-1"
+  x[x %in% c("Adult", "Adult Education")] <- "13"
+  y <- as.numeric(x)
+  return(y)
+}
+
+
+#' Recode NCES race categories to shorter names
+#'
+#' @param x a character vector with NCES race codes, often from Urban Institute
+#'
+#' @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",
+             "African American")] <- "black"
+  x[x %in% c("Hispanic", "Hispanic Or Latino", "Hispanic or Latino")] <-
+    "hisp_lat"
+  x[x %in% c("White", "white", "White and Not Hispanic")] <- "white"
+  x[x %in% c("Asian", "Asian American")] <- "asian"
+  x[x %in% c("Two Or More Races", "Two or More Races")] <- "two_or_more"
+  x[x %in% c("Native Hawaiian Or Other Pacific Islander",
+             "Native Hawaiian or Other Pacific Islander",
+             "Native Hawaiian Pacific Islander")] <- "native_haw"
+  x[x %in% c("American Indian", "American Indian Or Alaska Native",
+             "American Indian or Alaska Native", "American Indian or Native Alaskan")] <- "amind"
+  x[x %in% c("Not Reported")] <- "other"
+  return(x)
+}
+
+

man/add_logo.Rd

@@ -14,7 +14,7 @@ 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

@@ -18,7 +18,7 @@ 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/countDots.Rd

@@ -10,7 +10,7 @@ countDots(x)
 \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_png.Rd

@@ -10,11 +10,8 @@ get_png(filename)
 \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
 }
-\examples{
-
-}

man/grade_level_to_num.Rd

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{grade_level_to_num}
+\alias{grade_level_to_num}
+\title{Recode grade level from character to numeric}
+\usage{
+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/measure_caption.Rd

@@ -17,6 +17,6 @@ the caption
 Measure a ggplot2 object caption
 }
 \examples{
-p1 <- qplot(mpg, wt, data = mtcars)
+p1 <- ggplot2::qplot(mpg, wt, data = mtcars)
 measure_caption(p1) # Should equal 1 since no caption is required
 }

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

@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{race_short_names}
+\alias{race_short_names}
+\title{Recode NCES race categories to shorter names}
+\usage{
+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/star_subs.Rd

@@ -0,0 +1,28 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/utils.R
+\name{star_subs}
+\alias{star_subs}
+\title{Unsuppress data using sampling}
+\usage{
+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}
+
+\item{max_value}{the numeric maximum value the replacement for the "*" can be}
+}
+\value{
+a numeric vector with no characters representing suppressed values
+}
+\description{
+Unsuppress data using sampling
+}
+\examples{
+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 = 200)
+}