Part B

Introduction

In this section, using the Leaflet package in R, geocoded project data from the Tennessee FastTrack program is mapped according to the investment size made by new and expanding companies companies. The data ranges from 2011 to 2023 and was acquired through an open records request during another class.

Mapping with Leaflet

Load in packages for mapping in Leaflet

library(leaflet)
library(leafem)
library(leafpop)
library(sf)
library(scales)
library(tidyverse)
library(USAboundaries)
library(remotes)
library(here)

Load in the FastTrack geodatabase layer and clean up field names.

(FastTrack <- read_sf(here("data", "FastTrackProjects.gdb"), "FastTrack_all") %>% 
     select("USER_Company", "USER_Capital_Investment", "USER_Grants_Total", "USER_Landed_Month__Year") %>% 
     rename("company" = "USER_Company", "investment" = "USER_Capital_Investment", "grants" = "USER_Grants_Total", "date" = "USER_Landed_Month__Year"))
## Simple feature collection with 1290 features and 4 fields
## Geometry type: POINT
## Dimension:     XY
## Bounding box:  xmin: -90.11614 ymin: 34.99269 xmax: -81.77817 ymax: 36.64349
## Geodetic CRS:  WGS 84
## # A tibble: 1,290 × 5
##    company       investment grants date                               Shape
##    <chr>              <dbl>  <dbl> <dttm>                       <POINT [°]>
##  1 Chick-fil-A …   16300000 3   e5 2022-02-16 18:00:00 (-86.60411 36.03176)
##  2 Marque of Br…    1350000 1.58e5 2021-09-29 19:00:00 (-86.03296 36.08078)
##  3 BRS Offroad,…     655500 2.70e5 2021-04-05 19:00:00 (-87.54859 35.53764)
##  4 RevSpring, I…    2400000 1.08e5 2020-08-30 19:00:00 (-86.67957 36.07214)
##  5 LKQ Corporat…   26000000 1.95e6 2017-01-16 18:00:00  (-86.6393 36.03451)
##  6 Ebuys, Inc. …    8010000 1.06e5 2016-09-27 19:00:00 (-86.60736 36.02853)
##  7 TWB Company     18016000 8.2 e4 2015-06-02 19:00:00  (-86.6294 36.03639)
##  8 HCA, Inc.       10100000 8.10e5 2014-01-30 18:00:00 (-86.63635 36.03222)
##  9 Cavalry Logi…    1670000 1.10e5 2015-12-03 18:00:00 (-86.65857 36.04737)
## 10 Ebuys, Inc. …    1500000 5.45e4 2013-12-30 18:00:00 (-86.60736 36.02853)
## # ℹ 1,280 more rows

Initialize a basic leaflet map with the data

leaflet(data = FastTrack) %>% 
    addProviderTiles(providers$CartoDB.Voyager) %>% 
    addCircleMarkers(radius = 3,
                     stroke = FALSE,
                     label = ~company)

Add a clean-looking popup using the leafpop package.

# Define the popup table qualities
popTable <- leafpop::popupTable(
    st_drop_geometry(FastTrack[,1:5]),
    feature.id = FALSE, 
    row.numbers = FALSE)

leaflet(data = FastTrack) %>% 
    addProviderTiles(providers$CartoDB.Voyager) %>% 
    addCircleMarkers(radius = 3,
                     stroke = FALSE,
                     label = ~company,
                     popup = popTable)

Add color to the points using quantile classifications with 9 breaks going from yellow to green. Also, changing the tile to a darker option will increase color contrast.

# Define a color palette
pal <- colorQuantile(palette = "YlGn", domain = FastTrack$investment, n = 9)

leaflet(data = FastTrack) %>% 
    addProviderTiles(providers$CartoDB.DarkMatter) %>% 
    addCircleMarkers(radius = 3,
                     stroke = TRUE,
                     weight = 2,
                     color = ~pal(investment),
                     fillOpacity = 1,
                     label = ~company,
                     popup = popTable)

Add a legend and other useful map surrounds. By default, colorQuantile used in the last step labels categories with percent values. There is no native way to change it, but using outside functions, custom color and label attributes can be derived from the colorQuantile palette.

#Create customized number labels from the quantile palette.
pal_colors <- unique(pal(sort(FastTrack$investment)))
numclas <- 9
pal_label <- quantile(FastTrack$investment, seq(0, 1, length.out = numclas + 1), include.lowest = TRUE, na.rm = TRUE)
pal_label <- as.character(dollar(pal_label)) # Convert to dollar format
pal_label <- paste(lag(pal_label), pal_label, sep = " - ")[-1] # Skips NA lag

# Create map
leaflet(data = FastTrack) %>% 
    addProviderTiles(providers$CartoDB.DarkMatter) %>% 
    addCircleMarkers(radius = 3,
                     stroke = TRUE,
                     weight = 2,
                     color = ~pal(investment),
                     fillOpacity = 1,
                     label = ~company,
                     popup = popTable) %>%
    # add legend
    addLegend(position = "bottomright",
              opacity = 1,
              colors = pal_colors,
              labels = pal_label,
              values = ~investment,
              title = "Capital Investment") %>% 
    addScaleBar(position = "bottomleft")

Customize the map further by adjusting marker size by the investment size (scaled by 10 million). Changing the marker size can emphasize the sheer difference in the amount being invested within each area.

# Create map
leaflet(data = FastTrack) %>% 
    addProviderTiles(providers$CartoDB.DarkMatter) %>% 
    addCircleMarkers(radius = ~investment/10000000, # Scale size down by 10 million
                     stroke = TRUE,
                     weight = 1,
                     color = ~pal(investment),
                     fillOpacity = .6,
                     label = ~company,
                     popup = popTable) %>%
    # add legend
    addLegend(position = "bottomright",
              opacity = 1,
              colors = pal_colors,
              labels = pal_label,
              values = ~investment,
              title = "Capital Investment") %>%
    addScaleBar(position = "bottomleft")