Initial Set Up Steps

First chunk contains all the libraries needed to run the code and some important global variables. Second chunk contains all the instance variables needed to set up the snap resources map.

library(shinydashboard)
library(tidyverse)
library(leaflet)
library(shiny)
library(Rcpp)
library(sf)
library(tmaptools)
library(htmlwidgets)
library(googlesheets4)
library(RColorBrewer)
library(lubridate)
library(purrr)
library(shinythemes)

library(censusapi)
library(rgeos)
library(tidycensus)
library(tigris)
library(usmap)

library(colorspace)
library(ggplot2)
library(reshape2)
library(formattable)
library(plotly)
library(lubridate)
library(DT)

Sys.setenv(CENSUS_KEY="c8aa67e4086b4b5ce3a8717f59faa9a28f611dab")
github_directory <- "https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/"
github_rds <- "https://github.com/stanfordfuturebay/stanfordfuturebay.github.io/blob/master/data/"

options(
  tigris_class = "sf",
  tigris_use_cache = TRUE
)

mapbox_sat <- "https://api.mapbox.com/styles/v1/samanyl/ck9hpl0sm0fuq1ip8yfb2yrn8/tiles/256/{z}/{x}/{y}@2x?access_token=pk.eyJ1Ijoic2FtYW55bCIsImEiOiJjazlocGNvYWgxMHhxM2Rud2pxdzVnMnp2In0.D_j3K9tXiEddHH-8UUkeZQ"
mapbox_satAtt <- "© <a href='https://www.mapbox.com/map-feedback/'>Mapbox</a> Satellite Map"

bay_county_names <-
  c(
    "Alameda",
    "Contra Costa",
    "Marin",
    "Napa",
    "San Francisco",
    "San Mateo",
    "Santa Clara",
    "Solano",
    "Sonoma"
  )

setwd("C:/Users/liusa/github/covid19/Sam_Liu/SNAP")

col <- c("#5c2a9d","#e2598b","#ffd31d","#f57b51", "#1f4068", "#f78259")

# bay_counties <-
#   counties("CA", cb = F, progress_bar=F) %>%
#   filter(NAME %in% bay_county_names)
#
# zctas <-
#   zctas(cb=F)
#
# bay_zctas <-
#   zctas %>%
#   dplyr::select(ZCTA5CE10) %>%
#   st_join(bay_counties %>% dplyr::select(geometry),left=F)
#
# saveRDS(bay_zctas, file = "bay_zctas.rds")
bay_counties <- readRDS(gzcon(url(paste0(github_rds,"bay_counties.rds?raw=true")))) %>% 
  arrange(NAME) %>% 
  mutate(SNAP_HH=c(58880,30792,6263,2881,40592,11724,45606,20567,15779)) %>% 
  mutate(SNAP_participants=c(102011,58374,9556,5342,57944,20658,78848,36782,26005)) %>% 
  dplyr::select(NAME,geometry,SNAP_HH, SNAP_participants)

gs4_deauth()

retailers <- read_sheet("1tvMBCWNeh7kyyKklntmWfV1zNJx8bN-KxHIYmaULZxg")

retailers$long <- as.numeric(retailers$long)
retailers$lat <- as.numeric(retailers$lat)

snap <- retailers %>% filter(type == "SNAP_accepting_retailer")
wic <- retailers %>% filter(type == "WIC_only_store")
snap_wic <- retailers %>% filter(type == "WIC_SNAP_retailer")
snap_restaurant <- retailers %>% filter(type=="SNAP_restaurant")
snap_farmers <- retailers %>% filter(type=="SNAP_farmers_market")

snap_curbside <- snap %>% filter(!is.na(curbside_pickup))
wic_curbside <- wic %>% filter(!is.na(curbside_pickup))
snapwic_curbside <- snap_wic %>% filter(!is.na(curbside_pickup))
snaprest_curbside <- snap_restaurant %>% filter(!is.na(curbside_pickup))
snapfarm_curbside <- snap_farmers %>% filter(!is.na(curbside_pickup))

snap_delivery <- snap %>% filter(!is.na(delivery))
wic_delivery <- wic %>% filter(!is.na(delivery))
snapwic_delivery <- snap_wic %>% filter(!is.na(delivery))
snaprest_delivery <- snap_restaurant %>% filter(!is.na(delivery))
snapfarm_delivery <- snap_farmers %>% filter(!is.na(delivery))

snap_senior <- snap %>% filter(!is.na(senior_hours))
wic_senior <- wic %>% filter(!is.na(senior_hours))
snapwic_senior <- snap_wic %>% filter(!is.na(senior_hours))
snaprest_senior <- snap_restaurant %>% filter(!is.na(senior_hours))
snapfarm_senior <- snap_farmers %>% filter(!is.na(senior_hours))

snapIcon <- makeIcon(
  iconUrl = "baymap/bag.png",
  iconWidth=25,iconHeight=25)

wicIcon <- makeIcon(
  iconUrl = "baymap/love.png",
  iconWidth=30,iconHeight=30)

snapwicIcon <- makeIcon(
  iconUrl = "baymap/snapwic.png",
  iconWidth=30,iconHeight=30)

snaprestIcon <- makeIcon(
  iconUrl = "baymap/cutlery.png",
  iconWidth=25,iconHeight=25)

snapfarmIcon <- makeIcon(
  iconUrl = "baymap/chicken.png",
  iconWidth=25,iconHeight=25)

homeIcon <- makeIcon(
  iconUrl = "baymap/internet.png",
  iconWidth=25,iconHeight=25)

html_legend <- "<img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/bag.png' height='30' width='30'> SNAP Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/love.png' height='30' width='30'> WIC Only Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/snapwic.png' height='30' width='30'> SNAP and WIC Accepting Retailers<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/money.png' height='30' width='30'> Cash EBT Withdrawal Locations<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/cutlery.png' height='30' width='30'> SNAP Accepting Restaurants<br/><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/chicken.png' height='30' width='30'> SNAP Accepting Farmers Markets"

cluster <-
  markerClusterOptions(
    showCoverageOnHover=F,
    spiderfyOnMaxZoom=F,
    disableClusteringAtZoom=14
    )

# time format --> format(dataset$____, %I:%M%p)

pop <- function(dataset){
  result <-
    paste0(
      ifelse(
        is.na(dataset$web_link),
        paste0("<strong>",dataset$site_name,"</strong><br>"),
        paste0("<a href='",dataset$web_link,"' target='_blank'><strong>",dataset$site_name,"</strong></a><br>")
      ),
      dataset$address, "<br>",
      dataset$city,", ",
      dataset$state," ",
      dataset$zip,
      "<br><br><img src='https://raw.githubusercontent.com/stanfordfuturebay/stanfordfuturebay.github.io/master/data/pin.png' height='12' width='12'>
      <a href='https://www.google.com/maps/dir/?api=1&destination=",
      dataset$lat,",",
      dataset$long,"' target='_blank'>Directions To Here</a>",
      '<br><br><strong>Hours of Operation: </strong><br>',
      dataset$days_hours_line1,
      ifelse(
        is.na(dataset$days_hours_line2),
        "",
        paste0("<br>",dataset$days_hours_line2)
      ),
      ifelse(
        is.na(dataset$days_hours_line3),
        "",
        paste0("<br>",dataset$days_hours_line3)
      ),
      ifelse(
        is.na(dataset$days_hours_line4),
        "",
        paste0("<br>",dataset$days_hours_line4)
      ),
      "<br><br><strong>Contact Information:</strong><br>",
      ifelse(
        is.na(dataset$web_link),
        "",
        paste0("<a href='",dataset$web_link,"' target='_blank'>Website</a><br>")
      ),
      dataset$phone,"<br>",
      ifelse(
        is.na(dataset$notes),
        "",
        paste0("<br><strong>Notes: </strong>",dataset$notes,"<br>")
      ),
      ifelse(
        is.na(dataset$senior_hours),
        "",
        paste0(
          '<br><strong style="color:red">** SPECIAL SENIOR HOURS ** </strong><br>',
          dataset$senior_hours)
      )
    )
  return(result)
}

Leaflet Snap Circle Icons

This was just to test the layout of circle icons - personal side project.

Leaflet Snap with Flat Icons

Official snap resources prototype of bay map using Charlie’s data in Google Sheets.

mpi <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addMarkers(
      lng = snap$long,
      lat = snap$lat,
      clusterOptions = cluster,
      popup = pop(snap),
      icon = snapIcon,
      group = "SNAP Only Retailers"
      ) %>%
    addMarkers(
      lng = wic$long,
      lat = wic$lat,
      clusterOptions = cluster,
      popup = pop(wic),
      icon = wicIcon,
      group = "WIC Only Retailers"
      ) %>%
    addMarkers(
      lng = snap_wic$long,
      lat = snap_wic$lat,
      clusterOptions = cluster,
      popup = pop(snap_wic),
      icon = snapwicIcon,
      group = "SNAP and WIC Accepting Retailers"
      ) %>%
    addMarkers(
      lng = snap_restaurant$long,
      lat = snap_restaurant$lat,
      clusterOptions = cluster,
      popup = pop(snap_restaurant),
      icon = snaprestIcon,
      group = "SNAP Accepting Restaurants"
      ) %>%
    addMarkers(
      lng = snap_farmers$long,
      lat = snap_farmers$lat,
      clusterOptions = cluster,
      popup = pop(snap_farmers),
      icon = snapfarmIcon,
      group = "SNAP Accepting Farmers Markets"
      ) %>%
    addMarkers(
      lng = snap_curbside$long,
      lat = snap_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snap_curbside),
      icon = snapIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = wic_curbside$long,
      lat = wic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(wic_curbside),
      icon = wicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapwic_curbside$long,
      lat = snapwic_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_curbside),
      icon = snapwicIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snaprest_curbside$long,
      lat = snaprest_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_curbside),
      icon = snaprestIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snapfarm_curbside$long,
      lat = snapfarm_curbside$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_curbside),
      icon = snapfarmIcon,
      group = "Offers Curbside Pick-up"
      ) %>%
    addMarkers(
      lng = snap_delivery$long,
      lat = snap_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snap_delivery),
      icon = snapIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = wic_delivery$long,
      lat = wic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(wic_delivery),
      icon = wicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_delivery$long,
      lat = snapwic_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_delivery),
      icon = snapwicIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_delivery$long,
      lat = snaprest_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_delivery),
      icon = snaprestIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_delivery$long,
      lat = snapfarm_delivery$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_delivery),
      icon = snapfarmIcon,
      group = "Offers CSA Box Delivery"
      ) %>%
    addMarkers(
      lng = snap_senior$long,
      lat = snap_senior$lat,
      clusterOptions = cluster,
      popup = pop(snap_senior),
      icon = snapIcon,
      group = "Offers Senior Hours"
      ) %>%
    addMarkers(
      lng = wic_senior$long,
      lat = wic_senior$lat,
      clusterOptions = cluster,
      popup = pop(wic_senior),
      icon = wicIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snapwic_senior$long,
      lat = snapwic_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapwic_senior),
      icon = snapwicIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snaprest_senior$long,
      lat = snaprest_senior$lat,
      clusterOptions = cluster,
      popup = pop(snaprest_senior),
      icon = snaprestIcon,
      group = "Offers Delivery"
      ) %>%
    addMarkers(
      lng = snapfarm_senior$long,
      lat = snapfarm_senior$lat,
      clusterOptions = cluster,
      popup = pop(snapfarm_senior),
      icon = snapfarmIcon,
      group = "Offers Delivery"
      ) %>%
    addPolygons(
      data = bay_counties,
      fillOpacity = 0,
      color = "black",
      weight=2,
      dashArray = 3,
      label = as.character(bay_counties$NAME),
      labelOptions = labelOptions(noHide = T, textOnly = TRUE,
                                  style=list('font-weight'='bold','text-transform'='uppercase')),
      group = "Bay Area County Lines"
      ) %>%
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("Bay Area County Lines", "SNAP Only Retailers","WIC Only Retailers", 
                        "SNAP and WIC Accepting Retailers","Cash EBT Withdrawal Locations",
                        "SNAP Accepting Restaurants","SNAP Accepting Farmers Markets",
                        "Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours")
      ) %>%
    addControl(
      html=html_legend,
      position="bottomleft") %>%
  hideGroup(c("Offers Curbside Pick-up", "Offers Delivery","Offers Senior Hours", "Bay Area County Lines"))

mpi

Table that reflects the number of SNAP users per county in the Bay Area.

baymap_tbl <- 
  bay_counties %>%
  as.data.frame() %>% 
  dplyr::select(-geometry) %>% 
  dplyr::rename("County"="NAME","Total SNAP Users by Household"="SNAP_HH","Total Individual SNAP Users"="SNAP_participants") %>% 
  formattable(align = c(rep("c")))

baymap_tbl$`Total SNAP Users by Household` <- comma(baymap_tbl$`Total SNAP Users by Household`,format="d")
baymap_tbl$`Total Individual SNAP Users` <- comma(baymap_tbl$`Total Individual SNAP Users`,format="d")
  
baymap_tbl
County Total SNAP Users by Household Total Individual SNAP Users
Alameda 58,880 102,011
Contra Costa 30,792 58,374
Marin 6,263 9,556
Napa 2,881 5,342
San Francisco 40,592 57,944
San Mateo 11,724 20,658
Santa Clara 45,606 78,848
Solano 20,567 36,782
Sonoma 15,779 26,005

Walmart vs. SNAP Demographics

Facteus data doesn’t reflect SNAP user data, so we tried to relate them by overlaying their statistics on a map with relevant calculated data in a table.

## most popular/accessible walmart among zipcodes (plot number of transactions on map)

# bay_zipcodes <-
#   read.csv("baymap/bayarea_zipcodes.csv") %>% 
#   dplyr::select(PO_NAME,ZIP) %>%
#   left_join(city_county_state,by=c("PO_NAME"="City"))
# 
# bay_zipcodes$ZIP <- as.character(bay_zipcodes$ZIP)
# 
# saveRDS(bay_zipcodes,"baymap/bayarea_zipcodes.rds")
# 
# spending_brand_sum <-
#   bay_zipcodes %>%
#   left_join(spending_brand %>% filter(merchant=="WALMART"),by=c("ZIP"="zip")) %>%
#   group_by(merchant,ZIP,PO_NAME,County,SNAP_HH) %>%
#   summarize(
#     transactions_avg=round(mean(as.numeric(transaction_counts)))) %>%
#   left_join(bay_zctas,by=c("ZIP"="ZCTA5CE10")) %>%
#   distinct(ZIP,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   mutate(combined=paste0(ZIP,": ",round(transactions_avg)," Daily Avg Walmart Transactions")) %>%
#   na.omit()
# 
# spending_brand_sum <- spending_brand_sum[order(spending_brand_sum$transactions_avg),]
# 
# saveRDS(spending_brand_sum,"baymap/spending_brand_sum.rds")
# 
# gcf["zip"] <- as.character(gcf$zip)
# 
# gcf_bay <-
#   gcf %>%
#   right_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
#   filter(zip %in% spending_brand_sum$ZIP) %>%
#   distinct(zip,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   mutate(combined=paste0(zip,": ",total_individuals, " SNAP Applicants")) %>%
#   na.omit()
# 
# gcf_bay <- gcf_bay[order(gcf_bay$total_individuals),]
# 
# saveRDS(gcf_bay,"baymap/gcf_bay.rds")
# 
# online2020 <-
#   walmart_online %>%
#   filter(year(date) == 2020, zip %in% spending_brand_sum$ZIP) %>%
#   dplyr::select(zip,transaction_counts) %>%
#   group_by(zip) %>%
#   summarize(total_counts = sum(as.numeric(transaction_counts))) %>%
#   left_join(bay_zctas,by=c("zip"="ZCTA5CE10")) %>%
#   distinct(zip,.keep_all = T) %>%
#   st_as_sf(dim = "XY", sf_column_name = "geometry") %>%
#   st_transform(crs=4326) %>%
#   arrange(total_counts) %>%
#   na.omit() %>%
#   saveRDS("baymap/online2020.rds")
# 
# walmart_bay <-
#   readRDS("P:/Shared/SFBI/Restricted Data Library/Safegraph/covid19analysis/core/2020/03/CoreRecords-CORE_POI-2019_03-2020-03-25/core_poi-ca.rds") %>%
#   filter(location_name =="Walmart" & toupper(city) %in% city_county_state$City) %>%
#   dplyr::select(location_name, postal_code, latitude, longitude, street_address, city) %>%
#   saveRDS("baymap/walmart_bay.rds")

bay_zipcodes <- readRDS("baymap/bayarea_zipcodes.rds")

spending_brand_sum <- readRDS("baymap/spending_brand_sum.rds")
spending_brand_sum_top10 <- tail(spending_brand_sum,10)
spending_brand_sum_top25 <- tail(spending_brand_sum,25)
spending_brand_sum_top50 <- tail(spending_brand_sum,50)

gcf_bay <- readRDS("baymap/gcf_bay.rds")
gcf_bay_top10 <- tail(gcf_bay,10)
gcf_bay_top25 <- tail(gcf_bay,25)
gcf_bay_top50 <- tail(gcf_bay,50)

online2020 <- readRDS("baymap/online2020.rds")
online2020_bottom25 <- head(online2020,25)
online2020_top25 <- tail(online2020,25)

fp <- leaflet() %>%
    addProviderTiles(providers$CartoDB.VoyagerLabelsUnder, group = "Default") %>%
    addTiles(urlTemplate = mapbox_sat, attribution = mapbox_satAtt, group = "Satellite") %>%
    addPolygons(
      data = spending_brand_sum_top10,
      weight=2,
      color = col[1],
      # label = spending_brand_sum_top10$combined,
      group = "Walmart Top 10"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top25,
      weight=2,
      color = col[1],
      # label = spending_brand_sum_top25$combined,
      group = "Walmart Top 25"
      ) %>%
    addPolygons(
      data = spending_brand_sum_top50,
      color = col[1],
      weight=2,
      # label =  spending_brand_sum_top50$combined,
      group = "Walmart Top 50"
      ) %>%
    addPolygons(
      data = gcf_bay_top10,
      weight=2,
      color = col[2],
      # label = gcf_bay_top10$combined,
      group = "SNAP Top 10"
      ) %>%
    addPolygons(
      data = gcf_bay_top25,
      weight=2,
      color = col[2],
      # label = gcf_bay_top25$combined,
      group = "SNAP Top 25"
      ) %>%
    addPolygons(
      data = gcf_bay_top50,
      color = col[2],
      weight=2,
      # label = gcf_bay_top50$combined,
      group = "SNAP Top 50"
      ) %>%
    addPolygons(
      data = online2020_bottom25,
      color = col[3],
      weight=2,
      # label = as.character(online2020_bottom25$total_counts),
      group = "Walmart Online Bottom 25"
      ) %>%
    addPolygons(
      data = online2020_top25,
      color = col[4],
      weight=2,
      # label = as.character(online2020_top25$total_counts),
      group = "Walmart Online Top 25"
      ) %>%
    addPolygons(
      data = bay_counties,
      fillOpacity = 0,
      color = "black",
      weight=2,
      dashArray = 3,
      label = as.character(bay_counties$NAME),
      labelOptions = labelOptions(noHide = T, textOnly = TRUE,
                                  style=list('font-weight'='bold','text-transform'='uppercase')),
      group = "Bay Area County Lines"
      ) %>%
    addCircleMarkers(
      lng = walmart_bay$longitude,
      lat=walmart_bay$latitude,
      radius=3,
      fillColor = col[5],
      color = col[5],
      fillOpacity = "80%",
      popup = paste0("<strong>",walmart_bay$location_name,"</strong><br>",
                     walmart_bay$street_address,"<br>",walmart_bay$city,", ",walmart_bay$postal_code),
      group = "Walmart Locations"
    ) %>% 
    addCircleMarkers(
      lng = walmart_bay_online$longitude,
      lat=walmart_bay_online$latitude,
      radius=3,
      fillColor = col[6],
      color = col[6],
      fillOpacity = "80%",
      popup = paste0("<strong>",walmart_bay_online$location_name," Grocery Pick-Up</strong><br>",
                     walmart_bay_online$street_address,"<br>",walmart_bay_online$city,", ",walmart_bay_online$postal_code),
      group = "Walmart Grocery Pick-up Locations"
    ) %>% 
    addLayersControl(
      baseGroups = c("Default","Satellite"),
      overlayGroups = c("Bay Area County Lines", "Walmart Locations", "Walmart Grocery Pick-up Locations","Walmart Top 10","Walmart Top 25","Walmart Top 50", 
                        "SNAP Top 10","SNAP Top 25", "SNAP Top 50",
                        "Walmart Online Bottom 25", "Walmart Online Top 25")
    ) %>%
  hideGroup(c("Walmart Top 10","Walmart Top 50","SNAP Top 10","SNAP Top 50", "Walmart Online Bottom 25", "Bay Area County Lines"))

fp
walsnap_tbl <-
  gcf_bay_top50 %>%
  dplyr::select(-geometry) %>%
  as.data.frame() %>%
  left_join(spending_brand_sum_top50 %>% dplyr::select(-geometry) %>% as.data.frame(), by=c("zip"="ZIP"), suffix=c("_SNAP","_walmart")) %>%
  left_join(online2020_top25, by=c("zip")) %>%
  na.omit() %>% 
  mutate(snap_users = scales::percent(total_individuals/SNAP_HH)) %>%
  dplyr::select(zip,transactions_avg, total_counts, total_individuals, snap_users, PO_NAME, County) %>%
  arrange(desc(transactions_avg)) %>% 
  dplyr::rename("Zip"="zip","CITY"="PO_NAME","SNAP Applicants"="total_individuals","Daily Avg Walmart Transactions"="transactions_avg", "Total 2020 Online Walmart Transactions"="total_counts", "COUNTY"="County", "% of SNAP Users in County" = "snap_users") %>% 
  formattable(align = c(rep("c")),
              list(area(col = 4:4) ~ color_tile("#ffffff", "#eab9c9"),
                   area(col = 2:2) ~ color_tile("#ffffff", "#c9b6e4"),
                   area(col = 3:3) ~ color_tile("#ffffff", "#f9b384"))) %>% 
  as.datatable()

walsnap_tbl

Shiny App Implementation

For full dashboard/shinyapp results, visit https://stanfordfuturebay.shinyapps.io/baymap/

body_bay <-
  sidebarLayout(
    position="right",
    sidebarPanel(
      width=3,
      textInput("address","Input Address:"),
      sliderInput("slider", "Miles Radius:", 1, 3, 2),
      actionButton("go",label="Go")
      ),
    mainPanel(
      width=9,
      style='margin-right: -10px',
      splitLayout(
        cellWidths = c("30%","70%"),
        cellArgs = list(
          style='white-space: normal;',
          style='overflow: hidden;',
          style='padding: 10px;'),
        verticalLayout(
          h4(strong("About the Map")),
          p("This map highlights the key opportunities for SNAP online integration around the San Francisco Bay Area. Each icon represents different SNAP accepting retailers as well as WIC. We are manually updating these SNAP retailer hours with COVID-19 operating hours."),
          p("Using July 2019 bi-annual SNAP Participants data from USDA, we see that the highest number of SNAP users in the Bay Area are in Alameda and Santa Clara Counties (shown in the table to the right)."),
          h4(strong("How To Use the Map")),
          p("1. Scroll up and down to zoom in and out of the map",
            br(),
            "2. Filter through different retailers through layers icon in the top right corner of the map",
            br(),
            "3. Toggle the county lines on and off through the layers icon as well",
            br(),
            "4. Use the inputs from the right sidebar to zoom into a specific address with a 1, 2, or 3 mile-radius"),
          br(),
          p(strong("Disclaimer: "),"This map is not intended to substitute an all-encompassing resources map. For that, please go to this ", a("link", href="https://www.bayareacommunity.org/#/"),".",style="font-size:14px"),
          br(),
          p("Created by Samantha Liu for the ",a("Stanford Future Bay Initiative",href="http://bay.stanford.edu/covid19?utm_campaign=ConsortiumUpdate-5.18.20&utm_medium=email&utm_source=autopilot"),style="font-size:12px")
        ),
      leafletOutput("snapmap",height="86vh", width="50vw"),
      absolutePanel(
        style='white-space: normal; border: 1px solid gray; border-radius: 10px; padding: 10px; font-size: 14px',
        top=295,right=-320,width="31%", height="56%",
        formattableOutput("baymap_tbl")
      )
      )
    )
  )
body_shopping <-
  tabBox(
    id = "tabset2",
    width=12,
    tabPanel(
      "About the Data",
      style="padding: 20px",
      h4("Purpose of this Analysis"),
      p("The purpose of this analysis is to predict the number of potential people impacted by Walmart's recent ",a("Online SNAP Program",href="https://www.walmart.com/ideas/discover-grocery-pickup-delivery/walmart-grocery-pickup-accepts-snap-ebt-payments/355540")," launch. Until this program launched, SNAP beneficiaries did not have the luxury to buy their groceries online. This means SNAP recipients have higher risks of either contracting or passing on the virus during shelter-in-place orders. Even if this program turns out to not be not highly utilized, it is extremely important that every person has the equal opportunity to access grocery deliveries after COVID-19 passes."),
      h4("Analysis Steps", style="margin-top: 20px"),
      p("We started with a high-level approach to first understand the nature of spending patterns among the lower-income communities and at Walmart within the past four months. Then, we used a map to visualize the space and draw correlations between SNAP users and Facteus sources. Our process can be condensed into the following steps which have their own corresponding analysis tabs:"),
      HTML("<ol>
              <li>Monthly Spendings</li>
              <li>Grocer Spendings</li>
              <li>Walmart Online vs. Instore Purchases</li>
              <li> Walmart vs. SNAP Users Map Overlay</li>
           </ol>"),
      h4("Data Sources", style="margin-top: 20px"),
      p("This transaction dataset is primarily from three sources: "),
      HTML("<ul>
              <li>Challenger Banks - Simple, N26, etc.</li>
              <li>Payroll Cards</li>
              <li>Government Cards</li>
            </ul>"),
      p("Because of this, it's mostly tracking the purchase patterns of lower-income and younger consumers."),
      br(),
      p(em("Challenger banks"),"are newer smaller banks that mostly serve people who are under-banked. They are usually online-only."),
      p(em("Payroll cards"),"are debit cards given to employees by employers who can then direct debit their payroll onto those cards."),
      p(em("Government cards"),"are mostly cards given to an alimony recipient to allow them access to funds obtained by garnishing a wage.")
    ),
    tabPanel(
      "Monthly Spendings",
      style="padding: 20px",
      fluidRow(
        column(12,
         h3("Where are lower-income communities spending their money and how has SIP orders affected that?", style="text-align: center"),
         h4("Process:", style="margin-top: 20px"),
         p("The Facteus dataset provided by Safegraph combines merchant category codes (MCC) with daily transactions between the years 2017 and 2020. Since we are only interested in pre-SIP orders and post-SIP orders effects, we filtered this dataset down to the years 2019 and 2020. We then aggregated the total transactions of each year for every MCC to get our values that are used in the figures below. To determine the top 10 MCC, we need a reference year. We chose the reference year to be 2020 in order to align with our goals - to determine the effects of SIP orders. Finally, we created a bar graph for each month and generated their respective tables."),
         h4("Findings:", style="margin-top: 20px"),
         p("We found that the top 3 consistent categories that lower-income communities spend their money on are: Fast Food, Grocery Stores, and Retail. Since SNAP benefits can only be used for groceries, we see the constant need for groceries in and out of SIP."),
         p("As an interesting side-note, the difference in magnitudes of total transactions between January and April 2020 is drastic. Furthermore, Taxis and Fuel Dispensers (gas stations) have been replaced by Book and Record Shops in April. This makes sense as people are driving siginificantly less and exploring new hobbies such as reading."),
         p("The figures below show the 10 shopping categories with the highest number of transactions in 2020. They also cross-reference these categories with that of 2019. The tables below the figures provide the description of and the total transactions for each MCC in 2019 and 2020. The tables are ordered by MCC to easily look-up the MCCs"),
         br(),
         p(strong("Instructions for Figures Below:"),"Use the drop-down menu on each side of the site to choose which months you would like to compare side-by-side.")
         )
      ),
      splitLayout(
        cellArgs = list(
          style='white-space: normal;',
          style='overflow: hidden;',
          style='padding: 10px;'
          ),
        verticalLayout(
          selectInput("mcc_month_l", "Month:",
            c("January" = "jan",
              "February" = "feb",
              "March" = "mar",
              "April" = "apr")
          ),
          plotlyOutput("mcc_l"),
          br(),
          formattableOutput("mcc_plt_l")
          ),
        verticalLayout(
          selectInput("mcc_month_r", "Month:",
            c("January" = "jan",
              "February" = "feb",
              "March" = "mar",
              "April" = "apr"),
            selected="apr"
          ),
          plotlyOutput("mcc_r"),
          br(),
          formattableOutput("mcc_plt_r")
        )
      )),
      tabPanel(
        "Grocer Spendings",
        style="padding: 20px",
        fluidRow(
          column(12,
            h3("How has daily average spendings on groceries changed between January and April over the years?", style="text-align: center"),
            h4("Process:", style="margin-top: 20px"),
            p("Building upon our ",em("Monthly Spendings")," analysis, we further filtered the data to only focus on the MCC 5411 - Grocery Stores. We were curious to know how spendings changed on a monthly and a weekly basis. To determine these results, we split our data into two datasets, each grouped the average daily spendings by the month and by the week. We then created line graphs for each dataset which can be seen below."),
            p("We were then curious to know how do spendings change on a day-to-day basis. Because each date corresponds to different weekends and weekdays and thus behaviors change on a weekend-to-weekday basis, performing the same calculations as before would not produce informative insights. Therefore, we aggregated the spendings data by the days of the week and then produced a bar graph for this daily analysis."),
            h4("Findings:", style="margin-top: 20px"),
            p("Even though the total grocery store transactions decreased, the average spendings per transaction went significantly up. This makes sense as people are stocking up more on groceries to avoid going out too frequently. With everyone stocking up on groceries, there is a greater risk for critical produce and food items to be out of stock more frequently. This only further justifies the need for constant and reliable grocery stocks during these times. SNAP online purchsae programs will help ensure that lower-income communities will be able to find the nutritional food they need and better plan around out-of-stock situations."),
            p("The figures below show the average daily spendings on groceries on a monthly, weekly, and day-of-the-week basis."),
            br(),
            p(strong("Instructions for Figures Below:"),"Use the dropdown menu to choose the frequency of the data. Description of each frequency type is underneath the dropdown menu. For each plot, click on legend items to toggle on and off specific years. Double click on a legend item to isolate a single year.")
          )
        ),
        splitLayout(
          cellArgs = list(
            style='white-space: normal;',
            style='overflow: hidden;',
            style='padding: 10px;'
          ),
          plotlyOutput("grocer_plt"), 
          verticalLayout(
            selectInput("grocer", "Frequency:",
                        c("Monthly" = "annually",
                          "Weekly" = "weekly",
                          "Day of the Week" = "weekday")
            ),
            br(),
            p(em("Monthly"),"analyzes the overall changes in the average daily grocery spendings on a monthly basis."),
            p(em("Weekly"),"analyzes the overall changes in the average daily grocery spendings on a weekly basis."),
            p(em("Day of the Week"),"analyzes the overall changes in the average daily grocery spendings on a daily basis."),
            br(),
            p(strong("Disclaimer:"),"This section only analyzes the changes from January to May to capture the spending effects of SIP orders on groceries.", style="font-size: 13px")
          )
        )
      ),
    tabPanel(
      "Walmart Online vs Instore Purchases",
      style="padding: 20px",
      fluidRow(
        column(12,
          h3("What are the Walmart online vs. instore shopping trends for lower-income communities before and after SIP orders?", style="text-align: center"),
          h4("Process:", style="margin-top: 20px"),
          p("The Facteus datasets provides us with Walmart transactions dataset that is already broken down into online and instore purchases. We first wanted to see which areas in the Bay Area utilize the online-shopping platform the most and how these patterns have changed between the months of January and April 2020. We believe this timeframe offers a comprehensive overview of changes in behavior before and after SIP orders. We first aggregated the daily data into weekly data. We were able to plot our first bar chart to determine the percentage of current transactions are online and its trend over the past few months (left figure under the map). Then, we determined the relative change of online and instore transactions over the past few months by dividing the week's total online/instore transactions over the four months' total online/instore transactions. This tells us how much of the total transactions are at the beginning of the year and how much are at the end of the year (right figure under the map). Afterwards, we wanted to know the change in online-instore transactions ratio over time. This was found by dividing the weekly number of online transactions by the weekly number of instore transactions (center figure under the map). Finally, taking these same ratios, we aggregated them into monthly data by zip codes in the Bay Area. We were then able to produce a heat map of online-instore ratios for the Bay Area in January, February, March, and April."),
          h4("Findings:", style="margin-top: 20px"),
          p("By mid-April, there is an overall increase in online transactions at Walmart. The perceived increase in online purchases may be caused by the decrease in instore purchases. Walmart also released their SNAP Online Purchase Program on April 13, which may be another reason for the observed spike in online-purchases. This shows the growing opportunity for SNAP Online Purchase programs."),
          p("The figures below help visualize these findings. The map shows the monthly progression of Walmart online-transactions ratio around the Bay Area throughout January and April. The figures below the map show the weekly progression of Walmart online transactions in the Bay Area throughout January and April."),
          br(),
          p(strong("Instructions for Figures Below:"),"Scroll through each section and read their descriptions to gain a better understanding of what each figure is showing.")
          )
      ),
      fluidRow(
        style="padding: 15px",
        column(7,
         leafletOutput("walmart",height="70vh"),
          absolutePanel(
            top=10, right=30,
            sliderInput("animation", "Month:",min=1,max=4,value=1,width="60px",
                        animate=animationOptions(interval=1200,loop=T)))
         ),
        column(5,
         h4("How to Use the Map"),
         p("1. Scroll up and down to zoom in and out of the map",
           br(),
           "2. Use the sliding bar in the map to see the change in Walmart's online-instore transaction ratio throughout the Bay Area per month",
           br(), 
           "3. Alternatively, click the play button underneath the sliding bar to show the same time progression autoatically",
           br(),
           "4. Hover over each colored polygon to see the online-transactions ratio for that region",
           br(),
           "5. Click on each dot to see the address of the Walmart location. Orange dots mean that the Walmart location offers Grocery Pick-Up"),
         h4("Conclusions", style="margin-top: 20px"),
         p("We found a strong correlation between Walmart online-instore transaction ratios and geographics of the Bay. There seems to be a higher online-instore transactions ratio in the Peninsula (west side of the Bay). Moreover, as time progresses, cities around San Francisco and Concord area appear to make more online purchases from Walmart while cities around Fremont and Hayward appear to make less online purchases from Walmart. This may be due to the fact that Walmarts are mostly located in the East Bay (east side of the Bay). Therefore, people who live further away will take advantage of the online-shopping opportunity since the store is not as accessible to them."),
         br(),
         p(strong("Disclaimer: "),"Some zip code areas disappear and reappear again because no online-purchases were made in those areas during the corresponding month.", style="font-size: 13px")
         )
        ),
      fluidRow(
        style="padding: 10px; text-align: center",
        column(4,
         h4("Percent of Total Transactions"),
         p(em("What percentage of Walmart transactions are online?")),
         p("Majority of Walmart transactions are still instore. However, we do see the percentage of online transactions grow as time in SIP goes on.")
         ),
        column(4, 
         h4("Online-Instore Transactions Ratio"),
         p(em("How has the online-instore transaction ratio changed?")),
         p("There is a decently sharp increase in the online-instore transactions ratio throughout SIP. This is probably a doubling effect due to the increase of online shopping and the decrease of instore shopping.")
         ),
        column(4, 
         h4("Relative Change of Transactions in %"),
         p(em("When did the number of online-purchases spike?")),
         p("The number of Walmart online-purchases started to rise around week 12 and peaked around week 15, which is roughly the second week of April. This is coincidentally around the same time when Walmart announced their Online Purchase Program.")
         )
        ),
      fluidRow(
        column(4, plotlyOutput("per_plt")),
        column(4, plotlyOutput("onin_plt")),
        column(4, plotlyOutput("rel_plt"))
        )
      ),
    tabPanel(
      "Walmart vs SNAP Users",
      style="padding: 20px",
      fluidRow(
        column(12,
          h3("How can we correlate Walmart shoppers from the Facteus dataset to SNAP users?", style="text-align: center"),
          h4("Process:", style="margin-top: 20px"),
          p("This entire time, the Facteus data is not representative of the SNAP user population. Therefore, we used USDA's July 2019 bi-annual county-level data in combination with Code for America's GetCalFresh data to represent the demographics of SNAP users. Our attempt at bridging these two datasets was to map the locations with the highest number of daily average Walmart transactions on top of the locations with the highest number of SNAP applicants on top of the locations with the lowest number of Walmart online transactions. We broke down the daily average Walmart transactions and SNAP applicants layers into three rankings - highest 10, highest 25, and highest 50. We broke down the total number of online Walmart transactions layer into two rankings - highest 25 and lowest 25. To see if there was a correlation between the location of Walmarts and the overlaid maps, we plotted every Walmart location in the Bay Area and specified which ones offered Walmart Grocery Pick-Up services - these are the only locations that accept SNAP EBT online."),
          p("To relate the map to some numbers, we condensed the relevant information into a table. The table only displays information on locations where the 50 highest Walmart average daily transactions, the 50 highest number of SNAP applicants, and the 25 highest online Walmart transactions all overlap. An additional variable that was calculated is the percent of SNAP users in the county. This was calculated by taking the number of SNAP applicants and dividng it by the number of actual SNAP households reported for the county. This represents the percentage of SNAP applicants who are SNAP users, assuming they all have been approved over the past year, that are from a particular city within a county."),
          h4("Findings:", style="margin-top: 20px"),
          p("We found that the critical areas to focus on for SNAP online purchase integration are the darker pink colored areas on the map. These areas represent lower-income communities who may have great benefit in taking advantage of the Walmart SNAP Online Purchase Program since they appear to shop at Walmart frequently and sometimes online and have the decently high SNAP participation. Therefore, we may be more successful in outreaching to local SNAP retailers these communities to start a pilot SNAP online purchase program for the Bay Area."),
          p("The map geographically shows where there are high numbers of SNAP and Walmart users. The table underneath the map numerically shows where there are high numbers of SNAP and Walmart users With both tools, we are able to see how many cities have large numbers of SNAP applicants and Walmart daily and online transactions."),
          br(),
          p(strong("Instructions for Figures Below:"), "Follow the instructions by the map to know specific details. For the table underneath the map, filter any column of interest by clicking the column name. Darker colors correlate to larger numbers. Also, use the search bar to search for specific results.")
          )
      ),
      fluidRow(
        style="padding: 5px",
        column(7,leafletOutput("facteus",height="55vh")),
        column(5,
          h4("How to Use the Map"),
          p("1. Scroll up and down to zoom in and out of the map",
           br(),
           "2. Filter through the different layers rankings with the layers icon in the top right corner of the map",
           br(),
            "3. Toggle the county lines and Walmart locations on and off through the layers icon as well",
           br(),
           "5. Click on each dot to see the address of the Walmart location. Orange dots mean that the Walmart location offers Grocery Pick-Up"),
          h4("Color Legend", style="margin-top:20px"),
          p(strong("Light Pink",style="color: #e497cd")," correlates to the number of SNAP applications received",
            br(),
            strong("Purple",style="color: #7f78d2")," correlates to the average number of Walmart transactions on a given day",
            br(),
            strong("Yellow",style="color: #f3c623")," correlates to the 25 locations with the lowest total online Walmart transactions for 2020 thus far",
            br(),
            strong("Light Orange",style="color: #ffa069")," correlates to the 25 locations with the highest total online Walmart transactions for 2020 thus far"
            ),
          br(),
          p(strong("Note: "),"Any other color seen is a result of these colored layers laying on top of each other", style="font-size: 13px")
          )
        ),
      fluidRow(
        style="padding: 15px",
        column(12,
          DTOutput("facteus_tbl"),
          style='white-space: normal; overflow-y: scroll; height: 56vh; font-size: 13px; text-align: center'
        )
      )
    )
  )
body_information <-
  sidebarLayout(
    position="right",
    sidebarPanel(
      width=3,
      h4(strong("External Resources")),
      p(a("USDA Website",href="https://www.fns.usda.gov/snap/supplemental-nutrition-assistance-program")),
      p(a("Application Resources by State", href="https://www.fns.usda.gov/snap/state-directory")),
      p(a("Feeding America",href="https://www.feedingamerica.org/take-action/advocate/federal-hunger-relief-programs/snap")),
      h4(strong("Public Data Sources")),
      p(a("USDA Bi-Annual Data Sources", href="https://www.fns.usda.gov/pd/supplemental-nutrition-assistance-program-snap")),
      h4(strong("Private Data Sources")),
      p("Code For America - GetCalFresh"),
      p("Safegraph - Facteus")
    ),
    mainPanel(
      width=9,
      h3(strong("What is SNAP?")),
      p("SNAP stands for the Supplemental Nutrition Assistance Program, formerly known as food stamps. It is a federal nutrition program that relieves the financial burden of providing meals and groceries for lower-income families. SNAP benefits can be used to purchase food at grocery stores, convenience stores, and some farmers' markets and co-op food programs."),
      p("WIC is essentially SNAP for the supplemental needs of women, infants, and children. WIC provides federal grants to states for supplemental foods, health care referrals, and nutrition education for low-income pregnant, breastfeeding, and non-breastfeeding postpartum women, and to infants and children up to age five who are found to be at nutritional risk."),
      p("For more information, refer to the provided links on the right.")
    )
  )
ui <-
  navbarPage(
    "Project SNAP",
    theme=shinytheme("flatly"),
    tabPanel(
      "Bay Area SNAP Access",
      body_bay
    ),
    tabPanel(
      "Shopping Patterns",
      body_shopping
    ),
    tabPanel(
      "What is SNAP?",
      body_information
    )
  )

server <- function(input,output,session){
  output$snapmap <- renderLeaflet({ mpi })
  output$baymap_tbl <- renderFormattable({ baymap_tbl })
  observeEvent(input$go,{
    loc <- geocode_OSM(input$address,as.sf = T)
    leafletProxy("snapmap") %>%
      removeShape(c("user_address","user_address_radius")) %>%
      addMarkers(
        lng=loc$lon,
        lat=loc$lat,
        icon=homeIcon,
        layerId="user_address") %>%
      addCircles(
        data=loc,
        lng = loc$lon,
        lat = loc$lat,
        color = "#81b1f3",
        weight = 0.25,
        radius = input$slider * 1609.344, # 2-mile radius
        fillOpacity = 0.5,
        label = paste(input$slider,"-mile radius"),
        highlightOptions =
          highlightOptions(
            weight = 2,
            opacity = 1
            ),
        layerId = "user_address_radius"
      ) %>%
      flyTo(loc$lon, loc$lat, zoom = 16-input$slider)
  })

  output$facteus <- renderLeaflet({ fp })
  output$facteus_tbl <- renderDT({ walsnap_tbl })
  output$mcc_l <- renderPlotly({
    switch(
      input$mcc_month_l,
      "jan"=jan$plt,
      "feb"=feb$plt,
      "mar"=mar$plt,
      "apr"=apr$plt
    )
  })
  output$mcc_plt_l <- renderFormattable({
    switch(
      input$mcc_month_l,
      "jan"=jan$tbl,
      "feb"=feb$tbl,
      "mar"=mar$tbl,
      "apr"=apr$tbl
    )
  })
  output$mcc_r <- renderPlotly({
    switch(
      input$mcc_month_r,
      "jan"=jan$plt,
      "feb"=feb$plt,
      "mar"=mar$plt,
      "apr"=apr$plt
    )
  })
  output$mcc_plt_r <- renderFormattable({
    switch(
      input$mcc_month_r,
      "jan"=jan$tbl,
      "feb"=feb$tbl,
      "mar"=mar$tbl,
      "apr"=apr$tbl
    )
  })
  output$grocer_plt <- renderPlotly({
    switch(
      input$grocer,
      "annually"=grocer_annual,
      "weekly"=grocer_weekly,
      "weekday"=grocer_weekday
    )
  })
  output$per_plt <- renderPlotly({ percentage_plt })
  output$rel_plt <- renderPlotly({ relative_plt })
  output$onin_plt <-  renderPlotly({ online_instore_plt })
  output$walmart <- renderLeaflet({ io_mp })
  observe({ 
    if (input$animation == 1) {
      leafletProxy("walmart") %>% 
        showGroup(c("January")) %>% 
        hideGroup(c("February","March","April","Walmart Grocery Pick-up Locations", "Walmart Locations")) %>% 
        showGroup(c("Walmart Grocery Pick-up Locations", "Walmart Locations"))
    } else if (input$animation == 2) {
      leafletProxy("walmart") %>% 
        showGroup(c("February")) %>% 
        hideGroup(c("January","March","April","Walmart Grocery Pick-up Locations", "Walmart Locations")) %>% 
        showGroup(c("Walmart Grocery Pick-up Locations", "Walmart Locations"))
    } else if (input$animation == 3) {
      leafletProxy("walmart") %>% 
        showGroup(c("March")) %>% 
        hideGroup(c("February","January","April","Walmart Grocery Pick-up Locations", "Walmart Locations")) %>% 
        showGroup(c("Walmart Grocery Pick-up Locations", "Walmart Locations"))
    } else if (input$animation == 4) {
      leafletProxy("walmart") %>% 
        showGroup(c("April")) %>% 
        hideGroup(c("February","March","January","Walmart Grocery Pick-up Locations", "Walmart Locations")) %>% 
        showGroup(c("Walmart Grocery Pick-up Locations", "Walmart Locations"))
    }
  })

  session$onSessionEnded(stopApp)
}

runApp(shinyApp(ui,server),launch.browser=T)