Merge pull request #677 from USEPA/development

Development

DESCRIPTION

@@ -34,6 +34,7 @@ Imports:
     hrbrthemes,
     htmltools,
     leaflet,
+    leaflet.extras2,
     magrittr,
     methods,
     openxlsx,
@@ -67,7 +68,6 @@ Suggests:
     htmlwidgets, 
     jsonlite,
     leaflet.extras,
-    leaflet.extras2,
     mapview,
     rnaturalearth,
     rvest,

NAMESPACE

@@ -69,6 +69,7 @@ export(ejscreenit_for_ejam)
 export(ejscreenit_see_table)
 export(fips2countyname)
 export(fips2name)
+export(fips2pop)
 export(fips2state_abbrev)
 export(fips2state_fips)
 export(fips2statename)
@@ -128,8 +129,6 @@ export(makenumericdfFORSHINY)
 export(map2browser)
 export(map_blockgroups_over_blocks)
 export(map_counties_in_state)
-export(map_facilities)
-export(map_facilities_proxy)
 export(map_google)
 export(map_shapes_leaflet)
 export(map_shapes_leaflet_proxy)
@@ -283,7 +282,6 @@ import(openxlsx)
 import(pins)
 import(readxl)
 import(sf)
-import(shiny)
 import(shiny, except = c(dataTableOutput, renderDataTable))
 import(shinycssloaders)
 import(sp)

R/FIPS_FUNCTIONS.R

@@ -1002,8 +1002,8 @@ fips_place_from_placename = function(place_st, geocoding = FALSE, exact = FALSE,
       results <- fips_place_from_placename_grep(place_st_dont_say_cdp_or_city,
                                                 all_placename = pre_comma(all_place_st_dont_say_cdp_or_city, trim = TRUE),
                                                 all_ST = post_comma(all_place_st_dont_say_cdp_or_city, trim = TRUE))
-      results <- results[, .( query,placename,ST,countyname,fips, count_city_matched, count_city_state_matched)]
 
+      results <- results[, .( query,placename,ST,countyname,fips, count_city_matched, count_city_state_matched)]
       ### Get back a table of candidates,
       ###   but where do we check for exact match ? and where to choose which of possible hits is best ?
 
@@ -1070,14 +1070,15 @@ fips_place_from_placename = function(place_st, geocoding = FALSE, exact = FALSE,
     }
     #################################################### # 
     ## compile those findings and print to show possible hits, duplicates, county info, etc.
-
-    if (is.data.frame(results[[1]])) {
+    if(is.data.table(results) && usegrep){
+      #This condition is for usegrep = true. Without it, this if else would result in results being an empty dataframe
+    }
+    else if (is.data.frame(results[[1]])) {
       results <- data.frame(rbindlist(results))
       rownames(results) <- NULL
     } else {
       results = data.frame() # and results$fips will be NULL and NROW is 0
     }
-
     if (verbose) {
       if (NROW(results) == 0) {
         cat(paste0('\n\nyou can also try, for example:\n  censusplaces[grep("', place_st[1], '", censusplaces$placename, ignore.case = T), ]\n\n'))
@@ -1527,13 +1528,93 @@ fips_counties_from_countynamefull <- function(fullname, exact = TRUE) {
 # fips2...   ####
 ############################################################################# #
 
+# fips2pop() and f2p() helper
+
 # fips_st2eparegion()
 # fips2state_abbrev()
 # fips2state_fips()
 # fips2statename()
 # fips2countyname()
 # fips2name()
 ############################################################################# #
+################################################## # 
+
+#' Get population counts (ACS EJScreen) by FIPS
+#' Utility to aggregate just population count for each FIPS Census unit
+#' 
+#' @param fips vector of fips (can be state, county, tract, blockgroup, block).
+#'  If block, it estimates using weights like it does when aggregating for a report.
+#'  If city/cdp, it returns NA currently since those pop counts are not in blockgroupstats.
+#'
+#' @return vector of population counts same length as fips vector
+#' 
+#' @export
+#'
+fips2pop <- function(fips) {
+
+  pop = rep(NA, times = length(fips))
+  ftype = fipstype(fips)
+
+  # to handle possibly multiple types of fips in one shapefile:
+  for (onetype in unique(ftype)) {
+    pop[ftype == onetype]  <- f2p(fips[ftype == onetype], onetype = onetype)
+  }
+
+  # Population <- prettyNum(pop, big.mark = ",")
+
+  return(pop)
+}
+################################################## # 
+
+
+# helper function to get population counts (ACS EJScreen) by FIPS, for just 1 type of fips at a time
+
+f2p = function(fips, onetype) {
+
+  if (missing(onetype)) {
+    onetype = unique(fipstype(fips))
+    if (length(onetype) > 1) {stop('can only handle 1 fipstype at a time, so all must be e.g., state fips')}
+  }
+
+  pop <- rep(NA, times = length(fips))
+
+  if (onetype == 'city') {
+    # harder case - will not address here for now
+  }
+
+  if (onetype == 'blockgroup') {
+    pop <- blockgroupstats[fips, pop, on = 'bgfips']
+    # pop <- blockgroupstats$pop[match(fips, blockgroupstats$bgfips)]
+  }
+
+  if (onetype %in% c('state', 'county', 'tract')) {
+    if (onetype == 'state')  {fipslen = 2}
+    if (onetype == 'county') {fipslen = 5}
+    if (onetype == 'tract')  {fipslen = 11}
+    poptable <- blockgroupstats[substr(bgfips, 1, fipslen) %in% fips,
+                                .(pop = sum(pop, na.rm = T)),
+                                by = .(fips = substr(bgfips, 1, fipslen))]
+    pop <- poptable$pop[match(fips, poptable$fips)]
+  }
+
+  if (onetype == 'block') {
+    ## very inefficient draft but it works
+    if (exists("blockid2fips")) {
+      # pop is not essential and 
+      # it is slow to load and slow to do this, 
+      # so dont bother to load if not already here?
+
+      ##  use rounded (parent blockgroupstats$pop * blockwts$blockwt)
+      bgpop <- blockgroupstats[substr(fips, 1, 12), pop, on = 'bgfips']
+      inputfips = data.table(blockfips = fips)
+      inputid = data.table(blockid = blockid2fips[inputfips, blockid, on = 'blockfips'])
+      pop <- round(bgpop * blockwts[inputid, blockwt, on = 'blockid'], 0)
+    }
+  }
+
+  return(pop)
+}
+################################################## # 
 
 
 #' FIPS - Get EPA Region number from state FIPS code