├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── geolocate.R ├── internals.R ├── lookup.R ├── sysdata.rda └── zzz.R ├── README.Rmd ├── README.md ├── codecov.yml ├── cran-comments.md ├── data-raw ├── .gitignore ├── archive-tracts.R ├── archive-zips.R ├── internal.R ├── tiger-local.vrt └── tiger.vrt ├── fipio.Rproj ├── inst └── testdata │ └── testdata.rds ├── man ├── as_fips.Rd ├── coords_to_fips.Rd ├── dot-intersects.Rd ├── dot-segment_intersect.Rd ├── figures │ └── logo.png ├── fips_abbr.Rd ├── fips_county.Rd ├── fips_geometry.Rd ├── fips_metadata.Rd ├── fips_state.Rd └── using_fastmatch.Rd ├── pkgdown ├── _pkgdown.yml └── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico └── tests ├── testthat.R └── testthat ├── setup-fipio.R └── test-fipio.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^LICENSE\.md$ 2 | ^codecov\.yml$ 3 | ^\.github$ 4 | ^README\.Rmd$ 5 | ^cran-comments\.md$ 6 | ^_pkgdown\.yml$ 7 | ^docs$ 8 | ^pkgdown$ 9 | ^data-raw$ 10 | ^CRAN-SUBMISSION$ 11 | ^CRAN-RELEASE$ 12 | ^.*\.Rproj$ 13 | ^\.Rproj\.user$ 14 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: macOS-latest, r: 'release'} 26 | 27 | - {os: windows-latest, r: 'release'} 28 | # Use 3.6 to trigger usage of RTools35 29 | - {os: windows-latest, r: '3.6'} 30 | 31 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 32 | - {os: ubuntu-latest, r: 'release'} 33 | - {os: ubuntu-latest, r: 'oldrel-1'} 34 | - {os: ubuntu-latest, r: 'oldrel-2'} 35 | - {os: ubuntu-latest, r: 'oldrel-3'} 36 | 37 | env: 38 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 39 | R_KEEP_PKG_SOURCE: yes 40 | 41 | steps: 42 | - uses: actions/checkout@v4 43 | 44 | - uses: r-lib/actions/setup-r@v2 45 | with: 46 | r-version: ${{ matrix.config.r }} 47 | http-user-agent: ${{ matrix.config.http-user-agent }} 48 | use-public-rspm: true 49 | 50 | - uses: r-lib/actions/setup-r-dependencies@v2 51 | with: 52 | extra-packages: any::rcmdcheck 53 | needs: check 54 | 55 | - uses: r-lib/actions/check-r-package@v2 56 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | tags: ['*'] 7 | 8 | name: pkgdown 9 | 10 | jobs: 11 | pkgdown: 12 | runs-on: ubuntu-latest 13 | env: 14 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 15 | steps: 16 | - uses: actions/checkout@v4 17 | 18 | - uses: r-lib/actions/setup-pandoc@v2 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::pkgdown, local::. 27 | needs: website 28 | 29 | - name: Deploy package 30 | run: | 31 | git config --local user.name "$GITHUB_ACTOR" 32 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 33 | Rscript -e 'pkgdown::deploy_to_branch(branch = "docs", new_process = FALSE)' 34 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: covr::codecov() 31 | shell: Rscript {0} 32 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .Rdata 4 | .httr-oauth 5 | .DS_Store 6 | docs 7 | inst/doc -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: fipio 2 | Title: Lightweight Federal Information Processing System (FIPS) Code Information Retrieval 3 | Version: 1.1.2.9000 4 | Authors@R: 5 | c(person(given = "Justin", 6 | family = "Singh-Mohudpur", 7 | role = c("aut", "cre"), 8 | email = "justin@justinsingh.me", 9 | comment = c(ORCID = "0000-0002-5233-5799")), 10 | person(given = "Mike", 11 | family = "Johnson", 12 | role = "ctb", 13 | email = "mikecp11@gmail.com", 14 | comment = c(ORCID = "0000-0002-5288-8350")), 15 | person(given = "Urban Flooding Open Knowledge Network (UF-OKN)", 16 | role = c("fnd"))) 17 | Description: Provides a lightweight suite 18 | of functions for retrieving information 19 | about 5-digit or 2-digit US FIPS codes. 20 | URL: https://fipio.justinsingh.me, https://github.com/program--/fipio 21 | BugReports: https://github.com/program--/fipio/issues 22 | License: MIT + file LICENSE 23 | Encoding: UTF-8 24 | Roxygen: list(markdown = TRUE) 25 | RoxygenNote: 7.1.2 26 | Depends: 27 | R (>= 3.5.0) 28 | Suggests: 29 | testthat (>= 3.0.0), 30 | mockery (>= 0.4.2), 31 | covr, 32 | fastmatch (>= 1.0.0) 33 | Config/testthat/edition: 3 34 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: fipio authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 fipio authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(coords_to_fips,character) 4 | S3method(coords_to_fips,data.frame) 5 | S3method(coords_to_fips,list) 6 | S3method(coords_to_fips,matrix) 7 | S3method(coords_to_fips,numeric) 8 | S3method(coords_to_fips,sf) 9 | S3method(coords_to_fips,sfc) 10 | S3method(coords_to_fips,sfg) 11 | export(as_fips) 12 | export(coords_to_fips) 13 | export(fips_abbr) 14 | export(fips_county) 15 | export(fips_geometry) 16 | export(fips_metadata) 17 | export(fips_state) 18 | export(using_fastmatch) 19 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # fipio 1.1.2.9000 2 | 3 | # fipio 1.1.2 4 | 5 | - Fixed `coords_to_fips()` throwing `order` error due to `ret_index` being a list ([#15](https://github.com/program--/fipio/issues/15)) 6 | - Return documentation back to linking to https://github.com/program-- instead of UFOKN's GitHub org. 7 | 8 | # fipio 1.1.1 9 | 10 | - Added [Mike Johnson](https://github.com/mikejohnson51) to `DESCRIPTION`. 11 | - Fixed `coords_to_fips()` throwing error in some edge cases ([#11](https://github.com/program--/fipio/issues/11)). 12 | - Fixed `as_fips()` throwing error for unknown states. ([#10](https://github.com/program--/fipio/issues/10)). 13 | - Fixed `as_fips()` edge case throwing error ([#13](https://github.com/program--/fipio/pull/13)). 14 | 15 | # fipio 1.1.0 16 | 17 | * **`fipio` now depends on R >= 3.5.0 due to using `.rds` and version 3 `.rda` files.** 18 | 19 | ## Enhancements 20 | * Updated internal FIPS table to TIGER 2021. 21 | * Removed `sfheaders` from suggested imports. 22 | 23 | ## New features 24 | * Added the function `coords_to_fips()`, which provides coordinates to FIPS code utility. This is implemented without `sf` using a simple ray casting algorithm for intersections. Based on a few benchmarks, `coords_to_fips()` performs approximately the same as using `sf::st_intersects()` against the geometry table, but is most likely slower in the case of having a *large* amount of points. 25 | * Added the function `as_fips()`, which provides a reverse lookup utility for FIPS codes. 26 | * Added `fastmatch` to `Suggests`. If `fastmatch` is installed, all `fipio` functions utilizing `base::match` will instead use `fastmatch::fmatch`. 27 | - *Note:* this addition includes the function `fipio::using_fastmatch()` for debugging purposes, and test coverage for `.has_fastmatch()`, `using_fastmatch()`, and `.onLoad()` are *essentially* covered by the unit test containing the function calls to `expect_match_assignment()`. 28 | * Added `data-raw/` directory describing process to get internal tables. 29 | 30 | 31 | # fipio 1.0.0 32 | 33 | * Added a `NEWS.md` file to track changes to the package. 34 | * Initial commit to version control with the following functions: 35 | - `fips_abbr()` - Gets state abbreviation. 36 | - `fips_state()` - Gets state name. 37 | - `fips_county()` - Gets county name. 38 | - `fips_geometry()` - Gets geometry. 39 | - `fips_metadata()` - Gets the information above as a `data.frame`. 40 | -------------------------------------------------------------------------------- /R/geolocate.R: -------------------------------------------------------------------------------- 1 | #' @title Associate a set of coordinates to FIPS codes 2 | #' @param x `data.frame`, `matrix`, `sf`/`sfc`/`sfg` object, 3 | #' or longitude in *EPSG:4326* 4 | #' @param ... Named arguments passed on to methods 5 | #' @param y Latitude in *EPSG:4326* 6 | #' @param coords Coordinates columns if `x` is a `data.frame` or `matrix`. 7 | #' @examples 8 | #' # Some coordinates at UC Santa Barbara 9 | #' coords_to_fips(x = -119.8696, y = 34.4184) 10 | #' @return a `character` vector of FIPS codes 11 | #' @export 12 | coords_to_fips <- function(x, ...) { 13 | UseMethod("coords_to_fips") 14 | } 15 | 16 | # nocov start 17 | #' @rdname coords_to_fips 18 | #' @export 19 | coords_to_fips.sf <- function(x, ...) { 20 | coords_to_fips( 21 | x = do.call( 22 | rbind, 23 | lapply(x[[attr(x, "sf_column")]], as.numeric) 24 | ) 25 | ) 26 | } 27 | 28 | #' @rdname coords_to_fips 29 | #' @export 30 | coords_to_fips.sfc <- function(x, ...) { 31 | coords_to_fips(x = do.call(rbind, lapply(x, as.numeric))) 32 | } 33 | 34 | #' @rdname coords_to_fips 35 | #' @export 36 | coords_to_fips.sfg <- function(x, ...) { 37 | coords_to_fips(x = as.numeric(x)[[1]], 38 | y = as.numeric(x)[[2]]) 39 | } 40 | # nocov end 41 | 42 | #' @rdname coords_to_fips 43 | #' @export 44 | coords_to_fips.list <- function(x, ...) { 45 | coords_to_fips(x = do.call(rbind, x)) 46 | } 47 | 48 | #' @rdname coords_to_fips 49 | #' @export 50 | coords_to_fips.data.frame <- function(x, coords = c(1, 2), ...) { 51 | coords_to_fips(x = x[[coords[1]]], 52 | y = x[[coords[2]]]) 53 | } 54 | 55 | #' @rdname coords_to_fips 56 | #' @export 57 | coords_to_fips.matrix <- function(x, coords = c(1, 2), ...) { 58 | coords_to_fips(x = x[, coords[1]], 59 | y = x[, coords[2]]) 60 | } 61 | 62 | #' @rdname coords_to_fips 63 | #' @export 64 | coords_to_fips.character <- function(x, y, ...) { 65 | coords_to_fips(x = as.numeric(x), 66 | y = as.numeric(y)) 67 | } 68 | 69 | #' @rdname coords_to_fips 70 | #' @export 71 | coords_to_fips.numeric <- function(x, y, ...) { 72 | county_fips <- nchar(as.character(.lookup_fips)) > 3 73 | lookup_fips <- .lookup_fips[county_fips] 74 | lookup_geometry <- .geometry_fips[county_fips] 75 | rm(county_fips) 76 | 77 | # Filter out geometries by bounding box, 78 | # like a spatial index 79 | intersected <- which(sapply( 80 | lookup_geometry, 81 | FUN = function(g) { 82 | bb <- .bbox(g) 83 | any(x >= bb[1] & y >= bb[2] & 84 | x <= bb[3] & y <= bb[4]) 85 | }, 86 | USE.NAMES = FALSE 87 | )) 88 | 89 | # Get fips and geometry based on `intersected` 90 | lookup_fips <- lookup_fips[intersected] 91 | lookup_geometry <- lookup_geometry[intersected] 92 | 93 | ret_index <- lapply( 94 | lookup_geometry, 95 | FUN = .intersects, 96 | x = x, 97 | y = y 98 | ) 99 | 100 | ret_value <- .pad0(lookup_fips)[!is.na(ret_index)] 101 | ret_index <- ret_index[!is.na(ret_index)] 102 | 103 | rm(lookup_fips, lookup_geometry) 104 | 105 | result <- character(length(x)) 106 | for (ind in seq_along(ret_value)) { 107 | result[ret_index[[ind]]] <- ret_value[ind] 108 | } 109 | 110 | result 111 | } 112 | -------------------------------------------------------------------------------- /R/internals.R: -------------------------------------------------------------------------------- 1 | #nocov start 2 | #' @keywords internal 3 | .has_fastmatch <- function() { 4 | requireNamespace("fastmatch", quietly = TRUE) 5 | } 6 | #nocov end 7 | 8 | #' @keywords internal 9 | .bbox <- function(geometry) { 10 | geometry <- .to_matrix(geometry) 11 | c(xmin = min(geometry[, 1]), 12 | ymin = min(geometry[, 2]), 13 | xmax = max(geometry[, 1]), 14 | ymax = max(geometry[, 2])) 15 | } 16 | 17 | #' Simple intersection via ray casting 18 | #' @return indices of points in `x` and `y` 19 | #' that intersect `geometry` 20 | #' @keywords internal 21 | .intersects <- function(x, y, geometry) { 22 | geometry <- .to_matrix(geometry) 23 | starts <- geometry[-nrow(geometry), ] 24 | ends <- geometry[-1, ] 25 | nodes <- cbind(starts, ends) 26 | rm(starts, ends) 27 | 28 | sides <- lapply( 29 | seq_len(nrow(nodes)), 30 | FUN = function(i) { 31 | list(list(X = nodes[i, 1], 32 | Y = nodes[i, 2]), 33 | list(X = nodes[i, 3], 34 | Y = nodes[i, 4])) 35 | } 36 | ) 37 | 38 | # `names(.)` are the indices of points in `x` and `y` 39 | # the values are how many sides that point intersects with `geometry` 40 | points_per_side <- table(unlist(lapply( 41 | sides, 42 | FUN = function(side) which(.segment_intersect(side, x, y)) 43 | ))) 44 | 45 | # indices of the point(s) that intersect with `geometry` 46 | # i.e. if below = 6, then (x[6], y[6]) intersects `geometry`. 47 | ret <- as.numeric(names(which(points_per_side %% 2 == 1))) 48 | 49 | if (length(ret) == 0) { 50 | NA_real_ 51 | } else { 52 | ret 53 | } 54 | } 55 | 56 | #' Check if a point intersects with a side of a polygon 57 | #' @keywords internal 58 | .segment_intersect <- function(side, x, y) { 59 | .slope <- function(x1, y1, x2, y2) ((y2 - y1) / (x2 - x1)) 60 | 61 | offset <- ifelse(side[[1]]$Y > side[[2]]$Y, 1, 0) 62 | a <- side[[1 + offset]] 63 | b <- side[[2 - offset]] 64 | y <- ifelse((y == a$Y) | (y == b$Y), y + 0.0001, y) 65 | m1 <- ifelse(a$X != b$X, .slope(a$X, a$Y, b$X, b$Y), Inf) 66 | m2 <- ifelse(a$X != x, .slope(a$X, a$Y, x, y), Inf) 67 | c1 <- (y < a$Y | y > b$Y) | (x > max(a$X, b$X)) 68 | c2 <- x < min(a$X, b$X) 69 | 70 | ifelse(c1, FALSE, ifelse(c2, TRUE, m2 >= m1)) 71 | } 72 | 73 | #nocov start 74 | #' @keywords internal 75 | .to_matrix <- function(geometry) { 76 | if (isNamespaceLoaded("sf")) { 77 | as.matrix(geometry) 78 | } else { 79 | do.call( 80 | rbind, 81 | unlist(geometry, 82 | recursive = FALSE) 83 | ) 84 | } 85 | } 86 | 87 | #' @keywords internal 88 | .index <- function(fips, tbl = .lookup_fips) { 89 | match(as.integer(fips), tbl) 90 | } 91 | 92 | 93 | #' @keywords internal 94 | .pad0 <- function(x) { 95 | sapply(x, function(y) { 96 | if (is.na(y)) { 97 | as.character(y) 98 | } else { 99 | sprintf(paste0( 100 | "%0", 101 | if (nchar(as.character(y)) < 3) 2 else 5, 102 | if (is.character(y)) "s" else "d" 103 | ), y) 104 | } 105 | }, USE.NAMES = FALSE) 106 | } 107 | 108 | #' @keywords internal 109 | .pad <- function(x, len) { 110 | sapply(x, function(y) { 111 | if (is.na(y)) { 112 | as.character(y) 113 | } else { 114 | sprintf(paste0( 115 | "%0", 116 | len, 117 | if (is.character(y)) "s" else "d" 118 | ), y) 119 | } 120 | }, USE.NAMES = FALSE) 121 | } 122 | 123 | #' @keywords internal 124 | .subint <- function(x, n) { 125 | if (n <= 0) { 126 | stop("n must be > 0") 127 | } 128 | 129 | tmp <- as.double(x) 130 | cutoff <- 10 ^ n 131 | 132 | while (any(abs(tmp) >= cutoff)) { 133 | index <- abs(tmp) >= cutoff 134 | tmp[index] <- tmp[index] / 10 135 | } 136 | 137 | as.integer(trunc(tmp)) 138 | } 139 | #nocov end -------------------------------------------------------------------------------- /R/lookup.R: -------------------------------------------------------------------------------- 1 | #' @title Convert a state name, abbreviation, or county name to FIPS codes 2 | #' @param state State names, state abbreviations, or 3 | #' one of the following: "all", "conus", "territories" 4 | #' @param county County names or "all" 5 | #' @return a `character` vector 6 | #' @examples 7 | #' fipio::as_fips(state = "California") 8 | #' fipio::as_fips(state = "NC") 9 | #' fipio::as_fips(state = "Rhode Island", county = "Washington") 10 | #' fipio::as_fips(c("CA", "North Carolina"), c("Stanislaus", "NEW HANOVER")) 11 | #' fipio::as_fips("CONUS") 12 | #' fipio::as_fips(state = "NC", county = "all") 13 | #' 14 | #' @export 15 | as_fips <- function(state, county = NULL) { 16 | if (missing(state) | any(state == "") | is.null(state)) { 17 | stop("`state` must be specified at least.", call. = FALSE) 18 | } 19 | 20 | contains_all <- "all" %in% state 21 | contains_ter <- ("us-territories" %in% state) | 22 | ("territories" %in% state) 23 | 24 | if (length(state) > 1) { 25 | if (contains_all & !contains_ter) { 26 | stop(paste("`state` must only also contain ", 27 | "'territories' or 'us-territories'", 28 | "when it contains 'all'.")) 29 | } 30 | } 31 | 32 | state <- tolower(state) 33 | state <- ifelse( 34 | state == "virgin islands" | state == "us virgin islands", 35 | "united states virgin islands", 36 | ifelse( 37 | state == "northern mariana islands" | state == "mariana islands", 38 | "commonwealth of the northern mariana islands", 39 | state 40 | ) 41 | ) 42 | 43 | ind <- nchar(as.character(.lookup_fips)) < 3 44 | ret <- .lookup_fips[ind] 45 | 46 | if (contains_all) { 47 | if (!contains_ter) { 48 | # Only states, no territories 49 | ret <- ret[ret < 60] 50 | } 51 | } else if ("conus" %in% state) { 52 | # Return all state fip codes, except HI, AK, Guam, etc. 53 | if (contains_ter) { 54 | # CONUS and territories 55 | ret <- ret[!ret %in% c(2, 15)] 56 | } else { 57 | # Only CONUS 58 | ret <- ret[!ret %in% c(2, 15, 60, 66, 69, 72, 78)] 59 | } 60 | } else { 61 | if (contains_ter) { 62 | repl <- which(state == "us-territories" | state == "territories") 63 | 64 | state <- c( 65 | state[seq_len(repl - 1)], 66 | "american samoa", 67 | "guam", 68 | "commonwealth of the northern mariana islands", 69 | "puerto rico", 70 | "united states virgin islands", 71 | if (repl != length(state)) state[seq(repl + 1, length(state))] 72 | ) 73 | } 74 | 75 | # Return state fip codes based on name 76 | nms <- tolower(with(.metadata_fips, name[ind])) 77 | abr <- tolower(with(.metadata_fips, state_abbr[ind])) 78 | x <- match(state, nms) 79 | y <- match(state, abr) 80 | rm(nms, abr) 81 | 82 | x[is.na(x) & !is.na(y)] <- y[is.na(x) & !is.na(y)] 83 | ret <- ret[x] 84 | rm(x, y) 85 | } 86 | 87 | if (any(!is.null(county))) { 88 | county <- tolower(county) 89 | c_ind <- !ind & as.integer(substr(.pad0(.lookup_fips), 1, 2)) %in% ret 90 | 91 | if ("all" %in% county) { 92 | if (length(county) == 1) { 93 | # Return all fip codes in every state 94 | ret <- .lookup_fips[c_ind] 95 | } else { 96 | ret <- unlist(mapply(as_fips, state, county), use.names = FALSE) 97 | } 98 | } else { 99 | abr <- with(.metadata_fips, state_abbr[match(ret, .lookup_fips)]) 100 | county <- trimws(gsub("county", "", county)) # county names 101 | counties <- with(.metadata_fips, name[c_ind]) # county fips codes 102 | 103 | # matched county codes 104 | county_codes <- .lookup_fips[c_ind][ 105 | match(county, tolower(counties)) 106 | ] 107 | 108 | if (length(ret) != length(county_codes)) { 109 | # max() call solves edge case `state = c("CA", "NC")`, 110 | # `county = "Stanislaus"` where only c("06099") is returned. 111 | ret <- rep(ret, length.out = max( 112 | length(county_codes), 113 | length(state), 114 | length(county) 115 | )) 116 | } 117 | 118 | if (all(is.na(county_codes))) { 119 | repl <- TRUE 120 | } else { 121 | repl <- !is.na(c( 122 | county_codes, 123 | rep(NA, abs(length(ret) - length(county_codes))) 124 | )) 125 | } 126 | 127 | ret[repl] <- county_codes[repl] 128 | 129 | # solves returning NA for nonexistant counties 130 | if (length(!is.na(county)) > length(state) & 131 | length(is.na(county)) != 0) { 132 | ret[!repl] <- NA 133 | } 134 | } 135 | } 136 | 137 | # added as.integer() to force left 0 padding, 138 | # doesn't seem to work with strings 139 | .pad0(as.integer(ret)) 140 | } 141 | 142 | #' @title Get the state abbreviation for a FIPS code 143 | #' @param fip 2-digit or 5-digit FIPS code 144 | #' @return a `character` vector 145 | #' @examples 146 | #' fipio::fips_abbr("37") 147 | #' fipio::fips_abbr("06001") 148 | #' 149 | #' @export 150 | fips_abbr <- function(fip) { 151 | with(.metadata_fips, state_abbr[.index(fip)]) 152 | } 153 | 154 | #' @title Get the state name for a FIPS code 155 | #' @inheritParams fips_abbr 156 | #' @return a `character` vector 157 | #' @examples 158 | #' fipio::fips_state("37") 159 | #' fipio::fips_state("06001") 160 | #' 161 | #' @export 162 | fips_state <- function(fip) { 163 | x <- with(.metadata_fips, state_name[.index(fip)]) 164 | x[is.na(x)] <- with(.metadata_fips, name[.index(fip)])[is.na(x)] 165 | x 166 | } 167 | 168 | #' @title Get the county name for a FIPS code 169 | #' @inheritParams fips_abbr 170 | #' @return a `character` vector 171 | #' @examples 172 | #' fipio::fips_county("37129") 173 | #' fipio::fips_county("06001") 174 | #' 175 | #' # 2-digit FIP codes will not work 176 | #' fipio::fips_county("37") 177 | #' 178 | #' @export 179 | fips_county <- function(fip) { 180 | x <- with(.metadata_fips, name[.index(fip)]) 181 | x[nchar(as.character(fip)) == 2] <- NA 182 | x 183 | } 184 | 185 | 186 | #' @title Get the geometry for a FIPS code 187 | #' @inheritParams fips_abbr 188 | #' @return an `sfg`/`sfc` object 189 | #' @examples 190 | #' \dontrun{ 191 | #' fipio::fips_geometry("37") 192 | #' fipio::fips_geometry("06001") 193 | #' } 194 | #' 195 | #' @export 196 | fips_geometry <- function(fip) { 197 | .geometry_fips[.index(fip)] 198 | } 199 | 200 | #' @title Get the metadata for a FIPS code 201 | #' @inheritParams fips_abbr 202 | #' @param geometry If `TRUE`, returns a geometry column 203 | #' @return a `data.frame` 204 | #' @examples 205 | #' fipio::fips_metadata("37") 206 | #' fipio::fips_metadata("06001") 207 | #' 208 | #' @export 209 | fips_metadata <- function(fip, geometry = FALSE) { 210 | df <- .metadata_fips[.index(fip), ] 211 | df[is.na(df$state_name), ]$state_name <- df[is.na(df$state_name), ]$name 212 | if (geometry) df$geometry <- fips_geometry(fip) 213 | 214 | rownames(df) <- NULL 215 | df$fip_code <- .pad0(fip) 216 | df$feature_code <- .pad(df$feature_code, 7) 217 | df 218 | } 219 | 220 | #nocov start 221 | #' @title Get the matching function that `fipio` is using 222 | #' @description 223 | #' This function is primarily for debugging purposes, 224 | #' or for ensuring that the correct matching function 225 | #' is used. 226 | #' @return `TRUE` if `fastmatch::fmatch` is used. 227 | #' @export 228 | using_fastmatch <- function() { 229 | if (getNamespaceName(environment(match))[[1]] == "fastmatch") { 230 | TRUE 231 | } else { 232 | FALSE 233 | } 234 | } 235 | #nocov end 236 | -------------------------------------------------------------------------------- /R/sysdata.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/R/sysdata.rda -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | #nocov start 2 | .onLoad <- function(libname, pkgname) { 3 | # Use `fastmatch::fmatch` and `fastmatch::%fin%` if it's available 4 | assign("match", 5 | if (.has_fastmatch()) fastmatch::fmatch else base::match, 6 | pos = getNamespace("fipio")) 7 | 8 | assign("%in%", 9 | if (.has_fastmatch()) fastmatch::`%fin%` else base::`%in%`, 10 | pos = getNamespace("fipio")) 11 | } 12 | #nocov end -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # fipio 17 | 18 | 19 | [![CRAN status](https://www.r-pkg.org/badges/version/fipio)](https://CRAN.R-project.org/package=fipio) 20 | [![CRAN downloads](https://cranlogs.r-pkg.org/badges/fipio)](https://CRAN.R-project.org/package=fipio) 21 | [![codecov](https://codecov.io/gh/program--/fipio/graph/badge.svg?token=1ODDHARQM1)](https://app.codecov.io/gh/program--/fipio) 22 | [![R-CMD-check](https://github.com/program--/fipio/workflows/R-CMD-check/badge.svg)](https://github.com/program--/fipio/actions) 23 | [![MIT License](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/license/mit/) 24 | 25 | 26 | `fipio` is a **lightweight** package that makes it easy to get information about a US FIPS code. 27 | 28 | ## Installation 29 | 30 | You can install the released version of `fipio` from [CRAN](https://cran.r-project.org/package=fipio) with: 31 | 32 | ``` r 33 | install.packages("fipio") 34 | ``` 35 | 36 | or the development version with `pak` or `remotes`: 37 | ``` r 38 | # Using `pak` 39 | pak::pkg_install("program--/fipio") 40 | 41 | # Using `remotes` 42 | remotes::install_github("program--/fipio") 43 | ``` 44 | 45 | ## Usage 46 | 47 | `fipio` makes it easy to get information about a US FIPS code. 48 | Let's answer a few questions that might come up if you have a FIPS code: 49 | 50 | ```{r} 51 | fip <- "37129" 52 | 53 | # What state is `37129` in? 54 | fipio::fips_state(fip) 55 | 56 | # Alternatively, you can use the state FIPS code by itself 57 | fipio::fips_state("37") 58 | 59 | # What about the state abbreviation? 60 | fipio::fips_abbr(fip) 61 | 62 | # What county is `37129`? 63 | fipio::fips_county(fip) 64 | 65 | # It'd be nice to have this all in a data.frame... 66 | fipio::fips_metadata(fip) 67 | 68 | # And the metadata for the state by itself... 69 | fipio::fips_metadata("37") 70 | ``` 71 | 72 | ### With `sf` 73 | `fipio` also includes functions that support geometry for FIPS codes. This requires 74 | `sfheaders` at the very least to get an `sf`-compatible geometry object back. 75 | 76 | ```{r, include = FALSE} 77 | library(sf, quietly = TRUE) 78 | ``` 79 | 80 | ```{r} 81 | # I'm doing spatial work, what's the geometry of `37129`? 82 | fipio::fips_geometry(fip) 83 | 84 | # What if I need it with my other metadata? 85 | fipio::fips_metadata(fip, geometry = TRUE) 86 | ``` 87 | 88 | ### Vectorized 89 | `fipio` functions are inherently vectorized, so you can use them with vectors of FIPS codes easily: 90 | ```{r} 91 | fips <- c("37129", "44001", "48115") 92 | 93 | fipio::fips_state(fips) 94 | 95 | fipio::fips_abbr(fips) 96 | 97 | fipio::fips_county(fips) 98 | 99 | fipio::fips_metadata(fips) 100 | 101 | fipio::fips_geometry(fips) 102 | ``` 103 | 104 | ### Reverse Geolocate Coordinates to FIPS 105 | `fipio` contains the ability to locate the FIPS code(s) for a set of coordinates (in `WGS84`/`EPSG:4326`): 106 | ```{r} 107 | # With a single set of coordinates 108 | fipio::coords_to_fips(x = -119.8696, y = 34.4184) 109 | 110 | # Vectorized 111 | fipio::coords_to_fips( 112 | x = c(-81.4980534549709, -81.1249425046948), 113 | y = c(36.4314781444978, 36.4911893240597) 114 | ) 115 | 116 | # With a `data.frame` or `matrix` 117 | fipio::coords_to_fips( 118 | x = data.frame( 119 | X = c(-81.4980534549709, -81.1249425046948), 120 | Y = c(36.4314781444978, 36.4911893240597) 121 | ), 122 | coords = c("X", "Y") 123 | ) 124 | 125 | # With an `sfg` object 126 | fipio::coords_to_fips( 127 | x = sf::st_point(c(-81.4980534549709, 128 | 36.4314781444978)), 129 | dim = "XY" 130 | ) 131 | 132 | # With an `sf` object 133 | fipio::coords_to_fips( 134 | x = sf::st_as_sf( 135 | data.frame(X = c(-81.4980534549709, -81.1249425046948), 136 | Y = c(36.4314781444978, 36.4911893240597)), 137 | coords = c("X", "Y"), 138 | crs = 4326 139 | ) 140 | ) 141 | ``` 142 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # fipio 5 | 6 | 7 | 8 | [![CRAN 9 | status](https://www.r-pkg.org/badges/version/fipio)](https://CRAN.R-project.org/package=fipio) 10 | [![CRAN 11 | downloads](https://cranlogs.r-pkg.org/badges/fipio)](https://CRAN.R-project.org/package=fipio) 12 | [![codecov](https://codecov.io/gh/program--/fipio/graph/badge.svg?token=1ODDHARQM1)](https://app.codecov.io/gh/program--/fipio) 13 | [![R-CMD-check](https://github.com/program--/fipio/workflows/R-CMD-check/badge.svg)](https://github.com/program--/fipio/actions) 14 | [![MIT 15 | License](https://img.shields.io/badge/license-MIT-blue.svg)](https://opensource.org/license/mit/) 16 | 17 | 18 | `fipio` is a **lightweight** package that makes it easy to get 19 | information about a US FIPS code. 20 | 21 | ## Installation 22 | 23 | You can install the released version of `fipio` from 24 | [CRAN](https://cran.r-project.org/package=fipio) with: 25 | 26 | ``` r 27 | install.packages("fipio") 28 | ``` 29 | 30 | or the development version with `pak` or `remotes`: 31 | 32 | ``` r 33 | # Using `pak` 34 | pak::pkg_install("program--/fipio") 35 | 36 | # Using `remotes` 37 | remotes::install_github("program--/fipio") 38 | ``` 39 | 40 | ## Usage 41 | 42 | `fipio` makes it easy to get information about a US FIPS code. Let’s 43 | answer a few questions that might come up if you have a FIPS code: 44 | 45 | ``` r 46 | fip <- "37129" 47 | 48 | # What state is `37129` in? 49 | fipio::fips_state(fip) 50 | #> [1] "North Carolina" 51 | 52 | # Alternatively, you can use the state FIPS code by itself 53 | fipio::fips_state("37") 54 | #> [1] "North Carolina" 55 | 56 | # What about the state abbreviation? 57 | fipio::fips_abbr(fip) 58 | #> [1] "NC" 59 | 60 | # What county is `37129`? 61 | fipio::fips_county(fip) 62 | #> [1] "New Hanover" 63 | 64 | # It'd be nice to have this all in a data.frame... 65 | fipio::fips_metadata(fip) 66 | #> state_region state_division feature_code state_name state_abbr 67 | #> 1 3 5 1026329 North Carolina NC 68 | #> name fip_class tiger_class combined_area_code metropolitan_area_code 69 | #> 1 New Hanover H1 G4020 NA 70 | #> functional_status land_area water_area fip_code 71 | #> 1 A 497937486 353803887 37129 72 | 73 | # And the metadata for the state by itself... 74 | fipio::fips_metadata("37") 75 | #> state_region state_division feature_code state_name state_abbr 76 | #> 1 3 5 1027616 North Carolina NC 77 | #> name fip_class tiger_class combined_area_code 78 | #> 1 North Carolina G4000 NA 79 | #> metropolitan_area_code functional_status land_area water_area fip_code 80 | #> 1 A 125933327733 13456093195 37 81 | ``` 82 | 83 | ### With `sf` 84 | 85 | `fipio` also includes functions that support geometry for FIPS codes. 86 | This requires `sfheaders` at the very least to get an `sf`-compatible 87 | geometry object back. 88 | 89 | ``` r 90 | # I'm doing spatial work, what's the geometry of `37129`? 91 | fipio::fips_geometry(fip) 92 | #> Geometry set for 1 feature 93 | #> Geometry type: MULTIPOLYGON 94 | #> Dimension: XY 95 | #> Bounding box: xmin: -78.02992 ymin: 33.7868 xmax: -77.67528 ymax: 34.38929 96 | #> Geodetic CRS: WGS 84 97 | #> MULTIPOLYGON (((-77.89701 33.7868, -77.8952 33.... 98 | 99 | # What if I need it with my other metadata? 100 | fipio::fips_metadata(fip, geometry = TRUE) 101 | #> state_region state_division feature_code state_name state_abbr 102 | #> 1 3 5 1026329 North Carolina NC 103 | #> name fip_class tiger_class combined_area_code metropolitan_area_code 104 | #> 1 New Hanover H1 G4020 NA 105 | #> functional_status land_area water_area geometry 106 | #> 1 A 497937486 353803887 MULTIPOLYGON (((-77.89701 3... 107 | #> fip_code 108 | #> 1 37129 109 | ``` 110 | 111 | ### Vectorized 112 | 113 | `fipio` functions are inherently vectorized, so you can use them with 114 | vectors of FIPS codes easily: 115 | 116 | ``` r 117 | fips <- c("37129", "44001", "48115") 118 | 119 | fipio::fips_state(fips) 120 | #> [1] "North Carolina" "Rhode Island" "Texas" 121 | 122 | fipio::fips_abbr(fips) 123 | #> [1] "NC" "RI" "TX" 124 | 125 | fipio::fips_county(fips) 126 | #> [1] "New Hanover" "Bristol" "Dawson" 127 | 128 | fipio::fips_metadata(fips) 129 | #> state_region state_division feature_code state_name state_abbr 130 | #> 1 3 5 1026329 North Carolina NC 131 | #> 2 1 1 1219777 Rhode Island RI 132 | #> 3 3 7 1383843 Texas TX 133 | #> name fip_class tiger_class combined_area_code metropolitan_area_code 134 | #> 1 New Hanover H1 G4020 NA 135 | #> 2 Bristol H4 G4020 148 136 | #> 3 Dawson H1 G4020 NA 137 | #> functional_status land_area water_area fip_code 138 | #> 1 A 497937486 353803887 37129 139 | #> 2 N 62500772 53359134 44001 140 | #> 3 A 2331781561 4720730 48115 141 | 142 | fipio::fips_geometry(fips) 143 | #> Geometry set for 3 features 144 | #> Geometry type: MULTIPOLYGON 145 | #> Dimension: XY 146 | #> Bounding box: xmin: -102.2085 ymin: 32.52327 xmax: -71.20837 ymax: 41.7762 147 | #> Geodetic CRS: WGS 84 148 | #> MULTIPOLYGON (((-77.89701 33.7868, -77.8952 33.... 149 | #> MULTIPOLYGON (((-71.33097 41.68696, -71.32372 4... 150 | #> MULTIPOLYGON (((-102.2027 32.52327, -102.1201 3... 151 | ``` 152 | 153 | ### Reverse Geolocate Coordinates to FIPS 154 | 155 | `fipio` contains the ability to locate the FIPS code(s) for a set of 156 | coordinates (in `WGS84`/`EPSG:4326`): 157 | 158 | ``` r 159 | # With a single set of coordinates 160 | fipio::coords_to_fips(x = -119.8696, y = 34.4184) 161 | #> [1] "06083" 162 | 163 | # Vectorized 164 | fipio::coords_to_fips( 165 | x = c(-81.4980534549709, -81.1249425046948), 166 | y = c(36.4314781444978, 36.4911893240597) 167 | ) 168 | #> [1] "37009" "37005" 169 | 170 | # With a `data.frame` or `matrix` 171 | fipio::coords_to_fips( 172 | x = data.frame( 173 | X = c(-81.4980534549709, -81.1249425046948), 174 | Y = c(36.4314781444978, 36.4911893240597) 175 | ), 176 | coords = c("X", "Y") 177 | ) 178 | #> [1] "37009" "37005" 179 | 180 | # With an `sfg` object 181 | fipio::coords_to_fips( 182 | x = sf::st_point(c(-81.4980534549709, 183 | 36.4314781444978)), 184 | dim = "XY" 185 | ) 186 | #> [1] "37009" 187 | 188 | # With an `sf` object 189 | fipio::coords_to_fips( 190 | x = sf::st_as_sf( 191 | data.frame(X = c(-81.4980534549709, -81.1249425046948), 192 | Y = c(36.4314781444978, 36.4911893240597)), 193 | coords = c("X", "Y"), 194 | crs = 4326 195 | ) 196 | ) 197 | #> [1] "37009" "37005" 198 | ``` 199 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Resubmission 2 | 3 | This is a resubmission. This version addresses bugfixes. See the NEWS.md file for details. 4 | 5 | ## Test environments 6 | 7 | * GitHub Actions (ubuntu-latest): devel, release, oldrel, 3.6, 3.5 8 | * GitHub Actions (windows): release, 3.6 9 | * GitHub Actions (macOS): release 10 | * win-builder: devel 11 | 12 | ## R CMD check results 13 | 14 | 0 errors | 0 warnings | 0 note 15 | -------------------------------------------------------------------------------- /data-raw/.gitignore: -------------------------------------------------------------------------------- 1 | *_shp/ 2 | *\.gpkg 3 | *\.gdb 4 | \.fuse* 5 | *\.zip -------------------------------------------------------------------------------- /data-raw/archive-tracts.R: -------------------------------------------------------------------------------- 1 | query <- " 2 | SELECT 3 | GEOID AS tract_code, 4 | ALAND AS land_area, 5 | AWATER AS water_area, 6 | SHAPE AS geometry 7 | FROM 8 | cb_2020_us_tract_500k 9 | " %>% stringr::str_replace_all("\n", " ") %>% stringr::str_squish() 10 | 11 | tbl_tracts <- sf::st_read("data-raw/cb_2020_us_all_500k.gdb", query = query) %>% 12 | dplyr::arrange(tract_code) %>% 13 | sf::st_transform(4326) 14 | 15 | .lookup_tracts <- bit64::as.integer64(tbl_tracts$tract_code) 16 | bit64::hashcache(.lookup_tracts) 17 | .metadata_tracts <- sf::st_drop_geometry(tbl_tracts) %>% 18 | dplyr::select(-tract_code) 19 | 20 | .geometry_tracts <- tbl_tracts %>% 21 | dplyr::select(tract_code, geometry) %>% 22 | rmapshaper::ms_simplify( 23 | keep = 0.05, 24 | sys = TRUE, 25 | explode = TRUE, 26 | keep_shapes = TRUE 27 | ) %>% 28 | dplyr::group_by(tract_code) %>% 29 | dplyr::mutate(geometry = sf::st_combine(geometry)) %>% 30 | dplyr::ungroup() %>% 31 | dplyr::distinct(tract_code, .keep_all = TRUE) %>% 32 | dplyr::arrange(tract_code) %>% 33 | dplyr::pull(geometry) -------------------------------------------------------------------------------- /data-raw/archive-zips.R: -------------------------------------------------------------------------------- 1 | # zcta_query <- " 2 | # SELECT 3 | # ZCTA5CE20 AS zip_code 4 | # FROM 5 | # tl_2021_us_zcta520 6 | # " 7 | # 8 | # tbl_zip <- 9 | # sf::st_read(tiger_vrt, query = zcta_query, quiet = TRUE) %>% 10 | # sf::st_transform(4326) %>% 11 | # dplyr::arrange(zip_code) 12 | # 13 | # .lookup_zips <- as.integer(tbl_zip$zip_code) 14 | # .metadata_zips <- sf::st_join(tbl_zip, tbl_fips, join = predicate_zip) %>% 15 | # sf::st_drop_geometry() %>% 16 | # dplyr::arrange(zip_code) %>% 17 | # dplyr::mutate( 18 | # zip_code = match(as.integer(zip_code), .lookup_zips), 19 | # fip_code = match(as.integer(fip_code), .lookup_fips) 20 | # ) %>% 21 | # as.data.frame(row.names = seq_len(nrow(.))) 22 | # Original: 23 | # .geometry_zips <- tbl_zip %>% 24 | # rmapshaper::ms_simplify( 25 | # keep = 0.02, 26 | # sys = TRUE, 27 | # explode = TRUE, 28 | # keep_shapes = TRUE 29 | # ) %>% 30 | # sf::st_make_valid() %>% 31 | # dplyr::group_by(zip_code) %>% 32 | # dplyr::mutate(geometry = sf::st_combine(geometry)) %>% 33 | # dplyr::ungroup() %>% 34 | # dplyr::distinct(zip_code, .keep_all = TRUE) %>% 35 | # dplyr::arrange(zip_code) 36 | # if (!all(as.integer(.geometry_zips$zip_code) == .lookup_zips)) { 37 | # stop("Geometry isn't indexed correctly") 38 | # } else { 39 | # .geometry_zips <- sf::st_geometry(.geometry_zips) 40 | # } 41 | #> Loaded original dataset into mapshaper and simplified to 0.3% 42 | #> Resulting data was exported then loaded into R 43 | # .geometry_zips <- readRDS("data-raw/zips.rds") -------------------------------------------------------------------------------- /data-raw/internal.R: -------------------------------------------------------------------------------- 1 | # Download to disk approach, new `tiger.vrt` uses VSIs 2 | #> tiger_url <- "https://www2.census.gov/geo/tiger/TIGER2021/" 3 | #> state_zip <- "./data-raw/tl_2021_us_state.zip" 4 | #> withr::defer(unlink(state_zip)) 5 | #> httr::GET( 6 | #> paste0(tiger_url, "STATE/tl_2021_us_state.zip"), 7 | #> httr::write_disk(state_zip, overwrite = TRUE), 8 | #> httr::progress() 9 | #> ) 10 | #> state_dir <- fs::dir_create("./data-raw/state_shp") 11 | #> unzip(state_zip, exdir = state_dir) 12 | #> withr::defer(fs::dir_delete(state_dir)) 13 | #> state_shp <- list.files(state_dir, pattern = "\\.shp$", full.names = TRUE) 14 | #> Download TIGER shapefiles for counties ====================================== 15 | #> county_zip <- "./data-raw/tl_2021_us_county.zip" 16 | #> withr::defer(unlink(county_zip)) 17 | #> httr::GET( 18 | #> paste0(tiger_url, "COUNTY/tl_2021_us_county.zip"), 19 | #> httr::write_disk(county_zip, overwrite = TRUE), 20 | #> httr::progress() 21 | #> ) 22 | #> county_dir <- fs::dir_create("./data-raw/county_shp") 23 | #> unzip(county_zip, exdir = county_dir) 24 | #> withr::defer(fs::dir_delete(county_dir)) 25 | #> county_shp <- list.files(county_dir, pattern = "\\.shp$", full.names = TRUE) 26 | #> Download TIGER shapefiles for ZCTA codes ==================================== 27 | #> zcta_zip <- "./data-raw/tl_2021_us_zcta520.zip" 28 | #> withr::defer(unlink(zcta_zip)) 29 | #> httr::GET( 30 | #> paste0(tiger_url, "ZCTA520/tl_2021_us_zcta520.zip"), 31 | #> httr::write_disk(zcta_zip, overwrite = TRUE), 32 | #> httr::progress() 33 | #> ) 34 | #> zcta_dir <- fs::dir_create("./data-raw/zcta_shp") 35 | #> unzip(zcta_zip, exdir = zcta_dir) 36 | #> withr::defer(fs::dir_delete(zcta_dir)) 37 | #> zcta_shp <- list.files(zcta_dir, pattern = "\\.shp$", full.names = TRUE) 38 | #============================================================================== 39 | 40 | library(dplyr) 41 | 42 | predicate_zip <- function(x, y) { 43 | indices <- list() 44 | gint <- sf::st_intersects(x, y) 45 | gtouch <- sf::st_touches(x, y) 46 | 47 | iter <- length(gint) 48 | 49 | lapply( 50 | seq_len(iter), 51 | function(i) { 52 | indices[[i]] <<- 53 | gint[[i]][!gint[[i]] %in% gtouch[[i]]] 54 | } 55 | ) 56 | 57 | attr(indices, "predicate") <- "intersects & !touches" 58 | attr(indices, "region.id") <- attr(gint, "region.id") 59 | attr(indices, "ncol") <- attr(gint, "ncol") 60 | class(indices) <- c("sgbp", "list") 61 | 62 | indices 63 | } 64 | 65 | # Load shapefiles and transform 66 | tiger_vrt <- "data-raw/tiger-local.vrt" 67 | 68 | fips_query <- " 69 | SELECT 70 | states.REGION AS state_region, 71 | states.DIVISION AS state_division, 72 | counties.STATEFP as state_code, 73 | counties.COUNTYNS AS feature_code, 74 | counties.GEOID AS fip_code, 75 | states.NAME as state_name, 76 | states.STUSPS AS state_abbr, 77 | counties.NAME AS name, 78 | counties.CLASSFP AS fip_class, 79 | counties.MTFCC AS tiger_class, 80 | counties.CSAFP AS combined_area_code, 81 | counties.METDIVFP AS metropolitan_area_code, 82 | counties.FUNCSTAT AS functional_status, 83 | counties.ALAND AS land_area, 84 | counties.AWATER AS water_area 85 | FROM 86 | tl_2021_us_county counties 87 | LEFT JOIN 88 | tl_2021_us_state states 89 | ON 90 | counties.STATEFP = states.STATEFP 91 | UNION ALL 92 | SELECT 93 | REGION AS state_region, 94 | DIVISION AS state_division, 95 | STATEFP AS state_code, 96 | STATENS AS feature_code, 97 | GEOID AS fip_code, 98 | STUSPS AS state_abbr, 99 | NAME AS name, 100 | MTFCC AS tiger_class, 101 | null AS combined_area_code, 102 | null AS metropolitan_area_code, 103 | FUNCSTAT AS functional_status, 104 | ALAND AS land_area, 105 | AWATER AS water_area 106 | FROM 107 | tl_2021_us_state 108 | " 109 | 110 | tbl_fips <- sf::st_read(tiger_vrt, query = fips_query, quiet = TRUE) %>% 111 | sf::st_transform(4326) %>% 112 | dplyr::arrange(fip_code) %>% 113 | dplyr::select(-state_code) %>% 114 | dplyr::mutate( 115 | state_region = as.integer(state_region), 116 | state_division = as.integer(state_division), 117 | feature_code = as.integer(feature_code), 118 | tiger_class = as.factor(tiger_class), 119 | functional_status = as.factor(functional_status), 120 | fip_class = as.factor(fip_class), 121 | combined_area_code = as.integer(combined_area_code) 122 | ) 123 | 124 | .lookup_fips <- as.integer(tbl_fips$fip_code) 125 | .metadata_fips <- sf::st_drop_geometry(tbl_fips) %>% 126 | dplyr::select(-fip_code) 127 | 128 | .geometry_fips <- tbl_fips %>% 129 | rmapshaper::ms_simplify( 130 | keep = 0.05, 131 | sys = TRUE, 132 | explode = TRUE, 133 | keep_shapes = TRUE 134 | ) %>% 135 | dplyr::group_by(fip_code) %>% 136 | dplyr::mutate(geometry = sf::st_combine(geometry)) %>% 137 | dplyr::ungroup() %>% 138 | dplyr::distinct(fip_code, .keep_all = TRUE) %>% 139 | dplyr::arrange(fip_code) 140 | 141 | if (!all(as.integer(.geometry_fips$fip_code) == .lookup_fips)) { 142 | stop("Geometry isn't indexed correctly") 143 | } else { 144 | .geometry_fips <- sf::st_geometry(.geometry_fips) 145 | } 146 | 147 | # Save transformed data to internal tables ==================================== 148 | 149 | # Export to data 150 | save( 151 | .lookup_fips, 152 | .metadata_fips, 153 | .geometry_fips, 154 | file = "R/sysdata.rda", 155 | compress = "xz", 156 | compression_level = -9, 157 | version = 3 158 | ) 159 | -------------------------------------------------------------------------------- /data-raw/tiger-local.vrt: -------------------------------------------------------------------------------- 1 | 2 | 3 | ./data-raw/county_shp/tl_2021_us_county.shp 4 | 5 | 6 | ./data-raw/state_shp/tl_2021_us_state.shp 7 | 8 | -------------------------------------------------------------------------------- /data-raw/tiger.vrt: -------------------------------------------------------------------------------- 1 | 2 | 3 | /vsizip/vsicurl/https://www2.census.gov/geo/tiger/TIGER2021/COUNTY/tl_2021_us_county.zip/tl_2021_us_county.shp 4 | 5 | 6 | /vsizip/vsicurl/https://www2.census.gov/geo/tiger/TIGER2021/STATE/tl_2021_us_state.zip/tl_2021_us_state.shp 7 | 8 | 9 | /vsizip/vsicurl/https://www2.census.gov/geo/tiger/TIGER2021/ZCTA520/tl_2021_us_zcta520.zip/tl_2021_us_zcta520.shp 10 | 11 | -------------------------------------------------------------------------------- /fipio.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /inst/testdata/testdata.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/inst/testdata/testdata.rds -------------------------------------------------------------------------------- /man/as_fips.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{as_fips} 4 | \alias{as_fips} 5 | \title{Convert a state name, abbreviation, or county name to FIPS codes} 6 | \usage{ 7 | as_fips(state, county = NULL) 8 | } 9 | \arguments{ 10 | \item{state}{State names, state abbreviations, or 11 | one of the following: "all", "conus", "territories"} 12 | 13 | \item{county}{County names or "all"} 14 | } 15 | \value{ 16 | a \code{character} vector 17 | } 18 | \description{ 19 | Convert a state name, abbreviation, or county name to FIPS codes 20 | } 21 | \examples{ 22 | fipio::as_fips(state = "California") 23 | fipio::as_fips(state = "NC") 24 | fipio::as_fips(state = "Rhode Island", county = "Washington") 25 | fipio::as_fips(c("CA", "North Carolina"), c("Stanislaus", "NEW HANOVER")) 26 | fipio::as_fips("CONUS") 27 | fipio::as_fips(state = "NC", county = "all") 28 | 29 | } 30 | -------------------------------------------------------------------------------- /man/coords_to_fips.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/geolocate.R 3 | \name{coords_to_fips} 4 | \alias{coords_to_fips} 5 | \alias{coords_to_fips.sf} 6 | \alias{coords_to_fips.sfc} 7 | \alias{coords_to_fips.sfg} 8 | \alias{coords_to_fips.list} 9 | \alias{coords_to_fips.data.frame} 10 | \alias{coords_to_fips.matrix} 11 | \alias{coords_to_fips.character} 12 | \alias{coords_to_fips.numeric} 13 | \title{Associate a set of coordinates to FIPS codes} 14 | \usage{ 15 | coords_to_fips(x, ...) 16 | 17 | \method{coords_to_fips}{sf}(x, ...) 18 | 19 | \method{coords_to_fips}{sfc}(x, ...) 20 | 21 | \method{coords_to_fips}{sfg}(x, ...) 22 | 23 | \method{coords_to_fips}{list}(x, ...) 24 | 25 | \method{coords_to_fips}{data.frame}(x, coords = c(1, 2), ...) 26 | 27 | \method{coords_to_fips}{matrix}(x, coords = c(1, 2), ...) 28 | 29 | \method{coords_to_fips}{character}(x, y, ...) 30 | 31 | \method{coords_to_fips}{numeric}(x, y, ...) 32 | } 33 | \arguments{ 34 | \item{x}{\code{data.frame}, \code{matrix}, \code{sf}/\code{sfc}/\code{sfg} object, 35 | or longitude in \emph{EPSG:4326}} 36 | 37 | \item{...}{Named arguments passed on to methods} 38 | 39 | \item{coords}{Coordinates columns if \code{x} is a \code{data.frame} or \code{matrix}.} 40 | 41 | \item{y}{Latitude in \emph{EPSG:4326}} 42 | } 43 | \value{ 44 | a \code{character} vector of FIPS codes 45 | } 46 | \description{ 47 | Associate a set of coordinates to FIPS codes 48 | } 49 | \examples{ 50 | # Some coordinates at UC Santa Barbara 51 | coords_to_fips(x = -119.8696, y = 34.4184) 52 | } 53 | -------------------------------------------------------------------------------- /man/dot-intersects.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/internals.R 3 | \name{.intersects} 4 | \alias{.intersects} 5 | \title{Simple intersection via ray casting} 6 | \usage{ 7 | .intersects(x, y, geometry) 8 | } 9 | \value{ 10 | indices of points in \code{x} and \code{y} 11 | that intersect \code{geometry} 12 | } 13 | \description{ 14 | Simple intersection via ray casting 15 | } 16 | \keyword{internal} 17 | -------------------------------------------------------------------------------- /man/dot-segment_intersect.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/internals.R 3 | \name{.segment_intersect} 4 | \alias{.segment_intersect} 5 | \title{Check if a point intersects with a side of a polygon} 6 | \usage{ 7 | .segment_intersect(side, x, y) 8 | } 9 | \description{ 10 | Check if a point intersects with a side of a polygon 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/man/figures/logo.png -------------------------------------------------------------------------------- /man/fips_abbr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{fips_abbr} 4 | \alias{fips_abbr} 5 | \title{Get the state abbreviation for a FIPS code} 6 | \usage{ 7 | fips_abbr(fip) 8 | } 9 | \arguments{ 10 | \item{fip}{2-digit or 5-digit FIPS code} 11 | } 12 | \value{ 13 | a \code{character} vector 14 | } 15 | \description{ 16 | Get the state abbreviation for a FIPS code 17 | } 18 | \examples{ 19 | fipio::fips_abbr("37") 20 | fipio::fips_abbr("06001") 21 | 22 | } 23 | -------------------------------------------------------------------------------- /man/fips_county.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{fips_county} 4 | \alias{fips_county} 5 | \title{Get the county name for a FIPS code} 6 | \usage{ 7 | fips_county(fip) 8 | } 9 | \arguments{ 10 | \item{fip}{2-digit or 5-digit FIPS code} 11 | } 12 | \value{ 13 | a \code{character} vector 14 | } 15 | \description{ 16 | Get the county name for a FIPS code 17 | } 18 | \examples{ 19 | fipio::fips_county("37129") 20 | fipio::fips_county("06001") 21 | 22 | # 2-digit FIP codes will not work 23 | fipio::fips_county("37") 24 | 25 | } 26 | -------------------------------------------------------------------------------- /man/fips_geometry.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{fips_geometry} 4 | \alias{fips_geometry} 5 | \title{Get the geometry for a FIPS code} 6 | \usage{ 7 | fips_geometry(fip) 8 | } 9 | \arguments{ 10 | \item{fip}{2-digit or 5-digit FIPS code} 11 | } 12 | \value{ 13 | an \code{sfg}/\code{sfc} object 14 | } 15 | \description{ 16 | Get the geometry for a FIPS code 17 | } 18 | \examples{ 19 | \dontrun{ 20 | fipio::fips_geometry("37") 21 | fipio::fips_geometry("06001") 22 | } 23 | 24 | } 25 | -------------------------------------------------------------------------------- /man/fips_metadata.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{fips_metadata} 4 | \alias{fips_metadata} 5 | \title{Get the metadata for a FIPS code} 6 | \usage{ 7 | fips_metadata(fip, geometry = FALSE) 8 | } 9 | \arguments{ 10 | \item{fip}{2-digit or 5-digit FIPS code} 11 | 12 | \item{geometry}{If \code{TRUE}, returns a geometry column} 13 | } 14 | \value{ 15 | a \code{data.frame} 16 | } 17 | \description{ 18 | Get the metadata for a FIPS code 19 | } 20 | \examples{ 21 | fipio::fips_metadata("37") 22 | fipio::fips_metadata("06001") 23 | 24 | } 25 | -------------------------------------------------------------------------------- /man/fips_state.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{fips_state} 4 | \alias{fips_state} 5 | \title{Get the state name for a FIPS code} 6 | \usage{ 7 | fips_state(fip) 8 | } 9 | \arguments{ 10 | \item{fip}{2-digit or 5-digit FIPS code} 11 | } 12 | \value{ 13 | a \code{character} vector 14 | } 15 | \description{ 16 | Get the state name for a FIPS code 17 | } 18 | \examples{ 19 | fipio::fips_state("37") 20 | fipio::fips_state("06001") 21 | 22 | } 23 | -------------------------------------------------------------------------------- /man/using_fastmatch.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/lookup.R 3 | \name{using_fastmatch} 4 | \alias{using_fastmatch} 5 | \title{Get the matching function that \code{fipio} is using} 6 | \usage{ 7 | using_fastmatch() 8 | } 9 | \value{ 10 | \code{TRUE} if \code{fastmatch::fmatch} is used. 11 | } 12 | \description{ 13 | This function is primarily for debugging purposes, 14 | or for ensuring that the correct matching function 15 | is used. 16 | } 17 | -------------------------------------------------------------------------------- /pkgdown/_pkgdown.yml: -------------------------------------------------------------------------------- 1 | home: 2 | title: fipio 3 | description: A lightweight utility for FIP code information retrieval 4 | 5 | url: https://fipio.justinsingh.me 6 | 7 | authors: 8 | Urban Flooding Open Knowledge Network (UF-OKN): 9 | href: https://ufokn.com 10 | html: 11 | footer: 12 | roles: [aut, cre] 13 | text: Developed by 14 | sidebar: 15 | roles: [aut, cre, fnd] 16 | 17 | template: 18 | bootstrap: 5 19 | bslib: 20 | base_font: {google: "Roboto"} 21 | code_font: {google: "Fira Code"} 22 | 23 | reference: 24 | - title: FIPS Lookup 25 | contents: 26 | - fips_abbr 27 | - fips_state 28 | - fips_county 29 | - fips_geometry 30 | - fips_metadata 31 | 32 | - title: Reverse FIPS Lookup 33 | contents: 34 | - as_fips 35 | - coords_to_fips 36 | 37 | - title: Development 38 | contents: 39 | - using_fastmatch 40 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/program--/fipio/85ccde86cd84a1c12536b2e4bfc947bfc60b00c2/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(mockery) 3 | library(fipio) 4 | 5 | test_check("fipio") 6 | -------------------------------------------------------------------------------- /tests/testthat/setup-fipio.R: -------------------------------------------------------------------------------- 1 | geolocate_data <- readRDS(system.file( 2 | "testdata", 3 | "testdata.rds", 4 | package = "fipio") 5 | ) 6 | 7 | local_fipio <- function(fip_code, state_abbr, state_name, county_name) { 8 | 9 | multi_test <- if (length(fip_code) > 1) TRUE else FALSE 10 | 11 | state_code <- substr(fip_code, 1, 2) 12 | 13 | descs <- if (multi_test) { 14 | c("fipio functions return correct information for multiple fips", 15 | "fipio geometry returns correct information for multiple fips", 16 | "fipio as_fips returns correct information for multiple descriptions") 17 | } else { 18 | c(paste("fipio functions return correct information for fip", fip_code), 19 | paste("fipio geometry returns correct information for fip", fip_code), 20 | "fipio as_fips returns correct information for a given description") 21 | } 22 | 23 | testthat::test_that(descs[1], { 24 | expect_abbr(state_code, state_abbr) 25 | expect_abbr(fip_code, state_abbr) 26 | expect_state(state_code, state_name) 27 | expect_state(fip_code, state_name) 28 | expect_county( 29 | fip_code, 30 | ifelse( 31 | nchar(fip_code) == 2, 32 | NA, 33 | county_name 34 | ) 35 | ) 36 | expect_metadata(state_code, state_name) 37 | expect_metadata( 38 | fip_code, 39 | ifelse( 40 | nchar(fip_code) == 2, 41 | state_name, 42 | county_name 43 | ) 44 | ) 45 | }) 46 | 47 | testthat::test_that(descs[2], { 48 | expect_geometry_class(fip_code) 49 | }) 50 | 51 | testthat::test_that(descs[3], { 52 | expect_fips(state_name, county_name, fip_code) 53 | expect_fips(state_abbr, county_name, fip_code) 54 | expect_fips(toupper(state_name), county_name, fip_code) 55 | expect_fips(toupper(state_abbr), county_name, fip_code) 56 | expect_fips(tolower(state_name), county_name, fip_code) 57 | expect_fips(tolower(state_abbr), county_name, fip_code) 58 | }) 59 | } 60 | 61 | expect_abbr <- function(fip, expected) { 62 | testthat::expect_equal(fipio::fips_abbr(fip), expected) 63 | } 64 | 65 | expect_state <- function(fip, expected) { 66 | testthat::expect_equal(fipio::fips_state(fip), expected) 67 | } 68 | 69 | expect_county <- function(fip, expected) { 70 | testthat::expect_equal(fipio::fips_county(fip), expected) 71 | } 72 | 73 | expect_metadata <- function(fip, expected) { 74 | meta <- fipio::fips_metadata(fip) 75 | 76 | testthat::expect_s3_class(meta, "data.frame") 77 | 78 | testthat::expect_equal(meta$name, expected) 79 | exp_names <- c( 80 | "state_region", "state_division", "feature_code", "state_name", 81 | "state_abbr", "name", "fip_class", "tiger_class", "combined_area_code", 82 | "metropolitan_area_code", "functional_status", "land_area", "water_area", 83 | "fip_code" 84 | ) 85 | 86 | testthat::expect_named(meta, exp_names) 87 | testthat::expect_equal(meta$fip_code, fip) 88 | } 89 | 90 | expect_geometry_class <- function(fip) { 91 | expect_success({ 92 | geom <- fipio::fips_geometry(fip) 93 | geom_meta <- fipio::fips_metadata(fip, geometry = TRUE) 94 | 95 | sf_class <- c("sfg", "sfc", "sf") 96 | tests <- unlist( 97 | lapply( 98 | c(geom, geom_meta$geometry), 99 | FUN = function(x) { 100 | any(sf_class %in% class(x)) 101 | } 102 | ) 103 | ) 104 | 105 | if (all(tests)) { 106 | testthat::succeed(message = "Geometry returned!") 107 | } else { 108 | testthat::fail( 109 | message = paste( 110 | "These fips did not return geometry:", 111 | paste(fip, collapse = ", ") 112 | ) 113 | ) 114 | } 115 | }) 116 | } 117 | 118 | expect_fips <- function(state, county, expected) { 119 | if (missing(county)) county <- NULL 120 | testthat::expect_equal( 121 | fipio::as_fips(state = state, county = county), 122 | expected 123 | ) 124 | } 125 | 126 | expect_match_assignment <- function(expected) { 127 | temp_env <- testthat::test_env("fipio") 128 | assign("match", 129 | if (.has_fastmatch()) fastmatch::fmatch else base::match, 130 | pos = temp_env) 131 | fname <- getNamespaceName(environment(get("match", pos = temp_env)))[[1]] 132 | testthat::expect_equal(fname, expected) 133 | rm(temp_env) 134 | } 135 | -------------------------------------------------------------------------------- /tests/testthat/test-fipio.R: -------------------------------------------------------------------------------- 1 | fip_codes <- c("46093", "30099", "72015", "29229", "01083") 2 | state_abbrs <- c("SD", "MT", "PR", "MO", "AL") 3 | state_names <- c("South Dakota", "Montana", "Puerto Rico", "Missouri", "Alabama") 4 | county_names <- c("Meade", "Teton", "Arroyo", "Wright", "Limestone") 5 | 6 | # Vectorized test 7 | local_fipio( 8 | fip_code = fip_codes, 9 | state_abbr = state_abbrs, 10 | state_name = state_names, 11 | county_name = county_names 12 | ) 13 | 14 | # Test with both 5-digit and 2-digit fip codes 15 | local_fipio( 16 | fip_code = c(fip_codes[1], substr(fip_codes[2], 1, 2)), 17 | state_abbr = state_abbrs[1:2], 18 | state_name = state_names[1:2], 19 | county_name = c(county_names[1], state_names[2]) 20 | ) 21 | 22 | # Individual tests 23 | invisible(mapply( 24 | FUN = local_fipio, 25 | fip_code = fip_codes, 26 | state_abbr = state_abbrs, 27 | state_name = state_names, 28 | county_name = county_names 29 | )) 30 | 31 | testthat::test_that("as_fips edge cases", { 32 | expect_fips("CA", NULL, "06") 33 | expect_fips("california", NULL, "06") 34 | 35 | expect_fips(c("CA", "NC"), 36 | c("Stanislaus"), 37 | c("06099", "37")) 38 | 39 | expect_fips(c("CA", "NC", "RI"), 40 | c("Stanislaus", NA, "Bristol"), 41 | c("06099", "37", "44001")) 42 | 43 | expect_fips(c("CA", "NC", "RI"), 44 | c(NA, "New Hanover", "Bristol"), 45 | c("06", "37129", "44001")) 46 | 47 | expect_fips(c("CA", "NC", "RI"), 48 | c(NA, "New Hanover", NA), 49 | c("06", "37129", "44")) 50 | 51 | expect_fips("CA", "fakecounty", as.character(NA)) 52 | 53 | expect_fips("CA", 54 | c("San Luis Obispo", "Santa Barbara", "Ventura"), 55 | c("06079", "06083", "06111")) 56 | 57 | testthat::expect_error(fipio::as_fips()) 58 | testthat::expect_error(fipio::as_fips("")) 59 | testthat::expect_error(fipio::as_fips(NULL)) 60 | 61 | testthat::expect_equal( 62 | fipio::as_fips(state = "American Samoa", county = "all"), 63 | c("60010", "60020", "60030", "60040", "60050") 64 | ) 65 | 66 | testthat::expect_equal( 67 | fipio::fips_state(fipio::as_fips("conus")), 68 | sort( 69 | c(state.name[!state.abb %in% c("AK", "HI")], "District of Columbia") 70 | ) 71 | ) 72 | 73 | testthat::expect_equal( 74 | fipio::as_fips(c("conus", "territories")), 75 | sort(c( 76 | fipio::as_fips(state.name[!state.abb %in% c("AK", "HI")]), 77 | "11", "60", "66", "69", "72", "78" 78 | )) 79 | ) 80 | 81 | testthat::expect_equal( 82 | fipio::as_fips("territories"), 83 | c("60", "66", "69", "72", "78") 84 | ) 85 | 86 | testthat::expect_equal( 87 | fipio::as_fips("us-territories"), 88 | c("60", "66", "69", "72", "78") 89 | ) 90 | 91 | testthat::expect_error(fipio::as_fips(c("all", "NC"))) 92 | 93 | testthat::expect_equal( 94 | fipio::as_fips("all"), 95 | sort(c(fipio::as_fips(state.name), "11")) 96 | ) 97 | 98 | testthat::expect_equal( 99 | fipio::as_fips(c("CA", "RI"), c("Alameda", "all")), 100 | c("06001", "44001", "44003", "44005", "44007", "44009") 101 | ) 102 | }) 103 | 104 | # Test matching function 105 | # Coverage for match(), .has_fastmatch(), .onLoad() 106 | testthat::test_that("`fmatch` is assigned to `match` if it is installed", { 107 | testthat::skip_if(!requireNamespace("mockery", quietly = TRUE)) 108 | testthat::skip_if(!requireNamespace("fastmatch", quietly = TRUE)) 109 | m <- mockery::mock(FALSE, TRUE) 110 | mockery::stub(expect_match_assignment, ".has_fastmatch", m) 111 | 112 | expect_match_assignment("base") 113 | expect_match_assignment("fastmatch") 114 | }) 115 | 116 | # Test geolocation function 117 | testthat::test_that("fipio geolocates on `base` classes", { 118 | testthat::skip_if( 119 | as.numeric(R.Version()$major) < 3 & 120 | as.numeric(R.Version()$minor) < 5 121 | ) 122 | 123 | indices <- sample(seq_len(nrow(geolocate_data)), 30) 124 | 125 | # Single Numeric 126 | testthat::expect_identical( 127 | fipio::coords_to_fips( 128 | x = geolocate_data[[2]][indices[1]], 129 | y = geolocate_data[[3]][indices[1]] 130 | ), 131 | geolocate_data[[1]][indices[1]] 132 | ) 133 | 134 | # Single Character 135 | testthat::expect_identical( 136 | fipio::coords_to_fips( 137 | x = as.character(geolocate_data[[2]][indices[1]]), 138 | y = as.character(geolocate_data[[3]][indices[1]]) 139 | ), 140 | geolocate_data$FIPS[indices[1]] 141 | ) 142 | 143 | # Vectorized Numeric 144 | testthat::expect_identical( 145 | fipio::coords_to_fips( 146 | x = geolocate_data[[2]][indices], 147 | y = geolocate_data[[3]][indices] 148 | ), 149 | geolocate_data$FIPS[indices] 150 | ) 151 | 152 | # Vectorized Character 153 | testthat::expect_identical( 154 | fipio::coords_to_fips( 155 | x = as.character(geolocate_data[[2]][indices]), 156 | y = as.character(geolocate_data[[3]][indices]) 157 | ), 158 | geolocate_data$FIPS[indices] 159 | ) 160 | 161 | # data.frame 162 | testthat::expect_identical( 163 | fipio::coords_to_fips( 164 | x = data.frame( 165 | X = geolocate_data[[2]][indices], 166 | Y = geolocate_data[[3]][indices] 167 | ), 168 | coords = c("X", "Y") 169 | ), 170 | geolocate_data[[1]][indices] 171 | ) 172 | 173 | # matrix 174 | testthat::expect_identical( 175 | fipio::coords_to_fips( 176 | matrix( 177 | data = c( 178 | geolocate_data$X[indices], 179 | geolocate_data$Y[indices] 180 | ), 181 | ncol = 2, nrow = 30 182 | ) 183 | ), 184 | geolocate_data$FIPS[indices] 185 | ) 186 | }) 187 | 188 | testthat::test_that("fipio geolocates on `sf` classes", { 189 | # testthat::skip_if_not_installed("sf") 190 | # testthat::skip_if_not_installed("sfheaders") 191 | testthat::skip_on_cran() 192 | 193 | indices <- sample(seq_len(nrow(geolocate_data)), 10) 194 | 195 | # sf 196 | testthat::expect_identical( 197 | fipio::coords_to_fips(geolocate_data[indices, ]), 198 | geolocate_data$FIPS[indices] 199 | ) 200 | 201 | # sfc 202 | testthat::expect_identical( 203 | fipio::coords_to_fips(geolocate_data[indices, ]$geometry), 204 | geolocate_data$FIPS[indices] 205 | ) 206 | 207 | # sfg 208 | testthat::expect_identical( 209 | fipio::coords_to_fips(geolocate_data[indices[1], ]$geometry), 210 | geolocate_data$FIPS[indices[1]] 211 | ) 212 | }) 213 | 214 | testthat::test_that("fipio returns NA for nonexistant states/counties", { 215 | testthat::expect_equal( 216 | fipio::as_fips(state = "FAKE"), 217 | NA_character_ 218 | ) 219 | 220 | testthat::expect_equal( 221 | fipio::as_fips(state = c("CA", "FAKE", "north carolina")), 222 | c("06", NA_character_, "37") 223 | ) 224 | 225 | testthat::expect_equal( 226 | fipio::as_fips(state = "FAKE", county = "FAKE"), 227 | NA_character_ 228 | ) 229 | 230 | testthat::expect_equal( 231 | fipio::as_fips(state = "CA", county = c("FAKE", "Alameda")), 232 | c(NA_character_, "06001") 233 | ) 234 | 235 | testthat::expect_equal( 236 | fipio::as_fips( 237 | state = c("RI", "CA"), 238 | county = c("bristol", "FAKE", "Alameda") 239 | ), 240 | c("44001", NA_character_, "06001") 241 | ) 242 | }) 243 | --------------------------------------------------------------------------------