R 使用 ggplotly 和 geom_sf 在动画地图中更改标签
R changing labels in an animated map using ggplotly and geom_sf
我想创建一个动画地图,显示宾夕法尼亚州匹兹堡随时间推移发生的事件数量(按街区)。我可以创建地图,但我不知道如何在工具提示中添加 Neighborhood 的名称。到目前为止,这是我的代码。
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"))
)
但是当我将鼠标悬停在任何街区的地图上并单击播放或拖动滑块时,所有图例都会发生变化。例如,这个社区应该是 "Central business district." 有没有办法让社区的名称保持不变,只更改计数和日期(如果您悬停在特定区域)?
非常感谢
我正在使用 R 3.6.1、plotly 4.9.1 和 ggplot '3.2.1'。
我的猜测是 gplotly()
函数没有正确地将 ggplot 对象转换为 plotly。转换为 plotly 时,sf 绘图和动画可能存在一些问题。如果查看 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")
在 R 和 plotly 中制作地图的两个很好的教程
https://blog.cpsievert.me/2018/03/30/visualizing-geo-spatial-data-with-sf-and-plotly/
https://plotly-r.com/maps.html
希望对您有所帮助!
我想创建一个动画地图,显示宾夕法尼亚州匹兹堡随时间推移发生的事件数量(按街区)。我可以创建地图,但我不知道如何在工具提示中添加 Neighborhood 的名称。到目前为止,这是我的代码。
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"))
)
但是当我将鼠标悬停在任何街区的地图上并单击播放或拖动滑块时,所有图例都会发生变化。例如,这个社区应该是 "Central business district." 有没有办法让社区的名称保持不变,只更改计数和日期(如果您悬停在特定区域)?
非常感谢
我正在使用 R 3.6.1、plotly 4.9.1 和 ggplot '3.2.1'。
我的猜测是 gplotly()
函数没有正确地将 ggplot 对象转换为 plotly。转换为 plotly 时,sf 绘图和动画可能存在一些问题。如果查看 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")
在 R 和 plotly 中制作地图的两个很好的教程
https://blog.cpsievert.me/2018/03/30/visualizing-geo-spatial-data-with-sf-and-plotly/
https://plotly-r.com/maps.html
希望对您有所帮助!