R changing labels in an animated map using ggplotly and geom_sf

Question

I want to create an animated map that shows the number of incidents over time in Pittsburgh, PA (by neighborhood). I can create the map, but I can't figure out how to add the name of the Neighborhood in the tooltip. This is my code so far.

library(plotly)
library(ggplot2)
library(sf)


#Downloading shapefile
download.file("http://pghgis-pittsburghpa.opendata.arcgis.com/datasets/dbd133a206cc4a3aa915cb28baa60fd4_0.zip",
              destfile = "Pittsburgh_Neighborhoods",mode = 'wb')
unzip("Pittsburgh_Neighborhoods", exdir = ".")

Neighborhoods <-  st_read("Neighborhoods_.shp") %>% 
  st_transform(crs = "+proj=longlat +datum=WGS84")

#Creating fake data
dates <- seq(as.Date('2017-01-01'),as.Date('2019-12-31'),by = "1 month")
count <- sample(1:30,3240,replace=T)
neigh <- Neighborhoods$hood

df <- merge(dates,neigh)
colnames(df) <- c("Month_Yr", "Neighborhood")
df$count <- count
df$Month_Yr <- format(df$Month_Yr, "%Y-%m") ##Changing to charch

#Merging data frame with neighborhoods layers
map_data <- merge(Neighborhoods, df, by.x = "hood", by.y = "Neighborhood")

#######Create plot with text
p_map2 <- ggplot() +
  geom_sf(data = Neighborhoods, colour = "#ffffff20", fill = "#2d2d2d60", size = .5) +
  geom_sf(data = map_data, aes(fill = count, frame = Month_Yr,
                               text = paste0(
                                 "Neighborhood: ", hood, "\n",
                                 "Month Year: ", Month_Yr, "\n",
                                 "Number of fake incidents: ", count
                               ))) +

  ggtitle("Fake incidents over time in Pittsburgh") +
  scale_fill_viridis_c(option = "magma",begin = 0.1, direction = -1) +
  theme_void() + 
  theme(axis.title.x=element_blank(), axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.title.y=element_blank(), axis.text.y=element_blank(),
        axis.ticks.y=element_blank())

#animating the map using ggplotly
pg_map2 <- p_map2 %>%
  ggplotly(tooltip = "text") %>% ##adding the text in the tooltip
  style(hoverlabel = list(bgcolor = "white"), hoveron = "fill") %>%
  plotly_build()

#for some weird reason, the map animates the polygons and not the data, correcting that... 
pg_map2$x$frames <- lapply(
  pg_map2$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

#Adding animation bar
pg_map2 %>% 
  animation_button(
    x = 1, xanchor = "right", y = 0, yanchor = "bottom"
  ) %>%
  animation_slider(
    currentvalue = list(prefix = "Month Year ", font = list(color="red"))
  )

But when I hover over the map in any neighborhood and click play or drag the slider, all the legend changes. For instance, this neighborhood should be "Central business district." Is there a way to keep the name of the neighborhood the same and only change the counts and date (if you are hovering a specific area)?

Thanks so much in advance

Answer 1

I am using R 3.6.1, plotly 4.9.1 and ggplot '3.2.1'.

My guess is that the gplotly() function is not converting the ggplot object to plotly correctly. Maybe there are some issues with sf plots and animations when converting to plotly. If you look in your pg_map2$x$frames object, you will see that each frame has a different number of elements in the data field. And I think each element is supposed to be one of the neighborhood polygons. So the number of elements should not change from one frame to the other.

I think this is the reason you are getting that weird behavior in the animation. And probably the same reason the labels are changing.

What I did was work directly in the plotly API. This seems to have solved the problem. I am filtering 5 months of data just to make the rendering lighter (it was taking some time to render the whole dataset).

# Merging data frame with neighborhoods layers and adding a column with the tip text
map_data <- merge(Neighborhoods, df, by.x = "hood", by.y = "Neighborhood") %>%
  mutate(text=paste0("Neighborhood: ", hood, "\n","Month Year: ", Month_Yr, "\n","Number of fake incidents: ", count))

map_data %>% filter(Month_Yr %in% c("2017-01", "2017-02", "2017-03", "2017-04", "2017-05")) %>%
  plot_ly(stroke = I("black"), split=~hood, color=~count, text=~text, showlegend = FALSE, hoverinfo = "text", hoveron = "fills", frame=~Month_Yr) %>%
  style(hoverlabel = list(bgcolor = "white")) %>% 
  animation_slider(currentvalue = list(prefix = "Month Year ", font = list(color="red"))) %>%
  layout(title="Fake incidents over time in Pittsburgh")

Two good tutorials for making maps in R and plotly

https://blog.cpsievert.me/2018/03/30/visualizing-geo-spatial-data-with-sf-and-plotly/

https://plotly-r.com/maps.html

Hope this helps!