r语言 - Drawing Polygons with leaflet in shiny?

Question

我有一个美国月平均气温的地理空间数据集。我想在一个闪亮的应用程序中显示这张传单地图。随着时间滑块，用户应该能够选择每个月的可视化。

当我试图用我在网上找到的代码运行我的数据时，我遇到了许多问题，不幸的是，我不知道究竟需要哪些数据。

Wetransfer我上传数据集数据。

关于数据集的相关信息:我希望滑块通过"Valid_Seas"列(按美国部分地区分列的月值)或"值"。多边形(列:Geometry)应该用"Prob"列着色，这是月平均温度。

关于r.s cript:从第215行开始，我尝试创建ShinyApp地图，就像您可以在这里看到的那样:

ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style="z-index:500;", # legend over my map (map z = 400)
tags$h3("Average Temperature"), 
sliderInput("periode", "Months 2021",
min(tempyear21$values),
max(tempyear21$values),
value = range(tempyear21$values),
step = 1,
sep = ""
)
)
)
#bis hier hin stimmt es 
server <- function(input, output, session) {

# reactive filtering data from UI

reactive_data_chrono <- reactive({
tempyear21 %>%
filter(Valid_Seas >= input$periode[1] & Valid_Seas <= input$periode[2])
})


# static backround map
output$map <- renderLeaflet({
leaflet(tempyear21) %>%
addTiles() %>%
fitBounds(-49.57,24.91,-166.99,68.00)
})  

# reactive circles map
observe({
leafletProxy("map", data = reactive_data_chrono()) %>%
clearShapes() %>%
addMarkers(lng=~lng,
lat=~lat,
layerId = ~id) # Assigning df id to layerid
})
}
shinyApp(ui, server)

我非常期待任何建议。亲切的问候

佩妮

Answer 1

我发现你的代码有三个问题。首先，您的输入滑块返回数字，而您的数据集列Valid_Seas是字符("Jan 2021"等)。因此，在应用filter之后，数据集将减少到零行。最好用values列代替。

其次,如果你想显示逐月,你应该只通过一个数字作为value参数sliderInput,像

ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style="z-index:500;", # legend over my map (map z = 400)
tags$h3("Average Temperature"), 
sliderInput("periode", "Months 2021",
min(tempyear21$values),
max(tempyear21$values),
value = min(tempyear21$values), # !
step = 1,
animate=TRUE, # add play button
sep = ""
)
)
)

否则，您将得到几个月的叠加。

第三个问题:你的数据集有多边形，在你的服务器函数你使用addMarkers。您需要使用addPolygons代替。为了填充多边形，需要为每个数字确定一种颜色。classInt和RColorBrewer包可以帮助您:

library(classInt)
library(RColorBrewer)
n <- 3 # number of categories
pal <- RColorBrewer::brewer.pal(n, "Reds")
ivar <- classInt::classIntervals(
tempyear21$Prob, n=n, style="quantile"
) 
tempyear21$colcode <- classInt::findColours(ivar, pal)
legend_names <- names(attr(tempyear21$colcode, "table"))

关于服务器功能，我认为你的leafletProxy是正确的。

server <- function(input, output, session) {        
# static map elements
output$map <- renderLeaflet({
leaflet() |> addTiles() |> 
fitBounds(-49.57,24.91,-166.99,68.00) |>
addLegend(position="topleft", colors=pal, labels=legend_names)
})

# map handler
map_proxy <- leafletProxy("map", session)

# react on slider changes
observeEvent(input$periode, {
dat <- subset(tempyear21, values == input$periode)
map_proxy |> leaflet::clearShapes() |>
leaflet::addPolygons(
data=dat,
weight=1,
color=dat$colcode, # border
opacity=1,
fillColor=dat$colcode 
) 
})  
}