尝试使用反应式表达式更新空间多边形数据框

问题描述 投票：0回答：2

我已经为独立工作的输入和传单地图编写了代码，但当我尝试让它们相互依赖时出错。总的来说，我试图允许调整这 4 个滑块以提供“权重”，然后将其用于计算空间多边形数据框中的新字段。然后我想将更新后的文件放入 Leaflet 中。然后我希望能够使用另一个滑块按分数进一步过滤多边形。

我严格按照这个RStudio教程来格式化我的代码。基本上，我使用反应式表达式来进行计算，将它们定义为变量（例如 NewVar <- reactive({...})), and then trying to use that variable in subsequent code in the data argument (eg data = NewVar()). My code would error when I did that and also when I referred to columns with ~ (eg values = ~Column). But I couldn't refer to columns using $Column because it is a function now, not a Spatial Polygon DataFrame. I tried to fix this by, within the reactive function, assigning the function to a variable (eg SPDF <- NewVar()) and then using values = SPDF$Column. That is also erroring (Warning: Error in <-: invalid (NULL) left side of assignment) and (Warning: Error in : trying to get slot "data" from an object of a basic class ("numeric") with no slots).

我将完整代码粘贴在下面。如果有什么突出的情况，请告诉我 - 或者帮助我了解如何从对空间多边形数据框进行计算的反应式表达式中正确调用列。 

# 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)
r shiny reactive r-leaflet
2个回答
1
投票

我通过将 leaflet() %>% 移动到代码的 renderLeaflet({}) 部分中定义变量的位置下方来使代码正常工作。见下图：

# 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 ({
        merge.proj <- defaultData()
        pal <- colorpal()
        lab <- labels()
  leaflet() %>% 
  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)
0
投票

这是我以前见过的问题。基本上，最推荐的闪亮设计模式虽然简单易懂，但会导致这些死胡同。我更喜欢使用 

reactiveValues
来解决这个问题，因为这可以为您提供所需的灵活性。

我无法使用您的代码，因为它不是完整的示例（

merge.proj
未在任何地方定义）。

但是我修改了你说的“密切关注”的例子来使用

reactiveValues
，这样你就可以明白我的意思了。

library(shiny)
library(leaflet)

r_colors <- rgb(t(col2rgb(colors()) / 255))
names(r_colors) <- colors()

ui <- fluidPage(
  leafletOutput("mymap"),
  p(),
  actionButton("recalc", "New points")
)

server <- function(input, output, session) {

  # initialize our leaflet map into a reactive value
  rv <- reactiveValues(lmap=leaflet() %>% addProviderTiles(providers$Stamen.TonerLite,
                                          options = providerTileOptions(noWrap = TRUE))

  points <- eventReactive(input$recalc, {
     cbind(rnorm(40) * 2 + 13, rnorm(40) + 48)

     # now modify our leaflet map with our new points
     # note we could do anything with our map, we have access to all its columns
     rv$lmap <- addMarkers(rv$lmap,data=points())
  }, ignoreNULL = FALSE)

  output$mymap <- renderLeaflet({
     # reactively render the map when it changes
     rv$lmap
  })
}

shinyApp(ui, server)

逻辑比仅使用纯反应值更复杂，但我发现它会带来更灵活的结构。

在您的情况下，您需要将 

merge.proj
初始化到该 
reactiveValues
列表中（我认为）。另请注意，该列表中可以有多个元素，它们非常灵活。

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.