I'm putting together a Shiny app that involves a Leaflet map. Unfortunately, whenever I run it, it produces this error: "no applicable method for 'metaData' applied to an object of class "NULL"". I'm pretty sure the error is stemming from the AddLegends functionality towards the bottom, because if I run it with that part taken out, it seems to work alright. Not too sure what I'm doing wrong, as I'm following the same steps I used in AddPolygons, which as I said, seems to work alright.
On a separate issue, is there a way to get the map stop resetting every time a new metric?
library(leaflet)
library(sf)
library(dplyr)
library(shiny)
library(RColorBrewer)
samples <- st_read("sample_shape.shp")
territory <- samples %>% st_buffer(0) %>% group_by(territory) %>% summarise_if(is.numeric, sum)
territory_field <- samples %>% st_buffer(0) %>% group_by(territory,field) %>% summarise_if(is.numeric, sum)
territory_field_coverage <- samples %>% st_buffer(0) %>% group_by(territory, field, coverage) %>% summarise_if(is.numeric, sum)
county <- samples %>% st_buffer(0) %>% group_by(county) %>% summarise_if(is.numeric, sum)
district <- samples %>% st_buffer(0) %>% group_by(district) %>% summarise_if(is.numeric, sum)
metrics_list <- c(samples %>% st_drop_geometry() %>% dplyr::select_if(is.numeric) %>% colnames())
ui <- fluidPage(
fluidRow(
column("",
width = 10, offset = 1,
tags$h3("Select"),
panel(
selectizeInput('counties', label = 'County', multiple = TRUE, c(unique(sort(county$county)))),
selectizeInput('cds', label = 'District', multiple = TRUE, c(unique(sort(district$district)))),
selectizeInput('territories', label = 'Territory', multiple = TRUE, c(unique(sort(territory$territory)))),
uiOutput("field"),
uiOutput("coverage"),
selectInput("metric", label = 'Select Metric', choices = metrics_list, selected = "sales"),
checkboxInput("allCoverages", "See All Coverage", TRUE)
),
leafletOutput(outputId = "map", height = "600")
)
)
)
server <- function(input, output, session) {
output$field <- renderUI({
selectizeInput("fields", "Field", multiple = TRUE, c(unique(sort(territory_field$field[territory_field$territory == input$territories]))))
})
output$coverage <- renderUI({
selectizeInput("coverages", "Coverage", multiple = TRUE, c(unique(sort(territory_field_coverage$coverage[territory_field_coverage$field == input$field]))))
})
map_data <- reactive({
if(!is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& (is.null(input$counties) | !is.null(input$counties))
& (is.null(input$cds) | !is.null(input$cds)))
res <- territory_field %>% filter(territory %in% input$territories)
else
if(!is.null(input$fields)
& is.null(input$coverages)
& (is.null(input$counties) | !is.null(input$counties))
& (is.null(input$cds) | !is.null(input$cds))
& input$allCoverages == FALSE)
res <- territory_field_coverage %>% filter(field %in% input$fields)
else
if(!is.null(input$coverages)
& (is.null(input$counties) | !is.null(input$counties))
& (is.null(input$cds) | !is.null(input$cds))
& input$allCoverages == FALSE)
res <- territory_field_coverage %>% filter(coverage %in% input$coverages)
else
if(is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& is.null(input$counties)
& is.null(input$cds)
& input$allCoverages == FALSE)
res <- territory %>% group_by(territory)
else
if(!is.null(input$counties)
& is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& is.null(input$cds)
& input$allCoverages == FALSE)
res <- county %>% filter(county %in% input$counties)
else
if(!is.null(input$cds)
& is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& is.null(input$counties)
& input$allCoverages == FALSE)
res <- district %>% filter(district %in% input$cds)
else
if(!is.null(input$cds)
& is.null(input$territories)
& is.null(input$fields)
& is.null(input$coverages)
& !is.null(input$counties)
& input$allCoverages == FALSE)
res <- district %>% filter(district %in% input$cds)
else
if(input$allCoverages == TRUE
& (is.null(input$territories) | !is.null(input$territories))
& (is.null(input$fields) | !is.null(input$fields))
& (is.null(input$coverages) | !is.null(input$coverages))
& (is.null(input$cds) | !is.null(input$cds))
& (is.null(input$counties) | !is.null(input$counties)))
res <- territory_field_coverage %>% filter(is.null(input$territories) | territory %in% input$territories,
is.null(input$fields) | field %in% input$fields,
is.null(input$coverages) | coverage %in% input$coverages)
res
})
output$map <- renderLeaflet({
req(input$metric)
res <- map_data()
map <- leaflet() %>%
addProviderTiles(provider = "CartoDB.Positron",
providerTileOptions(detectRetina = FALSE,
reuseTiles = TRUE,
minZoom = 4,
maxZoom = 8))
map %>% draw_demographics(input, res)
})
getpal <- function(cpop,nmax){
if (length(cpop)>1){
# try out value from nmax down to 1
for (n in nmax:1){
qpct <- 0:n/n
cpopcuts <- quantile(cpop,qpct)
# here we test to see if all the cuts are unique
if (length(unique(cpopcuts))==length(cpopcuts)){
if (n==1){
# The data is very very skewed.
# using quantiles will make everything one color in this case (bug?)
# so fall back to colorBin method
return(colorBin("YlOrRd",cpop, bins=nmax))
}
return(colorQuantile("YlOrRd", cpop, probs=qpct))
}
}
}
# if all values and methods fail make everything white
pal <- function(x) { return("white") }
}
draw_demographics <- function(map, input, data) {
cpop <- data[[input$metric]]
if (length(cpop)==0) return(map) # no pop data so just return (much faster)
pal <- getpal(cpop,7)
map %>%
clearShapes() %>%
addPolygons(data = data,
fillColor = ~pal(cpop),
fillOpacity = 1,
color = "#BDBDC3",
weight = 3) %>% addLegend("bottomright",
pal = ~pal(cpop),
values = ~cpop,
title = "Sales",
opacity = 1)
}
}
shinyApp(ui,server)
