Societal Cost of High Impact Weather Events

Synopsis

With severe weather events occurring with greater frequency and severity, it would be useful to know which weather events have the highest overall cost to society. This information could be used to direct policy and resources that affect preparation for and mitigation of such events.

The National Weather Service has a log of storm events dating back to 1950. While this information is not comprehensive, relies entirely on voluntary reporting and while the NWS makes no guarantee of accuracy, it is still worthwhile for a first cut analysis. To allow mixing of costs due to damage with costs of fatalities and injuries, estimates of costs for injuries/fatalities from recent studies on automobile accidents were used as a reference point.

The results show that Hurricane events far exceed all other sources for material damage and total cost, even though the fatalities and injuries from Hurricane Katrina do not appear to be included in the data set. Tsunami's when they occur, Tornadoes, Flooding, Heat and Drought events also figure prominently, while winter weather-related events turn out to be relatively inexpensive.

Data Processing

The source of the Storm Data was the National Weather Service, which provides instructions on how to fill out the form, as well as full descriptions of 48 weather event categories that will be the basis for the cost analysis. The Storm Data file was downloaded to the working directory and imported.

stDF <- read.csv("repdata_data_StormData.csv.bz2")

Calculating Material Cost to Society of Storm Events.

The economic data is divided into Crop and Property damage, with an “exponent” value that, when populated (not “”), indicates multiply the base value by 1000 (k), 1 million (m) or 1 billion (b). A small number (less than 0.05%) of records had the exponent populated to some other value, in those instances the assumption was that the actual damage value reflected the cost in dollars (multiplied by 1).

dim(subset(stDF, !(tolower(CROPDMGEXP) %in% c("k","m","b","")) |
                 !(tolower(PROPDMGEXP) %in% c("k","m","b",""))))[1]/dim(stDF)[1]
## [1] 0.0003856823

Combine Crop and Property damage into a single Materials Cost (MTLCOST) value.

stDF$CROPPWR    <- 1 
stDF[tolower(stDF$CROPDMGEXP) == "k", ]$CROPPWR <-       1000
stDF[tolower(stDF$CROPDMGEXP) == "m", ]$CROPPWR <-    1000000
stDF[tolower(stDF$CROPDMGEXP) == "b", ]$CROPPWR <- 1000000000
stDF$PROPPWR    <- 1 
stDF[tolower(stDF$PROPDMGEXP) == "k", ]$CROPPWR <-       1000
stDF[tolower(stDF$PROPDMGEXP) == "m", ]$CROPPWR <-    1000000
stDF[tolower(stDF$PROPDMGEXP) == "b", ]$CROPPWR <- 1000000000
stDF$MTLCOST    <- stDF$CROPPWR * stDF$CROPDMG + stDF$PROPPWR * stDF$PROPDMG

Human Health Impact data

The casulalty data is divided into fatalities and injuries, with no indication of how serious those injuries were.

While it is useful for this study to combine these into a single metric, a quick literature search turned up no studies on average cost of a fatality or death in storms, but did turn up a AAA Study which relied upon a calculation of the cost of injuries or fatalities in automobile accidents. While these studies contain a number of assumptions (work from 80s-90s was inflation-adjusted in 2009, and an average injury cost in 2003 was also inflation-adjusted) as a crude benchmark, the results have some value.

The AAA study estimated the overall cost of a fatality to society at $6 million 2009 dollars, with an injury 126,000. This figure unfortunately includes the damage to the vehicle. Another IHS study shows the average age of a car on the roads in 2014 to be over 11 years old, so the cost is trivial compared to the cost of a fatality, and by removing 6k from average cost of an injury for the average vehicle value, a convenient ratio of 50 injuries = 1 fatality can be used to estimate overall cost to society of injuries and fatalities during a storm event.

With both Human and Material cost calculated, the figures were also combined to allow analysis of total cost to society from both sources.

stDF$HUMCOST    <- (stDF$FATALITIES * 50 + stDF$INJURIES) * 120000

stDF$TOTCOST    <- stDF$HUMCOST + stDF$MTLCOST

Mapping User-entered Event Types to NWS Weather Events

The final step is to group the Event Types into the 48 official NWS weather events.

Unfortunately in practice, this was a free-form field and the majority of the data did not have Event Type names that matched the official categories. Even when proper values were used, entries were often misspelled or several categories combined into one entry. In addition the storm data report was also used to record that no unusual weather occurred, so a 49th category was created for entries where essentially there was no weather event.

Because of the lack of standard entries, regular expression matching could only be done with great care, and a significant number of the event types could be mapped only by drilling into the detail text to discover what was actually happening. As a general rule, if multiple categories were in the Event Type label, the first listed was used to sort the observation. (eg SNOW/SLEET would sort under Heavy Snowfall, and SLEET/SNOW sorts under Sleet).

A mapping data frame was created for ease of manually sorting EVTYPE fields into EVENT fields, and is preserved for reference outside of the main data set. Regular expresssions, when used, are mapped into the evTmp vector and incorporated into the manually set values in the final line of each evMap statement.

evMap <- data.frame(EVTYPE = unique(stDF$EVTYPE),
                    EVENT = "",stringsAsFactors=FALSE)
evMap[evMap$EVTYPE == 
      "ASTRONOMICAL LOW TIDE",]$EVENT <- "Astronomical Low Tide (Z)"
evMap[evMap$EVTYPE %in% c("AVALANCE",
      "AVALANCHE"),]$EVENT <- "Avalanche (Z)"
evTmp <- as.vector(evMap[grep("^blizzard",tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c(evTmp,"GROUND BLIZZARD"), ]$EVENT <- "Blizzard (Z)"
evMap[evMap$EVTYPE %in%  c("COASTAL FLOODING", "COASTAL FLOOD",
      "Erosion/Cstl Flood", "Coastal Flooding", "BEACH FLOOD",
      "TIDAL FLOOD", "Tidal Flooding", "TIDAL FLOODING",
      "COASTALFLOOD", "Coastal Flood", "coastal flooding", 
      "COASTAL/TIDAL FLOOD", "COASTAL FLOODING/EROSION", 
      "ASTRONOMICAL HIGH TIDE", "BEACH EROSION/COASTAL FLOOD",
      "CSTL FLOODING/EROSION",  " COASTAL FLOOD", "HIGH TIDES",
      "COASTAL  FLOODING/EROSION"), ]$EVENT <- "Coastal Flood (Z)"
evMap[evMap$EVTYPE %in% c("RECORD COLD", "COLD", "Cold and Frost",  
      "RECORD COLD AND HIGH WIND", "RECORD COLD/FROST", "COLD WEATHER",
      "SEVERE COLD", "COLD WAVE", "PROLONG COLD", "WIND CHILL", 
      "COLD/WINDS", "PROLONG COLD/SNOW", "Cold", "UNSEASONABLY COLD", 
      "Unseasonable Cold", "Record Cold",  "Extended Cold",  
      "LOW TEMPERATURE RECORD", "LOW TEMPERATURE", "RECORD LOW",
      "Cold Temperature", "COLD AND SNOW", "Prolong Cold", "COOL SPELL",
      "COLD AND SNOW", "Prolong Cold", "Cold and Frost", "COLD AND FROST",
      "COLD TEMPERATURES", "COLD WIND CHILL TEMPERATURES", "RECORD  COLD",
      "HYPERTHERMIA/EXPOSURE", "HYPOTHERMIA", "Hypothermia/Exposure",
      "HYPOTHERMIA/EXPOSURE", "RECORD COOL", "UNSEASONABLY COOL", 
      "UNSEASONABLY COOL & WET", "UNSEASONAL LOW TEMP",
      "UNUSUALLY COLD",  "COLD/WIND CHILL", "LOW WIND CHILL",
      "WIND CHILL/HIGH WIND"), ]$EVENT <- "Cold/Wind Chill (Z)"
evMap[evMap$EVTYPE %in% c("MUDSLIDES", "MUD SLIDE", "MUD SLIDES",
      "MUD SLIDES URBAN FLOODING", "MUDSLIDE", "MUD/ROCK SLIDE",
      "LANDSLIDE", "LANDSLIDES", "LANDSLIDE/URBAN FLOOD", "Landslump",
      "Mudslide", "Mudslides", "MUDSLIDE/LANDSLIDE", "LANDSLUMP",
      "ROCK SLIDE"), ]$EVENT <- "Debris Flow (C)" 
evMap[evMap$EVTYPE %in% c("DENSE FOG", "FOG", "PATCHY DENSE FOG"), ]$EVENT <- "Dense Fog (Z)" 
evMap[evMap$EVTYPE %in% c("SMOKE", "DENSE SMOKE"), ]$EVENT <- "Dense Smoke (Z)" 
evMap[evMap$EVTYPE %in% c("DROUGHT", "RECORD LOW RAINFALL", "DRY WEATHER",
      "ABNORMALLY DRY", "BELOW NORMAL PRECIPITATION", "DRIEST MONTH",
      "DRY", "DRY CONDITIONS", "DRY PATTERN", "DRYNESS", "EXCESSIVE",
      "EXCESSIVELY DRY", "DRY SPELL", "Record dry month", "RECORD DRYNESS",
      "UNSEASONABLY DRY", "VERY DRY", "LACK OF SNOW",
      "DROUGHT/EXCESSIVE HEAT"), ]$EVENT <- "Drought (Z)"
evMap[evMap$EVTYPE %in% c("DUST DEVIL", "Dust Devil", "DUST DEVEL",
      "WHIRLWIND", "Whirlwind", "LANDSPOUT", "ROTATING WALL CLOUD",
      "DUST DEVIL WATERSPOUT"), ]$EVENT <- "Dust Devil (C)" 
evMap[evMap$EVTYPE %in% c("DUST STORM",  "DUSTSTORM", 
      "DUST STORM/HIGH WINDS", "BLOWING DUST",
      "SAHARAN DUST", "Saharan Dust" ), ]$EVENT <- "Dust Storm (Z)" 
evMap[evMap$EVTYPE %in% c("EXTREME HEAT", "EXCESSIVE HEAT", "RECORD/EXCESSIVE HEAT", 
      "EXCESSIVE HEAT/DROUGHT"), ]$EVENT <- "Excessive Heat (Z)"
evMap[evMap$EVTYPE %in% c("EXTREME WINDCHILL TEMPERATURES",
      "EXTREME COLD/WIND CHILL", "EXTREME WIND CHILLS", "ICE JAM",
      "EXTREME WIND CHILL",  "EXTREME WINDCHILL", "BITTER WIND CHILL",
      "EXTREME WIND CHILL/BLOWING SNO", "EXTREME/RECORD COLD",    
      "BITTER WIND CHILL TEMPERATURES", "Extreme Cold", "Excessive Cold",
      "EXTREME COLD" ), ]$EVENT <- "Extreme Cold/Wind Chill (Z)"
evMap[evMap$EVTYPE %in% c("FLASH FLOOD", "FLASH FLOODING",
      "FLASH FLOODING/THUNDERSTORM WI", "FLASH FLOODS", "FLOOD/FLASH",
      "FLOOD/FLASHFLOOD", "Flood/Flash Flood", "FLOOD/FLASH/FLOOD",
      "FLASH FLOOD/FLOOD", "FLOOD FLOOD/FLASH", "DAM FAILURE",
      "FLOOD/FLASH FLOOD", "FLOOD/FLASH FLOODING", "DAM BREAK", 
      "FLASH FLOOD WINDS", "FLASH FLOOD/", "LOCAL FLASH FLOOD",
      "FLASH FLOOD FROM ICE JAMS", "FLASH FLOOD - HEAVY RAIN",
      "FLASH FLOOD/ STREET", "FLASH FLOOD/HEAVY RAIN", "FLOOD FLASH",
      "FLASH FLOOD/ FLOOD", "FLASH FLOODING/FLOOD", "FLASH FLOOODING",
      "FLASH FLOOD/LANDSLIDE", "FLASH FLOOD LANDSLIDES",
      " FLASH FLOOD" ), ]$EVENT <- "Flash Flood (C)"       
evMap[evMap$EVTYPE %in% c("FLOODING", "FLOOD", "BREAKUP FLOODING",
      "RIVER FLOOD", "FLOOD WATCH/", "FLOODING/HEAVY RAIN",
      "URBAN FLOODING", "URBAN/SMALL FLOODING", "LOCAL FLOOD",
      "FLOOD/RAIN/WINDS", "URBAN/SMALL STREAM FLOODING", "Flood",
      "STREAM FLOODING", "FLOOD/RAIN/WIND", "SMALL STREAM URBAN FLOOD",
      "URBAN FLOOD", "URBAN/SMALL STREAM FLOOD", "MINOR FLOODING",
      "URBAN/SMALL STREAM  FLOOD", "URBAN AND SMALL STREAM FLOOD",
      "SMALL STREAM FLOODING", "FLOODS", "SMALL STREAM/URBAN FLOOD",
      "SMALL STREAM AND URBAN FLOODIN", "RURAL FLOOD", "MAJOR FLOOD",
      "SMALL STREAM AND URBAN FLOOD", "ICE JAM FLOODING", "HIGH WATER", 
      "STREET FLOOD", "URBAN AND SMALL STREAM FLOODIN", "MINOR FLOOD",
      "SMALL STREAM FLOOD", "RIVER AND STREAM FLOOD", "RIVER FLOODING",
      "FLOOD/RIVER FLOOD", "HIGHWAY FLOODING", "SNOWMELT FLOODING",
      "FLOOD & HEAVY RAIN", "URBAN SMALL STREAM FLOOD", "URBAN FLOODS", 
      "URBAN FLOOD LANDSLIDE", "Minor Flooding", "Ice jam flood (minor", 
      "River Flooding", "STREET FLOODING", "Flood/Strong Wind",
      "Urban Flooding", "Urban flood", "Urban Flood", "SMALL STREAM",
      "SMALL STREAM AND", "Sml Stream Fld", "URBAN AND SMALL",
      "URBAN AND SMALL STREAM", "URBAN/SMALL STRM FLDG", "URBAN/SMALL",
      "URBAN/SMALL STREAM", "URBAN/SML STREAM FLDG", "URBAN/SML STREAM FLD",
      "URBAN SMALL", "URBAN/STREET FLOODING"), ]$EVENT <- "Flood (C)" 
evMap[evMap$EVTYPE %in% c("FOG AND COLD TEMPERATURES", "Ice Fog", 
      "FREEZING FOG", "Freezing Fog"), ]$EVENT <- "Freezing Fog (Z)" 
evMap[evMap$EVTYPE %in% c("FREEZE", "DAMAGING FREEZE", "FROST\\FREEZE",
      "AGRICULTURAL FREEZE", "HARD FREEZE", "EARLY FREEZE", "Freeze",
      "Damaging Freeze", "Frost/Freeze", "LATE FREEZE", "FROST/FREEZE",
      "FROST", "EARLY FROST", "Early Frost", "Frost", 
      "FIRST FROST"), ]$EVENT <- "Frost/Freeze (Z)" 
evMap[evMap$EVTYPE %in% c("FUNNEL CLOUD", "FUNNEL", "FUNNEL CLOUDS",
      "WALL CLOUD/FUNNEL CLOUD", "COLD AIR FUNNEL", "COLD AIR FUNNELS",
      "FUNNEL CLOUD/HAIL", "FUNNEL CLOUD.", "FUNNELS", "LARGE WALL CLOUD",
      "Funnel Cloud"), ]$EVENT <- "Funnel Cloud (C)"
evTmp <- as.vector(evMap[grep("^hail",tolower(evMap$EVTYPE)),]$EVTYPE) 
evMap[evMap$EVTYPE %in% c("SMALL HAIL", "DEEP HAIL", "small hail",
      "Small Hail", "LATE SEASON HAIL", "NON SEVERE HAIL",
      "MARINE HAIL", evTmp), ]$EVENT <- "Hail (C)" 
evMap[evMap$EVTYPE %in% c("HEAT", "RECORD HEAT", "RECORD WARM TEMPS.", 
      "RECORD HEAT WAVE", "HEAT WAVES", "HEAT WAVE DROUGHT",
      "HEAT/DROUGHT", "HEAT DROUGHT", "Record Heat", "Heat Wave",
      "DRY HOT WEATHER", "HOT PATTERN", "HOT/DRY PATTERN", "VERY WARM",
      "RECORD HIGH TEMPERATURE", "HIGH TEMPERATURE RECORD", "HEAT WAVE",
      "Record High", "RECORD WARM", "RECORD WARM TEMPS", "Record Warmth",
      "RECORD HIGH TEMPERATURES", "HIGH TEMPERATURE RECORD", "RECORD WARMTH",      
      "Hot and Dry", "HOT SPELL", "UNSEASONABLY HOT", "RECORD HIGH",
      "UNSEASONABLY WARM", "UNSEASONABLY WARM & WET", "UNUSUAL WARMTH",
      "UNUSUAL/RECORD WARMTH", "UNSEASONABLY WARM/WET", "UNUSUALLY WARM",
      "UNSEASONABLY WARM AND DRY", "UNSEASONABLY WARM YEAR",
      "WARM DRY CONDITIONS", "ABNORMAL WARMTH", "PROLONG WARMTH",
      "HOT WEATHER", "WARM WEATHER" ), ]$EVENT <- "Heat (Z)"
evMap[evMap$EVTYPE %in% c("RAIN/SNOW", "HEAVY RAIN", "HEAVY RAINS",
      "HEAVY RAIN/LIGHTNING", "RECORD RAINFALL", "RAINSTORM",
      "HEAVY RAIN/FLOODING", "HEAVY RAIN/SNOW", "RAIN", "HVY RAIN",
      "HEAVY RAIN/SEVERE WEATHER", "HEAVY RAIN AND FLOOD", 
      "ABNORMALLY WET", "COOL AND WET", "DOWNBURST", "MIXED PRECIPITATION", 
      "EXCESSIVE PRECIPITATION", "EXCESSIVE WETNESS", "EXTREMELY WET",
      "RAIN AND WIND", "EXCESSIVE RAIN", "TORRENTIAL RAIN", 
      "HEAVY RAIN; URBAN FLOOD WINDS;", "HEAVY RAINS/FLOODING", 
      "HEAVY RAIN/MUDSLIDES/FLOOD", "RAIN/WIND", "EXCESSIVE RAINFALL",
      "HEAVY RAINFALL", "HEAVY RAIN/URBAN FLOOD", "Heavy Rain",
      "HEAVY PRECIPATATION", "Heavy Precipitation", "HEAVY PRECIPITATION",
      "HEAVY RAIN/SMALL STREAM URBAN", "Heavy Rain and Wind",
      "RECORD PRECIPITATION", "UNSEASONABLY WET", "Wet Month", "Wet Year",
      "HEAVY SHOWER", "HEAVY SHOWERS", "MIXED PRECIP", "Mixed Precipitation",
      "Heavy Rain/High Surf", "Rain Damage", "Torrential Rainfall",
      "HEAVY RAIN/WIND", "Heavy rain", "Monthly Rainfall", "WET WEATHER",
      "RAIN (HEAVY)", "UNSEASONAL RAIN", "EARLY RAIN", "PROLONGED RAIN",
      "MONTHLY RAINFALL", "LOCALLY HEAVY RAIN", "HEAVY RAIN EFFECTS",
      "RECORD/EXCESSIVE RAINFALL" ), ]$EVENT <- "Heavy Rain (C)"
evTmp <- as.vector(evMap[grep("^heavy snow",tolower(evMap$EVTYPE)),]$EVTYPE)
evTmp <- c(evTmp, as.vector(evMap[grep("^snow[ /]",tolower(evMap$EVTYPE)),]$EVTYPE))
evMap[evMap$EVTYPE %in% c("BLOWING SNOW","FIRST SNOW", "EARLY SNOW", 
      "BLOWING SNOW- EXTREME WIND CHI",  "HEAVY LAKE SNOW", "Snow and Ice",
      "BLOWING SNOW & EXTREME WIND CH","WET SNOW",  "RECORD SNOW", 
      "RECORD SNOW/COLD", "BLOWING SNOW/EXTREME WIND CHIL", "Drifting Snow", 
      "NEAR RECORD SNOW", "SNOWFALL RECORD", "Late Season Snowfall",
      "blowing snow", "ACCUMULATED SNOWFALL", "HEAVY WET SNOW",
      "Record May Snow", "Record Winter Snow", "UNUSUALLY LATE SNOW",
      "Late-season Snowfall", "Blowing Snow", "Early snowfall", "Snow",
      "Monthly Snowfall", "Seasonal Snowfall", "Mountain Snows", 
      "SNOW", "RECORD SNOWFALL", "SNOWSTORM", "LATE SEASON SNOW",  
      "MONTHLY SNOWFALL", "EARLY SNOWFALL", "EXCESSIVE SNOW",
      "SNOW- HIGH WIND- WIND CHILL", "LATE SNOW", "SNOW\\COLD",     
      "FALLING SNOW/ICE", evTmp), ]$EVENT <- "Heavy Snow (C)"
evTmp <- as.vector(evMap[grep("^high surf",tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c("HEAVY SURF COASTAL FLOODING", "ROUGH SEAS",  
      "HEAVY SURF", "HAZARDOUS SURF", "   HIGH SURF ADVISORY",
      "HEAVY SEAS", "HEAVY SWELLS", "HIGH SWELLS", "HIGH  SWELLS",
      "HIGH WAVES", "ROGUE WAVE", "Marine Accident", "HIGH SEAS",
      "Beach Erosion", "BEACH EROSION", "COASTAL EROSION", "BEACH EROSIN",
      "ROUGH SURF", "Heavy Surf", "Heavy surf and wind", "WIND AND WAVE",
      "HEAVY SURF/HIGH SURF", evTmp), ]$EVENT <- "High Surf (Z)" 
evTmp <- as.vector(evMap[grep("^high wind",tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c("Heatburst", "HIGH  WINDS", "WIND STORM",
      "DRY MICROBURST 50", "DRY MICROBURST 53", "DRY MICROBURST 58",
      "DRY MICROBURST 61", "DRY MICROBURST 84", "HIGH",
      "WAKE LOW WIND", evTmp), ]$EVENT <- "High Wind (Z)"
evTmp <- as.vector(evMap[grep("^hurricane",tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c("TYPHOON", evTmp), ]$EVENT <- "Hurricane/Typhoon (Z)"
evTmp <- as.vector(evMap[grep("^ice storm",tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c("GLAZE/ICE STORM", "Icestorm/Blizzard", 
      evTmp), ]$EVENT <- "Ice Storm (Z)" 
evMap[evMap$EVTYPE %in% c("LAKE FLOOD", 
      "LAKESHORE FLOOD"), ]$EVENT <- "Lakeshore Flood (Z)" 
evMap[evMap$EVTYPE %in% c("LAKE EFFECT SNOW", "LAKE-EFFECT SNOW",
      "Lake Effect Snow"), ]$EVENT <- "Lake-Effect Snow (Z)" 
evTmp <- as.vector(evMap[grep("^lightning",tolower(evMap$EVTYPE)),]$EVTYPE)
evTmp <- evTmp[grep("LIGHTNING FIRE", evTmp, invert = TRUE)]
evMap[evMap$EVTYPE %in% c(" LIGHTNING", "LIGHTING", "LIGNTNING", 
      evTmp), ]$EVENT <- "Lightning (C)"
evMap[evMap$EVTYPE == "MARINE HAIL", ]$EVENT <- "Marine Hail (M)" 
evMap[evMap$EVTYPE == "MARINE HIGH WIND", ]$EVENT <- "Marine High Wind (M)" 
evMap[evMap$EVTYPE %in% c("MARINE STRONG WIND", 
       "MARINE MISHAP"), ]$EVENT <- "Marine Strong Wind (M)" 
evMap[evMap$EVTYPE %in% c("MARINE THUNDERSTORM WIND", 
      "MARINE TSTM WIND"), ]$EVENT  <- "Marine Thunderstorm Wind (M)"  
evMap[evMap$EVTYPE %in% c("RIP CURRENTS HEAVY SURF", "RIP CURRENTS/HEAVY SURF",
      "RIP CURRENT","RIP CURRENTS"), ]$EVENT  <- "Rip Current (Z)"  
evMap[evMap$EVTYPE == "SEICHE", ]$EVENT <- "Seiche (Z)"
evTmp <- as.vector(evMap[grep("^sleet",tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c("FREEZING RAIN AND SLEET","FREEZING RAIN/SLEET",
      "FREEZING RAIN SLEET AND", "FREEZING RAIN SLEET AND LIGHT",
      "LIGHT SNOW AND SLEET", evTmp), ]$EVENT <- "Sleet (Z)"
evMap[evMap$EVTYPE %in% c("STORM SURGE/TIDE", "COASTAL SURGE", 
      "STORM SURGE"), ]$EVENT  <- "Storm Surge/Tide (Z)"  
evMap[evMap$EVTYPE %in% c( "WIND", "WIND DAMAGE", "WINDS", "Coastal Storm", 
      "GUSTY WINDS", "STRONG WINDS", "STRONG WIND", "GUSTY LAKE WIND",
      "DOWNBURST WINDS", "DRY MICROBURST WINDS", "MICROBURST WINDS",
      "GRADIENT WINDS", "NON TSTM WIND", "WIND/HAIL", "DRY MICROBURST",
      "STORM FORCE WINDS", "ICE/STRONG WINDS", "Wind", "Wind Damage",
      "Strong Wind", "Strong Winds", "Strong winds", "Gusty Wind",
      "Gradient wind", "Gusty wind/rain", "GUSTY WIND/HVY RAIN",
      "Gusty Winds", "GUSTY WIND", "STRONG WIND GUST", "Gusty winds",
      "GRADIENT WIND", "gradient wind", "STRONG WIND GUST", " WIND",
      "BLOW-OUT TIDE", "BLOW-OUT TIDES", "Microburst", "MICROBURST", 
      "WIND ADVISORY", "GUSTY WIND/HAIL", "SEVERE TURBULENCE", "WIND GUSTS",
      "wet micoburst", "WET MICROBURST", "WND", "NON-SEVERE WIND DAMAGE",
      "NON-TSTM WIND", "DRY MIRCOBURST WINDS"), ]$EVENT <- "Strong Wind (Z)"
evTmp <- as.vector(evMap[grep("^thunderstorm", tolower(evMap$EVTYPE)),]$EVTYPE)
evTmp <- c(evTmp, as.vector(evMap[grep("^tstm[ /]",tolower(evMap$EVTYPE)),]$EVTYPE))
evMap[evMap$EVTYPE %in% c( "SEVERE THUNDERSTORM", "SEVERE THUNDERSTORMS",
      "GUSTY THUNDERSTORM WINDS", "GUSTY THUNDERSTORM WIND", "TSTM",  
      "THUDERSTORM WINDS", "THUNDERESTORM WINDS", "THUNDEERSTORM WINDS",
      "Metro Storm, May 26", "APACHE COUNTY", " TSTM WIND", "TSTMW",
      "SEVERE THUNDERSTORM WINDS", "THUNDESTORM WINDS", "THUNERSTORM WINDS",
      "DROWNING", "RAPIDLY RISING WATER", "THUNDERSNOW", "Thundersnow shower",
      "THUNDERSTROM WIND", "THUNDERSTROM WINDS", "THUNDERTORM WINDS",
      "THUNDERTSORM WIND", "GUSTNADO", "GUSTNADO AND", " TSTM WIND (G45)",
      "TUNDERSTORM WIND", evTmp), ]$EVENT <- "Thunderstorm Wind (Z)" 
evTmp <- as.vector(evMap[grep("^tornado", tolower(evMap$EVTYPE)),]$EVTYPE)
evMap[evMap$EVTYPE %in% c( "COLD AIR TORNADO", "WALL CLOUD", "TORNDAO", 
      evTmp), ]$EVENT <- "Tornado (Z)" 
evMap[evMap$EVTYPE == "TROPICAL DEPRESSION", ]$EVENT <- "Tropical Depression (M)"
evTmp <- as.vector(evMap[grep("^tropical storm", tolower(evMap$EVTYPE)),]$EVTYPE) 
evMap[evMap$EVTYPE %in% c("REMNANTS OF FLOYD", evTmp), ]$EVENT  <- "Tropical Storm (M)" 
evMap[evMap$EVTYPE == "TSUNAMI", ]$EVENT <- "Tsunami (M)"
evTmp <- as.vector(evMap[grep("^volcanic", tolower(evMap$EVTYPE)),]$EVTYPE) 
evMap[evMap$EVTYPE %in% c("VOG", evTmp), ]$EVENT  <- "Volcanic Ash (M)" 
evTmp <- as.vector(evMap[grep("^waterspout", tolower(evMap$EVTYPE)),]$EVTYPE)  
evMap[evMap$EVTYPE %in% c(" WATERSPOUT", "WATER SPOUT",  "WAYTERSPOUT",
      evTmp), ]$EVENT  <- "Waterspout (M)" 
evTmp <- as.vector(evMap[grep("fire", tolower(evMap$EVTYPE)),]$EVTYPE)  
evMap[evMap$EVTYPE %in% evTmp, ]$EVENT  <- "Wildfire (Z)" 
evTmp <- as.vector(evMap[grep("^winter storm", tolower(evMap$EVTYPE)),]$EVTYPE)  
evMap[evMap$EVTYPE %in% c("COASTALSTORM", "COASTAL STORM", 
      evTmp), ]$EVENT  <- "Winter Storm (Z)" 
evTmp <- as.vector(evMap[grep("^winter weather", tolower(evMap$EVTYPE)),]$EVTYPE)  
evMap[evMap$EVTYPE %in% c("MODERATE SNOW", "MODERATE SNOWFALL",
      "Light snow", "Light Snow", "Light Snowfall", "LIGHT SNOW",
      "LIGHT SNOW/FREEZING PRECI", "LIGHT SNOW/FREEZING PRECIP",
      "Light Snow/Flurries", "PATCHY ICE", "ICE ON ROAD", "ICY ROADS",
      "ICE/SNOW", "ICE AND SNOW", "Ice/Snow", "ICE", "GLAZE ICE",
      "Black Ice", "BLACK ICE", "ICE ROADS", "ICE FLOES", "Icy Roads",
      "Freezing Rain", "FREEZING RAIN AND SNOW", "FREEZING RAIN/SNOW",
      "Freezing Spray", "Glaze", "GLAZE", "HEAVY MIX", "ICE PELLETS",
      "COLD AND WET CONDITIONS", "Freezing drizzle", "Freezing Drizzle",
      "FREEZING DRIZZLE", "FREEZING DRIZZLE AND FREEZING",  
      "LIGHT FREEZING RAIN", "Freezing rain", "FREEZING RAIN",
      "Wintry Mix", "WINTRY MIX","WINTER MIX", "WINTERY MIX", "Wintry mix",
       evTmp), ]$EVENT  <- "Winter Weather (Z)"
evTmp <- as.vector(evMap[grep("^summary", tolower(evMap$EVTYPE)),]$EVTYPE)  
evMap[evMap$EVTYPE %in% c("MONTHLY TEMPERATURE","RECORD TEMPERATURE",
       "RECORD TEMPERATURES", "?", "No Severe Weather", "MILD PATTERN", 
       "Temperature record", "Record temperature", "Record Temperatures",
       "Mild and Dry Pattern", "MILD/DRY PATTERN", "MONTHLY PRECIPITATION",
       "NORTHERN LIGHTS", "OTHER", "Other", "RED FLAG CRITERIA", "SOUTHEAST",
       "NONE", "NORMAL PRECIPITATION", evTmp), ]$EVENT  <- "No Event Occurred"

stDF <- merge(stDF,evMap)

Results

Before comparing Weather Event categories, some sanity checking was done to get a sense of the scale of the data. There's about 1.8 trillon dollars of material cost, but only 15,000 fatalities and about 10x as many injuries. To put that in perspective, that's only about 6 months worth of automobile fatalities, so we seem to do pretty well at keeping people alive during storm events. Because of this the Human Cost is less than a tenth of the Material Cost.

sum(stDF$MTLCOST)    
## [1] 1.793645e+12
sum(stDF$HUMCOST)
## [1] 107733360000
sum(stDF$FATALITIES)  
## [1] 15145
sum(stDF$INJURIES)    
## [1] 140528

Total Cost to Society

First the total cost was analyzed. This is the cost from 1950-2011 of all events reported, not adjusted for inflation.

sumMTLCOST <- sort(unlist(lapply(split(stDF$MTLCOST,stDF$EVENT),sum)), 
                   decreasing = TRUE)
sumHUMCOST <- sort(unlist(lapply(split(stDF$HUMCOST,stDF$EVENT),sum)), 
                   decreasing = TRUE)
sumTOTCOST <- sort(unlist(lapply(split(stDF$TOTCOST,stDF$EVENT),sum)), 
                   decreasing = TRUE)
suppressWarnings(library(RColorBrewer))
par(mfcol=c(3,1), las = 1, mar = c(3,16,2,2), cex.axis = 1.33)
suppressWarnings( barplot(sumMTLCOST[10:1]/1000000000, horiz = TRUE,
  col=(brewer.pal(6,"Blues")), log = "x", xlim = c(1,10000), 
  main = "Top 10 Weather Event Material Costs:  Crop & Property Damage"))
text(100,1,"Billions of US Dollars", cex=1.5)
suppressWarnings( barplot(sumHUMCOST[10:1]/1000000000, horiz = TRUE,
  col=(brewer.pal(5,"Reds")), log = "x", xlim = c(1,10000), 
  main = "Top 10 Weather Event Human Costs: Death & Injuries"))
text(100,1,"Billions of US Dollars", cex=1.5)
suppressWarnings( barplot(sumTOTCOST[10:1]/1000000000, horiz = TRUE,
  col=(brewer.pal(5,"Purples")),  log = "x", xlim = c(1,10000), 
  main = "Top 10 Weather Event Total Society Cost" ))
text(100,1,"Billions of US Dollars", cex=1.5)

plot of chunk unnamed-chunk-7

The 10 events shown here represent 99.5% of Material Cost, and about 87% of Human Cost from all events.

sum(sumMTLCOST[1:10])/sum(sumMTLCOST)
## [1] 0.9956356
sum(sumHUMCOST[1:10])/sum(sumHUMCOST)
## [1] 0.8696827
sum(sumTOTCOST[1:10])/sum(sumTOTCOST)
## [1] 0.9788279

Looking at the charts, it is striking that Hurricane is missing from the Death or Injury graph. Hurricane Katrina alone had from FEMA 1833 fatalities, which, if included, would be 11% of the total fatalities. A query of LA state events tagged as Hurricanes showed only 2 fatalities and 3 injuries, so the conclusion is the Katrina data on deaths and injuries is missing from this data set. Were it present, Hurricane/Typhoon would fall just below Excessive Heat.

sum(subset(stDF,EVENT == "Hurricane/Typhoon (Z)" & STATE == "LA")$FATALITIES)
## [1] 2
sum(subset(stDF,EVENT == "Hurricane/Typhoon (Z)" & STATE == "LA")$INJURIES)
## [1] 3
(sumHUMCOST["Hurricane/Typhoon (Z)"] + (1833 * 6000000))/1000000000
## Hurricane/Typhoon (Z) 
##              11.96796

The vast majority of property damage over time seems to have been from flooding and extremely high winds. Human costs are clustered around heat events and sudden, violent weather changes that are difficult to escape when caught.

Average Cost Per Weather Event to Society

Viewing the cost entirely from the total values reported does not give the whole picture, as frequent events such as Tornadoes and Floods will be magnified and because of no inflation adjustment, recent data will outweigh earlier data. Taking an average cost per event helps both problems, and might be more useful to see what single event is most likey to be very costly if it occurs. The average events clustered more tightly, so the Pareto shows only 5 values.

avgMTLCOST <- sort(unlist(lapply(split(stDF$MTLCOST,stDF$EVENT),mean)), 
                   decreasing = TRUE)
avgHUMCOST <- sort(unlist(lapply(split(stDF$HUMCOST,stDF$EVENT),mean)), 
                   decreasing = TRUE)
avgTOTCOST <- sort(unlist(lapply(split(stDF$TOTCOST,stDF$EVENT),mean)), 
                   decreasing = TRUE)
par(mfcol=c(3,1), las = 1, mar = c(3,16,2,2), cex.axis = 1.33)
suppressWarnings( barplot(avgMTLCOST[5:1]/1000000, horiz = TRUE,
  col=(brewer.pal(6,"Blues")), log = "x", xlim = c(1,10000), 
  main = "Top 5 Weather Event Average Material Costs:  Crop & Property Damage" ))
text(100,1,"Millions of US Dollars", cex=1.5)
suppressWarnings( barplot(avgHUMCOST[10:1]/1000000, horiz = TRUE,
  col=(brewer.pal(5,"Reds")),log = "x", xlim = c(1,10000), 
  main = "Top 10 Weather Event Average Human Costs:  Death & Injuries" ))
text(100,1,"Millions of US Dollars", cex=1.5)
suppressWarnings( barplot(avgTOTCOST[5:1]/1000000, horiz = TRUE,
  col=(brewer.pal(6,"Purples")), log = "x", xlim = c(1,10000), 
  main = "Top 5 Weather Event Average Society Cost" ))
text(100,1,"Millions of US Dollars", cex=1.5)

plot of chunk unnamed-chunk-10

The five events shown here are 99.9% of Material Cost and 99.4% of Total cost, but 10 events show only 88% of Human Cost. Because Material and Total are so concentrated only the Human Cost retains all 10 values in these Pareto charts.

sum(avgMTLCOST[1:5])/sum(avgMTLCOST)
## [1] 0.9989344
sum(avgHUMCOST[1:10])/sum(avgHUMCOST)
## [1] 0.8825893
sum(avgTOTCOST[1:5])/sum(avgTOTCOST)
## [1] 0.9939426

Adding the Katrina data back into the average human cost chart puts per-Hurricane cost at nearly 40 million, easily topping the list.

((sumHUMCOST["Hurricane/Typhoon (Z)"] + (1833 * 6000000))/(1+dim(stDF[stDF$EVENT == "Hurricane/Typhoon (Z)",])[1]))/1000000
## Hurricane/Typhoon (Z) 
##               39.8932

What is striking in the average view is that Drought and Wildfires replaced Tornado and Flash Floods on a per-event basis for Material Costs - these events are more serious when they occur, but are much less frequent over the 60 year period of the data.

For Human Costs, Tsunami replaced Tornadoes as the number one threat, but the two Heat entries remain in second and third place. It is important to note that even for Tsunami, the absolute number of deaths and injuries per event is small - on average based on cost maybe 1-2 fatalities or 50-100 injuries. This is why Katrina was such a shocking event.

When looking at total societal cost on a per-event basis, the first worry is about big events that hit your entire coastline, then worry about individual heat and drought events. It is interesting that none of the cold weather events were of much significance in any of the views, and that rain/wind/flooding less extreme than Hurricane force seem to be well mitigated on a per-event basis.

Looking at both charts, resources need to be spent on maintaining flood-prevention infrastructure while simultaneously addressing risks of hot and dry conditions which are dangerous to both crops and humans. Not all regions are subject to Hurricane, Tsunami or Tornado, but heat, drought and more normal flooding are a risk anywhere.