R/data_access.R

In eiballots: Ballot-Level Microdata and Summaries for Ecological Inference (Florida 2000)

# eiballots/R/data_access.R
# User-facing functions for data loading and catalog browsing.

# ----------------------------------------------------------------------------
# Loading functions
# ----------------------------------------------------------------------------

#' Load raw microdata for a single county
#'
#' Reads a county-level `.RData` file and returns its contents as a
#' `data.frame`. The data source is resolved in this order:
#' 1. The `source` argument (if not `NULL`).
#' 2. `getOption("data_dir")` (set once with `options(data_dir = ...)`).
#' 3. The default OSF repository (online).
#'
#' @param county Character string. County code, e.g. `"Lee"`. Must be a key
#'   in [county_catalog].
#' @param source Character string or `NULL`. Either a local directory path
#'   (e.g. `"~/data/"`) or the base URL of a remote repository. If `NULL`,
#'   the source is resolved automatically (see Details).
#'
#' @return A `data.frame` with one row per voter and columns:
#'   \itemize{
#'     \item `COUNTY`: county code.
#'     \item `PRECINCT`: precinct identifier within the county.
#'     \item One column per race on the ballot (see [election_catalog] for
#'       the code-to-office mapping).
#'   }
#'
#' @details
#' To avoid specifying `source` in every call, set `options(data_dir)` once
#' at the start of your session or in your `.Rprofile`:
#' ```r
#' options(data_dir = "~/my_data/")   # local files
#' # or leave unset to use the online OSF repository
#' ```
#'
#' @examples
#' \donttest{
#' # From the online repository
#' lee <- get_county_data("Lee")
#'
#' # From a local directory
#' lee <- get_county_data("Lee", source = "~/local_data/")
#' }
#'
#' @seealso [get_election_data()], [ei_summary()], [list_counties()]
#' @export
get_county_data <- function(county, source = NULL) {
    if (inherits(county, "county")) county <- county$county
    if (!county %in% names(county_catalog))
    stop(
      sprintf(
        "County '%s' not found in the catalog.\nUse list_counties() to see available counties.",
        county
      ),
      call. = FALSE
    )
  .fetch_county_file(county, .get_source(source))
}


#' Load raw microdata for one or more races
#'
#' Determines which county files are needed for the requested races, loads
#' them (downloading if necessary), and returns a combined `data.frame` with
#' only the relevant columns.
#'
#' @param elections Character vector of race codes, e.g. `c("PRE", "USS")`.
#'   All codes must be keys in [election_catalog].
#' @param source Character string or `NULL`. Either a local directory path
#'   (e.g. `"~/data/"`) or the base URL of a remote repository. If `NULL`,
#'   the source is resolved automatically (see Details).
#'
#' @return A `data.frame` with columns `COUNTY`, `PRECINCT`, and one column
#'   per requested race. Rows from all relevant counties are combined via
#'   `rbind`. Voters not eligible for a given race have `NA` in that column.
#'
#' @details
#' The counties to load are determined automatically from [election_catalog].
#' For races spanning all counties (`counties = "all"`), every county in
#' [county_catalog] is loaded. For district-level races, only the relevant
#' counties are loaded.
#'
#' To avoid specifying `source` in every call, set `options(data_dir)` once
#' at the start of your session or in your `.Rprofile`:
#' ```r
#' options(data_dir = "~/my_data/")   # local files
#' # or leave unset to use the online OSF repository
#' ```
#'
#' @examples
#' \donttest{
#' # Presidential and Senate races (all counties)
#' df <- get_election_data(c("PRE", "USS"))
#'
#' # Including a district-level race (only counties with that race)
#' df <- get_election_data(c("PRE", "HOS3"))
#' }
#'
#' @seealso [get_county_data()], [ei_summary()]
#' @export
get_election_data <- function(elections, source = NULL) {
  .validate_elections(elections)
  counties.needed <- .counties_for_elections(elections)
  src             <- .get_source(source)

  data.list <- lapply(counties.needed, function(co) {
    d         <- get_county_data(co, source = src)
    cols.keep <- c("COUNTY", "PRECINCT", elections)
    # Races not present in this county become NA columns
    for (e in setdiff(elections, names(d))) d[[e]] <- NA_character_
    d[, cols.keep, drop = FALSE]
  })

  do.call(rbind, data.list)
}


# ----------------------------------------------------------------------------
# Catalog browsing functions
# ----------------------------------------------------------------------------

#' List available races
#'
#' Returns a summary `data.frame` of the races available in the dataset,
#' optionally filtered by type or level.
#'
#' @param type Optional. Filter by race type: `"single_member"`,
#'   `"multi_member"`, or `"referendum"`.
#' @param level Optional. Filter by scope: `"federal"`, `"state"`,
#'   `"county"`, `"district"`, or `"local"`.
#'
#' @return A `data.frame` with columns `code`, `office`, `type`, `level`,
#'   and `counties`.
#'
#' @examples
#' list_elections()
#' list_elections(level = "federal")
#' list_elections(type = "referendum")
#'
#' @seealso [election_catalog], [list_counties()]
#' @export
list_elections <- function(type = NULL, level = NULL) {
  rows <- lapply(names(election_catalog), function(code) {
    e <- election_catalog[[code]]
    data.frame(
      code     = code,
      office   = e$office,
      type     = e$type,
      level    = e$level,
      counties = if (identical(e$counties, "all")) "all"
                 else paste(e$counties, collapse = ", "),
      stringsAsFactors = FALSE
    )
  })
  df <- do.call(rbind, rows)
  if (!is.null(type))  df <- df[df$type  == type,  , drop = FALSE]
  if (!is.null(level)) df <- df[df$level == level, , drop = FALSE]
  rownames(df) <- NULL
  df
}


#' List available counties
#'
#' Returns a `data.frame` with each county in the dataset and the number of
#' races in its data file.
#'
#' @return A `data.frame` with columns `county` and `n_elections`.
#'
#' @examples
#' list_counties()
#'
#' @seealso [county_catalog], [list_elections()]
#' @export
list_counties <- function() {
  df <- data.frame(
    county      = names(county_catalog),
    n_elections = vapply(county_catalog, length, integer(1L)),
    stringsAsFactors = FALSE
  )
  rownames(df) <- NULL
  df
}


# ----------------------------------------------------------------------------
# Internal catalog helpers
# ----------------------------------------------------------------------------

.validate_elections <- function(elections) {
  unknown <- setdiff(elections, names(election_catalog))
  if (length(unknown) > 0L)
    stop(
      sprintf(
        "Race code(s) not found in catalog: %s\nUse list_elections() to see available races.",
        paste(unknown, collapse = ", ")
      ),
      call. = FALSE
    )
  invisible(TRUE)
}

#.counties_for_elections <- function(elections) {
#  all.cnts <- lapply(elections, function(e) {
#    cnts <- election_catalog[[e]]$counties
#    if (identical(cnts, "all")) names(county_catalog) else cnts
#  })
#  unique(unlist(all.cnts))
#}

.counties_for_elections <- function(elections) {
  all_cnts <- lapply(elections, function(e) {
    cnts <- election_catalog[[e]]$counties
    if (identical(cnts, "all")) names(county_catalog) else cnts
  })
  # Intersection: load only counties present in ALL requested elections.
  result <- Reduce(intersect, all_cnts)
  if (length(result) == 0L)
    warning(
      sprintf(
        paste0(
          "No county participates in all requested elections: %s.\n",
          "Check election_catalog for each race's geographic scope.\n",
          "Use list_elections() to see the counties for each race."
        ),
        paste(elections, collapse = ", ")
      ),
      call. = FALSE
    )
  result
}