gpt4 book ai didi

r - 自更新以来未在传单 r map 中绘制多边形

转载 作者:行者123 更新时间:2023-12-01 00:15:21 25 4
gpt4 key购买 nike

我有一个 Shiny 的应用程序,其中有一个带有两个不同多边形的传单 map 。传单 map 运行良好,直到我将传单包更新到 2.0.1。现在,当我运行应用程序时……多边形没有被绘制出来,也没有向我抛出任何错误。我环顾四周,没有发现任何可以解决我的问题的方法。如果有人能给我一些指导或指出正确的方向,我将不胜感激!

访问 shapefile 的链接:
https://drive.google.com/drive/folders/1bPHrAu6Wae1y5uiZCsSMtSi6Rja157bj?usp=sharing

代码:

library(shiny)
library(shinydashboard)
library(leaflet)
library(sf)
library(rmapshaper)
### Read in shapefiles ###
NJ_Map_Road<-st_read(getwd(),layer="2014_NJ_Integrated_Report_AU")
Impaired_HUCS<-st_read(getwd(),layer = "Impaired_HUCS_Shapefile")
### Change projection to work with leaflet ###
map_df <- st_transform(NJ_Map_Road, crs="+init=epsg:4326")
map_impaired_df<-st_transform(Impaired_HUCS,crs="+init=epsg:4326")
###########################################################################################
### simplify shapefiles ###
map_df<-ms_simplify(map_df)
map_impaired_df<-ms_simplify(map_impaired_df)
###########################################################################################
### This drop Z and M dimensions
good_map_df<- st_zm(map_df, drop = T, what = "ZM")
good_imp_map_df<- st_zm(map_impaired_df, drop = T, what = "ZM")
#################################################################

ui<- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
box(width=12,leafletOutput("leaf"))))
### Server ###
server<- function(input,output,session){
### This creates interactive map ###
output$leaf<- renderLeaflet({
leaflet(options = leafletOptions(minZoom = 7))%>%
addTiles()%>%
addTiles(group = "OSM (default)") %>%
addProviderTiles(providers$OpenStreetMap.BlackAndWhite, group = "Grey") %>%
addProviderTiles(providers$Esri.WorldImagery, group = "Satellite") %>%
setView(lng = -74.4 ,lat =40, zoom = 7)%>%
addPolygons(data= good_map_df,color = "#636060",weight = 1,smoothFactor = 1,
opacity = 0.5, fillOpacity = 0.1,group = "HUCs",fillColor = "white",
highlightOptions = highlightOptions(color = "blue",
weight = 2,bringToFront = TRUE))%>%

addPolygons(data = good_imp_map_df,color = "#F3161B",weight = 1,smoothFactor = 1,
opacity = 0.5, fillOpacity = 2,
group = "Impaired HUCs",
highlightOptions = highlightOptions(color = "blue",
weight = 2,bringToFront = TRUE),
label = ~ paste(HUC14TXT,AU_name),
layerId = ~ good_imp_map_df$AU_name)%>%
addLayersControl(
baseGroups = c("OSM (default)", "Grey", "Satellite"),
overlayGroups = c("HUCs","Impaired HUCs"),
options = layersControlOptions(collapsed = FALSE))%>%
addLegend("bottomright",colors = c("#636060","#F3161B"),opacity = 2,
labels = c("HUC14s","Impaired HUCs"))
})
###########################################################################################
### Allows user to have map zoomed in when impaired HUC is clicked ###
observe({
click <- input$leaf_shape_click
if(is.null(click))
return()
else
leafletProxy("leaf")%>%
setView(lng = click$lng , lat = click$lat, zoom=10)
})

}

shinyApp(ui,server)

最佳答案

再挖一点,问题似乎与ms_simplify()有关。向几何列添加名称:

polys_sf<-st_read(system.file("shape/nc.shp", package="sf") ) %>% 
st_transform(crs="+init=epsg:4326") %>%
ms_simplify(.)

names(st_geometry(polys_sf))

[1] "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20" "21" "22" "23" "24" "25"
[27] "26" "27" "28" "29" "30" "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45" "46" "47" "48" "49" "50" "51"
[53] "52" "53" "54" "55" "56" "57" "58" "59" "60" "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72" "73" "74" "75" "76" "77"
[79] "78" "79" "80" "81" "82" "83" "84" "85" "86" "87" "88" "89" "90" "91" "92" "93" "94" "95" "96" "97" "98" "99"

正如 https://github.com/r-spatial/sf/issues/880#issuecomment-435304536 中所建议的,删除名称将解决问题。因此,这有效:
library(shiny)
library(shinydashboard)
library(leaflet)
library(sf)
library(rmapshaper)
### Read in shapefiles ###
polys_sf<-st_read(system.file("shape/nc.shp", package="sf") ) %>%
st_transform(crs="+init=epsg:4326") %>%
ms_simplify(.)

names(st_geometry(polys_sf)) = NULL

ui<- dashboardPage(
header = dashboardHeader(),
sidebar = dashboardSidebar(),
body = dashboardBody(
box(width=12,leafletOutput("leaf"))))
### Server ###
server<- function(input,output,session){
### This creates interactive map ###
output$leaf<- renderLeaflet({
leaflet(options = leafletOptions(minZoom = 7))%>%
addPolygons(data= polys_sf)
})
}

shinyApp(ui,server)

, 而如果你注释掉 names(st_geometry(polys_sf)) = NULL line 多边形未显示。

哼!

(顺便说一句,作为旁注/建议:基于“R”包中可用的“测试”数据集构建一个最小的可重现示例可以帮助查明问题并允许其他人轻松重现/理解它。

关于r - 自更新以来未在传单 r map 中绘制多边形,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/53227205/

25 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com