As a first class project in R, I am trying to build a Shiny app to display Paris Metro lines, stops and schedule.
I successfully managed to create a dynamic map that show stops based on selected line. I'd like now to display selected stop schedule based on selected hour. I am having issues to update the data and to display it. So far my logic is fine as it is working manually in an R script, but in the App I don't know how to display it in a table.
As you can see in the screenshot below, the table has the right header but no data inside.
How could I turn this around ?
Here is my code:
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)
Thank you very much for your help!! Best,
