course5_project2
FAR
2023-10-09
Avaliation of harmfulness effects from weather events in USA
Synopsis
The basic goal of this study is to explore the NOAA Storm Database and identify the types of events are the most harmful with respect to population health in USA and the ones which have the greatests economic consequences.
Data Processing
The first step of this analysis is to download data and select the variables to be worked with. Also damage and crop expences were converted in order to evaluate the most expensive weather events.
# Upload libraries
library(data.table)## Warning: package 'data.table' was built under R version 4.3.1library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.3.1## Warning: package 'ggplot2' was built under R version 4.3.1## Warning: package 'tibble' was built under R version 4.3.1## Warning: package 'tidyr' was built under R version 4.3.1## Warning: package 'readr' was built under R version 4.3.1## Warning: package 'purrr' was built under R version 4.3.1## Warning: package 'dplyr' was built under R version 4.3.1## Warning: package 'stringr' was built under R version 4.3.1## Warning: package 'forcats' was built under R version 4.3.1## Warning: package 'lubridate' was built under R version 4.3.1## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::between() masks data.table::between()
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::first() masks data.table::first()
## ✖ lubridate::hour() masks data.table::hour()
## ✖ lubridate::isoweek() masks data.table::isoweek()
## ✖ dplyr::lag() masks stats::lag()
## ✖ dplyr::last() masks data.table::last()
## ✖ lubridate::mday() masks data.table::mday()
## ✖ lubridate::minute() masks data.table::minute()
## ✖ lubridate::month() masks data.table::month()
## ✖ lubridate::quarter() masks data.table::quarter()
## ✖ lubridate::second() masks data.table::second()
## ✖ purrr::transpose() masks data.table::transpose()
## ✖ lubridate::wday() masks data.table::wday()
## ✖ lubridate::week() masks data.table::week()
## ✖ lubridate::yday() masks data.table::yday()
## ✖ lubridate::year() masks data.table::year()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(ggplot2)
library(dplyr)
library(gridExtra)## Warning: package 'gridExtra' was built under R version 4.3.1##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combine# Downloading and uploading data
temp <- tempfile()
download.file("https://d396qusza40orc.cloudfront.net/repdata%2Fdata%2FStormData.csv.bz2",temp)
df <- read.csv(temp)
unlink(temp)
# Select data to evaluate events about population health and economic consequences
database <- df %>% select(BGN_DATE, COUNTYNAME, STATE, EVTYPE, FATALITIES,
INJURIES, PROPDMG,PROPDMGEXP, CROPDMG, CROPDMGEXP)
# Convert date into Date-Format + Mutate column with the year of event
database$BGN_DATE <- as.Date(database$BGN_DATE, "%m/%d/%Y")
database <- database %>% mutate(YEAR = year(database$BGN_DATE))
# Filter out in PROPDMGEXP and CROPDMGEXP values different than "", "K", "M" or "B"
database <- database[database$PROPDMGEXP %in% c("", "K", "M", "B"),]
database <- database[database$CROPDMGEXP %in% c("", "k", "K", "m", "M", "B"),]
# Convert units of expenses
# Create matrix of transformation from letters to number
let <- c("", "k", "K", "m", "M", "B")
num <- c(0, 1000, 1000, 1000000, 1000000, 1000000000)
convert <- data.frame(let, num)
# Add converted data into dataframe
# Property expences
database <- database %>% merge(x = database,
y = convert,
by.x = "PROPDMGEXP",
by.y = "let")
# Rename converted column for property damage expence
colnames(database)[12] <- "REALPROPDMGEXP"
# Crop expences
database <- database %>% merge(x = database,
y = convert,
by.x = "CROPDMGEXP",
by.y = "let")
# Rename converted column for crop damage expence
colnames(database)[13] <- "REALCROPDMGEXP"
# Calculate property, crop and total damage
database <- database %>% mutate(PROP = PROPDMG*REALPROPDMGEXP,
CROP = CROPDMG*REALCROPDMGEXP,
TOTAL = PROP + CROP)
database <- database %>% select(COUNTYNAME, STATE, EVTYPE, FATALITIES, YEAR,
INJURIES, PROP, CROP, TOTAL)After processing data, the analysis carried in this study evaluated events that were the most harmfull and expesive to human life each year, based on injuries, fatalities and costs data.
Results
# Summarize fatalities and injuries per year for each event
WEHL <- database %>% group_by(YEAR, EVTYPE) %>%
summarize(FAT = sum(FATALITIES),
INJ = sum(INJURIES))## `summarise()` has grouped output by 'YEAR'. You can override using the
## `.groups` argument.# Select top-2 events with the most fatalities and injuries per year
WEHLf <- WEHL %>% group_by(YEAR) %>%
top_n(2, FAT)
WEHLi <- WEHL %>% group_by(YEAR) %>%
top_n(2, INJ)
# Define plot theme
theme <- theme_minimal() + theme(legend.position = "bottom",
text = element_text(size = 8),
legend.key.size = unit(.5,"cm"))
# Plot Fatalities and Injuries
plot1 <- ggplot(data = WEHLi, aes(x = YEAR, y = INJ, fill = EVTYPE)) +
geom_bar(position = "fill", stat = "identity") + theme +
scale_fill_brewer(palette = "Paired") + labs(title = "Top-2 injuries causes per year",y = "Frequency of Injuries")
plot2 <- ggplot(data = WEHLf, aes(x = YEAR, y = FAT, fill = EVTYPE)) + geom_bar(position = "fill", stat = "identity") + theme + scale_fill_brewer(palette = "Paired") + labs(title = "Top-2 fatalities causes per year", y = "Frequency of Fatalities")
grid.arrange(plot1, plot2, nrow = 2)
Until 80’s, most of injuries and fatalities caused by weather events were most related to Tornadoes and Wind incidents. Since late 90’s, weather events related to high temperatures and flash floods happened to be more frequent, leading to more injuries and fatalities.
# Summarize fatalities and injuries per year for each event
WEE <- database %>% group_by(YEAR, EVTYPE) %>%
summarize(PROP = sum(PROP),
CROP = sum(CROP),
TOTAL = sum(TOTAL))## `summarise()` has grouped output by 'YEAR'. You can override using the
## `.groups` argument.# Select top-1 events with the most fatalities and injuries per year
WEEp <- WEE %>% group_by(YEAR) %>%
top_n(1, PROP)
WEEc <- WEE %>% group_by(YEAR) %>%
top_n(1, CROP)
WEEt <- WEE %>% group_by(YEAR) %>%
top_n(1, TOTAL)
# Define plot theme
theme <- theme_minimal() + theme(legend.position = "bottom",
text = element_text(size = 8),
legend.key.size = unit(.5,"cm"))
# Plot Fatalities and Injuries
plot1 <- ggplot(data = WEEp, aes(x = YEAR, y = PROP, fill = EVTYPE)) +
geom_bar(position = "fill", stat = "identity") + theme +
scale_fill_brewer(palette = "Paired") + labs(title = "Top-1 property damage per year",y = "% of damage")
plot2 <- ggplot(data = WEEc, aes(x = YEAR, y = CROP, fill = EVTYPE)) + geom_bar(position = "fill", stat = "identity") + theme + scale_fill_brewer(palette = "Paired") + labs(title = "Top-1 crop damage per year", y = "% of damage")
plot3 <- ggplot(data = WEEt, aes(x = YEAR, y = TOTAL, fill = EVTYPE)) + geom_bar(position = "fill", stat = "identity") + theme + scale_fill_brewer(palette = "Paired") + labs(title = "Top-1 total damage per year", y = "% of damage")
plot3
In terms of expenses, wind related events are the most harmful yet.