Reputation: 119
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