Btukfyl

I have shapefile which I am reading into R using readOGR to convert it to SpatialPolygonDataframe. The attribute table looks as shown in the figure below.

Each row is a zone (postal code area) and there are values for each hour of the day eg: h_0, h_1, ...h_23 measured for each zone. In my shiny app I want to show a map which changes as the user select a particular hour using sliderInput widget. The shiny app looks like below:

The code that produces the above result is here:

 library(shiny)

 library(leaflet)

 library(reshape2)

 library(maps)

 library(mapproj)

 library(rgdal)

 library(RColorBrewer)

 library(sp)

 library(rgeos)







ui <- fluidPage(



 titlePanel("Title"),



 sidebarLayout(



 sidebarPanel(

   tabsetPanel(id= "tabs",



              tabPanel("Map", id = "Map", 

                       br(), 



                       p("Choose options below to interact with the Map"), 



                       sliderInput("hour", "Select the hours", min = 0 , max = 23, 

                                   value = 7, step = 1, dragRange= TRUE)

                       )

  )

),



mainPanel(



  tabsetPanel(type= "tabs",





              tabPanel("Map", leafletOutput(outputId = "map"))

          )

  )

 )

 )







 server <- function(input, output) {





  layer <- reactive( {



      shp = readOGR("shp",layer = "attractiveness_day3")

      shp_p <- spTransform(shp, CRS("+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"))



  })



 output$map <- renderLeaflet({

     bins<- c(0, 2000, 4000, 8000, 16000, Inf)

    pal <- colorBin("YlOrRd", domain = layer()$h_7, bins = bins)



    leaflet(layer()) %>% 

    setView(13.4, 52.5, 9) %>% 

    addTiles()%>%

      addPolygons( 

        fillColor = ~pal(h_7),

        weight = 0.0,

        opacity = 1,

        color = "white",

        dashArray = "3",

        fillOpacity = 0.7 

      )  %>% 

      addLegend(pal = pal, values = ~h_7, opacity = 0.7, title = NULL, position = "bottomright")





  })

  #until here it works but onwards not. 

 observe(leafletProxy("map", layer())%>%

           clearShapes()%>%

           addPolygons( 

             fillColor = ~pal(h_7),  # is it possible here to pass column name dynamically

             weight = 0.0,

             opacity = 1,

             color = "white",

             dashArray = "3",

             fillOpacity = 0.7 

           )  %>% 

           addLegend(pal = pal, values = ~h_7, opacity = 0.7, title = NULL, position = "bottomright")

 )



}





shinyApp(ui, server)

So currently the choropleth map is populated with values of column h_7 selected statically. But I don't know how and whether I can dynamically pass the column name based on sliderInput selection ( For eg. If sliderInput value is 8 the corresponding column is h_8). And then render the map based on the selected column passed from reactive funnction to the observe and leafletProxy functions.

sample data : sample data

It is possible to pass the column names as a string. In leafletProxy you can link to your column values with dataset[[column_name]]. With a single square bracket you are not only selecting the values, but also the corresponding polygons.

For your app to work you need to call layer() outside the leafletProxy function. In addition, use clearControls() to remove duplicate legends.

Finally, I am not sure why you put your shapefile in a reactive expression. It wil also work if you just add it as a variable in your server.

 observeEvent({input$hour},{

    hour_column <- paste0('h_',input$hour)

    data = layer()[hour_column]

    pal <- colorBin("YlOrRd", domain = as.numeric(data[[hour_column]]), bins = bins)

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

      clearShapes()%>%

      addPolygons( 

        fillColor = pal(as.numeric(data[[hour_column]])),  

        weight = 0.0,

        opacity = 1,

        color = "white",

        dashArray = "3",

        fillOpacity = 0.7 

      )  %>% clearControls() %>%

      addLegend(pal = pal, values =as.numeric(data[[hour_column]]), opacity = 0.7, title = NULL, position = "bottomright")

  })