根据反应值添加

时间:2018-09-21 08:31:58

标签: r shiny react-leaflet shiny-reactivity

我希望能够根据用户输入在我的交互式地图应用程序上添加图例功能,以便当他选择输入范围时,颜色映射会根据所选条件而变化。您可以与该应用程序here进行交互特别是使用交互式映射选项卡。我希望能够从颜色映射选项卡中应用该概念。 这是代码片段:

ui<-fluidPage(
 tabItem(
        tabName = "map2",
        h3("INTERACTIVE MAP"),
        fluidPage(

          title = "MAP DISPLAY",status = "primary",solidHeader = TRUE,
          leafletOutput("leaf2",height = 500),





          #h2("USER EXPLORER",style="color:#3474A7"),
          fluidRow(
            column(6,
                   #slider input for population per km2  
                   sliderInput(inputId = "pop2",
                               label = "Population Per km2:",
                               min = min(mp@data$PpDnsty,na.rm =T),
                               max = max(mp@data$PpDnsty,na.rm =T),
                               value = c(min(mp@data$PpDnsty,na.rm =T),
                                         max(mp@data$PpDnsty,na.rm =T))
                   ),
                   #slider input for piped water on plot  
                   sliderInput(inputId = "pw2",
                               label = "Piped Water On Plot:",
                               min = min(mp@data$PpdWtrP,na.rm =T),
                               max = max(mp@data$PpdWtrP,na.rm =T),
                               value = c(min(mp@data$PpdWtrP,na.rm =T),
                                         max(mp@data$PpdWtrP,na.rm =T))
                   )),
            column(6,
                   #slider input for water source on plot  
                   sliderInput(inputId = "ws",
                               label = "Water Source On Plot:",
                               min = min(mp@data$WtrSrOP,na.rm =T),
                               max = max(mp@data$WtrSrOP,na.rm =T),
                               value = c(min(mp@data$WtrSrOP,na.rm =T),
                                         max(mp@data$WtrSrOP,na.rm =T))
                   ),

                   #slider input for flush toilets  
                   sliderInput(inputId = "ft",
                               label = "Flush Toilets:",
                               min = min(mp@data$FlshTlt,na.rm =T),
                               max = max(mp@data$FlshTlt,na.rm =T),
                               value = c(min(mp@data$FlshTlt,na.rm =T),
                                         max(mp@data$FlshTlt,na.rm =T))
                   ))),
          fluidRow(
            column(6,

                   #slider input for Other Improved
                   sliderInput(inputId = "om",
                               label = "Other Improved:",
                               min = min(mp@data$OthrImp,na.rm =T),
                               max = max(mp@data$OthrImp,na.rm =T),
                               value = c(min(mp@data$OthrImp,na.rm =T),
                                         max(mp@data$OthrImp,na.rm =T))
                   ),

                   #slider input for unimproved
                   sliderInput(inputId = "um",
                               label = "Unimproved:",
                               min = min(mp@data$Unmprvd,na.rm =T),
                               max = max(mp@data$Unmprvd,na.rm =T),
                               value = c(min(mp@data$Unmprvd,na.rm =T),
                                         max(mp@data$Unmprvd,na.rm =T))
                   )
            ),
            column(6,

                   #slider input for open defecation
                   sliderInput(inputId = "od",
                               label = "Open Defecation:",
                               min = min(mp@data$OpnDfct,na.rm =T),
                               max = max(mp@data$OpnDfct,na.rm =T),
                               value = c(min(mp@data$OpnDfct,na.rm =T),
                                         max(mp@data$OpnDfct,na.rm =T))
                   ),

                   #slider input for elevation
                   sliderInput(inputId = "el",
                               label = "Elevation:",
                               min = min(mp@data$elevation,na.rm =T),
                               max = max(mp@data$elevation,na.rm =T),
                               value = c(min(mp@data$elevation,na.rm =T),
                                         max(mp@data$elevation,na.rm =T))
                   )
            )

          )









        )
        )


      )

server<-function(input,output){

#sliderinput reactive function for all numeric input options
  sld<-reactive({
    subset(mp,mp@data$PpDnsty>=input$pop2[1]&
             mp@data$PpDnsty<=input$pop2[2]&
             mp@data$PpdWtrP>=input$pw2[1]&
             mp@data$PpdWtrP<=input$pw2[2]&
             mp@data$WtrSrOP>=input$ws[1]&
             mp@data$WtrSrOP<=input$ws[2]& 
             mp@data$FlshTlt>=input$ft[1]&
             mp@data$FlshTlt<=input$ft[2]&
             mp@data$OthrImp>=input$om[1]&
             mp@data$OthrImp<=input$om[2]&
             mp@data$Unmprvd>=input$um[1]&
             mp@data$Unmprvd<=input$um[2]&
             mp@data$OpnDfct>=input$od[1]&
             mp@data$OpnDfct<=input$od[2]&
             mp@data$elevation>=input$el[1]&
             mp@data$elevation<=input$el[2]

    )

  })
#Base map(default)

  output$leaf2<-renderLeaflet({



    leaflet(mp) %>%

      #Initializing the map
      # setView(lng=36.092245, lat=-00.292115,zoom=15)%>%

      #default map
      #Add default OpenStreetMap map tiles
      addTiles()%>%

      # addProviderTiles("Esri.NatGeoWorldMap",group = "default")%>%  
      #addProviderTiles("CartoDB.Positron",group = "custom")%>%

      #nakuru lias polygons
      addPolygons(
        data = mp,
        fillColor = "blue",
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        highlightOptions = highlightOptions(
          weight = 2,
          color = "red",
          fillOpacity = 0.7,
          bringToFront = TRUE
        ),
        label =~LIA,
        popup = ~paste("<strong>Area Type:</strong>",AreaTyp,
                       "<br>",
                       "<strong>Piped Water On Plot:</strong>",PpdWtrP,"%",
                       "<br>",
                       "<strong>Water Source On Plot:</strong>",WtrSrOP,"%",
                       "<br>",
                       "<strong>Flash Toilets:</strong>",FlshTlt,"%",
                       "<br>",
                       "<strong>Other Improved:</strong>",OthrImp,"%",
                       "<br>",
                       "<strong>Unimproved:</strong>",Unmprvd,"%",
                       "<br>",
                       "<strong>Open Defecation:</strong>",OpnDfct,"%",
                       "<br>",
                       "<strong>Population Per km2:</strong>",PpDnsty,
                       "<br>",
                       "<strong>Elevation:</strong>",elevation,"m"
        )

      ) 




  })
#observe function for slider input numeric options
  observe({

    #color mapping function
    #pal1<-colorNumeric(palette = "magma",mp$PpDnsty)
    #pal1 <- colorBin("plasma",lias$PpDnsty, 15, pretty = TRUE)
    #pal1<- colorBin("Blues", lias$PpDnsty, 2, pretty = FALSE)


    leafletProxy("leaf2",data=sld()) %>%

      #Initializing the map
      #setView(lng=36.092245    , lat=-00.292115,zoom=10)%>%
      # clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        highlightOptions = highlightOptions(
          weight = 2,
          color = "red",
          fillOpacity = 0.7,
          bringToFront = TRUE
        ),
        label =~LIA,
        popup = ~paste("<strong>Area Type:</strong>",AreaTyp,
                       "<br>",
                       "<strong>Piped Water On Plot:</strong>",PpdWtrP,"%",
                       "<br>",
                       "<strong>WaterSource On Plot:</strong>",WtrSrOP,"%",
                       "<br>",
                       "<strong>Flash Toilets:</strong>",FlshTlt,"%",
                       "<br>",
                       "<strong>Other Improved:</strong>",OthrImp,"%",
                       "<br>",
                       "<strong>Unimproved:</strong>",Unmprvd,"%",
                       "<br>",
                       "<strong>Open Defecation:</strong>",OpnDfct,"%",
                       "<br>",
                       "<strong>Population Per km2:</strong>",PpDnsty,
                       "<br>",
                       "<strong>Elevation:</strong>",elevation,"m"

        )

      )
  })

}

shinyApp(ui,server)

0 个答案:

没有答案