R/explore_gtfs.R

In GTFSwizard: Exploring and Manipulating 'GTFS' Files

#' Explore GTFS Data in an Interactive Shiny Application
#'
#' This function pops-up a Shiny application for exploring General Transit Feed Specification (GTFS) data.
#' The application provides an overview of the GTFS data, visualizations of route characteristics, and
#' detailed information on selected routes, allowing users to analyze various aspects of a GTFS feed interactively.
#'
#' @param gtfs A GTFS object, preferably of class `wizardgtfs`. If not, the function attempts to convert it
#' to `wizardgtfs` using `GTFSwizard::as_wizardgtfs()`.
#'
#' @details
#' The Shiny application generated by this function has two main tabs:
#' - **Overview**: Displays general GTFS information, maps, and summary charts of the transit system, including frequency, fleet, speed, and other statistics.
#' - **By Route**: Allows users to select specific routes and view detailed maps and visualizations for each selected route.
#'
#' If the provided `gtfs` object does not contain a `shapes` table, it will attempt to add it using `GTFSwizard::get_shapes()`, issuing a warning
#'
#' @return A Shiny app object that, when run, opens an interactive dashboard for GTFS data exploration.
#'
#' @examples
#' if (interactive()) {
#'   # To run the Shiny application:
#'   explore_gtfs(gtfs = GTFSwizard::for_rail_gtfs)
#' }
#'
#' @seealso
#' [GTFSwizard::as_wizardgtfs()], [GTFSwizard::get_shapes()], [GTFSwizard::plot_calendar()]
#'
#' @importFrom shiny navbarPage tabPanel fluidRow column tableOutput hr renderTable
#' @importFrom leaflet leafletOutput addTiles addProviderTiles addLayersControl addPolylines addAwesomeMarkers renderLeaflet
#' @importFrom plotly plotlyOutput renderPlotly ggplotly
#' @importFrom dplyr filter group_by reframe mutate left_join
#' @importFrom lubridate year
#' @importFrom stats setNames
#' @importFrom tibble rownames_to_column
#' @importFrom GTFSwizard as_wizardgtfs get_shapes plot_frequency get_fleet get_headways plot_calendar
#' @export
# corrigir os by dos left_join

explore_gtfs <- function(gtfs){
  UseMethod('explore_gtfs')
}

#' @exportS3Method GTFSwizard::explore_gtfs list
explore_gtfs.list <- function(gtfs){
  gtfs <- GTFSwizard::as_wizardgtfs(gtfs)
  warning('\nThis gtfs object is not of wizardgtfs class.\nComputation may take longer.\nUsing as.gtfswizard() is advised.')
  return(explore_gtfs.wizardgtfs(gtfs))
}


#' @exportS3Method GTFSwizard::explore_gtfs wizardgtfs
explore_gtfs.wizardgtfs <-
  function(gtfs){

    if(purrr::is_null(gtfs$shapes)){

      gtfs <- GTFSwizard::get_shapes(gtfs)

      warning('\nThis gtfs object does not contain a shapes table.\nUsing get_shapes().')
    }

    # ui ----
    ui <- shiny::navbarPage(
      #theme = bs_theme(bootswatch = 'cosmo'),
      title = "GTFSwizard::explore_gtfs()",
      # overview ----
      shiny::tabPanel('Overview',
                      shiny::fluidRow(
                        shiny::column(
                          width = 5,
                          leaflet::leafletOutput('overview_map1', height = '45vh'),
                          shiny::tags$style(
                            'div#overview_map1{
          width:100%;
          heigth:45vh;
          border:solid green;
          border-radius:10px;
          }')
                        ),
                        shiny::column(
                          width = 7,
                          shiny::tableOutput('agency_table'),
                        ),
                      ),
                      shiny::hr(),
                      shiny::fluidRow(
                        shiny::column(
                          width = 8,
                          plotly::plotlyOutput('freq.sparkline', height = '350px')
                        ),
                        shiny::column(
                          width = 4,
                          plotly::plotlyOutput('fleet.sparkline', height = '350px')
                        )
                      ),
                      shiny::hr(),
                      shiny::fluidRow(
                        shiny::column(
                          width = 4,
                          plotly::plotlyOutput('hist.speed', height = '300px')
                        ),
                        shiny::column(
                          width = 4,
                          plotly::plotlyOutput('hist.hw', height = '300px')
                        ),
                        shiny::column(
                          width = 4,
                          plotly::plotlyOutput('hist.dt', height = '300px')
                        )
                      ),
                      shiny::hr(),
                      shiny::fluidRow(
                        shiny::column(
                          width = 6,
                          plotly::plotlyOutput('hist.dist', height = '300px')
                        ),
                        shiny::column(
                          width = 6,
                          plotly::plotlyOutput('hist.dur', height = '300px')
                        )
                      ),
                      shiny::hr(),
                      shiny::fluidRow(
                        shiny::column(shiny::plotOutput('p.calendar',
                                                        height = paste0(as.numeric(max(lubridate::year(gtfs$dates_services$date)) - as.numeric(min(lubridate::year(gtfs$dates_services$date)))  + 5) * 75, "px")
                        ),
                        width = 12)
                      ),
                      shiny::hr()
      ),
      # BY ROUTE ----
      shiny::tabPanel('By Route',
                      fluidRow(
                        shiny::selectizeInput(inputId = 'selected.routes',
                                              label = 'Choose routes of interest:',
                                              choices = sort(unique(gtfs$routes$route_id)),
                                              multiple = TRUE)
                      ),
                      shiny::hr(),
                      fluidRow(
                        shiny::column(
                          width = 7,
                          leaflet::leafletOutput('byroute_map1',
                                                 height = '75vh'),
                          shiny::tags$style(
                            'div#overview_map1{
                          width:100%;
                          heigth:60vh;
                          border:solid red;
                          border-radius:10px;
                          }')
                        ),
                        shiny::column(
                          width = 5,
                          shiny::fluidRow(plotly::plotlyOutput('freq.sparkline.byroute',
                                               #shiny::plotOutput('freq.sparkline.byroute',
                                               height = '350px'))
                          )
                      ),
                      shiny::hr()
      ),
    )

    # server ----
    server <- function(input, output, session) {

      # agency ----
      agency <-
        gtfs$agency %>%
        dplyr::filter(agency_id %in% c(gtfs$routes$agency_id %>% unique)) %>%
        t %>%
        data.frame %>%
        tibble::rownames_to_column() %>%
        stats::setNames(c('', ''))

      output$agency_table <-
        renderTable({agency})

      # maps ----
      trips.shp <-
        tidytransit::shapes_as_sf(gtfs$shapes)

      stops.shp <-
        tidytransit::gtfs_as_sf(gtfs) %>%
        .$stops %>%
        dplyr::left_join(
          gtfs$stop_times %>%
            dplyr::group_by(stop_id) %>%
            dplyr::reframe(`# trips` = n())
        )

      output$overview_map1 <- leaflet::renderLeaflet({
        leaflet::leaflet() %>%
          leaflet::addTiles(group = "OSM") %>%
          leaflet::addProviderTiles(leaflet::providers$CartoDB.Positron,group = 'Carto-Light') %>%
          leaflet::addProviderTiles(leaflet::providers$CartoDB.DarkMatter, group = 'Carto - Dark') %>%
          leaflet::addLayersControl(baseGroups = c('Carto - Light','Carto - Dark','OSM')) %>%
          leaflet::addPolylines(data = trips.shp) %>%
          leaflet::addAwesomeMarkers(data = stops.shp,
                                     popup = ~paste0('# trips ', `# trips`, '\n', stop_name),
                                     clusterOptions = leaflet::markerClusterOptions()
          ) %>%
          leaflet.extras::addFullscreenControl() %>%
          leaflet.extras::addResetMapButton() %>%
          leaflet.extras::addControlGPS() %>%
          leaflet.extras::addSearchOSM()

      })

      # frequency ----
      output$freq.sparkline <- plotly::renderPlotly({GTFSwizard::plot_frequency(gtfs)})

      # fleet ----
      fleet <-
        GTFSwizard::get_fleet(gtfs, method = 'by.hour') %>%
        dplyr::mutate(hour = as.numeric(hour))

      output$fleet.sparkline <- plotly::renderPlotly({

        fleet.hline <-
          weighted.mean(fleet$fleet, fleet$pattern_frequency, na.rm = TRUE)

        p.fleet.sparkline <-
          ggplot2::ggplot() +
          ggplot2::geom_vline(xintercept = c(0, 6, 12, 18, 24), color = 'gray', alpha = .25, linetype = 'dashed') +
          ggplot2::geom_hline(ggplot2::aes(yintercept = fleet.hline, linetype = 'Overall\nAverage\nFleet\n'), linewidth = .75) +
          ggplot2::geom_line(data = fleet, ggplot2::aes(hour, fleet, color = service_pattern, group = service_pattern), linewidth = 1) +
          ggplot2::labs(x = 'Hour of the day', y = 'Fleet (# vehicles)', title = 'System Fleet') +
          hrbrthemes::theme_ipsum() +
          hrbrthemes::scale_y_comma(big.mark = " ") +
          ggplot2::scale_linetype_manual(values = 'dashed') +
          ggplot2::scale_x_continuous(breaks = c(0, 6, 12, 18, 24)) +
          ggplot2::theme(
            panel.grid.major.x = element_blank(),
            panel.grid.major.y = element_blank(),
            axis.ticks.x = element_blank(),
            legend.position = 'none'
          )

        suppressWarnings({
          plotly::ggplotly(p.fleet.sparkline,
                           tooltip = c('x', 'y', 'color'))
        })

      })

      # headway ----
      output$hist.hw <- plotly::renderPlotly({GTFSwizard::plot_headways(gtfs)})

      # speed ----
      speed <-
        GTFSwizard::get_speeds(gtfs, method = 'by.route')

      output$hist.speed <- plotly::renderPlotly({

        p.hist.speed <-
          ggplot2::ggplot() +
          ggplot2::geom_histogram(data = speed, ggplot2::aes(x = average.speed, weight = trips * pattern_frequency)) +
          ggplot2::geom_vline(ggplot2::aes(xintercept = mean(speed$average.speed, na.rm = TRUE), color = paste('Overall\naverage\nhourly\nSpeed of\n', mean(speed$average.speed, na.rm = TRUE) %>% round, 'km/h')), linetype = 'dashed', linewidth = .75) +
          ggplot2::labs(title = 'Speeds Distribution (for all dates)', x = 'Speed (km/h)', y = 'Frequency (# route)', colour = '') +
          hrbrthemes::scale_x_comma(big.mark = " ") +
          hrbrthemes::scale_y_comma(big.mark = " ") +
          hrbrthemes::theme_ipsum() +
          ggplot2::theme(
            axis.ticks.x = element_blank()
          ) +
          ggplot2::scale_color_manual(values = 'red')

        plotly::ggplotly(p.hist.speed)

      })

      # dwell time ----
      dwell_time <-
        get_dwelltimes(gtfs, method = 'by.hour')
        #GTFSwizard::get_dwelltimes(gtfs, method = 'by.hour')

      output$hist.dt <- plotly::renderPlotly({

        p.hist.dt <-
          ggplot2::ggplot() +
          ggplot2::geom_histogram(data = dwell_time, ggplot2::aes(x = average.dwelltime, weight = (trips * pattern_frequency))) +
          ggplot2::geom_vline(ggplot2::aes(xintercept = weighted.mean(dwell_time$average.dwelltime, dwell_time$pattern_frequency, na.rm = TRUE), color = paste('Overall\nAverage\nDwell Time\n', weighted.mean(dwell_time$average.dwelltime, dwell_time$pattern_frequency, na.rm = TRUE) %>% round, 'seconds\n')), linetype = 'dashed', linewidth = .75) +
          ggplot2::labs(title = 'Dwell Time Distribution (for all dates)', x = 'Dwell time (s)', y = 'Frequency (# trips.days)', colour = '') +
          hrbrthemes::scale_x_comma(big.mark = " ") +
          hrbrthemes::scale_y_comma(big.mark = " ") +
          hrbrthemes::theme_ipsum() +
          ggplot2::theme(
            axis.ticks.x = element_blank()
          ) +
          ggplot2::scale_color_manual(values = 'red')

        suppressMessages({
          plotly::ggplotly(p.hist.dt)
        })

      })

      # dist ----
      distances <-
        GTFSwizard::get_distances(gtfs, method = 'by.route') %>%
        dplyr::mutate(average.distance = as.numeric(average.distance))

      output$hist.dist <- plotly::renderPlotly({

        p.hist.dist <-
          ggplot2::ggplot() +
          ggplot2::geom_histogram(data = distances, ggplot2::aes(x = average.distance, weight = (trips * pattern_frequency))) +
          ggplot2::geom_vline(ggplot2::aes(xintercept = weighted.mean(distances$average.distance, distances$pattern_frequency, na.rm = TRUE), color = paste('Overall\nAverage\nDistance\n', weighted.mean(distances$average.distance, distances$pattern_frequency, na.rm = TRUE) %>% round, 'm\n')), linetype = 'dashed', linewidth = .75) +
          ggplot2::labs(title = 'Distance Distribution (for all dates)', x = 'Distance (m)', y = 'Frequency (# trips.days)', colour = '') +
          hrbrthemes::scale_x_comma(big.mark = " ") +
          hrbrthemes::scale_y_comma(big.mark = " ") +
          hrbrthemes::theme_ipsum() +
          ggplot2::theme(
            axis.ticks.x = element_blank()
          ) +
          ggplot2::scale_color_manual(values = 'red')

        suppressMessages({
          plotly::ggplotly(p.hist.dist)
        })

      })

      # dur ----
      durations <-
        GTFSwizard::get_durations(gtfs, method = 'by.route')

      output$hist.dur <- plotly::renderPlotly({

        p.hist.dur <-
          ggplot2::ggplot() +
          ggplot2::geom_histogram(data = durations, ggplot2::aes(x = average.duration, weight = (trips * pattern_frequency))) +
          ggplot2::geom_vline(ggplot2::aes(xintercept = weighted.mean(durations$average.duration, durations$pattern_frequency, na.rm = TRUE), color = paste('Overall\nAverage\nDuration\n', weighted.mean(durations$average.duration, durations$pattern_frequency, na.rm = TRUE) %>% round, 'seconds\n')), linetype = 'dashed', linewidth = .75) +
          ggplot2::labs(title = 'Duration Distribution (for all dates)', x = 'Duration (s)', y = 'Frequency (# trips.days)', colour = '') +
          hrbrthemes::scale_x_comma(big.mark = " ") +
          hrbrthemes::scale_y_comma(big.mark = " ") +
          hrbrthemes::theme_ipsum() +
          ggplot2::theme(
            axis.ticks.x = element_blank()
          ) +
          ggplot2::scale_color_manual(values = 'red')

        suppressMessages({
          plotly::ggplotly(p.hist.dur)
        })

      })

      # calendar ----
      output$p.calendar <- shiny::renderPlot({

        suppressMessages({
          GTFSwizard::plot_calendar(gtfs, facet_by_year = TRUE)
        })

      })

      # BY ROOOOOOUTE -------
      # map by route ----
      gtfs.filtered <- shiny::reactive({
        GTFSwizard::filter_route(gtfs, route = input$selected.routes)
      })

      gtfs.filtered.trips.shp <- shiny::reactive({
        tidytransit::shapes_as_sf(gtfs.filtered() %>% .$shapes)
      })

      gtfs.filtered.stops.shp <- shiny::reactive({
        tidytransit::gtfs_as_sf(gtfs.filtered()) %>%
          .$stops %>%
          dplyr::left_join(
            gtfs.filtered() %>%
              .$stop_times %>%
              dplyr::group_by(stop_id) %>%
              dplyr::reframe(`# trips` = n())
          )
      })

      output$byroute_map1 <- leaflet::renderLeaflet({
        leaflet::leaflet() %>%
          leaflet::addTiles(group = "OSM") %>%
          leaflet::addProviderTiles(leaflet::providers$CartoDB.Positron,group = 'Carto-Light') %>%
          leaflet::addProviderTiles(leaflet::providers$CartoDB.DarkMatter, group = 'Carto - Dark') %>%
          leaflet::addLayersControl(baseGroups = c('Carto - Light','Carto - Dark','OSM')) %>%
          leaflet::addPolylines(data = gtfs.filtered.trips.shp()) %>%
          leaflet::addAwesomeMarkers(data = gtfs.filtered.stops.shp(),
                                     popup = ~paste0('# trips ', `# trips`),
                                     clusterOptions = leaflet::markerClusterOptions()
          ) %>%
          leaflet.extras::addFullscreenControl() %>%
          leaflet.extras::addResetMapButton() %>%
          leaflet.extras::addControlGPS() %>%
          leaflet.extras::addSearchOSM()

      })

      # frequency by route ----
      route <- shiny::reactive({input$selected.routes})

      output$freq.sparkline.byroute <- plotly::renderPlotly({plot_routefrequency(gtfs, route())})

      # headway by route ----
      headway.byroute <- shiny::reactive({
        GTFSwizard::get_headways(gtfs.filtered(), method = 'detailed')
      })


    }

    return(shiny::shinyApp(ui, server))

  }