Question

我想创建一个交互式的等值线图，这样当我将鼠标悬停在某个区域时，它会显示一个Count和我正在悬停的Region区域的名称。我正在使用的数据集可以在这里快速下载。 {{3}}

这是我的目标。

library(ggplot2)
library(rgdal)
utah <- readOGR(dsn= "PATH/HealthDistricts2015.shp", layer = "HealthDistricts2015")
utah@data$id = rownames(utah@data)
utah.points = fortify(utah, region="id")
utah.df = inner_join(utah.points, utah@data, by="id")

colnames(utah.df)[8] = "Region"
UDist <- sort(unique(as.character(utah.df$Region)))
RegionS = data.frame(Region = UDist, Count = sample(1:length(UDist)))

PlotData <- left_join(utah.df, RegionS, b = "Region")


ggplot(PlotData, aes(long,lat,group=group,fill=Count)) +
    geom_polygon() +
    geom_path(color="black") +
    coord_equal() + 
    theme_bw() +
    theme(axis.text.x=element_blank(),
        axis.ticks.x=element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major = element_line(colour = "white")
        ) +
    xlab("") +
    ylab("")

这段代码给了我一个很好的等值线图，但我想添加悬停功能。我尝试使用ggplotly()，但它没有给我一个很好的情节。我试图弄清楚如何使用plot_ly()绘制此图，但无法到达任何地方。有没有办法可以创建这样的情节，但是当我悬停显示“Count”和“Region”时？

Answer 1

您可以将mapbox与Plotly一起使用。

首先转换ArcGIS shape文件的坐标

lat_lon <- spTransform(utah, CRS("+proj=longlat +datum=WGS84"))

接下来将数据转换为GeoJSON对象

utah_geojson <- geojson_json(lat_lon)
geoj <- fromJSON(utah_geojson)

然后将每个区域添加为单独的图层

for (i in 1:length(geoj$features)) {
  all_layers[[i]] = list(sourcetype = 'geojson', 
                         source = geoj$features[[i]], 
                         type = 'fill',
                         )
}
p %>% layout(mapbox = list(layers = all_layers))

对于hoverinfo，我们只为每个区的质心添加一个点

p <- add_trace(p, 
               type='scattergeo',
               x = lat_lon@polygons[[i]]@labpt[[1]],
               y = lat_lon@polygons[[i]]@labpt[[2]],
               showlegend = FALSE,
               text = lat_lon@data[[1]][[i]],
               hoverinfo = 'text',
               mode = 'markers'
               )

完整代码

library(rgdal)
library(geojsonio)
library(rjson)
library(plotly)

Sys.setenv('MAPBOX_TOKEN' = 'secret_token')

utah <- readOGR(dsn= "HealthDistricts2015.shp", layer = "HealthDistricts2015")
lat_lon <- spTransform(utah, CRS("+proj=longlat +datum=WGS84"))
utah_geojson <- geojson_json(lat_lon)
geoj <- fromJSON(utah_geojson)
all_layers <- list()

my_colors <- terrain.colors(length(geoj$features))

p <- plot_mapbox()
for (i in 1:length(geoj$features)) {
  all_layers[[i]] = list(sourcetype = 'geojson', 
                         source = geoj$features[[i]], 
                         type = 'fill',
                         color = substr(my_colors[[i]], 1, 7),
                         opacity = 0.5
                         )
  p <- add_trace(p, 
                 type='scattergeo',
                 x = lat_lon@polygons[[i]]@labpt[[1]],
                 y = lat_lon@polygons[[i]]@labpt[[2]],
                 showlegend = FALSE,
                 text = lat_lon@data[[1]][[i]],
                 hoverinfo = 'text',
                 mode = 'markers'
                 )


}

p %>% layout(title = 'Utah',
             mapbox = list(center= list(lat=38.4, lon=-111),
                           zoom = 5.5,
                           layers = all_layers)

             )

使用Plotly在R中的等值线图

1 个答案: