W niniejszej analizie przedstawiono wpływ ekstremalnych zjawisk pogodowych na zdrowie ludności oraz straty ekonomiczne w Stanach Zjednoczonych na podstawie bazy danych NOAA. Dane obejmują lata 1950–2011. Wyniki pokazują, że tornada mają największy wpływ na zdrowie, powodując najwięcej ofiar śmiertelnych i obrażeń. Z kolei powodzie generują największe straty finansowe. W analizie wykorzystano pakiety R wspierające przetwarzanie danych i wizualizację. Dane zostały wczytane bezpośrednio z surowego pliku CSV w formacie bz2. Przeprowadzono wstępną obróbkę danych w celu ich uporządkowania. Wyniki zostały przedstawione na wykresach i w tabelach.
Poniżej wyświetlamy fragment pliku csv, aby zaplanować analizę.
storm_data <- read_csv("data_StormData.csv.bz2")
## Rows: 902297 Columns: 37
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (18): BGN_DATE, BGN_TIME, TIME_ZONE, COUNTYNAME, STATE, EVTYPE, BGN_AZI,...
## dbl (18): STATE__, COUNTY, BGN_RANGE, COUNTY_END, END_RANGE, LENGTH, WIDTH, ...
## lgl (1): COUNTYENDN
##
## ℹ 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.
head(storm_data)
## # A tibble: 6 × 37
## STATE__ BGN_DATE BGN_TIME TIME_ZONE COUNTY COUNTYNAME STATE EVTYPE BGN_RANGE
## <dbl> <chr> <chr> <chr> <dbl> <chr> <chr> <chr> <dbl>
## 1 1 4/18/1950… 0130 CST 97 MOBILE AL TORNA… 0
## 2 1 4/18/1950… 0145 CST 3 BALDWIN AL TORNA… 0
## 3 1 2/20/1951… 1600 CST 57 FAYETTE AL TORNA… 0
## 4 1 6/8/1951 … 0900 CST 89 MADISON AL TORNA… 0
## 5 1 11/15/195… 1500 CST 43 CULLMAN AL TORNA… 0
## 6 1 11/15/195… 2000 CST 77 LAUDERDALE AL TORNA… 0
## # ℹ 28 more variables: BGN_AZI <chr>, BGN_LOCATI <chr>, END_DATE <chr>,
## # END_TIME <chr>, COUNTY_END <dbl>, COUNTYENDN <lgl>, END_RANGE <dbl>,
## # END_AZI <chr>, END_LOCATI <chr>, LENGTH <dbl>, WIDTH <dbl>, F <dbl>,
## # MAG <dbl>, FATALITIES <dbl>, INJURIES <dbl>, PROPDMG <dbl>,
## # PROPDMGEXP <chr>, CROPDMG <dbl>, CROPDMGEXP <chr>, WFO <chr>,
## # STATEOFFIC <chr>, ZONENAMES <chr>, LATITUDE <dbl>, LONGITUDE <dbl>,
## # LATITUDE_E <dbl>, LONGITUDE_ <dbl>, REMARKS <chr>, REFNUM <dbl>
Wybieramy interesujące nas kategorie. Jest to EVTYPE określający typ zjawisk. Dla danych zdrowotnych injuries(ranni) oraz fatalities(śmierci). Dla danych ekonomicznych propdmg(szkody majątkowe), propdmgexp(skala), cropdmg(szkody w uprawach) i cropdmgexp(skala).
storm_data_cropped <- storm_data %>%
select(EVTYPE, FATALITIES, INJURIES, PROPDMG, PROPDMGEXP, CROPDMG, CROPDMGEXP)
head(storm_data_cropped)
## # A tibble: 6 × 7
## EVTYPE FATALITIES INJURIES PROPDMG PROPDMGEXP CROPDMG CROPDMGEXP
## <chr> <dbl> <dbl> <dbl> <chr> <dbl> <chr>
## 1 TORNADO 0 15 25 K 0 <NA>
## 2 TORNADO 0 0 2.5 K 0 <NA>
## 3 TORNADO 0 2 25 K 0 <NA>
## 4 TORNADO 0 2 2.5 K 0 <NA>
## 5 TORNADO 0 2 2.5 K 0 <NA>
## 6 TORNADO 0 6 2.5 K 0 <NA>
Transformujemy dane ekonomiczne, aby uwzględnić skale.
storm_data_transformed <- storm_data_cropped %>%
mutate(
CROPDMGEXP = if_else(is.na(CROPDMGEXP), "", CROPDMGEXP),
PROPDMGEXP = if_else(is.na(PROPDMGEXP), "", PROPDMGEXP),
PROPDMG_NUM = case_when(
PROPDMGEXP == "K" ~ PROPDMG * 1000,
PROPDMGEXP == "M" ~ PROPDMG * 1000000,
PROPDMGEXP == "B" ~ PROPDMG * 1000000000,
PROPDMGEXP == "" ~ PROPDMG,
TRUE ~ NA_real_
),
CROPDMG_NUM = case_when(
CROPDMGEXP == "K" ~ CROPDMG * 1000,
CROPDMGEXP == "M" ~ CROPDMG * 1000000,
CROPDMGEXP == "B" ~ CROPDMG * 1000000000,
CROPDMGEXP == "" ~ CROPDMG,
TRUE ~ NA_real_
)
) %>%
select(EVTYPE, FATALITIES, INJURIES, PROPDMG_NUM, CROPDMG_NUM)
head(storm_data_transformed)
## # A tibble: 6 × 5
## EVTYPE FATALITIES INJURIES PROPDMG_NUM CROPDMG_NUM
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 TORNADO 0 15 25000 0
## 2 TORNADO 0 0 2500 0
## 3 TORNADO 0 2 25000 0
## 4 TORNADO 0 2 2500 0
## 5 TORNADO 0 2 2500 0
## 6 TORNADO 0 6 2500 0
data_injuries <- storm_data_transformed %>%
select(EVTYPE, INJURIES) %>%
group_by(EVTYPE) %>%
summarise(total_injuries = sum(INJURIES, na.rm = TRUE)) %>%
arrange(desc(total_injuries))
print(data_injuries)
## # A tibble: 977 × 2
## EVTYPE total_injuries
## <chr> <dbl>
## 1 TORNADO 91346
## 2 TSTM WIND 6957
## 3 FLOOD 6789
## 4 EXCESSIVE HEAT 6525
## 5 LIGHTNING 5230
## 6 HEAT 2100
## 7 ICE STORM 1975
## 8 FLASH FLOOD 1777
## 9 THUNDERSTORM WIND 1488
## 10 HAIL 1361
## # ℹ 967 more rows
Widzimy wiele typów, które nie wywołały żadnych obrażeń. Ponadto musimy uwzględnić czytelność wykresu, a więc ustawiamy próg minimalnej sumarycznej liczby obrażeń zjawisk widoczych na wykresie na 400 i ich maksymalną wyświetlaną ilość na 20.
data_injuries_plot <- data_injuries %>%
filter(total_injuries >= 400) %>%
slice_head(n = 20)
barplot(data_injuries_plot$total_injuries,
names.arg = data_injuries_plot$EVTYPE,
las = 2,
col = "steelblue",
main = "Sumaryczna liczba obrażeń na typ zjawiska (top 20)",
ylab = "Sumaryczna liczba obrażeń",
cex.names = 0.5,
cex.axis = 0.7)
Widzimy, że tornada wywołują najwięcej obrażeń i dominują znacząco na
innymi zjawiskami. Znaczące obrażenia powodują również: powodzie, burze
wiatrowe, błyskawice oraz bardzo wysokie temperatury.
Następnie tworzymy wykres ukazujący sumę wypadków śmiertelnych w sposób analogiczny do powyższego.
data_fatalities <- storm_data_transformed %>%
select(EVTYPE, FATALITIES) %>%
group_by(EVTYPE) %>%
summarise(total_fatalities = sum(FATALITIES, na.rm = TRUE)) %>%
arrange(desc(total_fatalities))
data_fatalities_plot <- data_fatalities %>%
slice_head(n = 20)
barplot(data_fatalities_plot$total_fatalities,
names.arg = data_fatalities_plot$EVTYPE,
las = 2,
col = "steelblue",
main = "Sumaryczna liczba śmierci na typ zjawiska (top 20)",
ylab = "Sumaryczna liczba śmierci",
cex.names = 0.5,
cex.axis = 0.7)
Ponownie najwyższe obrażenia śmiertelne wywołują tornada, jednak nie
dominują już w tak rażącym stopniu. Kolejne są bardzo wysokie
temperatury, powodzie, gorąc i błyskawice.
Obliczamy sumy dla kategorii ekonomicznych.
data_summary <- storm_data_transformed %>%
group_by(EVTYPE) %>%
summarise(
total_prop_dmg = sum(PROPDMG_NUM, na.rm = TRUE),
total_crop_dmg = sum(CROPDMG_NUM, na.rm = TRUE),
total_dmg = total_prop_dmg + total_crop_dmg
) %>%
arrange(desc(total_dmg)) %>%
mutate(
total_prop_dmg_million = total_prop_dmg / 1e6,
total_crop_dmg_million = total_crop_dmg / 1e6,
total_dmg_million = total_dmg / 1e6
)
Rysujemy wykresy: 1. Straty finansowe (własność) w zależności od typu zjawiska - top 20 2. Straty finansowe (uprawy) w zależności od typu zjawiska - top 20 3. Straty całkowite w zależności od typu zjawiska - top 20
par(mfrow = c(1, 3), mar = c(5, 5, 4, 2))
top_20_prop <- data_summary %>%
arrange(desc(total_prop_dmg_million)) %>%
head(20)
barplot(top_20_prop$total_prop_dmg_million,
names.arg = top_20_prop$EVTYPE,
las = 2,
col = "steelblue",
main = "Straty finansowe (własność)",
ylab = "Straty finansowe (mln)",
cex.names = 0.5,
cex.axis = 0.7)
top_20_crop <- data_summary %>%
arrange(desc(total_crop_dmg_million)) %>%
head(20)
barplot(top_20_crop$total_crop_dmg_million,
names.arg = top_20_crop$EVTYPE,
las = 2,
col = "darkgreen",
main = "Straty finansowe (uprawy)",
ylab = "Straty finansowe (mln)",
cex.names = 0.5,
cex.axis = 0.7)
top_20_total_dmg <- data_summary %>%
arrange(desc(total_dmg_million)) %>%
head(20)
barplot(top_20_total_dmg$total_dmg_million,
names.arg = top_20_total_dmg$EVTYPE,
las = 2,
col = "darkorange",
main = "Całkowite straty",
ylab = "Całkowite straty (mln)",
cex.names = 0.5,
cex.axis = 0.7)
Największe straty powodowały powowodzie, huragany, tornada oraz sztormy.