R 基于输入选择的交互式地图显示颜色

R 基于输入选择的交互式地图显示颜色,r,shiny,shiny-server,R,Shiny,Shiny Server,我正在尝试制作一个闪亮的应用程序来显示一些空间数据。以下是我的数据摘录: polygon id country ctry ctry_id period category sub_category value 1 11011 1 11 ctry_a 11 1 practice_a subpractice_aa 1 2 11011 1 11 ctry_a 11 1 practice_a subpracti

我正在尝试制作一个闪亮的应用程序来显示一些空间数据。以下是我的数据摘录:

  polygon id country   ctry ctry_id period   category   sub_category value
1   11011  1      11 ctry_a      11      1 practice_a subpractice_aa     1
2   11011  1      11 ctry_a      11      1 practice_a subpractice_ab     1
3   11011  1      11 ctry_a      11      1 practice_a subpractice_ac     0
4   11011  1      11 ctry_a      11      1 practice_b subpractice_ba     0
5   11011  1      11 ctry_a      11      1 practice_b subpractice_bb     1
6   11011  1      11 ctry_a      11      1 practice_b subpractice_bc     1
我的目标是上色,当组合多边形/国家/时期/类别/子类别等于0时表示红色,当组合多边形/国家/时期/类别/子类别等于1时表示绿色。我想让它具有交互性,这样我就可以从菜单中更改一个类别,直接获得与新组合相关的值的颜色

我试过以下方法。不幸的是,以observeEvent{input$selectSubPractice}{开头的部分似乎会导致问题

谢谢你的帮助

# UI
ui <- fluidPage(
  sidebarLayout(
  sidebarPanel(
    selectInput("countrySelect", "Select Country",
              choices = unique(shapefile$ctry)),
    selectInput("countryPeriod", "Select Period",
                choices = "", selected = ""),
    selectInput("selectPractice", "Select Practice",
                choices = "", selected = ""),
    selectInput("selectSubPractice", "Select Sub Practice",
                choices = "", selected = "")),                               
  mainPanel(
  leafletOutput("mymap",
    height = 500)
  )
)
)

# Server
server <- function(input, output, session) {
 
 observeEvent(
   input$countrySelect,
   updateSelectInput(session, "countryPeriod", "Select Period",
                     choices = unique(shapefile$period[shapefile$ctry==input$countrySelect]),
                     selected = shapefile$period[1])
 ) 
 
 observeEvent(
   input$countryPeriod,
   updateSelectInput(session, "selectPractice", "Select Practice",
                     choices = unique(shapefile$category[shapefile$ctry==input$countrySelect & shapefile$period==input$countryPeriod],
                     selected = shapefile$category[1])
 )) 
 
 observeEvent(
   input$selectPractice,
   updateSelectInput(session, "selectSubPractice", "Select Sub Practice",
                     choices = unique(shapefile$sub_category[shapefile$category==input$selectPractice 
                                    & shapefile$ctry==input$countrySelect
                                    & shapefile$period==input$countryPeriod],
                                      selected = shapefile$category[1])
   )) 
 
  output$mymap <- renderLeaflet({
    leaflet() %>% 
      addProviderTiles(providers$Stamen.TonerLite,
                       options = providerTileOptions(noWrap = TRUE)) %>%
      setView(mean(shapefilebounds[1,]),
              mean(shapefilebounds[2,]),
              zoom=6)
  }
  )
  
  observeEvent({input$selectSubPractice},{
    pal <- colorBin("YlOrRd", shapefile$value[shapefile$sub_category==input$selectSubPractice 
                                            & shapefile$category==input$selectPractice
                                            & shapefile$period==input$countryPeriod
                                            & shapefile$ctry==input$countrySelect],
                                            bins=2, na.color = "#bdbdbd")
  leafletProxy("mymap", data = shapefile) %>%
    addTiles() %>% 
    clearShapes() %>% 
    addPolygons(data = shapefile, fillColor = ~pal(value), fillOpacity = 0.7, 
                color = "white", weight = 2)
  })  
}

shinyApp(ui, server)