Merge pull request #1 from pfizer-opensource/cran-release-v0.1

CRAN release v0.1

Author: chris-prener

.Rbuildignore

@@ -20,6 +20,8 @@
 ^\.github$
 ^revdep$
 ^CRAN-SUBMISSION$
-^data-raw$
+^inst/build-data$
+^inst/data-raw$
+^inst/examples$
 ^\.pfizer\.yml$
 ^LICENSE\.md$

CRAN-SUBMISSION

@@ -0,0 +1,3 @@
+Version: 0.1.0
+Date: 2024-07-12 15:44:43 UTC
+SHA: dc0ffc21f106e04a632d4488d7adca6934b3c3b4

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: zippeR
 Title: Working with United States ZIP Code and ZIP Code Tabulation Area Data
-Version: 0.1.0.9000
+Version: 0.1.0
 Authors@R: c(
     person("Christopher", "Prener", ,"Christopher.Prener@pfizer.com", c("aut", "cre"),
     comment = c(ORCID = "0000-0002-4310-9888")),
@@ -15,6 +15,7 @@ Description: Provides a set of functions for working with American postal codes,
 Depends: R (>= 3.5)
 License: Apache License (>= 2)
 URL: https://github.com/pfizer-opensource/zippeR
+BugReports: https://github.com/pfizer-opensource/zippeR/issues
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.3.1
@@ -26,14 +27,13 @@ Imports:
     purrr,
     readr,
     sf,
-    spatstat.geom,
+    spatstat.univar,
     stats,
     stringr,
     tibble,
     tidycensus,
     tidyr,
-    tigris,
-    utils
+    tigris
 Suggests:
     covr,
     knitr,

NAMESPACE

@@ -1,11 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
 export(zi_aggregate)
+export(zi_convert)
 export(zi_crosswalk)
 export(zi_get_demographics)
 export(zi_get_geometry)
+export(zi_label)
 export(zi_list_zctas)
 export(zi_load_crosswalk)
+export(zi_load_labels)
+export(zi_load_labels_list)
 export(zi_prep_hud)
 export(zi_repair)
 export(zi_validate)

NEWS.md

@@ -1,3 +1,3 @@
-# zippeR (development version)
+# zippeR 0.1.0
 
 * Initial CRAN submission version that contains functionality for working with UDS and HUD ZIP Code crosswalk files as well as Census Bureau ZCTA geometries and demographic data

R/zi_aggregate.R

@@ -53,50 +53,55 @@
 #'     \code{tidycensus::census_api_key()} has been used to write your key to
 #'     your \code{.Renviron} file. You can check whether an API key has been
 #'     written to \code{.Renviron} by using \code{Sys.getenv("CENSUS_API_KEY")}.
+#'
 #' @return A tibble containing all aggregated data requested in either
 #'     \code{"tidy"} or \code{"wide"} format.
 #'
 #' @examples
-#' \dontrun{
+#' # load sample demographic data
+#' mo22_demos <- zi_mo_pop
+#'
+#'   # the above data can be replicated with the following code:
+#'   # zi_get_demographics(year = 2022, variables = c("B01003_001", "B19013_001"),
+#'   #   survey = "acs5")
 #'
-#'   # download geometric data
-#'   geo <- zi_get_geometry(year = 2012, style = "zcta3",
-#'       state = "MO", territory = NULL, method = "centroid",
-#'       includes = c("516", "525"))
+#' # load sample geometric data
+#' mo22_zcta3 <- zi_mo_zcta3
 #'
-#'   # download demographic data
-#'   demo <- zi_get_demographics(year = 2012, variables = "B01003_001",
-#'       survey = "acs5")
+#'   # the above data can be replicated with the following code:
+#'   # zi_get_geometry(year = 2022, style = "zcta3", state = "MO",
+#'   #   method = "intersect")
 #'
-#'   # aggregate
-#'   demo <- zi_aggregate(demo, year = 2012, extensive = "B01003_001",
-#'       survey = "acs5", zcta = geo$ZCTA3)
+#' # aggregate a single variable
+#' zi_aggregate(mo22_demos, year = 2020, extensive = "B01003_001", survey = "acs5",
+#'   zcta = mo22_zcta3$ZCTA3)
 #'
+#' \donttest{
+#' # aggregate multiple variables, outputting wide data
+#' zi_aggregate(mo22_demos, year = 2020,
+#'   extensive = "B01003_001", intensive = "B19013_001", survey = "acs5",
+#'   zcta = mo22_zcta3$ZCTA3, output = "wide")
 #' }
 #'
 #' @export
 zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
                          intensive_method = "mean", survey,
                          output = "tidy", zcta = NULL, key = NULL){
 
-  # global variables
-  GEOID = ZCTA3 = key = variable = NULL
-
   # evaluate inputs
-
-  if (missing(year) == TRUE & missing(survey) == TRUE){
-    stop("Please specify arguments.")
+  if (missing(year)){
+    stop("The 'year' value is missing. Please provide a numeric value between 2010 and 2022.")
   }
 
-  if (is.numeric(year) == FALSE){
-    stop("The 'year' value provided is invalid. Please provide a numeric value between 2010 and 2020.")
+  if (!is.numeric(year)){
+    stop("The 'year' value provided is invalid. Please provide a numeric value between 2010 and 2022.")
   }
 
   if (length(survey) > 1){
     stop("One only 'survey' product may be requested at a time.")
   }
 
-  if (survey %in% c("sf1", "sf3", "acs1", "acs3", "acs5") == FALSE){
+  if (!survey %in% c("sf1", "sf3", "acs1", "acs3", "acs5")){
     stop("The 'survey' requested is invalid. Please choose one of 'sf1', 'sf3', 'acs1', 'acs3', or 'acs5'.")
   }
 
@@ -112,11 +117,15 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
     stop("The 'year' value provided is invalid for 3-year American Community Survey data. Please provide a year between 2010 and 2013.")
   }
 
-  if (output %in% c("tidy", "wide") == FALSE){
+  if (!output %in% c("tidy", "wide")){
     stop("The 'output' requested is invalid. Please choose one of 'tidy' or 'wide'.")
   }
 
-  if (survey %in% c("sf1", "sf3") == TRUE){
+  if (!inherits(.data, what = "data.frame")){
+    stop("The '.data' object provided is not a dataframe or dataframe like object. Please provide a dataframe.")
+  }
+
+  if (survey %in% c("sf1", "sf3")){
     error <- "Input data appear to be malformed - there should be three columns for Decennial Census data: 'GEOID', 'variable', and 'value'. Note that zi_aggregate() only accepts 'tidy' data."
 
     if (length(names(.data)) != 3){
@@ -138,23 +147,27 @@ zi_aggregate <- function(.data, year, extensive = NULL, intensive = NULL,
     }
   }
 
-  if (is.null(zcta) == FALSE){
+  if (!is.null(zcta)){
     valid <- zi_validate(zcta, style = "zcta3")
 
     if (valid == FALSE){
       stop("ZCTA data passed to the 'zcta' argument are invalid. Please use 'zi_validate()' with the 'verbose = TRUE' option to investgiate further. The 'zi_repair()' function may be used to address issues.")
     }
   }
 
+  if (is.null(extensive) & is.null(intensive)){
+    stop("At least one of 'extensive' or 'intensive' must be provided.")
+  }
+
   # set additional arguments
   ## call type
-  if (is.null(extensive) == FALSE){
+  if (!is.null(extensive)){
     extensive_id <- TRUE
   } else {
     extensive_id <- FALSE
   }
 
-  if (is.null(intensive) == FALSE){
+  if (!is.null(intensive)){
     intensive_id <- TRUE
   } else {
     intensive_id <- FALSE
@@ -301,7 +314,10 @@ zi_census_intensive <- function(.data, weights, method){
   if (method == "mean"){
     .data <- dplyr::summarise(.data, value = stats::weighted.mean(value, weight, na.rm = TRUE))
   } else if (method == "median"){
-    .data <- dplyr::summarise(.data, value = spatstat.geom::weighted.median(value, weight, na.rm = TRUE))
+    .data <- dplyr::summarise(
+      .data,
+      value = spatstat.univar::weighted.median(value, weight)
+    )
   }
 
   ## return output
@@ -389,9 +405,11 @@ zi_acs_intensive <- function(.data, weights, method){
                               estimate = stats::weighted.mean(estimate, weight, na.rm = TRUE),
                               moe = stats::weighted.mean(moe, weight, na.rm = TRUE))
   } else if (method == "median"){
-    .data <- dplyr::summarise(.data,
-                              estimate = spatstat.geom::weighted.median(estimate, weight, na.rm = TRUE),
-                              moe = spatstat.geom::weighted.median(moe, weight, na.rm = TRUE))
+    .data <- dplyr::summarise(
+      .data,
+      estimate = spatstat.univar::weighted.median(estimate, weight),
+      moe = spatstat.univar::weighted.median(moe, weight)
+    )
   }
 
   ## return output

R/zi_convert.R

@@ -0,0 +1,77 @@
+#' Convert Five-digit ZIP Codes to Three-digit ZIP Codes
+#'
+#' @description This function converts five-digit ZIP Codes to three-digit ZIP
+#'     Codes. The first three digits of a ZIP Code are known as the ZIP3 Code,
+#'     and corresponds to the sectional center facility (SCF) that processes mail
+#'     for a region.
+#'
+#' @usage zi_convert(.data, input_var, output_var)
+#'
+#' @param .data A data frame containing a column of five-digit ZIP Codes.
+#' @param input_var A character scalar specifying the column name with the five-digit
+#'    ZIP Codes in the data frame.
+#' @param output_var Optional; A character scalar specifying the column name to
+#'    store the three-digit ZIP Codes in the data frame.
+#'
+#' @return A tibble containing the original data frame with a new column of
+#'   three-digit ZIP Codes.
+#'
+#' @examples
+#' # add new column
+#' ## create sample data
+#' df <- data.frame(id = c(1:3), zip5 = c("63005", "63139", "63636"))
+#'
+#' ## convert ZIP Codes to ZIP3, creating a new column
+#' zi_convert(.data = df, input_var = zip5, output_var = zip3)
+#'
+#' # overwrite existing column
+#' ## create sample data
+#' df <- data.frame(id = c(1:3), zip = c("63005", "63139", "63636"))
+#'
+#' ## convert ZIP Codes to ZIP3, creating a new column
+#' zi_convert(.data = df, input_var = zip)
+#'
+#' @export
+zi_convert <- function(.data, input_var, output_var){
+
+  # check inputs
+  if (!inherits(.data, what = "data.frame")){
+    stop("The '.data' object provided is not a data frame.")
+  }
+
+  if (missing(input_var)){
+    stop("A value for 'input_var' is required.")
+  }
+
+  input_varQN <- as.character(substitute(input_var))
+
+  if (input_varQN %in% names(.data) == FALSE){
+    stop("The given 'input_var' column is not found in your data object.")
+  }
+
+  valid <- zi_validate(x = .data[[input_varQN]])
+
+  if (valid == FALSE){
+    stop(paste0("Input ZIP Code data in the '", input_varQN, "' column are invalid. Please use 'zi_validate()' with the 'verbose = TRUE' option to investigate further. The 'zi_repair()' function may be used to address issues."))
+  }
+
+  if (!missing(output_var)){
+    output_varQN <- as.character(substitute(input_var))
+
+    if (output_varQN %in% names(.data) == TRUE){
+      warning(paste0("The given 'output_var' column, '", output_varQN , "', was found in your data object, and the column was overwritten."))
+    }
+  } else {
+    output_varQN <- input_varQN
+  }
+
+  # convert ZIP Codes to ZIP3
+  .data[[output_varQN]] <- substr(.data[[input_varQN]], 1, 3)
+
+  # create output
+  out <- tibble::as_tibble(.data)
+
+  # return output
+  return(out)
+
+}