A heat map animation of daily deaths

Viewed 382

I have a data frame that has columns Region, Date, and Deaths, and I've imported the package "maps" and its 50 state map.

All of the examples I've seen ask me to merge() the data with the map. However, when I do this merging, I manage to end up with an object of over 4 million rows.

The daily data is in melted8 and then melted9.

Because of the huge size of the merge(), the animate() step takes a long time to run... in fact I cut it short after 10 minutes. I do not know if my ggplot() is correctly made, but it is also huge (240 mb).

Is there a more reasonably-sized object I could give to ggplot(), and am I giving ggplot() the right instructions?

# a sample
melted8[sample(nrow(melted8), 5), ]

region      date    deaths
<chr>       <int>   <dbl>
arizona     214 7.2815030
missouri    287 0.0000000
arkansas    160 0.3313668
mississippi 53  0.0000000
new jersey  300 0.7880939
library(ggplot2)
library(gganimate)
library(maps)

us.map <- map_data("state")      #50 state map from library(maps)
melted9 <- merge(us.map, melted8, by="region", all.x=T)

d <- ggplot(melted9) +
  geom_polygon(aes(long,lat, group = group), color='white', fill=NA, data=us.map) +
  geom_polygon(aes(long,lat, group = group, fill = deaths), color = "white") +
  scale_fill_gradient(low = "gray65", high = "red") +
  labs(title = "Deaths per Day") +
  ease_aes("linear")

a <- animate(d, duration = 30, nframes = nrow(melted9)/50, end_pause = 5)
a
1 Answers

You don't have to merge the dataset with the map file, if you use geom_map instead of geom_polygon.

See if this is faster for you:

layer_type.GeomMap <- function(x) 'point' # must run this line first

melted8 %>%
  ggplot(aes(fill = deaths, map_id = region)) +
  geom_map(map = us.map) +
  expand_limits(x = us.map$long, y = us.map$lat) +
  coord_fixed() +
  scale_fill_gradient(low = "gray65", high = "red") +
  theme(legend.position = "bottom") +
  labs(title = "Deaths per Day: {closest_state}",
       x = "lon", y = "lat") +
  transition_states(date)

result

Dataset used (simulating 7 days of records for each state):

library(dplyr)

set.seed(123)
melted8 <- data.frame(region = unique(us.map$region)) %>%
  mutate(date = list(seq(1, 7))) %>%
  tidyr::unnest(cols = c(date)) %>%
  group_by(region) %>%
  mutate(deaths = abs(rnorm(n()))) %>%
  ungroup()
Related