R 中的闪亮应用程序：如何根据输入选择更新 table 输出

Question

作为 R 中的第一个 class 项目，我正在尝试构建一个 Shiny 应用程序来显示巴黎地铁线路、站点和时间表。

我成功地创建了一个动态地图，它根据所选线路显示停靠点。我现在想根据选定的时间显示选定的停止时间表。我在更新数据和显示数据时遇到问题。到目前为止，我的逻辑很好，因为它在 R 脚本中手动工作，但在应用程序中我不知道如何在 table.

中显示它

正如您在下面的屏幕截图中看到的那样，table 具有正确的 header 但内部没有数据。

我怎样才能扭转局面？

这是我的代码：

library(shiny)
library(dplyr)
library(tidyverse)
library(leaflet)
library(DT)
library(lubridate)

## Files
routes <- readRDS("~/Desktop/EDHEC/Courses Nicolas/Msc DAAI/S1/R Programming/Project/RATP Data/rdsnew/routesnew.rds")
trips <- readRDS("~/Desktop/EDHEC/Courses Nicolas/Msc DAAI/S1/R Programming/Project/RATP Data/rdsnew/tripsnew.rds")
stop_times <- readRDS("~/Desktop/EDHEC/Courses Nicolas/Msc DAAI/S1/R Programming/Project/RATP Data/rdsnew/stoptimesnew.rds")
stops <- readRDS("~/Desktop/EDHEC/Courses Nicolas/Msc DAAI/S1/R Programming/Project/RATP Data/rdsnew/stopsnew.rds")
calendar <- readRDS("~/Desktop/EDHEC/Courses Nicolas/Msc DAAI/S1/R Programming/Project/RATP Data/rds/calendar_dates.rds")
terminus <- readRDS("~/Desktop/EDHEC/Courses Nicolas/Msc DAAI/S1/R Programming/Project/RATP Data/terminus.rds")

## Convert strings to Date
calendar$date <- as.Date(as.character(calendar$date),"%Y%m%d")
stop_times$arrival_time <- strptime(stop_times$arrival_time,format = "%H:%M:%S")

## Keep Today's data
calendar <- calendar[calendar$date == Sys.Date(),]

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Paris Metro Schedule"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
          selectInput(inputId = "Line", label = "Select your line", choices = c(1,2,3,4,5,6,7,'7B',8,9,10,11,12,13,14)),
          selectInput(inputId = "Direction", label = "Select your direction", choices = NULL),
          selectInput(inputId = "Stop", label = "Select your stop", choices = NULL),
          selectInput(inputId = "Hour", label = "Select your hour of departure", choices = c(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23))
        ),

        # Show a plot of the generated distribution
        mainPanel(
          leafletOutput("map"),
          tableOutput("table")
        )
    )
)


# Define server logic required to draw a histogram
server <- function(input, output,session) {
  
  
  #Create the map
  output$map <- renderLeaflet({
    leaflet() %>%
      addProviderTiles(providers$CartoDB.Positron) %>%
      setView(lng = 2.34, lat = 48.86, zoom = 12) %>%
      addMarkers(lng = stops$stop_lon, lat = stops$stop_lat, label = stops$stop_name)
  })
  
  #Set the values that will appear in the schedule table / terminus is set as the initial values but will be replaced
  schedule <- reactiveValues()
  schedule$df <- terminus 
  
  # Reactive to adjust inputs choices, map and schedule table data
  observe({
      
    #Logic to isolate the data to render based on inputs selection
      routes.kept <- routes[routes$route_short_name %in% input$Line,]
      terminus.kept <- terminus[terminus$route_short_name %in% input$Line,]
      direction.number <- terminus[terminus$Terminus %in% terminus.kept$Terminus,]
      trips.kept <- trips[trips$route_id %in% routes.kept$route_id & trips$service_id %in% calendar$service_id & trips$direction_id %in% direction.number$route_desc,]
      stop_times.kept <- stop_times[stop_times$trip_id %in% trips.kept$trip_id,]
      stops.kept <- stops[stops$stop_id %in% stop_times.kept$stop_id,]
      
    #Reactive inputs based on the first one
      choices_Stop <- stops.kept$stop_name %>% unique() %>% sort()
      updateSelectInput(session, "Stop", choices = choices_Stop)
      updateSelectInput(session, "Direction", choices = terminus.kept$Terminus)
    
    #Stop times to render in a table 
      schedule$df <- stop_times.kept[stop_times.kept$stop_id %in% input$Stop,] %>% select(arrival_time) %>% filter((hour(arrival_time) == input$Hour)) %>% arrange(arrival_time)
     
    #Update the map 
      leafletProxy("map") %>%
        clearMarkers() %>%
        addMarkers(lng = stops.kept$stop_lon, lat = stops.kept$stop_lat, label = stops.kept$stop_name)
    
   })

  # Create the table with schedule for specific stop and hour
  output$table <- renderTable(schedule$df)

}

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

Screenshot of the app UI

非常感谢您的帮助！！最好的，

Answer 1

显示 arrival_time 列，这可能意味着错误实际上并不在渲染中。问题很可能与您的过滤有关。

如果您通过 RStudio 中的调试器运行您的代码，您可以看到这行代码：

stop_times.kept[stop_times.kept$stop_id %in% input$Stop,]

产生 0 个案例，这就是为什么您的 table 看起来是空的。我认为你在这里设置了错误的子集（你已经将它设置为寻找 stop_id 的匹配项，它是一个整数，但是来自 input$Stop 的用户输入是停止名称，它们是字符）。如果你解决这个问题，table 输出应该被修复！

R 中的闪亮应用程序：如何根据输入选择更新 table 输出

Shiny app in R : How to update table output based on inputs selection

r

shiny

reactive