emaoca
emaoca

Reputation: 119

AddLegend based on reactive values in r leaflet

I'm trying to addlegend feature on my interactive map app based on user input such that when he selects a range of input the color mapping changes based on the conditions selected.

I tried to do this putting colorBin() inside reactive() function in this way:

colorpal <- reactive({
        colorBin(palette = "plasma", domain = data_input_ordered()$totale, bins = 6)
    })

and than using colorpal() inside renderLeaflet() in this way:

    output$mymap <- renderLeaflet(
        leaflet() %>%
            addProviderTiles(providers$Stamen.Terrain) %>%
            setView(lng = 9.768875, lat = 45.619111, zoom = 9) %>%
            addPolygons(data = province_lonlat,
                        weight = 1,
                        color = "white",
                        fillOpacity = 0.8,
                        fillColor = colorpal(data_input_ordered()$totale),
                        highlight = highlightOptions(weight = 1, 
                                                     color = "#666666",
                                                     fillOpacity = 0.5,
                                                     bringToFront = TRUE
                        ),
                        label =  lapply(labels(), HTML)
            ) %>%
            addLegend(pal = colorpal, 
                      values = data_input_ordered()$totale, 
                      position = "topright", 
                      labFormat = labelFormat(big.mark = ".")
            )
    )

The problem is the app is running but the map tab isn't showing anything but: "Error: argument is of length zero

Anyone has tips to fix my code making my map working properly?

Full code is here:

# APP

library(shiny)
library(shinydashboard)
library(leaflet)
library(rgdal)
library(dplyr)
library(DT)

province <- readOGR("../in/province.shp")
province_lonlat <- spTransform(province, CRS("+proj=longlat +datum=WGS84"))
crimini <- read.csv2("../in/crimini.csv")


### UI

ui <- dashboardPage(
    skin = "blue",
    dashboardHeader(title = "Crimini denunciati nelle province della Lombardia"),
    dashboardSidebar(
        sliderInput(
            # nome per indicare i valori controllati dallo slider (si utilizza nel SERVER per riferirsi ai dati da controllare)
            inputId = "date_range",
            label = "Anno",
            min = min(crimini$anno),
            max = max(crimini$anno),
            # valori iniziali dello slider
            value = c(min(crimini$anno), max(crimini$anno)),
            sep = ".",
            step = 1
            )
    ),
    dashboardBody(
        fluidRow(box(width = 12, leafletOutput(outputId = "mymap"))),
        fluidRow(box(width = 12, dataTableOutput(outputId = "summary_table")))
    )
    
)
    


### SERVER

server <- function(input, output) {
    
    data_input <- 
        # inserisco una funzione REACTIVE che aggiorna il calcolo ogni volta che i parametri di input vengono modificati
        reactive({
            crimini %>%
                # filtro i valori in base al massimo e al minimo selezionati con lo slider
                filter(`anno` >= input$date_range[1]) %>%
                filter(`anno` <= input$date_range[2]) %>%
                group_by(`provincia`) %>%
                summarize("totale" = sum(`n_crimini`),
                          "media annua" = round(sum(`n_crimini`) / (input$date_range[2] - input$date_range[1]), digits = 2)
                          )
        })
    
    data_input_ordered <- reactive({
        data_input()[order(match(data_input()$provincia, province_lonlat$provincia)), ]
    })
    
    labels <- reactive({
        paste("<p>", data_input_ordered()$provincia, "</p>",
              "<p>", "totale crimini: ", data_input_ordered()$totale, "</p>",
              "<p>", "media annua: ", round(data_input_ordered()$`media annua`, digits = 2), "</p>"
              )
    })
    
    colorpal <- reactive({
        colorBin(palette = "plasma", domain = data_input_ordered()$totale, bins = 6)
    })
    
    output$mymap <- renderLeaflet(
        leaflet() %>%
            addProviderTiles(providers$Stamen.Terrain) %>%
            setView(lng = 9.768875, lat = 45.619111, zoom = 9) %>%
            addPolygons(data = province_lonlat,
                        weight = 1,
                        color = "white",
                        fillOpacity = 0.8,
                        fillColor = colorpal(data_input_ordered()$totale),
                        highlight = highlightOptions(weight = 1, 
                                                     color = "#666666",
                                                     fillOpacity = 0.5,
                                                     bringToFront = TRUE
                        ),
                        label =  lapply(labels(), HTML)
            ) %>%
            addLegend(pal = colorpal, 
                      values = data_input_ordered()$totale, 
                      position = "topright", 
                      labFormat = labelFormat(big.mark = ".")
            )
    )
    
    output$summary_table <- renderDataTable(data_input())
    
}
    

Files are here: https://drive.google.com/drive/folders/1rL3R5W2cRrX34NDi9bpCphnVGTFcu6s7?usp=sharing

Upvotes: 1

Views: 428

Answers (0)

Related Questions