Question

Я хочу создать анимированную карту, которая показывает количество инцидентов с течением времени в Питтсбурге, штат Пенсильвания (по районам). Я могу создать карту, но не могу понять, как добавить название Соседства во всплывающую подсказку. Пока это мой код.

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"))
  )

Но когда я наведите курсор на карту в любом районе и нажмете кнопку воспроизведения или перетащите ползунок, все легенды изменятся. Например, этот район должен быть «Центральный деловой район». Есть ли способ сохранить название района одинаковым и изменить только количество и дату (если вы наводите указанную область c)?

Большое спасибо заранее

kikoralston · Answer 1 · 09 января 2020

Я использую R 3.6.1, график 4.9.1 и ggplot '3.2.1'.

Я предполагаю, что функция gplotly() не преобразует объект ggplot в график правильно. Может быть, есть некоторые проблемы с sf графиками и анимацией при конвертации в plotly. Если вы посмотрите на свой pg_map2$x$frames объект, вы увидите, что каждый кадр имеет различное количество элементов в поле данных. И я думаю, что каждый элемент должен быть одним из полигонов соседства. Поэтому количество элементов не должно меняться от одного кадра к другому.

Я думаю, что по этой причине вы получаете такое странное поведение в анимации. И, вероятно, по той же причине ярлыки меняются.

То, что я сделал, работало непосредственно в сюжетном API. Кажется, это решило проблему. Я фильтрую данные за 5 месяцев только для того, чтобы сделать рендеринг легче (для рендеринга всего набора данных потребовалось некоторое время).

# 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")

enter image description here