SEPTA Map R ObserveEvent的闪亮问题

时间:2019-01-09 23:53:57

标签: r shiny leaflet gtfs

我有以下“闪亮应用程序”:

  rm(list=ls()) 

# requirements
  requirement_vector <- c("shiny", "leaflet", "tidyverse", "gtfsr", "dataMeta")
  lapply(requirement_vector, require, character.only = TRUE)

# data load
{
  zip <- get_feed(url = "https://github.com/septadev/GTFS/releases/download/v201812161/gtfs_public.zip",
                  paste0(getwd(), "/SEPTA_Site"),
                  quiet = FALSE)
  unzip(zip, exdir = paste0(getwd(), "/SEPTA_Site"))
  RailData <- import_gtfs(paste0(getwd(), "/SEPTA_Site/google_rail.zip"), local = TRUE)
  BusData  <- import_gtfs(paste0(getwd(), "/SEPTA_Site/google_bus.zip"),  local = TRUE)
  delete_vector <- list.files(paste0(getwd(), "/SEPTA_Site"), pattern = "*.zip*")
  lapply(as.list(delete_vector), function(x) file.remove(paste0(getwd(), "/SEPTA_Site/", x, "")))

  Lines <- c('Broad Street Line', 'Bus', 'Market Frankford Line', 'Regional Rail', 'Trolley')
  RRRouteNames <- unique(RailData[["routes_df"]][["route_short_name"]]) %>% sort()
  BRouteNames <- unique(BusData[["routes_df"]][["route_id"]])
  rmv <-  c('BSL', 'BSO', 'MFL', 'MFO', 'NHSL', 'LUCYGO', 'LUCYGR')
  BRouteNames <- BRouteNames[!BRouteNames %in% rmv]
  TRouteNames <- c('10', '11', '13', '15', '34', '36', '101', '102')
  BRouteNames <- BRouteNames[!BRouteNames %in% TRouteNames]

  df <- RailData[["stops_df"]]
  df <- df %>% inner_join(RailData[["stop_times_df"]],df , by = "stop_id")
  df <- df %>% inner_join(RailData[["trips_df"]],df , by = "trip_id")
  df <- df %>% inner_join(RailData[["routes_df"]],df , by = "route_id")
  keep_vector <- c("stop_id", "stop_name", "stop_lat", "stop_lon", "zone_id", 
                   "arrival_time", "departure_time", "route_id", "route_text_color",
                   "direction_id", "route_short_name")
  df <- unique(df[keep_vector])
  df$route_short_name <- paste("Route ", df$route_short_name)

  rm(delete_vector, requirement_vector,keep_vector, rmv, zip)
} 

# ui 
{
  ui <- fluidPage(

    # App title
    titlePanel("Septa Price Map"),

    sidebarLayout(

      sidebarPanel(

        # Input: Input for type & line 
        selectInput(inputId = "line", label =  "Choose Your Service:",
                    choices = Lines, selected = "Broad Street Line"),
        conditionalPanel(
          condition = "input.line == 'Regional Rail'",
          selectInput(inputId = "line2", label =  "Choose Your Route:",
                      choices = RRRouteNames)),
        conditionalPanel(
          condition = "input.line == 'Trolley'",
          selectInput(inputId = "line3", label =  "Choose Your Route:",
                      choices = TRouteNames)),
        conditionalPanel(
          condition = "input.line == 'Bus'",
          selectInput(inputId = "line4", label =  "Choose Your Route:",
                      choices = BRouteNames)),
        conditionalPanel(
          condition = "input.line == 'Bus' || input.line == 'Trolley'",
          textOutput(outputId = "description")),
        actionButton(inputId = "clear", label = "Clear Selection")
      ),
      mainPanel({
        leafletOutput(outputId = "MyMap")
      })
    )
  ) 
}

# server
{
  server <- function(input, output) {
    output$MyMap <- renderLeaflet({
      if (input$line == "Broad Street Line"){
        map_gtfs(gtfs_obj = BusData, route_ids = 'BSL', stop_opacity = .75) %>% addProviderTiles(providers$Stamen.Terrain)
    } else if (input$line == "Market Frankford Line"){
        map_gtfs(gtfs_obj = BusData, route_ids = 'MFL', stop_opacity = .75) %>% addProviderTiles(providers$Stamen.Terrain)
    } else if (input$line == "Trolley"){
        map_gtfs(gtfs_obj = BusData, route_ids = input$line3, stop_opacity = .75) %>% addProviderTiles(providers$Stamen.Terrain)
    } else if (input$line == "Bus"){
        map_gtfs(gtfs_obj = BusData, route_ids = input$line4, stop_opacity = .75) %>% addProviderTiles(providers$Stamen.Terrain)
    } else if (input$line == "Regional Rail"){
      map_gtfs(gtfs_obj = RailData, route_ids = 
                 plyr::mapvalues(input$line2, 
                 RailData[["routes_df"]][["route_short_name"]],
                 RailData[["routes_df"]][["route_id"]],
                 warn_missing = FALSE), 
                 stop_opacity = .75) %>% addProviderTiles(providers$Stamen.Terrain)
    }  

    })

    output$description <- renderText({
      if (input$line == "Trolley") {
        plyr::mapvalues(input$line3, 
                        BusData[["routes_df"]][["route_id"]],
                        BusData[["routes_df"]][["route_long_name"]],
                        warn_missing = FALSE)}
      else {
        plyr::mapvalues(input$line4, 
                        BusData[["routes_df"]][["route_id"]],
                        BusData[["routes_df"]][["route_long_name"]],
                        warn_missing = FALSE)
      }
    })

    observeEvent(input$MyMap_marker_click, { 
      print(input$MyMap_marker_click) 
    })
  }
} 

shinyApp(ui = ui, server = server)

到目前为止,该功能还不错,它对初始输入有反应,并且能够映射各个路线。我的问题来自打印“标记单击”时的最后几行代码。每个停靠点的组,纬度和经度都会打印出来,但不会打印我正在寻找的stopID。此外,还会打印出一个名为$ .nonce的东西,而且我没有运气来寻找该数字所代表的含义。 stopID出现在弹出窗口中,所以我知道它存储在地图中的某个地方,我不确定该在哪里。我是新来的有光泽和传单的人,将不胜感激。

0 个答案:

没有答案