Is it possible to filter a simple feature (sf) object using selectizeGroupUI in R shiny

shiny
, ,
1

I'm trying to build a Shiny app containing a leaflet map showing movement paths, that can be bidirectionally filtered using two other columns in the dataset which contains the geometry data.

To do so, I'm trying to use selectizeGroupUI (shinyWidgets package), which allows bidirectional/mutually dependent filtering.

However, when I run the code I get the following error:

"Warning: Error in polygonData.default: Don't know how to get path data from object of class data.frame"

I have a feeling that this is because mapping path (linestring) data in a leaflet map requires the underlying dataset to be an sf object, whereas selectizeGroupUI converts the sf object into a data.table(?), hence the error message.

This is supported by the fact that when I convert the dataset from sf object to data.table and try to plot the paths as individual A and B coordinates (without a connecting line), the whole thing works perfectly.

Any idea whether there exists a work around?

Any help would be hugely appreciated, please and thanks!

** A reprex: **

library(tidyverse)
library(sf)
library(shiny)
library(shinyWidgets)

# generate the table with geometry data

geo_data <- structure(list(idx = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
                           start_lat = c(33.40693,33.64672, 33.57127, 33.42848, 33.54936, 33.53418, 33.60399, 33.49554,33.5056, 33.61696),
                           start_long = c(-112.0298, -111.9255, -112.049,-112.0998, -112.0912, -112.0911, -111.9273, -111.9687, -112.0563, -111.9866),
                           end_lat = c(33.40687, 33.64776, 33.57125, 33.42853,33.54893, 33.53488, 33.60401, 33.49647, 33.5056, 33.61654),
                           end_long = c(-112.0343,-111.9303, -112.0481, -112.0993, -112.0912, -112.0911, -111.931,-111.9711, -112.0541, -111.986)),
                      row.names = c(NA, -10L), spec = structure(list(cols = list(idx = structure(list(), class = c("collector_double","collector")),
                                                                                 start_lat = structure(list(), class = c("collector_double", "collector")),
                                                                                 start_long = structure(list(), class = c("collector_double", "collector")),
                                                                                 end_lat = structure(list(), class = c("collector_double", "collector")),
                                                                                 end_long = structure(list(), class = c("collector_double","collector"))),
                                                                     default = structure(list(), class = c("collector_guess","collector")), delim = ","),
                                                                class = "col_spec"),class = c("data.table","data.frame"))


geo_data<- setDT(geo_data)

geo_data <- geo_data[
  , {
    geometry <- sf::st_linestring(x = matrix(c(start_lat, start_long, end_long, end_long), ncol = 2, byrow = T))
    geometry <- sf::st_sfc(geometry)
    geometry <- sf::st_sf(geometry = geometry)
  }
  , by = idx
  ]



# generate the table with columns to filter the geometry data, join with geometry data and convert to sf

table <- structure(list(idx = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
                        column1 = c("A", "A", "A", "B", "B", "B", "C", "C", "C", "C"),
                        column2 = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)), row.names = c(NA, -10L),
                   class = c("tbl_df","tbl", "data.frame")) %>%
  left_join(x = ., y = geo_data, by = "idx", keep = FALSE)


sf <- sf::st_as_sf(table)


# Shiny

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        selectizeGroupUI(
          id = "my-filters",
          params = list(
            column1 = list(inputId = "column1", title = "column1:"),
            column2 = list(inputId = "column2", title = "column2:")
          )
        ), status = "primary"
      ),
      leafletOutput(outputId = "map")
    )
  )
)

server <- function(input, output, session) {
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = sf,
    vars = c("column1", "column2"))
  
  
  
  output$map <- renderLeaflet({
  leaflet() %>%
    addPolylines(data = res_mod())
  })
  
}



shinyApp(ui, server)
2

If you look at the source code for the module selectizeGroupServer, you can see that the data object that is passed through is forced to be a data frame unless the object you pass is a reactive. Since you are passing non-reactive sf object, it will always return a data frame. Your two options are then:

  1. Change sf to be reactive and pass that to the module
  2. Convert the resulting res_mod() data frame to sf

I think option 2 is best in this case, so this should work out. Note I used the function st_as_sf inside the leaflet call

library(tidyverse)
library(sf)
library(shiny)
library(shinyWidgets)
library(data.table)
library(leaflet)

# generate the table with geometry data

geo_data <- structure(list(idx = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
                           start_lat = c(33.40693,33.64672, 33.57127, 33.42848, 33.54936, 33.53418, 33.60399, 33.49554,33.5056, 33.61696),
                           start_long = c(-112.0298, -111.9255, -112.049,-112.0998, -112.0912, -112.0911, -111.9273, -111.9687, -112.0563, -111.9866),
                           end_lat = c(33.40687, 33.64776, 33.57125, 33.42853,33.54893, 33.53488, 33.60401, 33.49647, 33.5056, 33.61654),
                           end_long = c(-112.0343,-111.9303, -112.0481, -112.0993, -112.0912, -112.0911, -111.931,-111.9711, -112.0541, -111.986)),
                      row.names = c(NA, -10L), spec = structure(list(cols = list(idx = structure(list(), class = c("collector_double","collector")),
                                                                                 start_lat = structure(list(), class = c("collector_double", "collector")),
                                                                                 start_long = structure(list(), class = c("collector_double", "collector")),
                                                                                 end_lat = structure(list(), class = c("collector_double", "collector")),
                                                                                 end_long = structure(list(), class = c("collector_double","collector"))),
                                                                     default = structure(list(), class = c("collector_guess","collector")), delim = ","),
                                                                class = "col_spec"),class = c("data.table","data.frame"))


geo_data<- setDT(geo_data)

geo_data <- geo_data[
  , {
    geometry <- sf::st_linestring(x = matrix(c(start_lat, start_long, end_long, end_long), ncol = 2, byrow = T))
    geometry <- sf::st_sfc(geometry)
    geometry <- sf::st_sf(geometry = geometry)
  }
  , by = idx
]



# generate the table with columns to filter the geometry data, join with geometry data and convert to sf

table <- structure(list(idx = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10),
                        column1 = c("A", "A", "A", "B", "B", "B", "C", "C", "C", "C"),
                        column2 = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)), row.names = c(NA, -10L),
                   class = c("tbl_df","tbl", "data.frame")) %>%
  left_join(x = ., y = geo_data, by = "idx", keep = FALSE)


sf <- sf::st_as_sf(table)


# Shiny

ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        selectizeGroupUI(
          id = "my-filters",
          params = list(
            column1 = list(inputId = "column1", title = "column1:"),
            column2 = list(inputId = "column2", title = "column2:")
          )
        ), status = "primary"
      ),
      leafletOutput(outputId = "map")
    )
  )
)

server <- function(input, output, session) {
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = sf,
    vars = c("column1", "column2"))
  
  
  
  output$map <- renderLeaflet({
    leaflet() %>%
      addPolylines(data = res_mod() %>% st_as_sf())
  })
  
}



shinyApp(ui, server)
3

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

If you have a query related to it or one of the replies, start a new topic and refer back with a link.