是否可以在 R shiny 中使用 selectizeGroupUI 过滤简单的特征(sf)对象?

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

我正在尝试构建一个闪亮的应用程序,其中包含一个显示运动路径的传单地图,可以使用包含几何数据的数据集中的其他两列进行双向过滤。

为此,我尝试使用 selectizeGroupUI(shinyWidgets 包),它允许 bidirectional/mutually 依赖过滤。

但是,当我 运行 代码时,出现以下错误:

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

我感觉这是因为leaflet地图中的映射路径(线串)数据要求底层数据集是sf对象,而selectizeGroupUI将sf对象转换成data.table(?),因此出现错误消息。

当我将数据集从 sf 对象转换为 data.table 并尝试将路径绘制为单独的 A 和 B 坐标(没有连接线)时,这得到了支持,整个过程完美无缺.

知道是否存在解决方法吗?

如有任何帮助,我们将不胜感激,谢谢!

一个代表:


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)




res_mod() 被调用时,它 returns 一个 data.frame 但你可以像任何其他具有 [=13 的数据框对象一样使用 st_as_sf() 再次强制它返回=]列在里面。

    output$map <- renderLeaflet({
        leaflet() %>%
            addPolylines(data = st_as_sf(res_mod()))
    })

之后 output$map 再次开始工作。