install.packages("tidyverse")
##
## The downloaded binary packages are in
## /var/folders/2l/27g2p3vs4cj8t70v145f6w8w0000gn/T//RtmpftlW7d/downloaded_packages
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(readr)
fema_data_2023_2024 <- read_csv("Desktop/LSC/fema_data_2023_2024.csv")
## New names:
## Rows: 1761473 Columns: 72
## ── Column specification
## ──────────────────────────────────────────────────────── Delimiter: "," chr
## (17): incidentType, county, damagedStateAbbreviation, damagedCity, dama... dbl
## (52): ...1, disasterNumber, occupantsUnderTwo, occupants2to5, occupants... lgl
## (1): sbaEligible dttm (1): lastRefresh date (1): declarationDate
## ℹ Use `spec()` to retrieve the full column specification for this data. ℹ
## Specify the column types or set `show_col_types = FALSE` to quiet this message.
## • `` -> `...1`
# Assuming your dataset is already loaded and named fema_data_2023_2024
# Remove "(county)" from the county column
fema_data_2023_2024$county <- gsub("\\(county\\)", "", fema_data_2023_2024$county, ignore.case = TRUE)
# Trim any leading or trailing whitespace
fema_data_2023_2024$county <- trimws(fema_data_2023_2024$county)
# Install required packages if not already installed
if (!requireNamespace("dplyr", quietly = TRUE)) install.packages("dplyr")
if (!requireNamespace("leaflet", quietly = TRUE)) install.packages("leaflet")
if (!requireNamespace("sf", quietly = TRUE)) install.packages("sf")
if (!requireNamespace("maps", quietly = TRUE)) install.packages("maps")
if (!requireNamespace("DT", quietly = TRUE)) install.packages("DT")
if (!requireNamespace("htmltools", quietly = TRUE)) install.packages("htmltools")
# Load required libraries
library(dplyr)
library(leaflet)
library(sf)
## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE
library(maps)
##
## Attaching package: 'maps'
## The following object is masked from 'package:purrr':
##
## map
library(DT)
library(htmltools)
# Assuming disaster_summary is the dataframe we created earlier
disaster_summary <- fema_data_2023_2024 %>%
group_by(incidentType, declarationDate, disasterNumber, damagedStateAbbreviation) %>%
summarise(applications = n(), .groups = 'drop') %>%
arrange(desc(applications))
# Calculate total applications per state and keep disaster breakdown
state_data <- disaster_summary %>%
group_by(damagedStateAbbreviation) %>%
summarise(
total_applications = sum(applications),
disaster_breakdown = list(tibble(disasterNumber, declarationDate, applications))
) %>%
ungroup()
# Get US states map data
us_states <- st_as_sf(maps::map("state", plot = FALSE, fill = TRUE))
us_states$name <- tolower(us_states$ID)
# Create a data frame with state names and abbreviations
state_info <- data.frame(
name = tolower(state.name),
abbreviation = state.abb
)
# Join the state info and application data with the map data
us_states <- us_states %>%
left_join(state_info, by = "name") %>%
left_join(state_data, by = c("abbreviation" = "damagedStateAbbreviation"))
# Replace NA counts with 0 and empty list
us_states$total_applications[is.na(us_states$total_applications)] <- 0
us_states$disaster_breakdown[is.na(us_states$disaster_breakdown)] <- list(tibble(disasterNumber = character(), declarationDate = as.Date(character()), applications = numeric()))
# Create logarithmic color palette
max_applications <- max(us_states$total_applications, na.rm = TRUE)
log_breaks <- c(1, 10, 100, 1000, 10000, 100000, 1000000, max_applications)
pal <- colorBin(
palette = "YlOrRd",
domain = us_states$total_applications,
bins = log_breaks,
na.color = "white"
)
# Function to create popup content
create_popup_content <- function(state, total, breakdown) {
if (is.null(breakdown) || nrow(breakdown) == 0) {
return(paste0("<strong>", state, "</strong><br>No application data available"))
}
breakdown_table <- breakdown %>%
arrange(desc(applications)) %>%
slice_head(n = 10) %>% # Show top 10 disasters
mutate(
applications = format(applications, big.mark = ","),
declarationDate = format(declarationDate, "%Y-%m-%d"),
disasterNumber = sprintf('<span style="float:left;">%s</span>', disasterNumber)
) %>%
knitr::kable(format = "html", col.names = c("Disaster Number", "Declaration Date", "Applications"), escape = FALSE)
paste0(
"<strong>", state, "</strong><br>",
"Total Applications: ", format(total, big.mark = ","), "<br><br>",
breakdown_table
)
}
# Create the map
m <- leaflet(us_states) %>%
addTiles() %>%
setView(lng = -98, lat = 39, zoom = 4) %>%
addPolygons(
fillColor = ~pal(total_applications),
weight = 2,
opacity = 1,
color = "black",
dashArray = "3",
fillOpacity = 0.7,
highlightOptions = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE
),
popup = ~lapply(seq_len(nrow(us_states)), function(i) {
create_popup_content(us_states$abbreviation[i], us_states$total_applications[i], us_states$disaster_breakdown[[i]])
}),
label = ~paste0(
abbreviation, ": ",
format(total_applications, big.mark = ","), " applications"
),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"
)
) %>%
addLegend(
pal = pal,
values = ~total_applications,
opacity = 0.7,
title = "Total Applications",
position = "bottomright",
labFormat = labelFormat(big.mark = ",", digits = 0)
)
## Warning: sf layer has inconsistent datum (+proj=longlat +ellps=clrk66 +no_defs).
## Need '+proj=longlat +datum=WGS84'
## Warning in pal(total_applications): Some values were outside the color scale
## and will be treated as NA
# Create a data table for total applications per disaster number, including declaration date
disaster_table <- disaster_summary %>%
group_by(disasterNumber, declarationDate) %>%
summarise(total_applications = sum(applications), .groups = "drop") %>%
arrange(desc(total_applications))
dt <- datatable(
disaster_table,
options = list(pageLength = 10, scrollY = "300px"),
rownames = FALSE,
colnames = c("Disaster Number", "Declaration Date", "Total Applications")
) %>%
formatDate("declarationDate", method = "toLocaleDateString")
# Combine map and table in a single output
output <- tagList(
tags$h2("FEMA Data Visualization"),
tags$div(style = "display: flex; flex-direction: column; height: 800px;",
tags$div(style = "flex: 2;", m),
tags$div(style = "flex: 1; overflow-y: auto;",
tags$h3("Total Applications per Disaster Number"),
dt
)
)
)
# Display the combined output
output
FEMA Data Visualization
Total Applications per Disaster Number
# Install required packages if not already installed
if (!requireNamespace("dplyr", quietly = TRUE)) install.packages("dplyr")
if (!requireNamespace("leaflet", quietly = TRUE)) install.packages("leaflet")
if (!requireNamespace("sf", quietly = TRUE)) install.packages("sf")
if (!requireNamespace("tigris", quietly = TRUE)) install.packages("tigris")
if (!requireNamespace("htmltools", quietly = TRUE)) install.packages("htmltools")
# Load required libraries
library(dplyr)
library(leaflet)
library(sf)
library(tigris)
## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.
library(htmltools)
# Assuming fema_data_2023_2024 is your original dataset
# Summarize data by county
county_summary <- fema_data_2023_2024 %>%
group_by(county, damagedStateAbbreviation, incidentType, declarationDate, disasterNumber) %>%
summarise(applications = n(), .groups = 'drop') %>%
arrange(desc(applications))
# Calculate total applications per county and keep disaster breakdown
county_data <- county_summary %>%
group_by(county, damagedStateAbbreviation) %>%
summarise(
total_applications = sum(applications),
disaster_breakdown = list(tibble(disasterNumber, declarationDate, incidentType, applications))
) %>%
ungroup()
## `summarise()` has grouped output by 'county'. You can override using the
## `.groups` argument.
# Get US counties map data
us_counties <- counties(cb = TRUE, resolution = "20m")
## Retrieving data for the year 2022
## | | | 0% | |= | 2% | |=== | 4% | |==== | 5% | |===== | 7% | |====== | 9% | |======== | 11% | |========= | 13% | |========== | 14% | |============== | 20% | |================ | 23% | |===================== | 30% | |====================== | 32% | |======================== | 34% | |========================= | 36% | |========================== | 37% | |============================ | 39% | |============================== | 43% | |=============================== | 45% | |================================= | 47% | |================================== | 48% | |=================================== | 50% | |==================================== | 52% | |====================================== | 54% | |======================================= | 56% | |======================================== | 57% | |========================================= | 59% | |=========================================== | 61% | |============================================ | 63% | |============================================== | 66% | |================================================== | 72% | |===================================================== | 75% | |========================================================== | 82% | |=========================================================== | 84% | |============================================================ | 86% | |============================================================= | 88% | |================================================================ | 91% | |================================================================== | 95% | |===================================================================== | 99% | |======================================================================| 100%
# Join the county application data with the map data
us_counties <- us_counties %>%
left_join(county_data, by = c("NAME" = "county", "STUSPS" = "damagedStateAbbreviation"))
# Replace NA counts with 0 and empty list
us_counties$total_applications[is.na(us_counties$total_applications)] <- 0
us_counties$disaster_breakdown[is.na(us_counties$disaster_breakdown)] <- list(tibble(disasterNumber = character(), declarationDate = as.Date(character()), incidentType = character(), applications = numeric()))
# Create logarithmic color palette
max_applications <- max(us_counties$total_applications, na.rm = TRUE)
log_breaks <- c(1, 10, 100, 1000, 10000, 100000, max_applications)
pal <- colorBin(
palette = "YlOrRd",
domain = us_counties$total_applications,
bins = log_breaks,
na.color = "white"
)
# Function to create popup content
create_popup_content <- function(county, state, total, breakdown) {
if (is.null(breakdown) || nrow(breakdown) == 0) {
return(paste0("<strong>", county, ", ", state, "</strong><br>No application data available"))
}
breakdown_table <- breakdown %>%
arrange(desc(applications)) %>%
slice_head(n = 5) %>% # Show top 5 disasters
mutate(
applications = format(applications, big.mark = ","),
declarationDate = format(declarationDate, "%Y-%m-%d"),
disasterNumber = sprintf('<span style="float:left;">%s</span>', disasterNumber)
) %>%
knitr::kable(format = "html", col.names = c("Disaster Number", "Declaration Date", "Incident Type", "Applications"), escape = FALSE)
paste0(
"<strong>", county, ", ", state, "</strong><br>",
"Total Applications: ", format(total, big.mark = ","), "<br><br>",
breakdown_table
)
}
# Create the map
m <- leaflet(us_counties) %>%
addTiles() %>%
setView(lng = -98, lat = 39, zoom = 4) %>%
addPolygons(
fillColor = ~pal(total_applications),
weight = 1,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlightOptions = highlightOptions(
weight = 5,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE
),
popup = ~lapply(seq_len(nrow(us_counties)), function(i) {
create_popup_content(us_counties$NAME[i], us_counties$STUSPS[i], us_counties$total_applications[i], us_counties$disaster_breakdown[[i]])
}),
label = ~paste0(
NAME, ", ", STUSPS, ": ",
format(total_applications, big.mark = ","), " applications"
),
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "12px",
direction = "auto"
)
) %>%
addLegend(
pal = pal,
values = ~total_applications,
opacity = 0.7,
title = "Total Applications",
position = "bottomright",
labFormat = labelFormat(big.mark = ",", digits = 0)
)
## Warning: sf layer has inconsistent datum (+proj=longlat +datum=NAD83 +no_defs).
## Need '+proj=longlat +datum=WGS84'
## Warning in pal(total_applications): Some values were outside the color scale
## and will be treated as NA
# Display the map
m