显示/隐藏传单中的分组图层

时间:2018-08-27 14:39:13

标签: r shiny leaflet

我正在使用反应式和观察功能显示/隐藏图层,但是颜色功能似乎覆盖了反应式功能中的if语句。我想将我的图层分组(WatersourceOnPlot和PipedWateronPlot作为WaterAccess,然后将FlushToilets,OtherImproved,Unimproved和Open Defecation作为卫生),并能够使用颜色功能隐藏/显示图层。代码存在的问题是,我必须为每个图层创建一个selectInput才能使颜色映射起作用。当我将两个项目放在一个selectInput上时,第一个项目在进行颜色映射时会覆盖另一个项目。DOWNLOAD SHAPE FILE HERE

可复制的示例:

#loading libraries
library(shiny)
library(leaflet)
library(rgdal)

#loading shape file
mp<-readOGR(
  dsn="merge",
  layer="m1")

#Remove NAs from AreaType col
mp<-mp[!is.na(mp$AreaTyp),]

#ui
ui<-fluidPage(
  leafletOutput("map"),
  selectInput(inputId = "pop",
              label = " POPULATION:",
              choices = list(
                "All"=1,
                "Population Per Km2"=4
                #"< 15,000"=2
                # "15,001 - 30,000"=3 ,
                # ">30,001"=1
              )
  ),

  selectInput(inputId = "area1", 
              label = " AreaType:",
              choices = c(
                "All",

                unique(as.character(mp$AreaTyp))
              ) 
  ),
  selectInput(
    inputId = "pw",
    label = "Water Type:",
    choices = c(
      "All"=1,
      "Piped Water On Plot"=2,
      "Water source On Plot"=3
    )
  ),
  selectInput(
    inputId = "ws",
    label = "Water Type2:",
    choices = c(
      "All"=1,
      "Water source On Plot"=2
    )
  ),
  selectInput(
    inputId = "ft",
    label = "Sanitation1:",
    choices = c(
      "All"=1,
      "Flush Toilets"=2
    )
  ),
  selectInput(
    inputId = "oi",
    label = "Sanitation2:",
    choices = c(
      "All"=1,
      "Other Improved"=2
    )
  ),
  selectInput(
    inputId = "ui",
    label = "Sanitation3:",
    choices = c(
      "All"=1,
      "UnImproved"=2
    )
  ),
  selectInput(
    inputId = "od",
    label = "Sanitation4:",
    choices = c(
      "All"=1,
      "Open Defecation"=2
    )
  )
)

#server
server<-function(input,output){
  #INTERACTIVE MAPPING
  #colormapping
  pal<-colorFactor(rainbow(7),mp$AreaTyp)

  #reactive function for flush toilets
  fts<-reactive({
    dm<-mp
    if(input$ft==1){
      dm[dm$FlshTlt<=25,]
    }
    else if(input$ws==2)
    {
      dm[dm$FlshTlt>25&dm$FlshTlt<=50,]
    }

    return(dm)
  })

  #reactive function for water source on plot
  wsp<-reactive({
    dm<-mp
    if(input$ws==1){
      dm[dm$WtrSrOP<=25,]
    }
    else if(input$ws==2)
    {
      dm[dm$WtrSrOP>25&dm$WtrSrOP<=50,]
    }
    else if(input$ws==3)
    {
      dm[dm$WtrSrOP>50&dm$WtrSrOP<=75,]
    }
    else if(input$ws==4)
    {
      dm[dm$WtrSrOP>75,]
    }
    return(dm)
  })

  #reactive function for piped water on plot
  pwp<-reactive({
    dm<-mp
    if(input$pw==2){
      dm[dm$PpdWtrP<=25,]
    }
    else if(input$pw==3)
    {dm[dm$WtrSrOP<=25,]}
    return(dm)
  })

  #reactive function for population per km2 
  ppd<-reactive({
    dt<-mp
    if(input$pop==1){
      dt[dt$PpDnsty<=15000,]
    } else if(input$pop==3){
      dt[dt$PpDnsty>15000&dt$PpDnsty<=30000,]
    } else if(input$pop==4){
      dt[dt$PpDnsty>30000,]
    }
    return(dt)
  })

  #reactive function for areatype
  fdata<-reactive({
    data<-mp
    if(input$area1!="All"){
      data<-subset(data,AreaTyp %in% input$area1)

    }


    return(data)
  })



  output$map<-renderLeaflet({

    leaflet(mp) %>%

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

      #Base map
      #Add default OpenStreetMap map tiles
      addTiles(group = "default")%>%

      #Overlay map
      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
        )

      ) 

  })


  observe({
    pal<-colorFactor(rainbow(7),mp$AreaTyp)

    leafletProxy("map",data=fdata()) %>%

      clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        fillColor = ~pal(AreaTyp),
        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
        )

      )%>%
      addLegend(title = "AreaType", position = "topleft",
                pal = pal, values = ~AreaTyp, opacity = 1)
  })

  observe({
    pal1 <- colorBin("plasma", mp$PpDnsty, 15, pretty = TRUE)
    leafletProxy("map",data=ppd()) %>%

      # clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        fillColor = ~pal1(PpDnsty),
        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

        )

      )%>%
      addLegend(title = "Population Per km2", position = "topleft",
                pal = pal1, values = ~PpDnsty, opacity = 1)

  })
  observe({

    pal1 <- colorBin("plasma", mp$PpdWtrP, 5, pretty = TRUE)
    leafletProxy("map",data=pwp()) %>%

      # clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        fillColor = ~pal1(PpdWtrP),
        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

        )

      )%>%
      addLegend(title = "Piped Water On Plot(%)", position = "topleft",
                pal = pal1, values = ~PpdWtrP, opacity = 1)

  })
  observe({

    pal1 <- colorBin("plasma", mp$WtrSrOP, 5, pretty = TRUE)
    leafletProxy("map",data=wsp()) %>%

      # clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        fillColor = ~pal1(WtrSrOP),
        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

        )

      )%>%
      addLegend(title = " Water source On Plot(%)", position = "topleft",
                pal = pal1, values = ~WtrSrOP, opacity = 1)

  })
  observe({

    pal1 <- colorBin("plasma", mp$FlshTlt, 5, pretty = TRUE)
    leafletProxy("leaf",data=fts()) %>%

      # clearMarkers() %>%
      clearControls() %>%
      clearShapes()%>%
      addPolygons(
        weight = 1, smoothFactor = 0.5,
        opacity = 1.0, fillOpacity = 1.0,
        fillColor = ~pal1(FlshTlt),
        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

        )

      )%>%
      addLegend(title = "Flush Toilets(%)", position = "topleft",
                pal = pal1, values = ~FlshTlt, opacity = 1)

  })
}


#runApp
shinyApp(ui,server)

0 个答案:

没有答案