Question

作为R中的一流项目，我正在尝试构建一个Shiny应用程序以显示Paris Metro的线路，站点和时间表。

我成功地创建了一个动态地图，该地图根据选定的行显示了停靠点。我现在想显示基于选定小时的选定停止时间表。我在更新数据和显示数据时遇到问题。到目前为止，我的逻辑还不错，因为它可以在R脚本中手动工作，但是在App中，我不知道如何在表格中显示它。

如下面的屏幕快照所示，该表具有正确的标题，但内部没有数据。

如何解决这个问题？

这是我的代码：

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个个案，这就是为什么表看起来为空的原因。我认为您在这里设置了错误的子集（已将其设置为寻找stop_id的匹配项，stop_id是一个整数，但是input $ Stop中的用户输入是停止名称，即字符）。如果您修复此问题，则表输出应该已修复！

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

1 个答案: