1

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.

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)
4
  • Please ask only One question per Question.
    – Vince
    Dec 18, 2019 at 21:35
  • @Vince Done! Sorry about that. Would you be able to answer this question? Dec 18, 2019 at 21:38
  • No, just sprucing it up to attract answers.
    – Vince
    Dec 19, 2019 at 2:34
  • Answered here: community.rstudio.com/t/…
    – GISHuman
    Dec 19, 2019 at 13:21

1 Answer 1

0

I had that problem when using fillColor, and the way I solved it was using pal(cpop) instead of ~pal(cpop), not sure why though.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.