more factors variables (#38)

andrewallenbruce · Nov 9, 2023 · b7210bb · b7210bb
1 parent 929affe
commit b7210bb
Show file tree

Hide file tree

Showing 5 changed files with 56 additions and 54 deletions.
diff --git a/R/globals.R b/R/globals.R
@@ -258,6 +258,7 @@ utils::globalVariables(c(
   "distribution", # <cms_get_dates>
   "year", # <cms_get_dates>
   "state.abb", # <fct_stabb>
+  "state.name", # <fct_stname>
   "Variable", # <gt_datadict>
   "Description", # <gt_datadict>
   "Definition", # <gt_datadict>

diff --git a/R/nppes.R b/R/nppes.R
@@ -194,18 +194,27 @@ nppes <- function(npi = NULL,
                                tidyr::unpack(ep, names_sep = ".")
     if (tidy) {
 
-      results <- tidyup(results, dtype = 'ymd', yn = c('sole_prop', 'org_part'), cred = 'credential')
+      results <- tidyup(results,
+                        dtype = 'ymd',
+                        yn = c('sole_prop', 'org_part'),
+                        cred = 'credential')
 
-      if (!rlang::has_name(results, "gender"))    results$gender <- "9"
-      if (rlang::has_name(results, "tx_primary")) results$tx_primary <- as.logical(results$tx_primary)
+      if (!rlang::has_name(results, "gender")) results$gender <- "9"
 
       results <- dplyr::mutate(results,
-                      purpose = dplyr::if_else(purpose == "LOCATION", "PRACTICE", purpose),
-                      gender = fct_gen(gender),
+                      purpose     = dplyr::if_else(purpose == "LOCATION", "PRACTICE", purpose),
+                      gender      = fct_gen(gender),
                       entity_type = fct_enum(entity_type),
-                      state = fct_stabb(state)) |>
+                      state       = fct_stabb(state)) |>
         cols_nppes(2)
 
+      if (rlang::has_name(results, "tx_primary")) results$tx_primary <- as.logical(results$tx_primary)
+      if (rlang::has_name(results, "tx_state"))   results$tx_state   <- fct_stabb(results$tx_state)
+      if (rlang::has_name(results, "id_state"))   results$id_state   <- fct_stabb(results$id_state)
+      if (rlang::has_name(results, "pr_state"))   results$pr_state   <- fct_stabb(results$pr_state)
+      if (rlang::has_name(results, "purpose"))    results$purpose    <- fct_purp(results$purpose)
+      if (rlang::has_name(results, "pr_purpose")) results$pr_purpose <- fct_purp(results$pr_purpose)
+
       if (na.rm) results <- narm(results)
     }
   }

diff --git a/R/utils-fct.R b/R/utils-fct.R
@@ -66,4 +66,23 @@ fct_enum <- function(x) {
          labels = c("Individual", "Organization"))
 }
 
+#' Convert entity types to labelled factor
+#' @param x vector
+#' @autoglobal
+#' @noRd
+fct_pos <- function(x) {
+  factor(x,
+         levels = c("F", "N"),
+         labels = c("Facility", "Non-facility"))
+}
+
 
+#' Convert genders to unordered factor
+#' @param x vector
+#' @autoglobal
+#' @noRd
+fct_purp <- function(x) {
+  factor(x,
+         levels = c("PRACTICE", "MAILING", "LOCATION"),
+         labels = c("Practice", "Mailing", "Location"))
+}
diff --git a/R/utils.R b/R/utils.R
@@ -89,8 +89,19 @@ abb2full <- function(abb,
                      arg = rlang::caller_arg(abb),
                      call = rlang::caller_env()) {
 
-  results <- dplyr::tibble(x = state.abb,
-                           y = state.name) |>
+  results <- dplyr::tibble(x = c(state.abb[1:8],
+                                 'DC',
+                                 state.abb[9:50],
+                                 'AS', 'GU', 'MP', 'PR', 'VI', 'UK'),
+                           y = c(state.name[1:8],
+                                 'District of Columbia',
+                                 state.name[9:50],
+                                 'American Samoa',
+                                 'Guam',
+                                 'Northern Mariana Islands',
+                                 'Puerto Rico',
+                                 'Virgin Islands',
+                                 'Unknown')) |>
     dplyr::filter(x == abb) |>
     dplyr::pull(y)
 

diff --git a/vignettes/articles/geospatial.Rmd b/vignettes/articles/geospatial.Rmd
@@ -70,21 +70,6 @@ rhcs
 ```
 
 
-## Retrieve Counties from Zip codes with `{zipcodeR}`
-
-```{r}
-zip_db <- dplyr::tibble(zipcodeR::zip_code_db) |> 
-  dplyr::filter(state == "GA") |> 
-  dplyr::select(zip = zipcode, 
-                city = major_city, 
-                county, 
-                state, 
-                lat, 
-                lng) |> 
-  dplyr::mutate(county = stringr::str_remove(county, " County"))
-zip_db
-```
-
 ## Stack Distinct `LOCATION` & `PRACTICE` Addresses
 
 ```{r}
@@ -115,35 +100,20 @@ stack <- dplyr::bind_rows(
                 city = pr_city, 
                 state = pr_state, 
                 zip = pr_zip)) |> 
-  dplyr::mutate(zip = zipcodeR::normalize_zip(zip)) |> 
   dplyr::filter(!is.na(purpose)) |> 
   tidyr::nest(specialty = tx_desc, 
               other_names = c(org_parent, 
                               on_type, 
                               on_org_name)) |> 
+  add_counties(zcol = zip) |> 
   tidyr::unite("address", 
                address:state, 
                remove = TRUE, 
-               sep = " ") |> 
-  dplyr::inner_join(zip_db) # Join RHCs to Counties
+               sep = " ")
 stack
 ```
 
 
-
-```{r}
-# Create data frame of unique state/county pairs
-sc <- stack |> dplyr::distinct(state, county)
-# Retrieve county FIPS codes
-sc <- sc |> dplyr::mutate(fips = purrr::map2_chr(sc$state, sc$county, fipio::as_fips))
-# Retrieve geometries based on county FIPS
-sc <- sc |> dplyr::mutate(geometry = purrr::map(sc$fips, fipio::fips_geometry)) |> tidyr::unnest(geometry)
-# Create `{sf}` <MULTIPOLYGON> object
-sc <- sf::st_as_sf(sc)
-sc
-```
-
-
 ## Send to `{tidygeocoder}`
 
 ```{r}
@@ -158,31 +128,23 @@ rhc_geo
 ```
 
 
-
-## Convert to `{sf}` object
-
-## Retrieve Georgia state & counties shapefile from `{tigris}`
-
-```{r}
-ga_state <- tigris::states(year = 2022, progress_bar = FALSE) |> dplyr::filter(STUSPS == "GA")
-ga_state
-```
-
+## Retrieve Georgia counties shapefile from `{tigris}`
 
 ```{r}
 ga_counties <- tigris::counties(state = "GA", year = 2022, progress_bar = FALSE)  
 ga_counties
 ```
 
 
+## `{ggplot}`
+
 ```{r}
 p <- ggplot2::ggplot() + 
-  #ggplot2::geom_sf(data = ga_state, colour = "darkred") +
-  ggplot2::geom_sf(data = ga_counties, fill = "darkgreen", colour = "white", alpha = 0.5) +
-  ggplot2::geom_sf(data = sc, size = 3, fill = "white") +
+  ggplot2::geom_sf(data = ga_counties, fill = "darkgreen", colour = "white", alpha = 0.25) +
+  #ggplot2::geom_sf(data = stack, size = 3, fill = "white") +
   ggplot2::geom_point(rhc_geo, 
                       mapping = ggplot2::aes(long, lat), 
-                      fill = "orange", 
+                      fill = "white", 
                       color = "darkred", 
                       alpha = 0.75, 
                       size = 1.5,