R/laus_parse_series.R

Defines functions laus_parse_series

Documented in laus_parse_series

# Copyright (C) 2022 by Higher Expectations for Racine County

FIELD_SIZES <- c(
    LAUS = 2,
    SEASONALITY = 1,
    AREA_TYPE = 2,
    STATE_OR_REGION = 2,
    AREA_CODE = 11,
    MEASURE_CODE = 2
)

SERIES_BREAKS <- cumsum(FIELD_SIZES)
SERIES_NAMES <- c(
    NA,
    "seasonal",
    "area_prefix",
    "srd_code",
    "area_fips",
    "measure_code"
)

N_PARTS <- length(SERIES_NAMES)

INTEGER_COLUMNS <- SERIES_NAMES[c(4, 6)]


#' Separate a LAUS series code into its components
#'
#' @param .codes character vector with series codes
#'
#' @return a data frame with the following fields
#'     \describe{
#'         \item{seasonal}{'S' for seasonally-transformed data, 'U' otherwise}
#'         \item{area_prefix}{a 2-character code describing a level of geographic organization}
#'         \item{srd_code}{an integer holding a 2-digit FIPS code for a state, census region, or census division}
#'         \item{area_fips}{an 11-character FIPS code for an intrastate area}
#'         \item{measure_code}{an integer code for what the series measures.}
#'     }
#' @export
#'
#' @examples
#' laus_parse_series(c(
#'     "LAUST290000000000009",
#'     "LAUCS233569500000005",
#'     "LAUMT542658000000003",
#'     "LAUCN170630000000005",
#'     "LAUCA392120000000004",
#'     "LAUCN210230000000003",
#'     "LAUCN190410000000006",
#'     "LAUCT134319200000005",
#'     "LAUMC554802000000004",
#'     "LAURD840000000000006"
#' ))
laus_parse_series <- function(.codes) {
    if (any(nchar(.codes) != 20L)) {
        stop(".x must be vector of 20-character strings")
    }
    .result <- purrr::map2(
        SERIES_BREAKS[-N_PARTS] + 1,
        SERIES_BREAKS[-1],
        \(.x, .y) stringr::str_sub(.codes, start = .x, end = .y)
    ) |>
        rlang::set_names(
            SERIES_NAMES[-1]
        ) |>
        tibble::as_tibble() |>
        dplyr::mutate(
            dplyr::across(tidyselect::all_of(INTEGER_COLUMNS),
                          as.integer)
    ) |>
    invisible()
}
higherX4Racine/hiRx documentation built on Nov. 18, 2024, 10:20 a.m.