Question

我正在构建一个R Shiny工具来可视化飞行数据。我建立了一个数据表，其中包含飞机的纬度，长度，速度，航向，高度等。然后，我在leaflet地图上绘制这些观测值。一系列滑块和框可以对这些观察进行子集，以便仅绘制所需的观察值（例如，仅绘制具有特定高度的那些观测值）。在添加selectInput()窗口小部件并能够选择多个值之前，我在渲染观察结果时没有遇到任何问题。下面是我的代码的最小，可重现的示例。

server.R

library(shiny)
library(data.table)
library(leaflet)

shinyServer(function(input, output){

  # sample data set
  dt <- data.table(altitude = c(1,1,3,3,4,5,6,7,3,2),
                   long = c(-85.2753, -85.4364, -85.5358, -85.6644, -85.8208, 
                            -89.9233, -90.0456, -90.2775, -90.5800, -90.8761),
                   lat = c(45.3222, 45.3469, 45.3764, 45.4089, 45.4503,
                           44.0489, 44.1878, 44.3378, 44.4383, 44.5197),
                   origin = c('a', 'a', 'a', 'a', 'a', 'b', 'b', 'b', 'b', 'b'),
                   destination = c('c', 'c', 'c', 'c', 'c', 'd', 'd', 'd', 'd', 'd'))

  # subset the data on various inputs from ui.R
  subsetData <- reactive({
    new_data <- dt[altitude > input$alt_cut[1] &
                   altitude < input$alt_cut[2] &
                   origin %in% input$origin &
                   destination %in% input$dest, ]
    return(new_data)
  })

  # display the data in real time to identify if the subsetting
  # is occurring as expected.
  output$viewData <- renderTable({
    subsetData()
  })

  # plot the data points
  output$mapPlot <- renderLeaflet({
    leaflet() %>%
      fitBounds(-90.8761, 44.0489, -85.2753, 45.4503)
  })

  observe({
    leafletProxy('mapPlot') %>%
      clearGroup('A') %>%  # I think this line may not be functioning as I expect...
      addCircles(data = subsetData(),
                 group = 'A',
                 lng = ~long,
                 lat = ~lat,
                 radius = 2,
                 weight = 2)
  })
})

ui.R

shinyUI(fluidPage(
  titlePanel('Aircraft Flights'),
  sidebarLayout(
    sidebarPanel(
      sliderInput('alt_cut',
                  'Altitude range:',
                  min = 0,
                  max = 10,
                  value = c(0, 10),
                  step = 1),
      selectInput('origin',
                  'Filter on origin',
                  choices = c('a', 'b'),
                  selected = c('a', 'b'),
                  multiple = TRUE,
                  selectize = FALSE),
      selectInput('dest',
                  'Filter on destination',
                  choices = c('c', 'd'),
                  selected = c('c', 'd'),
                  multiple = TRUE,
                  selectize = FALSE)
    ),
    mainPanel(
      leafletOutput('mapPlot'),  # leaflet output for plotting the points
      tags$hr(),
      tableOutput('viewData')  # table for sanity check
    )
  )
))

点击某些原点和目的地组合后，绘图将停止反映在地图下方表格中正确显示的数据。例如，尝试以下一系列操作。

运行应用
选择原点：a（显示右上角的系列）
选择目的地：d（情节为空，因为a和d未链接）
选择目的地：c（右上角系列重新出现，因为a和c已链接）
选择目的地：d（右上角系列错误保留）

使用滑块在高度上进行子设置不再有效。由于表格中的数据正在变化，但情节没有变化，因此我认为clearGroup('A')行不会删除圆圈。

为什么表格和情节之间存在差异？

Screenshot问题：表格中没有数据，但地图上仍然绘制了点。

Answer 1

我没有足够的代表发表评论，否则我会在那里发帖。我无法使用该代码重现您的错误。您的测试用例应该正常工作。唯一的变化是我将您的代码放在一个文件中：

library(shiny)
library(data.table)
library(leaflet)

ui <- (fluidPage(
  titlePanel('Aircraft Flights'),
  sidebarLayout(
    sidebarPanel(
      sliderInput('alt_cut',
                  'Altitude range:',
                  min = 0,
                  max = 10,
                  value = c(0, 10),
                  step = 1),
      selectInput('origin',
                  'Filter on origin',
                  choices = c('a', 'b'),
                  selected = c('a', 'b'),
                  multiple = TRUE,
                  selectize = FALSE),
      selectInput('dest',
                  'Filter on destination',
                  choices = c('c', 'd'),
                  selected = c('c', 'd'),
                  multiple = TRUE,
                  selectize = FALSE)
    ),
    mainPanel(
      leafletOutput('mapPlot'),  # leaflet output for plotting the points
      tags$hr(),
      tableOutput('viewData')  # table for sanity check
    )
  )
))

server <- function(input, output) {

  # sample data set
  dt <- data.table(altitude = c(1,1,3,3,4,5,6,7,3,2),
                   long = c(-85.2753, -85.4364, -85.5358, -85.6644, -85.8208, 
                            -89.9233, -90.0456, -90.2775, -90.5800, -90.8761),
                   lat = c(45.3222, 45.3469, 45.3764, 45.4089, 45.4503,
                           44.0489, 44.1878, 44.3378, 44.4383, 44.5197),
                   origin = c('a', 'a', 'a', 'a', 'a', 'b', 'b', 'b', 'b', 'b'),
                   destination = c('c', 'c', 'c', 'c', 'c', 'd', 'd', 'd', 'd', 'd'))

  # subset the data on various inputs from ui.R
  subsetData <- reactive({
    new_data <- dt[altitude > input$alt_cut[1] &
                     altitude < input$alt_cut[2] &
                     origin %in% input$origin &
                     destination %in% input$dest, ]
    return(new_data)
  })

  # display the data in real time to identify if the subsetting
  # is occurring as expected.
  output$viewData <- renderTable({
    subsetData()
  })

  # plot the data points
  output$mapPlot <- renderLeaflet({
    leaflet() %>%
      fitBounds(-90.8761, 44.0489, -85.2753, 45.4503)
  })

  observe({
    leafletProxy('mapPlot') %>%
      clearGroup('A') %>%  # I think this line may not be functioning as I expect...
      addCircles(data = subsetData(),
                 group = 'A',
                 lng = ~long,
                 lat = ~lat,
                 radius = 2,
                 weight = 2)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 2

我发现了问题。抱歉重复this question。显然，当从数据表中过滤掉所有观察结果时，我可能会出现我在问题中描述的意外行为。在@ NicE的答案中加入nrow检查可以解决问题。

问题的原因仍然让我感到厌烦，但这是目前的解决方法。

R小册子图中数据的闪亮反应子集

2 个答案: