Карта SEPTA R блестящий выпуск с ObserveEvent - PullRequest
0 голосов
/ 10 января 2019

У меня есть следующее блестящее приложение:

  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 появляется во всплывающем окне, так что я знаю, что он хранится где-то на карте, я просто не уверен, где. Я новичок в блеске и листовке и буду признателен за любую помощь.

...