Shiny Leaflet Map With Points(Circles) Based on Different Columns

shiny shinyapps.io
,
1

I am trying to create a map where users can select to view trail count data from a list of trailheads by year. I have figured out to do a single year, though not elegantly, and am now trying to include multiple years. Here a simple dataset that is representative of the dataset I am using.

     site <- c("Browns Canyon", "Hancock", "Monarch Crest")
     lat <- c("38.76210", "38.70581", "38.49185")
     long <- c("-105.9776", "-106.3405", "-106.3171")
     Total2016 <- ("353", "1112", "9875")
     Total2017 <- c("0", "138", "7435")
     Total2018 <- c("201", "145", "16448")
     Total2019 <- c("153", "0", "9655")
     alluse <- data.frame(site, lat, long, Total2016, Total2017, Total2018, Total2019)

Here is my UI code

     ui <- navbarPage(
     "Visitor Usage", id = "nav",
     tabPanel("Trailhead Visitation", div(class = "outer",
     tags$head(includeCSS("www/style.css")),
     leafletOutput("UsageMap", width = "100%", height = "100%"),
      absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
                           draggable = TRUE, top = 70, left = "auto", right = 20, bottom =    
                           "auto", width = 330, height = "auto",
                                                 
      h2("Trailhead Explorer"),
                                                 
      selectInput("year", label = h4("Year:"),
                  choices = c("2016" = "Total2016",
                              "2017" = "Total2017",
                              "2018" = "Total2018",
                              "2019" = "Total2019"),
                  selected = "", width = "90%", multiple = TRUE),
                                                 
      tags$div(id="cite", 'Data provided by USFS and BLM and compiled for Chaffee County 
                           Recreation in Balance')
                                   ))))

Here is my Server Code. This is where things are getting complicated and I am at a loss.

What I am particularly having trouble with is how to apply different color palettes and circle sizes to the different years, how to display separate legends for the each of the years if they are selected, how to have popups for each selected year so that it only displays the selected year's totals, and how to more efficiently clear the map.

In the example that I have gotten to work, when a trailhead is clicked on it makes all the other points disappear, therefore if you click on the popup button to close it there is nothing left on the map. Any solutions for resetting the map would also be greatly appreciated.

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

    selectedYear <- reactive({input$year,
                             "2016" = alluse$Total2016,
                             "2017" = alluse$Total2017,
                             "2018" = alluse$Total2018,
                             "2019" = alluse$Total2019})

    pal1 <- colorBin(palette = "Reds", domain = alluse$Total2016, bins = 10, pretty = FALSE)
    pal2 <- colorBin(palette = "Oranges", domain = alluse$Total2017, bins = 10, pretty =    
    FALSE)
    pal3 <- colorBin(palette = "Reds", domain = alluse$Total2018, bins = 10, pretty = FALSE)
    pal4 <- colorBin(palette = "Oranges", domain = alluse$Total2019, bins = 10, pretty = FALSE)

    output$UsageMap <- renderLeaflet({
    leaflet() %>% addTiles() %>% addProviderTiles("Esri.WorldTopoMap") %>%
    setView(lng = -106.183908, lat = 38.766663, zoom = 9) %>%
    addCircles(data = alluse, lng = alluse$long, lat = alluse$lat,
             weight = 1, radius = sqrt(selectedYear)*30,
             fillColor = ~pal(selectedYear()),
             popup = "Trailhead: ", alluse$trailhead,  
             "Agency: ", alluse$agency, 
             "Usage: ", selectedYear) %>%
  addLegend("bottomleft", pal = pal, values = selectedYear(), title = "Trailhead Usage")
  })

  }

I have been working on this multiple year solution for about three weeks off and on and have hit a pretty hard wall. Any help or references would be greatly appreciated.

2

I adjusted my server code to the following:

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

    selectedYear <- reactive({switch(input$year,
                             "2016" = alluse$Total2016,
                             "2017" = alluse$Total2017,
                             "2018" = alluse$Total2018,
                             "2019" = alluse$Total2019)
       })

    pal1 <- colorBin(palette = "Reds", domain = NULL, bins = 10, pretty = FALSE)

    output$UsageMap <- renderLeaflet({
             leaflet(alluse) %>% 
             addProviderTiles("Esri.WorldTopoMap") %>%
            setView(lng = -106.183908, lat = 38.766663, zoom = 9) %>%
            addCircles(data = alluse, lng = alluse$long, lat = alluse$lat,
             weight = 1, radius = sqrt(selectedYear)*30,
             fillColor = ~pal1(selectedYear()),
             popup = paste0(h3("Trailhead:"), alluse$site), color = "#BDBDC3", fillOpacity = 0.8, 
              weight = 1) %>%
  addLegend("bottomleft", pal = pal1, values = selectedYear(), title = "Trailhead Usage")

})

        observeEvent(input$year, {
        trail_popup <- paste0(h3("Trailhead:"), selectedYear()$site,
                      h4("Total 2016:"), selectedYear()$Total2016,
                      h4("Total 2017:"), selectedYear()$Total2017,
                      h4("Total 2018:"), selectedYear()$Total2018,
                      h4("Total 2019:"), selectedYear()$Total2019)

leafletProxy("UsageMap", data = selectedYear()) %>%
  clearGroup(c("year"), fillColor = "orange",
             popup = trail_popup, 
             color = "#BDBDC3",
             fillOpacity = 0.8,
             weight = 5)
  })
  }

When I run the app I get the following warning messages:

Warning: Error in addCircles: formal argument "weight" matched by multiple actual arguments
[No stack trace available]
Warning: Error in clearGroup: unused arguments (fillColor = "orange", popup = trail_popup, color = "#BDBDC3", fillOpacity = 0.8, weight = 5)
[No stack trace available]

Thanks for any and all help.