no applicable method for 'metaData' applied to an object of class "NULL" with leaflet map

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?

The link to grab the shapefile can be found at this repo (not sure how to pull it directly within the script)

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)

You are right, it is the legend that is causing you grief. This just tripped me up too.

See this link.: https://github.com/rstudio/leaflet/issues/485

As per the link, you need to change your reference to:

addLegend("bottomright",
pal = pal,
values = data$cpop,
title = "Sales",
opacity = 1)

On an unrelated note, consider not using the name 'data' for your data frame. This is a function in R and will only lead to tears :upside_down_face:

1 Like

Thank you for the answer. Though I have another question. Why does the coloring on the legend remain grey?

image

Have you set these as factors i.e. is this a categorical field?

Check the factor levels to make sure:

levels(data$cpop)

levels(data$cpop)
Error in data$cpop : object of type 'closure' is not subsettable

Oh and it's not a categorial field, it's numeric

On reflection, I see that you used 'data' as a variable not a data frame as I first thought.

Change the values term from:

addLegend("bottomright",
pal = pal,
values = data$cpop,
title = "Sales",
opacity = 1)

to

addLegend("bottomright",
pal = pal,
values = cpop,
title = "Sales",
opacity = 1)

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.