CHANEY LAW FIRM BLOG

Subscribe to our Blog

Ruminations on a state championship

If you grew up in Arkadelphia, you've likely heard stories about the state championships in which the Badger football team has played. In his Southern Fried Blog, Rex Nelson provides several accounts of the great Badger teams of the 1970s, which culminated in the 1979 state title. Most Arkadelphians know that team was coached by a first-year head coach, who was a young 25-year old named John Outlaw. Rex's profile on Coach Outlaw as part of a series of 2013 inductees into the Arkansas Sports Hall of Fame is a must read.

Badger License Plate.png

In 1987, Outlaw coached the Badgers to another state championship victory over White Hall.

48051415_1177332705748422_4054431277539917824_n.jpg

The article below from the Siftings Herald memorialized the accomplishment:

A special thanks goes out to Chris Webb for posting these old news clippings on social media. I remember “Coach Webb” being the coach you wanted to run through a brick wall for in 7th grade football.

A special thanks goes out to Chris Webb for posting these old news clippings on social media. I remember “Coach Webb” being the coach you wanted to run through a brick wall for in 7th grade football.

While I was at the ‘87 state title game, I was also only a five-year old little boy trying to stay warm, and don't remember it. The '87 Badgers were the first of any Arkansas high school football team to be nationally ranked in the USA Today Super 25 as seen below.

47389876_1176114019203624_6833979943660027904_n.jpg
The ‘87 Badgers were also the first team in a lower classification to be ranked #1 overall in the state.

The ‘87 Badgers were also the first team in a lower classification to be ranked #1 overall in the state.

With a 51-26 win over Pea Ridge last Friday night, Arkadelphia will face Warren for the 4A state championship tomorrow. Who knew it would be 30 years before the Badgers would reach another state title game? Social media has been erupting all week with Arkadelphia High School graduates posting their favorite Badger memories, which motivated me to search around my house, as well as Don and Terri's, for footage of the '87 state title game. I found it on an old VHS tape in the last place I looked, tucked away in an old storage container long forgotten.

Coach Outlaw left for coaching opportunities in Texas after the '87 season. He was the Badgers' coach for 9 seasons, finishing with a record of 84-20-1. His final coaching record was 303-87-3. When he passed in December of 2011, Rex penned a fitting tribute about his life, which was about so much more than just football. A documentary about Coach Outlaw first premiered at the 2015 Hot Springs Documentary Film Festival. A few months after Coach Outlaw passed, so too did his top assistant and Clark County legend, Willie Tate. Again, Rex provided a fitting tribute to Coach Tate as he did with Coach Outlaw. As the Badgers are headed back to War Memorial Stadium tomorrow, our community is reminded of the last time we were there and the two men who were largely responsible for having the Badgers in the same position all those years ago.

After Coach Outlaw left for Texas, the Badgers finished 7-3 in '88, and missed the playoffs. A 1-9 season followed in '89. The next Badger team to have much success was the 1995 squad, who won a conference championship, but lost 3-2 in a first round home playoff game. In 1998, Arkadelphia hired its last state championship quarterback (featured in the '87 championship game video above), John Launius, to be head coach.

981018 Badger Program - Wynne.png

'98 was my sophomore year, and I had chosen not to play. As I watched friends and classmates improve to an overall 4-6 record, I knew I would be on the field with them in 1999. The most fun I had in high school was being a scout team tight end during the '99 season. I would be a backup my senior year to an all-state tight end who was a junior in 2000. Our '99 "psycho circus" defense featured two all-state linebackers that I had to face everyday in practice. The challenge was fun, and I enjoyed being part of a group that made our defense better.

One of the things Coach Launius instilled in us was taking advantage of opportunities. I can still hear him saying while addressing the team, "all you can ask for is a great opportunity!" He also preached accountability ("Be accountable, be a man, be a Badger!"). Our mantra the entire year was "11/12/99," which was the date of the first week of the state playoffs. At the end of the season, we beat Malvern to qualify as a 3 seed in an odd tie-breaker situation. We had given ourselves the opportunity Coach Launius preached about since his arrival as the Badger head coach. We drew Searcy in the first round, who had gone 8-2 that season. During the week before the game, Searcy sent us collector cups for the entire team from the "Searcy Senior Lions." Down 21-7 in the 3rd quarter, we rallied and sent the game to overtime at 21 apiece. We got the ball first in overtime, scored a touchdown on the first play, and held Searcy on four straight plays out of the end zone to win the first playoff game since the '87 state title team. Our starting center sent Searcy their collector cups back the following week.

Terri managed to catch some highlights.

991119 Wynne v. Arkadelphia - 1.png
991119 Wynne v. Arkadelphia - 2.png

The Wynne team we faced the next week had beaten us 28-7 in '98 in the regular season. Their '99 team featured Arrion Dixon, who would later play as a Razorback, and in the NFL. Their starting running back, Antonio Warren, would later play at Arkansas State. They also had a sophomore running back by the name of DeAngelo Williams, who at Memphis would become one of six collegiate players ever to rush for over 6,000 yards (three of these six won Heisman trophies), and just recently retired after a long NFL career. We lost the game 21-7.

1999 Badger Football

1999 Badger Football

There was much anticipation for the 2000 season. We knew we were going to be good, but the question everyone wondered, was how good? I think Coach Launius knew that too, and drilled a "one game at a time" approach into us.

2000 Badger Football

2000 Badger Football

We knew we had a chance at a special year after beating Benton for the first time since '87. Benton was in a higher classification than us. Two weeks later we played Little Rock-Parkview, who was also in a higher classification.

001015 Badger Program - Parkview.png

A 40-7 beat down over Parkview gave us a lot of confidence. Perhaps we were too confident. We faced the undefeated Hope Bobcats the next week, whom we had beaten in Hope the previous season.

Hope won 21-7 that night in a tough, physical game. We finished the regular season 9-1, and earned a home playoff game against Newport.

001027 Badger Program - Hot Springs.png

Our strong safety had been hurt the week before against Malvern, which proved to be a costly injury. We couldn't stop the Greyhounds from running the ball. After our season ended at 9-2, I put together the team's highlight film, which started a hobby of digital video editing that I still have today. Below is part of the highlight film I put together:

Like Coach Outlaw, Coach Launius left for Texas a few years after I graduated in 2001. The Badgers didn't have much playoff success until J.R. Eldridge became the head coach for the 2011 season. Two years later he had the Badgers in the quarterfinals, where they lost by a touchdown at Warren. I knew back then Coach Eldridge would be playing for a championship eventually. That is borne out by the '17 team being among the top teams in both scoring offense, and scoring defense in the 4A classification.

171209 State Championship Game Ticket.png

Badger football is something that has always brought the Arkadelphia community together. It did before my time, during my time, and is currently doing so now. It's been a fun week to live here. Reading old articles from teams in the past, seeing old pictures from the Outlaw days, and seeing my high school coach quarterback our last state title team has made me realize that while the '17 team is standing on all of our collective shoulders, we're all going to be standing on theirs tomorrow.

ATLA partners with the Church of Christ Disaster Relief Team to help flood victims in Northeast Arkansas

On May 20, 2017, members of the Arkansas Trial Lawyers Association partnered with the Church of Christ Disaster Relief Team of Pocahontas to help a family in Success, Arkansas with cleaning out flood damaged parts of their home. Members traveled as far as Fayetteville, Fort Smith, Sheridan, Little Rock, Arkadelphia, and Jonesboro to assist the family after record flooding occurred during the week of May 8, 2017.

Seen above is the Haggard family home. The Current River is seen in the background, which rose to approximately the bottom of the open window on the left.

Seen above is the Haggard family home. The Current River is seen in the background, which rose to approximately the bottom of the open window on the left.

Pictured above from left to right, the Mike Haggard family (in front and back); in the front in the blue shirt, Sarah Jewell, Ryan Jewell, Shayne Dobson (kneeling), ATLA President Joey McCutchen, Margaret Dobson, and Becky Dent. In the back row begi…

Pictured above from left to right, the Mike Haggard family (in front and back); in the front in the blue shirt, Sarah Jewell, Ryan Jewell, Shayne Dobson (kneeling), ATLA President Joey McCutchen, Margaret Dobson, and Becky Dent. In the back row beginning with the gray hat, Paul Ford, Mike Gaddy, Taylor Chaney, Lewis Strate, David Dobson, Joe Denton, and Joseph Gates.

From left to right, Joe Denton and Sarah Jewell are doing their best to rip up the floors of the Haggard home so the concrete slab underneath gets the opportunity to dry out. Other parts of the home had wet joist underneath the floors. Parts of the floor were more stubborn than others, which required more elbow grease from multiple people to remove them. Here are some other tips for cleaning up a home after a flood.

The Church of Christ Disaster Response Team is immediately available to the local congregation(s) in the disaster stricken area. The purpose of the Disaster Response Team is to aid the local congregation in recruiting and receiving volunteers to assist with the emotional and spiritual needs of the disaster victims and to assist them in the clean-up and rebuilding stage. They offer a mobile kitchen, mobile shower trailer, trained coordinators, completely stocked tool trailers, health kits, clean-up kits, baby kits, and school kits.

The efforts of the Disaster Response Team are possible through the financial donations from churches and individuals across the world, and by the volunteers who work with the Disaster Response Team. You can help by donating here.

Fundraising for the American Cancer Society

On April 1, 2017, Clark County Relay for Life hosted its annual "Celebrity Waiter" fundraiser for the American Cancer Society at the Walker Conference Center on the campus of Ouachita Baptist University. Taylor volunteered to be a "celebrity" waiter this year, while Don and Terri recruited others to help take up the fight against cancer.

Nine Clark County Relay for Life teams participated in waiting on 10+ tables. Taylor was part of the "Beauties Against The Beast" team, along with Derek Phillips and Elizabeth Gabbard (two "A" list Clark County celebrities, whether they're waiting tables or not). 

This year's theme was "movies." The CLF table chose the movie Greater, which honors the life of Brandon Burlsworth, the walk-on turned 1st team All-American offensive lineman for the University of Arkansas Razorbacks from 1994-1998. Just 11 days after being taken in the third round (63rd overall) of the 1999 NFL draft by the Indianapolis Colts, Burlsworth tragically died in a car wreck on his way home from Fayetteville to Harrison. 

After his death, friends and family established the Brandon Burlsworth Foundation to support the physical and spiritual needs of children, in particular those who have limited opportunities. The foundation encourages a strong faith, character and sportsmanship, developing positive values, and a life pattern that would exemplify "Doing It The Burls Way." You can donate to the Brandon Burlsworth Foundation by clicking here.

At the end of the night, the Celebrity Waiter event raised over $6,000 for the American Cancer Society in its fight against cancer. So many people were responsible for making this event a huge success.

The date of the event coincidentally was the five year anniversary of the motorcycle incident of the coach who signed the above football. If you look closely at the "Ode to the Razorbacks" vinyl record, one of the players is wearing #12. He was the …

The date of the event coincidentally was the five year anniversary of the motorcycle incident of the coach who signed the above football. If you look closely at the "Ode to the Razorbacks" vinyl record, one of the players is wearing #12. He was the first and only player to wear the number since 1950. The team's only other retired number is Burlsworth's #77, which the school retired on the first home game after his death in 1999.

The program above was for the Arkansas vs. Kentucky game on October 3, 1998 in War Memorial Stadium. Pictured above is Anthony Lucas, who caught 6 passes for 149 yards in the game. The Hogs won 27-20 after a Tim Couch pass fell incomplete on 4th and…

The program above was for the Arkansas vs. Kentucky game on October 3, 1998 in War Memorial Stadium. Pictured above is Anthony Lucas, who caught 6 passes for 149 yards in the game. The Hogs won 27-20 after a Tim Couch pass fell incomplete on 4th and goal at the end of regulation. Burlsworth led the Hogs' offensive line as the team rushed for 132 yards on 32 carries. Couch was taken with the 1st overall pick in the 1999 NFL draft by the Cleveland Browns.

Pictured above from left to right are Hailey O'Neal, Taylor, and Morgan Queen. The two young ladies did an outstanding job helping Taylor with his table.

Pictured above from left to right are Hailey O'Neal, Taylor, and Morgan Queen. The two young ladies did an outstanding job helping Taylor with his table.

Our table won the 2017 Celebrity of the Year Runner up.

Our table won the 2017 Celebrity of the Year Runner up.

These are all of the participants in the 2017 Clark County Relay for Life "Celebrity Waiter" event. All of their hard work made it a successful evening.

These are all of the participants in the 2017 Clark County Relay for Life "Celebrity Waiter" event. All of their hard work made it a successful evening.

According to the American Cancer Society, 1,688,780 new cancer cases and 600,920 cancer deaths are estimated to occur in 2017. That is approximately 4,630 new cases and and 1,650 deaths per day. In Arkansas alone, there are an estimated 16,080 new cancer cases expected to occur in 2017, and 6,800 deaths. You can access other important cancer information for Arkansas by clicking here. For more information about different types of cancer, click here. If you're interested in honoring a survivor or a loved one lost to cancer, or interested in helping save lives of people in your local community and elsewhere, click here. If you're interested in donating to the American Cancer Society in their fight against cancer, click here.

Visualizing Arkansas traffic fatalities, part 4

This is the latest post in a series analyzing Arkansas traffic fatalities. Please take a look at parts 1 (a map of 2015 traffic deaths), 2 (heat maps of fatalities by day from 2000-2015), and 3 (heat maps of fatalities by day of week from 2000-2015) if you haven't already.

Visualizations

Today's post is probably my favorite of this series. It piggybacks off parts 2 and 3, in that we further explore the relationship of the time of day to traffic fatalities. The first set of visualizations maps the raw number of traffic fatalities in the US by the time of day. You can click to zoom the image. Each horizontal band represents year between 2000 and 2015. Each row within the band is a day of the week, and each vertical column represents an hour of the day. From left to right (or top to bottom on small devices), you have drunk driving fatalities, non-drunk driving fatalities, and total fatalities. 

In this set of visualizations, we can clearly see two things. First, weekend evenings are very hazardous for drunk drivers. Second, we can see two distinct bands for morning and afternoon commutes for non-drunk-driving fatalities.

As I have with the earlier posts, I repeated the same analysis on Arkansas-specific wreck information. Again, the same trends appear to hold, although the bands aren't as smoothly colored (that tells us the data is a little noiser due to fewer data points). Note that this scale is different than the nationwide set. 

Code

We'll be using the same FARS data we used in the previous two posts. Let's set up our libraries, import the data into R, and get moving. For a more detailed explanation of what we're doing here, please refer to part 2.

library(foreign)
library(ggplot2) # v2.1.0.9000
library(plyr)
library(zoo)

data.dir <- "/path/to/your/dir/"

accidents_2015 <- read.dbf(paste(data.dir, "Data/FARS2015NationalDBF/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2014 <- read.dbf(paste(data.dir, "Data/FARS2014NationalDBF/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2013 <- read.dbf(paste(data.dir, "Data/FARS2013NationalDBF/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2012 <- read.dbf(paste(data.dir, "Data/FARS2012/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2011 <- read.dbf(paste(data.dir, "Data/FARS2011/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2010 <- read.dbf(paste(data.dir, "Data/FARS2010/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2009 <- read.dbf(paste(data.dir, "Data/FARS2009/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2008 <- read.dbf(paste(data.dir, "Data/FARS2008/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2007 <- read.dbf(paste(data.dir, "Data/FARS2007/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2006 <- read.dbf(paste(data.dir, "Data/FARS2006/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2005 <- read.dbf(paste(data.dir, "Data/FARS2005/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2004 <- read.dbf(paste(data.dir, "Data/FARS2004/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2003 <- read.dbf(paste(data.dir, "Data/FARS2003/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2002 <- read.dbf(paste(data.dir, "Data/FARS2002/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2001 <- read.dbf(paste(data.dir, "Data/FARS2001/accident.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2000 <- read.dbf(paste(data.dir, "Data/FARSDBF00/ACCIDENT.dbf", sep=""))[,c("STATE", "COUNTY", "HOUR", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]

accidents <- rbind(accidents_2015, accidents_2014, accidents_2013, accidents_2012, accidents_2011, accidents_2010, accidents_2009, accidents_2008, accidents_2007, accidents_2006, accidents_2005, accidents_2004, accidents_2003, accidents_2002, accidents_2001, accidents_2000)

# Subset Arkansas wrecks
# Comment out this line for nationwide analysis
accidents <- subset(accidents, STATE == 5)

Now, we need to clean the time of day data, as sometimes the midnight hour was entered as 0; other times as 24; and still other entries contained junk values like 99.

accidents <- subset(accidents, HOUR <= 24 & HOUR >= 0)
accidents$HOUR <- ifelse(accidents$HOUR == 24, 0, accidents$HOUR)

As we did with the other visualizations, we'll need to add some date columns to determine the day of week and year.

# Add date column
accidents$date <- as.Date(paste(accidents$YEAR, accidents$MONTH, accidents$DAY, sep='-'), "%Y-%m-%d")

accidents <- transform(accidents,
week = as.numeric(format(date, "%U")),
day = as.numeric(format(date, "%d")),
wday = as.numeric(format(date, "%w"))+1,
month = as.POSIXlt(date)$mon + 1,
year = as.POSIXlt(date)$year + 1900)

Next, we'll summarize the data by drunk/not drunk/all.

# Sum wrecks by drunk/not drunk/all
accidents_drunk <- accidents$DRUNK_DR > 0
accidents_not_drunk <- accidents$DRUNK_DR == 0
summary <- aggregate(FATALS ~ wday + HOUR + YEAR, accidents, sum)
summary_not_drunk <- aggregate(FATALS ~ wday + HOUR + YEAR, accidents, sum, subset=accidents_not_drunk)
summary_drunk <- aggregate(FATALS ~ wday + HOUR + YEAR, accidents, sum, subset=accidents_drunk)

data <- ddply(summary, .(wday, HOUR, YEAR), summarize, sum = sum(FATALS))
data_not_drunk <- ddply(summary_not_drunk, .(wday, HOUR, YEAR), summarize, sum = sum(FATALS))
data_drunk <- ddply(summary_drunk, .(wday, HOUR, YEAR), summarize, sum = sum(FATALS))

Let's set our max and min so that we can use the same scale across all three plots.

max <- max(c(max(data$sum), max(data_not_drunk$sum), max(data_drunk$sum)))
min <- min(c(min(data$sum), min(data_not_drunk$sum), min(data_drunk$sum)))

Next, we'll factor the days of week into human-readable format for each of the three data sets.

data$weekday<-factor(data$wday,levels=rev(1:7),labels=rev(c("S","M","T","W","Th","F","Sa")),ordered=TRUE)
data_not_drunk$weekday<-factor(data_not_drunk$wday,levels=rev(1:7),labels=rev(c("S","M","T","W","Th","F","Sa")),ordered=TRUE)
data_drunk$weekday<-factor(data_drunk$wday,levels=rev(1:7),labels=rev(c("S","M","T","W","Th","F","Sa")),ordered=TRUE)

Finally, we're done wrangling the data. Let's define a theme for the plots that's consistent with the previous two posts.

# Theme definitions
heat_map_theme <- theme(
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.spacing.x = unit(0, "points"),
panel.spacing.y = unit(1, "points"),
strip.placement = "outside",
strip.switch.pad.grid = unit(2,"points"),
strip.background = element_rect(fill="gray90", color=NA),
strip.text = element_text(color="gray5"),
axis.ticks = element_blank(),
axis.text.x = element_text(color="gray5", size=8),
axis.text.y = element_text(color="gray5", size=5),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.text = element_text(color="gray5"),
legend.title = element_text(color="gray5"),
plot.title = element_text(color="gray5", hjust=0.5),
plot.subtitle = element_text(color="gray5", hjust=0.5),
plot.caption = element_text(color="gray5", hjust=1, size=6),
panel.background = element_rect(fill="transparent", color=NA),
legend.background = element_rect(fill="transparent", color=NA),
plot.background = element_rect(fill="transparent", color=NA),
plot.margin = unit(c(0,0,0,0), "points"),
legend.key = element_rect(fill=alpha("white", 0.33), color=NA)
)

 

Now, we'll simply plot each of the three datasets and save the results.

imagedir <- "/PATH/TO/YOUR/DIRECTORY/"

# Plot and save drunk data
ggplot(data_drunk, aes(HOUR, weekday)) +
geom_tile(aes(fill=sum), na.rm = TRUE) +
facet_grid(YEAR ~ ., drop = FALSE, switch="y") +
scale_fill_gradient(name="Fatalities", low="yellow", high="red", na.value = alpha("white", 0.25), limits=c(min,max)) +
scale_x_continuous(limits=c(-0.5,24.5), breaks=c(2.5,5.5,8.5,11.5,14.5,17.5,20.5), labels=c("0300","0600","0900","Noon","1500","1800","2100"), expand = c(0,0)) +
scale_y_discrete(position="left") +
labs(title = "2000-2015 Traffic Fatalities, Nationwide", x="", y="", subtitle="by Time of Day (drunk driving only)", caption = "(based on data from NHTSA FARS: ftp://ftp.nhtsa.dot.gov/fars)") +
heat_map_theme

filename <- paste(c(imagedir, "2000-2015_fatalities_calendar_TOD (AR, drunk).png"), collapse="")
ggsave(filename, bg = "transparent")

# Plot and save not drunk data
ggplot(data_not_drunk, aes(HOUR, weekday)) +
geom_tile(aes(fill=sum), na.rm = TRUE) +
facet_grid(YEAR ~ ., drop = FALSE, switch="y") +
scale_fill_gradient(name="Fatalities", low="yellow", high="red", na.value = alpha("white", 0.25), limits=c(min,max)) +
scale_x_continuous(limits=c(-0.5,24.5), breaks=c(2.5,5.5,8.5,11.5,14.5,17.5,20.5), labels=c("0300","0600","0900","Noon","1500","1800","2100"), expand = c(0,0)) +
scale_y_discrete(position="left") +
labs(title = "2000-2015 Traffic Fatalities, Nationwide", x="", y="", subtitle="by Time of Day (excludes drunk driving)", caption = "(based on data from NHTSA FARS: ftp://ftp.nhtsa.dot.gov/fars)") +
heat_map_theme

# Save PNG file
filename <- paste(c(imagedir, "2000-2015_fatalities_calendar_TOD (AR, not drunk).png"), collapse="")
ggsave(filename, bg = "transparent")

# Plot and save all data
ggplot(data, aes(HOUR, weekday)) +
geom_tile(aes(fill=sum), na.rm = TRUE) +
facet_grid(YEAR ~ ., drop = FALSE, switch="y") +
scale_fill_gradient(name="Fatalities", low="yellow", high="red", na.value = alpha("white", 0.25), limits=c(min,max)) +
scale_x_continuous(limits=c(-0.5,24.5), breaks=c(2.5,5.5,8.5,11.5,14.5,17.5,20.5), labels=c("0300","0600","0900","Noon","1500","1800","2100"), expand = c(0,0)) +
scale_y_discrete(position="left") +
labs(title = "2000-2015 Traffic Fatalities, Nationwide", x="", y="", subtitle="by Time of Day", caption = "(based on data from NHTSA FARS: ftp://ftp.nhtsa.dot.gov/fars)") +
heat_map_theme

# Save PNG file
filename <- paste(c(imagedir, "2000-2015_fatalities_calendar_TOD (AR, all).png"), collapse="")
ggsave(filename, bg = "transparent")

Conclusion

I said at the beginning that this was probably my favorite of the three sets of visualizations. Do you agree with me that this set of visualizations is the most informative about when traffic fatalities occur?

Visualizing Arkansas traffic fatalities, Part 3

This is the latest post in a series analyzing Arkansas traffic fatalities. Please take a look at part 1 (a map of 2015 traffic deaths)  and part 2 (a heat map of all fatalities, both nationwide and in Arkansas, from 200-2015) if you haven't already.

Visualizations

Today's visualization piggybacks off part 2, in that we further explore the relationship of the day of the week to traffic fatalities, both nationwide and in Arkansas. The first set of visualizations maps the raw number of traffic fatalities in the US by the day of the week. You can click to zoom the image. Each band represents a single year between 2000 and 2015. Each row within the band is a year, and the column represents the band. From left to right (or top to bottom on small devices), you have drunk driving fatalities, non-drunk driving fatalities, and total fatalities. 

There are a couple of things that stand out here. As we saw in the previous post, weekends are far higher for drunk driving fatalities than during the week. A couple of things we couldn't easily see in the previous post is that non-drunk-driving fatalities are pretty evenly spread throughout the week. Finally, moving from top to bottom in the charts, it looks like traffic fatalities may have gone down somewhat over the past 15 years. 

As I will with the remaining posts, I repeated the same analysis on Arkansas-specific wreck information. Again, the same trends appear to hold, although the bands aren't as smoothly colored (that tells us the data is a little noiser due to fewer data points). Note that this scale is different than the nationwide set. 

Code

We'll be using the same FARS data we used in the previous two posts. Let's set up our libraries, import the data into R, and get moving. For a more detailed explanation of what we're doing here, please refer to part 2.

library(foreign)
library(ggplot2) # 2.1.0.9000
library(plyr)
library(zoo)

data.dir <- "/path/to/your/dir/"

# Read select columns from datasets
accidents_2015 <- read.dbf(paste(data.dir, "Data/FARS2015NationalDBF/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2014 <- read.dbf(paste(data.dir, "Data/FARS2014NationalDBF/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2013 <- read.dbf(paste(data.dir, "Data/FARS2013NationalDBF/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2012 <- read.dbf(paste(data.dir, "Data/FARS2012/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2011 <- read.dbf(paste(data.dir, "Data/FARS2011/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2010 <- read.dbf(paste(data.dir, "Data/FARS2010/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2009 <- read.dbf(paste(data.dir, "Data/FARS2009/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2008 <- read.dbf(paste(data.dir, "Data/FARS2008/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2007 <- read.dbf(paste(data.dir, "Data/FARS2007/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2006 <- read.dbf(paste(data.dir, "Data/FARS2006/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2005 <- read.dbf(paste(data.dir, "Data/FARS2005/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2004 <- read.dbf(paste(data.dir, "Data/FARS2004/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2003 <- read.dbf(paste(data.dir, "Data/FARS2003/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2002 <- read.dbf(paste(data.dir, "Data/FARS2002/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2001 <- read.dbf(paste(data.dir, "Data/FARS2001/accident.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]
accidents_2000 <- read.dbf(paste(data.dir, "Data/FARSDBF00/ACCIDENT.dbf", sep=""))[,c("STATE", "COUNTY", "DAY", "MONTH", "YEAR", "FATALS", "DRUNK_DR")]

# Merge all data
accidents <- rbind(accidents_2015, accidents_2014, accidents_2013, accidents_2012, accidents_2011, accidents_2010, accidents_2009, accidents_2008, accidents_2007, accidents_2006, accidents_2005, accidents_2004, accidents_2003, accidents_2002, accidents_2001, accidents_2000)

# Subset Arkansas wrecks
# Comment out the following line for nationwide chart
accidents <- subset(accidents, STATE == 5)

# Add date column
accidents$date <- as.Date(paste(accidents$YEAR, accidents$MONTH, accidents$DAY, sep='-'), "%Y-%m-%d")

# Divide and aggregate data into drunk/not drunk
accidents_drunk <- accidents$DRUNK_DR > 0
accidents_not_drunk <- accidents$DRUNK_DR == 0
summary <- aggregate(FATALS ~ date, accidents, sum)
summary_not_drunk <- aggregate(FATALS ~ date, accidents, sum, subset=accidents_not_drunk)
summary_drunk <- aggregate(FATALS ~ date, accidents, sum, subset=accidents_drunk)

Now, since this is a weekly analysis, we'll add in some information about each date itself.

# Date calculations
summary_not_drunk <- transform(summary_not_drunk,
week = as.numeric(format(date, "%U")),
day = as.numeric(format(date, "%d")),
wday = as.numeric(format(date, "%w"))+1,
month = as.POSIXlt(date)$mon + 1,
year = as.POSIXlt(date)$year + 1900)

summary_drunk <- transform(summary_drunk,
week = as.numeric(format(date, "%U")),
day = as.numeric(format(date, "%d")),
wday = as.numeric(format(date, "%w"))+1,
month = as.POSIXlt(date)$mon + 1,
year = as.POSIXlt(date)$year + 1900)

summary <- transform(summary,
week = as.numeric(format(date, "%U")),
day = as.numeric(format(date, "%d")),
wday = as.numeric(format(date, "%w"))+1,
month = as.POSIXlt(date)$mon + 1,
year = as.POSIXlt(date)$year + 1900)

This gives us the weekday and year (along with some other information we're not using here), which will form the x- and y-axis for our visualizations.

Next, we'll aggregate the data by year and day of week we created in the previous step. We'll also take the min and max so that we can use consistent scale colors across the three visualizations.

# Aggregation
data_not_drunk <- ddply(summary_not_drunk, .(wday, year), summarize, sum = sum(FATALS))
data_drunk <- ddply(summary_drunk, .(wday, year), summarize, sum = sum(FATALS))
data <- ddply(summary, .(wday, year), summarize, sum = sum(FATALS))
max <- max(c(max(data$sum), max(data_not_drunk$sum), max(data_drunk$sum)))
min <- min(c(min(data$sum), min(data_not_drunk$sum), min(data_drunk$sum)))

The next step is a user-experience step of changing the day of the week from a number to a more-familiar text abbreviation.

# Apply factors for days of week
data_not_drunk$weekday<-factor(data_not_drunk$wday,levels=1:7,labels=c("S","M","T","W","Th","F","Sa"),ordered=TRUE)
data_drunk$weekday<-factor(data_drunk$wday,levels=1:7,labels=c("S","M","T","W","Th","F","Sa"),ordered=TRUE)
data$weekday<-factor(data$wday,levels=1:7,labels=c("S","M","T","W","Th","F","Sa"),ordered=TRUE)

 

That's it for data wrangling. Now, we just need to plot the data. Again, we'll define a theme so that the charts look pretty and incorporate the same color scale.

# Define theme
heat_map_theme <- theme(
panel.grid.major.y = element_blank(),
panel.grid.minor.y = element_blank(),
panel.grid.minor.x = element_blank(),
panel.grid.major.x = element_blank(),
panel.spacing.x = unit(0, "points"),
panel.spacing.y = unit(1, "points"),
strip.background = element_rect(fill="gray90", color=NA),
strip.text = element_text(color="gray5"),
axis.ticks = element_blank(),
axis.text.x = element_text(color="gray5", size=9),
axis.text.y = element_text(color="gray5", size=9),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
legend.text = element_text(color="gray5"),
legend.title = element_text(color="gray5"),
plot.title = element_text(color="gray5", hjust=0.5),
plot.subtitle = element_text(color="gray5", hjust=0.5),
plot.caption = element_text(color="gray5", hjust=1, size=6),
panel.background = element_rect(fill="transparent", color=NA),
legend.background = element_rect(fill="transparent", color=NA),
plot.background = element_rect(fill="transparent", color=NA),
legend.key = element_rect(fill=alpha("white", 0.33), color=NA)
)

Next, we'll define a data directory to save the output.

imagedir <- "~/PATH/TO/YOUR/SAVE/DIRECTORY/Images/"

Now, we'll simply plot and save the output.

# Plot drunk and save
ggplot(data_drunk, aes(weekday, year)) +
geom_tile(aes(fill=sum), na.rm = FALSE) +
scale_fill_gradient(name="Fatalities", low="yellow", high="red", na.value = alpha("white", 0.25), limits=c(min,max)) +
scale_y_reverse(expand=(c(0,0))) +
labs(title = "2000-2015 Traffic Fatalities, Nationwide", x="", y="", subtitle="by Day of Week (drunk driving only)", caption = "(based on data from NHTSA FARS: ftp://ftp.nhtsa.dot.gov/fars)") +
heat_map_theme

filename <- paste(c(imagedir, "2000-2015_fatalities_calendar DOW (nationwide, drunk).png"), collapse="")
ggsave(filename, bg = "transparent")

# Plot not drunk and save
ggplot(data_not_drunk, aes(weekday, year)) +
geom_tile(aes(fill=sum), na.rm = FALSE) +
scale_fill_gradient(name="Fatalities", low="yellow", high="red", na.value = alpha("white", 0.25), limits=c(min,max)) +
scale_y_reverse(expand=(c(0,0))) +
labs(title = "2000-2015 Traffic Fatalities, Nationwide", x="", y="", subtitle="by Day of Week (excluding drunk driving)", caption = "(based on data from NHTSA FARS: ftp://ftp.nhtsa.dot.gov/fars)") +
heat_map_theme

filename <- paste(c(imagedir, "2000-2015_fatalities_calendar DOW (nationwide, not drunk).png"), collapse="")
ggsave(filename, bg = "transparent")

# Plot all and save
ggplot(data, aes(weekday, year)) +
geom_tile(aes(fill=sum), na.rm = FALSE) +
scale_fill_gradient(name="Fatalities", low="yellow", high="red", na.value = alpha("white", 0.25), limits=c(min,max)) +
scale_y_reverse(expand=(c(0,0))) +
labs(title = "2000-2015 Traffic Fatalities, Nationwide", x="", y="", subtitle="by Day of Week", caption = "(based on data from NHTSA FARS: ftp://ftp.nhtsa.dot.gov/fars)") +
heat_map_theme

filename <- paste(c(imagedir, "2000-2015_fatalities_calendar DOW (nationwide, all).png"), collapse="")
ggsave(filename, bg = "transparent")

Conclusion

We've seen using a couple of different metrics that drunk driving fatalities seem to occur more often on the weekend. In the next post, we'll look at another set of heat maps that break down when driving fatalities occur during the week even further: by time of day.