This is an R Markdown Notebook. When you execute code within the notebook, the results appear beneath the code.

Try executing this chunk by clicking the Run button within the chunk or by placing your cursor inside it and pressing Ctrl+Shift+Enter.

data <- read.csv("repdata_data_StormData.csv")

Question 1

relevant <- c( "EVTYPE", "FATALITIES", "INJURIES", "PROPDMG", "PROPDMGEXP", "CROPDMG", "CROPDMGEXP")
mydata <- data[, relevant]
head(mydata)
   EVTYPE FATALITIES INJURIES PROPDMG PROPDMGEXP CROPDMG CROPDMGEXP
1 TORNADO          0       15    25.0          K       0           
2 TORNADO          0        0     2.5          K       0           
3 TORNADO          0        2    25.0          K       0           
4 TORNADO          0        2     2.5          K       0           
5 TORNADO          0        2     2.5          K       0           
6 TORNADO          0        6     2.5          K       0           
sum(is.na(mydata))
[1] 0
library(dplyr)
topn <- 10
topn_health <- mydata %>% group_by(EVTYPE) %>% summarise (N=n(), Fatalities = sum(FATALITIES), Injuries = sum(INJURIES)) %>% arrange(-Fatalities) %>% head(topn)
`summarise()` ungrouping output (override with `.groups` argument)
topn_health

Question 2

prop_damage_values <- mydata %>% group_by(PROPDMGEXP) %>% summarize (N=n()) %>% arrange(PROPDMGEXP) 
`summarise()` ungrouping output (override with `.groups` argument)
crop_damage_values <- mydata %>% group_by(CROPDMGEXP) %>% summarize (N=n()) %>% arrange(CROPDMGEXP)
`summarise()` ungrouping output (override with `.groups` argument)
prop_damage_values
crop_damage_values
levels(prop_damage_values$PROPDMGEXP)
 [1] ""  "-" "?" "+" "0" "1" "2" "3" "4" "5" "6" "7" "8" "B" "h" "H" "K" "m" "M"
damages_translation <- c(0,0,0,1,10,10,10,10,10,10,10,10,10,10^9,100,100,10^3,10^6,10^6)
damages_translation <- data.frame(Code=prop_damage_values$PROPDMGEXP,Value = damages_translation)
damages_translation
   Code Value
1       0e+00
2     - 0e+00
3     ? 0e+00
4     + 1e+00
5     0 1e+01
6     1 1e+01
7     2 1e+01
8     3 1e+01
9     4 1e+01
10    5 1e+01
11    6 1e+01
12    7 1e+01
13    8 1e+01
14    B 1e+09
15    h 1e+02
16    H 1e+02
17    K 1e+03
18    m 1e+06
19    M 1e+06
mydata$Prop.Value <- damages_translation$Value[match(mydata$PROPDMGEXP, damages_translation$Code)]
mydata$Crop.Value <- damages_translation$Value[match(mydata$CROPDMGEXP, damages_translation$Code)]
topn <- 10
topn_economic <- mydata %>% group_by(EVTYPE) %>% summarize (N=n(), Prop.Damage = sum(Prop.Value*PROPDMG), Crop.Damage = sum(Crop.Value*CROPDMG)) %>% mutate (Total.Damage = Prop.Damage + Crop.Damage) %>% arrange(-Total.Damage) %>% head(topn)
`summarise()` ungrouping output (override with `.groups` argument)
topn_economic

Results >> Health Impact - Results

library(gridExtra)
library(grid)
library(ggplot2)
package 㤼㸱ggplot2㤼㸲 was built under R version 3.6.3
p1 <- ggplot(data=topn_health, aes(x=reorder(EVTYPE, Fatalities), y=Fatalities)) +   geom_bar(fill="lightblue",stat="identity")  + coord_flip() + 
    ylab("Fatalities") + xlab("Event type") +
    theme(legend.position="none")
p2 <- ggplot(data=topn_health, aes(x=reorder(EVTYPE, Injuries), y=Injuries)) +
    geom_bar(fill="#c41b40",stat="identity") + coord_flip() +
    ylab("Injuries") + xlab("Event type") 
grid.arrange(p1, p2, nrow = 2, top = "Health Impact of Top Weather Event Types")

We observe that Tornadoes claim top spot in both types of health impact, but spots 2-3 are different depending which kind of impact we're ranking by. Excessive heat is a major Fatalities driver (nearly twice as dangerous as next event type, Flash Flod), but in a pretty close tie w/ TSTM Wind, Flood, and Lightning in driving Injuries

Economic Impact - Results

p1 <- ggplot(data=topn_economic, aes(x=reorder(EVTYPE, Prop.Damage), y=Prop.Damage/10^6)) +   geom_bar(fill="lightblue",stat="identity")  + coord_flip() + 
    ylab("Property Damages ($M)") + xlab("Event type") +
    theme(legend.position="none") + scale_y_continuous(limit = c(0,max(topn_economic$Total.Damage/1000000)))
p2 <- ggplot(data=topn_economic, aes(x=reorder(EVTYPE, Crop.Damage), y=Crop.Damage/10^6)) +   geom_bar(fill="lightgreen",stat="identity")  + coord_flip() + 
    ylab("Crop Damages ($M)") + xlab("Event type") +
    theme(legend.position="none") + scale_y_continuous(limit = c(0,max(topn_economic$Total.Damage/1000000)))
p3 <- ggplot(data=topn_economic, aes(x=reorder(EVTYPE, Total.Damage), y=Total.Damage/10^6)) +   geom_bar(fill="#c41b40",stat="identity")  + coord_flip() + 
    ylab("Total Damages ($M)") + xlab("Event type") +
    theme(legend.position="none")
grid.arrange(p1, p2, p3, nrow = 3, top = "Economic Impact of Top Weather Event Types") + scale_y_continuous(limit = c(0,max(topn_economic$Total.Damage/1000000)))
NULL

We observe that Floods are by far the most economically costly weather events. Property damage is far and away the driving factor, with crop damage playing a much smaller role for the most damaging event types.

LS0tDQp0aXRsZTogIlBST0pFQ1QgMiBKT1NFIEJBRVpBIERJQVoiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQpUaGlzIGlzIGFuIFtSIE1hcmtkb3duXShodHRwOi8vcm1hcmtkb3duLnJzdHVkaW8uY29tKSBOb3RlYm9vay4gV2hlbiB5b3UgZXhlY3V0ZSBjb2RlIHdpdGhpbiB0aGUgbm90ZWJvb2ssIHRoZSByZXN1bHRzIGFwcGVhciBiZW5lYXRoIHRoZSBjb2RlLiANCg0KVHJ5IGV4ZWN1dGluZyB0aGlzIGNodW5rIGJ5IGNsaWNraW5nIHRoZSAqUnVuKiBidXR0b24gd2l0aGluIHRoZSBjaHVuayBvciBieSBwbGFjaW5nIHlvdXIgY3Vyc29yIGluc2lkZSBpdCBhbmQgcHJlc3NpbmcgKkN0cmwrU2hpZnQrRW50ZXIqLiANCg0KYGBge3J9DQpkYXRhIDwtIHJlYWQuY3N2KCJyZXBkYXRhX2RhdGFfU3Rvcm1EYXRhLmNzdiIpDQoNCg0KYGBgDQoNClF1ZXN0aW9uIDENCmBgYHtyfQ0KcmVsZXZhbnQgPC0gYyggIkVWVFlQRSIsICJGQVRBTElUSUVTIiwgIklOSlVSSUVTIiwgIlBST1BETUciLCAiUFJPUERNR0VYUCIsICJDUk9QRE1HIiwgIkNST1BETUdFWFAiKQ0KbXlkYXRhIDwtIGRhdGFbLCByZWxldmFudF0NCmhlYWQobXlkYXRhKQ0KYGBgDQoNCmBgYHtyfQ0Kc3VtKGlzLm5hKG15ZGF0YSkpDQpgYGANCg0KYGBge3J9DQpsaWJyYXJ5KGRwbHlyKQ0KYGBgDQoNCmBgYHtyfQ0KdG9wbiA8LSAxMA0KdG9wbl9oZWFsdGggPC0gbXlkYXRhICU+JSBncm91cF9ieShFVlRZUEUpICU+JSBzdW1tYXJpc2UgKE49bigpLCBGYXRhbGl0aWVzID0gc3VtKEZBVEFMSVRJRVMpLCBJbmp1cmllcyA9IHN1bShJTkpVUklFUykpICU+JSBhcnJhbmdlKC1GYXRhbGl0aWVzKSAlPiUgaGVhZCh0b3BuKQ0KYGBgDQoNCmBgYHtyfQ0KdG9wbl9oZWFsdGgNCmBgYA0KUXVlc3Rpb24gMg0KYGBge3J9DQpwcm9wX2RhbWFnZV92YWx1ZXMgPC0gbXlkYXRhICU+JSBncm91cF9ieShQUk9QRE1HRVhQKSAlPiUgc3VtbWFyaXplIChOPW4oKSkgJT4lIGFycmFuZ2UoUFJPUERNR0VYUCkgDQpgYGANCg0KYGBge3J9DQpjcm9wX2RhbWFnZV92YWx1ZXMgPC0gbXlkYXRhICU+JSBncm91cF9ieShDUk9QRE1HRVhQKSAlPiUgc3VtbWFyaXplIChOPW4oKSkgJT4lIGFycmFuZ2UoQ1JPUERNR0VYUCkNCmBgYA0KYGBge3J9DQpwcm9wX2RhbWFnZV92YWx1ZXMNCmBgYA0KYGBge3J9DQpjcm9wX2RhbWFnZV92YWx1ZXMNCmBgYA0KYGBge3J9DQpsZXZlbHMocHJvcF9kYW1hZ2VfdmFsdWVzJFBST1BETUdFWFApDQpgYGANCg0KYGBge3J9DQpkYW1hZ2VzX3RyYW5zbGF0aW9uIDwtIGMoMCwwLDAsMSwxMCwxMCwxMCwxMCwxMCwxMCwxMCwxMCwxMCwxMF45LDEwMCwxMDAsMTBeMywxMF42LDEwXjYpDQpkYW1hZ2VzX3RyYW5zbGF0aW9uIDwtIGRhdGEuZnJhbWUoQ29kZT1wcm9wX2RhbWFnZV92YWx1ZXMkUFJPUERNR0VYUCxWYWx1ZSA9IGRhbWFnZXNfdHJhbnNsYXRpb24pDQpkYW1hZ2VzX3RyYW5zbGF0aW9uDQpgYGANCmBgYHtyfQ0KbXlkYXRhJFByb3AuVmFsdWUgPC0gZGFtYWdlc190cmFuc2xhdGlvbiRWYWx1ZVttYXRjaChteWRhdGEkUFJPUERNR0VYUCwgZGFtYWdlc190cmFuc2xhdGlvbiRDb2RlKV0NCm15ZGF0YSRDcm9wLlZhbHVlIDwtIGRhbWFnZXNfdHJhbnNsYXRpb24kVmFsdWVbbWF0Y2gobXlkYXRhJENST1BETUdFWFAsIGRhbWFnZXNfdHJhbnNsYXRpb24kQ29kZSldDQoNCnRvcG4gPC0gMTANCnRvcG5fZWNvbm9taWMgPC0gbXlkYXRhICU+JSBncm91cF9ieShFVlRZUEUpICU+JSBzdW1tYXJpemUgKE49bigpLCBQcm9wLkRhbWFnZSA9IHN1bShQcm9wLlZhbHVlKlBST1BETUcpLCBDcm9wLkRhbWFnZSA9IHN1bShDcm9wLlZhbHVlKkNST1BETUcpKSAlPiUgbXV0YXRlIChUb3RhbC5EYW1hZ2UgPSBQcm9wLkRhbWFnZSArIENyb3AuRGFtYWdlKSAlPiUgYXJyYW5nZSgtVG90YWwuRGFtYWdlKSAlPiUgaGVhZCh0b3BuKQ0KYGBgDQoNCmBgYHtyfQ0KdG9wbl9lY29ub21pYw0KYGBgDQoNClJlc3VsdHMNCj4+IEhlYWx0aCBJbXBhY3QgLSBSZXN1bHRzDQpgYGB7cn0NCmxpYnJhcnkoZ3JpZEV4dHJhKQ0KYGBgDQoNCg0KYGBge3J9DQpsaWJyYXJ5KGdyaWQpDQpsaWJyYXJ5KGdncGxvdDIpDQpgYGANCmBgYHtyfQ0KcDEgPC0gZ2dwbG90KGRhdGE9dG9wbl9oZWFsdGgsIGFlcyh4PXJlb3JkZXIoRVZUWVBFLCBGYXRhbGl0aWVzKSwgeT1GYXRhbGl0aWVzKSkgKyAgIGdlb21fYmFyKGZpbGw9ImxpZ2h0Ymx1ZSIsc3RhdD0iaWRlbnRpdHkiKSAgKyBjb29yZF9mbGlwKCkgKyANCiAgICB5bGFiKCJGYXRhbGl0aWVzIikgKyB4bGFiKCJFdmVudCB0eXBlIikgKw0KICAgIHRoZW1lKGxlZ2VuZC5wb3NpdGlvbj0ibm9uZSIpDQoNCnAyIDwtIGdncGxvdChkYXRhPXRvcG5faGVhbHRoLCBhZXMoeD1yZW9yZGVyKEVWVFlQRSwgSW5qdXJpZXMpLCB5PUluanVyaWVzKSkgKw0KICAgIGdlb21fYmFyKGZpbGw9IiNjNDFiNDAiLHN0YXQ9ImlkZW50aXR5IikgKyBjb29yZF9mbGlwKCkgKw0KICAgIHlsYWIoIkluanVyaWVzIikgKyB4bGFiKCJFdmVudCB0eXBlIikgDQpncmlkLmFycmFuZ2UocDEsIHAyLCBucm93ID0gMiwgdG9wID0gIkhlYWx0aCBJbXBhY3Qgb2YgVG9wIFdlYXRoZXIgRXZlbnQgVHlwZXMiKQ0KYGBgDQpXZSBvYnNlcnZlIHRoYXQgVG9ybmFkb2VzIGNsYWltIHRvcCBzcG90IGluIGJvdGggdHlwZXMgb2YgaGVhbHRoIGltcGFjdCwgYnV0IHNwb3RzIDItMyBhcmUgZGlmZmVyZW50IGRlcGVuZGluZyB3aGljaCBraW5kIG9mIGltcGFjdCB3ZSdyZSByYW5raW5nIGJ5LiBFeGNlc3NpdmUgaGVhdCBpcyBhIG1ham9yIEZhdGFsaXRpZXMgZHJpdmVyIChuZWFybHkgdHdpY2UgYXMgZGFuZ2Vyb3VzIGFzIG5leHQgZXZlbnQgdHlwZSwgRmxhc2ggRmxvZCksIGJ1dCBpbiBhIHByZXR0eSBjbG9zZSB0aWUgdy8gVFNUTSBXaW5kLCBGbG9vZCwgYW5kIExpZ2h0bmluZyBpbiBkcml2aW5nIEluanVyaWVzDQoNCj4+IEVjb25vbWljIEltcGFjdCAtIFJlc3VsdHMNCg0KYGBge3J9DQpwMSA8LSBnZ3Bsb3QoZGF0YT10b3BuX2Vjb25vbWljLCBhZXMoeD1yZW9yZGVyKEVWVFlQRSwgUHJvcC5EYW1hZ2UpLCB5PVByb3AuRGFtYWdlLzEwXjYpKSArICAgZ2VvbV9iYXIoZmlsbD0ibGlnaHRibHVlIixzdGF0PSJpZGVudGl0eSIpICArIGNvb3JkX2ZsaXAoKSArIA0KICAgIHlsYWIoIlByb3BlcnR5IERhbWFnZXMgKCRNKSIpICsgeGxhYigiRXZlbnQgdHlwZSIpICsNCiAgICB0aGVtZShsZWdlbmQucG9zaXRpb249Im5vbmUiKSArIHNjYWxlX3lfY29udGludW91cyhsaW1pdCA9IGMoMCxtYXgodG9wbl9lY29ub21pYyRUb3RhbC5EYW1hZ2UvMTAwMDAwMCkpKQ0KDQpwMiA8LSBnZ3Bsb3QoZGF0YT10b3BuX2Vjb25vbWljLCBhZXMoeD1yZW9yZGVyKEVWVFlQRSwgQ3JvcC5EYW1hZ2UpLCB5PUNyb3AuRGFtYWdlLzEwXjYpKSArICAgZ2VvbV9iYXIoZmlsbD0ibGlnaHRncmVlbiIsc3RhdD0iaWRlbnRpdHkiKSAgKyBjb29yZF9mbGlwKCkgKyANCiAgICB5bGFiKCJDcm9wIERhbWFnZXMgKCRNKSIpICsgeGxhYigiRXZlbnQgdHlwZSIpICsNCiAgICB0aGVtZShsZWdlbmQucG9zaXRpb249Im5vbmUiKSArIHNjYWxlX3lfY29udGludW91cyhsaW1pdCA9IGMoMCxtYXgodG9wbl9lY29ub21pYyRUb3RhbC5EYW1hZ2UvMTAwMDAwMCkpKQ0KDQpwMyA8LSBnZ3Bsb3QoZGF0YT10b3BuX2Vjb25vbWljLCBhZXMoeD1yZW9yZGVyKEVWVFlQRSwgVG90YWwuRGFtYWdlKSwgeT1Ub3RhbC5EYW1hZ2UvMTBeNikpICsgICBnZW9tX2JhcihmaWxsPSIjYzQxYjQwIixzdGF0PSJpZGVudGl0eSIpICArIGNvb3JkX2ZsaXAoKSArIA0KICAgIHlsYWIoIlRvdGFsIERhbWFnZXMgKCRNKSIpICsgeGxhYigiRXZlbnQgdHlwZSIpICsNCiAgICB0aGVtZShsZWdlbmQucG9zaXRpb249Im5vbmUiKQ0KZ3JpZC5hcnJhbmdlKHAxLCBwMiwgcDMsIG5yb3cgPSAzLCB0b3AgPSAiRWNvbm9taWMgSW1wYWN0IG9mIFRvcCBXZWF0aGVyIEV2ZW50IFR5cGVzIikgKyBzY2FsZV95X2NvbnRpbnVvdXMobGltaXQgPSBjKDAsbWF4KHRvcG5fZWNvbm9taWMkVG90YWwuRGFtYWdlLzEwMDAwMDApKSkNCmBgYA0KV2Ugb2JzZXJ2ZSB0aGF0IEZsb29kcyBhcmUgYnkgZmFyIHRoZSBtb3N0IGVjb25vbWljYWxseSBjb3N0bHkgd2VhdGhlciBldmVudHMuIFByb3BlcnR5IGRhbWFnZSBpcyBmYXIgYW5kIGF3YXkgdGhlIGRyaXZpbmcgZmFjdG9yLCB3aXRoIGNyb3AgZGFtYWdlIHBsYXlpbmcgYSBtdWNoIHNtYWxsZXIgcm9sZSBmb3IgdGhlIG1vc3QgZGFtYWdpbmcgZXZlbnQgdHlwZXMuDQo=