0

I am working on a shiny app that creates an interactive choropleth map. The user first selects the country, then the state, and finally the variable of interest. The map reactively displays the value of the variable for each county in the selected state.

However, I am getting the error Error: no applicable method for 'metaData' applied to an object of class "c('sfc_GEOMETRY', 'sfc')" and I am not sure how to proceed. I believe the error is due to the addPolygons(data = filteredData()$geometry. Originally, I had not included data = but was getting a separate error that this SO question answered suggesting the need to add data =. Any ideas on how to address this error?

Example Data:

library(shiny)
library(leaflet)
library(sf)
#> Warning: package 'sf' was built under R version 4.2.3
#> Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUE
library(dplyr)
#> Warning: package 'dplyr' was built under R version 4.2.3
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union
library(geodata)
#> Warning: package 'geodata' was built under R version 4.2.3
#> Loading required package: terra
#> terra 1.7.29

# Minimum example data needed to represent the error
dat <- data.frame(
  country = c("United States", "United States", "United States", "United States", "United States",
              "United States", "United States", "United States", "United States", "United States",
              "United States", "United States", "United States", "United States", "United States",
              "United States", "United States", "United States", "United States", "United States",
              "United States", "United States", "United States", "United States", "United States",
              "United States"),
  state = c("Connecticut", "Connecticut", "Connecticut", "Connecticut", "Connecticut",
            "Connecticut", "Connecticut", "Connecticut", "Connecticut", "Connecticut",
            "Connecticut", "Connecticut", "Connecticut", "Connecticut", "Connecticut",
            "Connecticut", "Rhode Island", "Rhode Island", "Rhode Island", "Rhode Island",
            "Rhode Island", "Rhode Island", "Rhode Island", "Rhode Island", "Rhode Island",
            "Rhode Island"),
  county = c("Fairfield", "Fairfield", "Hartford", "Hartford",
             "Litchfield", "Litchfield", "Middlesex", "Middlesex",
             "New Haven", "New Haven", "New London", "New London",
             "Tolland", "Tolland", "Windham", "Windham",
             "Bristol", "Bristol", "Kent", "Kent",
             "Newport", "Newport", "Providence", "Providence",
             "Washington", "Washington"),
  Variable = c("Tmean", "Pmean_cm", "Tmean", "Pmean_cm",
               "Tmean", "Pmean_cm", "Tmean", "Pmean_cm",
               "Tmean", "Pmean_cm", "Tmean", "Pmean_cm",
               "Tmean", "Pmean_cm", "Tmean", "Pmean_cm",
               "Tmean", "Pmean_cm", "Tmean", "Pmean_cm",
               "Tmean", "Pmean_cm", "Tmean", "Pmean_cm",
               "Tmean", "Pmean_cm"),
  Value = c(10.5, 143, 10.6, 127, 8.3, 148, 10.5, 138, 10.4, 141, 10.6, 128, 9.2, 137, 9.7, 133, 10.8, 127, 10.3, 139, 10.6, 127, 10, 137, 10.5, 135)
)

# Retrieve the county geometry using geodat and sf packages
usa <- gadm(country = 'USA', level = 2, path = tempdir()) %>%
  st_as_sf() %>%
  filter(ENGTYPE_2 != 'Water body') %>%
  select(COUNTRY, NAME_1, NAME_2, geometry) %>%
  rename(country = COUNTRY,
         state = NAME_1,
         county = NAME_2)

# Join 'dat' with the 'usa' dataframe
dat <- left_join(dat, usa, by = c('country', 'state', 'county'))
rm(usa)

Created on 2023-07-19 with reprex v2.0.2

Shiny app that throws the error

# Setup user interface
ui <- fluidPage(
  titlePanel("Choropleth Map"),
  sidebarLayout(
    sidebarPanel(
      selectInput("countryInput", "Select Country:", choices = unique(dat$country)),
      uiOutput("stateDropdown"),
      selectInput("variableInput", "Select Variable:", choices = unique(dat$Variable))
    ),
    mainPanel(
      leafletOutput("map")
    )
  )
)

# Define the server
server <- function(input, output, session) {
  # Reactive function for state dropdown based on selected country
  stateChoices <- reactive({
    if (is.null(input$countryInput)) {
      return(NULL)
    } else {
      unique(dat$state[dat$country == input$countryInput])
    }
  })
  
  # Render state dropdown
  output$stateDropdown <- renderUI({
    selectInput("stateInput", "Select State:", choices = stateChoices())
  })
  
  # Render the chloropleth map
  output$map <- renderLeaflet({
    filteredData <- reactive({
      dat %>%
        filter(country == input$countryInput,
               state == input$stateInput,
               Variable == input$variableInput)
    })
    
    pal <- colorNumeric(
      palette = "Blues",
      domain = filteredData()$Value
    )
    
    stateData <- filteredData() %>%
      group_by(state)
    
    leaflet(data = stateData) %>%
      addProviderTiles("CartoDB.Positron") %>%
      setView(lng = -95.7129, lat = 37.0902, zoom = 4) %>%
      addPolygons(
        data = filteredData()$geometry,
        fillColor = ~pal(Value),
        color = "white",
        fillOpacity = 0.7,
        stroke = TRUE,
        weight = 1,
        layerId = ~state
      ) %>%
      fitBounds(
        lng1 = min(filteredData()$geometry$x),
        lat1 = min(filteredData()$geometry$y),
        lng2 = max(filteredData()$geometry$x),
        lat2 = max(filteredData()$geometry$y)
      )
  })
}

# Run the Shiny app
shinyApp(ui = ui, server = server)

1 Answer 1

1

There are several issues with your code. IMHO the main issue is that you join usa on dat so that the resulting object is no longer an sf object. Instead join dat on usa. Second, I would suggest to not put a reactive inside another reactive or a render function. Third, to simplify your data structures I would suggest to reshape your dataset to tidy format using e.g. tidyr::pivot_wider. Fourth, I use sf::st_bbox to get the bounding box for the filtered dataset. Finally, as you dynamically create the stateInput I added some req to make sure that all inputs need for the reactive and the render function are initialized.

library(shiny)
library(tidyr)
library(dplyr, warn=FALSE)
library(leaflet)
library(sf)

dat <- tidyr::pivot_wider(dat, names_from = Variable, values_from = Value)

choices_var <- names(dat)[!names(dat) %in% c("country", "state", "county")]
choices_country <- unique(dat$country)
# Filter join: Keep only regions with data
usa <- semi_join(usa, dat, by = c("country", "state", "county"))
# Join 'dat' with the 'usa' dataframe
dat <- left_join(usa, dat, by = c("country", "state", "county"))

# Setup user interface
ui <- fluidPage(
  titlePanel("Choropleth Map"),
  sidebarLayout(
    sidebarPanel(
      selectInput("countryInput", "Select Country:", choices = choices_country),
      uiOutput("stateDropdown"),
      selectInput("variableInput", "Select Variable:", choices = choices_var)
    ),
    mainPanel(
      leafletOutput("map")
    )
  )
)

# Define the server
server <- function(input, output, session) {
  # Reactive function for state dropdown based on selected country
  stateChoices <- reactive({
    req(input$countryInput)

    unique(dat$state[dat$country == input$countryInput])
  })

  # Render state dropdown
  output$stateDropdown <- renderUI({
    selectInput("stateInput", "Select State:", choices = stateChoices())
  })

  filteredData <- reactive({
    req(input$stateInput)

    dat %>%
      filter(
        country == input$countryInput,
        state == input$stateInput
      ) |>
      select(geometry, state, Value = input$variableInput)
  })

  # Render the chloropleth map
  output$map <- renderLeaflet({
    req(filteredData())

    pal <- colorNumeric(
      palette = "Blues",
      domain = filteredData()$Value
    )

    bbox <- sf::st_bbox(filteredData())
    
    leaflet(data = filteredData()) %>%
      addProviderTiles("CartoDB.Positron") %>%
      setView(lng = -95.7129, lat = 37.0902, zoom = 4) %>%
      addPolygons(
        fillColor = ~ pal(Value),
        color = "white",
        fillOpacity = 0.7,
        stroke = TRUE,
        weight = 1,
        layerId = ~state
      ) |>
      fitBounds(
        lng1 = bbox[["xmin"]],
        lat1 = bbox[["ymin"]],
        lng2 = bbox[["xmax"]],
        lat2 = bbox[["ymax"]]
      )
  })
}

# Run the Shiny app
shinyApp(ui = ui, server = server)
#> 
#> Listening on http://127.0.0.1:7138

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