我已经为独立工作的输入和传单地图编写了代码，但是当我试图让它们相互依赖时出错。总的来说，我试图允许调整这 4 个滑块以提供“权重”，然后用于计算我的空间多边形数据框中的新字段。然后，我想获取更新后的文件并将其放入 Leaflet。然后我希望能够使用另一个滑块按分数进一步过滤多边形。
我已经按照这个RStudio 教程密切格式化我的代码。基本上，我使用响应式表达式进行计算，将它们定义为变量（例如 NewVar <- reactive({...})），然后尝试在数据参数的后续代码中使用该变量（例如 data = 新变量（））。当我这样做时以及当我使用 ~ 引用列时（例如 values = ~Column），我的代码会出错。但是我不能使用 $Column 来引用列，因为它现在是一个函数，而不是空间多边形数据框。我试图通过在反应函数中将函数分配给变量（例如 SPDF <- NewVar()）然后使用 values = SPDF$Column 来解决这个问题。这也是错误的（警告：<-中的错误：赋值左侧无效（NULL））和（警告：错误：试图从没有插槽的基本类（“数字”）的对象中获取插槽“数据” ）。
我在下面粘贴整个代码。如果有任何突出之处，请告诉我 - 或者帮助我了解如何从对空间多边形数据框进行计算的反应式表达式中正确调用列。
# Build UI
ui <- fluidPage(
titlePanel("UNCWI Score Evaluation"),
sidebarLayout(
sidebarPanel(
sliderInput(inputId = "weightir", label = "Weight for IR",
value = 0.19, min = 0, max = 1),
sliderInput(inputId = "weightul", label = "Weight for Upland Protection",
value = 0.31, min = 0, max = 1),
sliderInput(inputId = "weightva", label = "Weight for Vulnerable Areas",
value = 0.21, min = 0, max = 1),
sliderInput(inputId = "weightwsc", label = "Weight for WSC",
value = 0.29, min = 0, max = 1),
actionButton("run", "Run")
),
mainPanel(
leafletOutput("map"),
sliderInput("range", "Scores", min = 0.0, max= 10.0, value = as.numeric(c("0.0", "10.0")), step = 0.1),
actionButton("export", "Export Shapefile")
)
))
# Render Outputs
server <- function(input, output) {
defaultData <- eventReactive(input$run, {
# Multiply by Weights
merge.proj@data$IR_WtScore <- round(merge.proj@data$MEAN_IR_Sc*input$weightir, digits = 1)
merge.proj@data$UL_WtScore <- round(merge.proj@data$MEAN_UL_Sc*input$weightul, digits = 1)
merge.proj@data$VA_WtScore <- round(merge.proj@data$MEAN_VA_Sc*input$weightva, digits = 1)
merge.proj@data$WSC_WtScore <- round(merge.proj@data$MEAN_WSC_S*input$weightwsc, digits = 1)
# Find Total Score
merge.proj@data$Total_Score <- merge.proj@data$IR_WtScore + merge.proj@data$UL_WtScore + merge.proj@data$VA_WtScore + merge.proj@data$WSC_WtScore
})
# Plot with leaflet
# Palette for map
colorpal <- reactive({
merge.proj <- defaultData()
colorNumeric(palette = "YlOrRd",
domain = merge.proj$Total_Score)
})
# Label Option for map
labels <- reactive({
merge.proj <- defaultData()
lsprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score:</strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})
# Render Default Map
output$map <- renderLeaflet ({leaflet() %>%
merge.proj <- defaultData()
pal <- colorpal()
lab <- labels()
addTiles() %>%
addPolygons(data=merge.proj,
fillColor = ~pal(Total_Score),
weight = 1,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 3,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = lab,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto")) %>%
addLegend(position = "bottomleft",pal = pal, opacity = 0.7, values = merge.proj$Total_Score, title = "<strong>Total Score</strong>")
})
# Update map to parcel score slider
# Subset data
filteredData <- reactive({
merge.proj <- defaultData()
merge.proj[merge.proj@data$Total_Score >= input$range[1] & merge.proj@data$Total_Score <= input$range[2],]
})
# New Palette
colorpal2 <- reactive({
merge.proj <- filteredData()
colorNumeric(palette = "YlOrRd",
domain = merge.proj$Total_Score)
})
# Label Option
labels2 <- reactive({
merge.proj <- filteredData()
sprintf("<strong>Parcel ID: </strong>%s<br/><strong>Total Score: </strong>%g", merge.proj$PARCEL_ID, merge.proj$Total_Score) %>% lapply(htmltools::HTML)
})
#Leaflet Proxy
observe({
merge.proj <- filteredData()
pal2 <- colorpal2()
lab2 <- labels2()
leafletProxy("map", data = filteredData()) %>%
clearShapes() %>%
addPolygons(
fillColor = ~pal2(Total_Score),
weight = 1,
opacity = 1,
color = "white",
dashArray = "3",
fillOpacity = 0.7,
highlight = highlightOptions(
weight = 3,
color = "#666",
dashArray = "",
fillOpacity = 0.7,
bringToFront = TRUE),
label = lab2,
labelOptions = labelOptions(
style = list("font-weight" = "normal", padding = "3px 8px"),
textsize = "15px",
direction = "auto"))
})
#Update Legend
observe({
proxy <- leafletProxy("map", data = filteredData())
pal2 <- colorpal2()
proxy %>% clearControls()
proxy %>% addLegend(position = "bottomleft",pal = pal2, opacity = 0.7, values = ~Total_Score, title = "<strong>Total Score</strong>")
})
# Export new shapefile
observeEvent(input$export, {
merge.proj <- filteredData()
writeOGR(merge.proj, dsn = "Data", layer = "UNCWI_Output", driver = "ESRI Shapefile")
})
}
shinyApp(ui = ui, server = server)