代码之家 › 专栏 › 技术社区 › val

在Shiny中应用传单贴图边界过滤数据

r-leaflet reactive-programming leaflet shiny r

1

val · 技术社区 · 6 年前

下面的代码旨在复制 this example 除了为“速度”添加额外参数之外。但是,我的地图数据表链接已断开- 有人能帮我找出那个虫子吗 ? 原始代码基于贴图的边界更新表,而在我的代码中,更改贴图缩放对我的表没有影响。我也无法让“速度”过滤器在表格和地图上工作,这是我正在寻找的功能。任何指点都将不胜感激。

library(shiny)
library(magrittr)
library(leaflet)
library(DT)

ships <-
  read.csv(
    "https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
  )

ui <- shinyUI(fluidPage(
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(width = 3,
                 numericInput(
                   "speed", label = h5("Ship's Speed"), value = 100
                 )),
    mainPanel(tabsetPanel(
      type = "tabs",
      tabPanel(
        "Leaflet",
        leafletOutput("leafletmap", width = "350px"),
        dataTableOutput("tbl")
      )
    ))
  )
))

server <- shinyServer(function(input, output) {
  in_bounding_box <- function(data, lat, long, bounds, speed) {
    data %>%
      dplyr::filter(
        lat > bounds$south &
          lat < bounds$north &
          long < bounds$east & long > bounds$west & ship_speed < input$speed
      )
  }

  output$leafletmap <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
      addCircleMarkers(
        data = ships,
        ~ long ,
        ~ lat,
        popup =  ~ speed,
        radius = 5 ,
        stroke = FALSE,
        fillOpacity = 0.8,
        popupOptions = popupOptions(closeButton = FALSE)
      )
  })

  data_map <- reactive({
    if (is.null(input$map_bounds)) {
      ships
    } else {
      bounds <- input$map_bounds
      in_bounding_box(ships, lat, long, bounds, speed)
    }
  })

  output$tbl <- DT::renderDataTable({
    DT::datatable(
      data_map(),
      extensions = "Scroller",
      style = "bootstrap",
      class = "compact",
      width = "100%",
      options = list(
        deferRender = TRUE,
        scrollY = 300,
        scroller = TRUE,
        dom = 'tp'
      )
    )
  })


})

shinyApp(ui = ui, server = server)

2 回复 | 直到 6 年前

1

3

Florian 6 年前

两个小改动:

在您链接的示例中, input$map_bounds 工作,因为传单输出对象被调用 map 。但是,您将其重命名为 leafletmap ,所以我们应该参考 input$leafletmap_bounds 。
在 dplyr 声明,我们应该参考 speed 不 ship_speed 。

下面给出了工作代码,希望对您有所帮助!

library(shiny)
library(magrittr)
library(leaflet)
library(DT)

ships <-
  read.csv(
    "https://raw.githubusercontent.com/Appsilon/crossfilter-demo/master/app/ships.csv"
  )

ui <- shinyUI(fluidPage(
  titlePanel(""),
  sidebarLayout(
    sidebarPanel(width = 3,
                 numericInput(
                   "speed", label = h5("Ship's Speed"), value = 100
                 )),
    mainPanel(tabsetPanel(
      type = "tabs",
      tabPanel(
        "Leaflet",
        leafletOutput("leafletmap", width = "350px"),
        dataTableOutput("tbl")
      )
    ))
  )
))

server <- shinyServer(function(input, output) {
  in_bounding_box <- function(data, lat, long, bounds, speed) {
    data %>%
      dplyr::filter(
        lat > bounds$south &
          lat < bounds$north &
          long < bounds$east & long > bounds$west & speed < input$speed
      )
  }

  output$leafletmap <- renderLeaflet({
    leaflet() %>%
      addProviderTiles("Esri.WorldImagery", group = "ESRI World Imagery") %>%
      addCircleMarkers(
        data = ships,
        ~ long ,
        ~ lat,
        popup =  ~ speed,
        radius = 5 ,
        stroke = FALSE,
        fillOpacity = 0.8,
        popupOptions = popupOptions(closeButton = FALSE)
      )
  })

  data_map <- reactive({
    if (is.null(input$leafletmap_bounds)) {
      ships
    } else {
      bounds <- input$leafletmap_bounds
      in_bounding_box(ships, lat, long, bounds, speed)
    }
  })

  output$tbl <- DT::renderDataTable({
    DT::datatable(
      data_map(),
      extensions = "Scroller",
      style = "bootstrap",
      class = "compact",
      width = "100%",
      options = list(
        deferRender = TRUE,
        scrollY = 300,
        scroller = TRUE,
        dom = 'tp'
      )
    )
  })


})

shinyApp(ui = ui, server = server)

2

Dhiraj 6 年前

正在渲染的传单贴图称为 leafletmap ,而不是指 map_bounds 尝试将其更改为 leafletmap_bounds :

  data_map <- reactive({
    if (is.null(input$leafletmap_bounds)) {
      ships
    } else {
      bounds <- input$leafletmap_bounds
      in_bounding_box(ships, lat, long, bounds, speed)
    }
  })

同样在过滤器中,更改 ship_speed 到 speed .希望能奏效。