根据RShiny中的先前选择显示下拉选项

时间:2017-10-27 03:20:21

标签: r shiny

我是RShiny的新手。我想根据之前的选择填充RShiny下拉列表。 例如在下图中, 用户首先选择'路线'在此基础上安排'下拉列表会被填充,然后用户选择'计划'然后' trip'下拉列表已填充,用户选择“旅行”。输入

enter image description here

这是我的代码:

library(shiny)
library("plotly")
library(lubridate)
require(rgl)
require(akima)
library(dplyr)
library(DT)

data335 <<- read.csv("final335eonly.csv")
#data335[c(2,4,5,8,9,10)] = lapply(data335[c(2,4,5,8,9,10)], as.numeric)


routes <<- as.vector(unique(data335[,'route_no']))

ui <- fluidPage(
  titlePanel("Demand Analysis"),

  selectInput("routeInput", "Select the route", choices = routes),
  selectInput("scheduleInput", "Select the schedule", c("")),
  selectInput("tripInput", "Select the trip", c(""))



)


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

  observeEvent(input$routeInput,
    {

      x <<- input$routeInput
      updateSelectInput(session, "scheduleInput",
                        choices = data335[data335$route_no == input$routeInput, ]$schedule_no,selected = tail(x, 1)
                        )
      }
  )
  observeEvent(input$scheduleInput,
    {
      y <<- input$scheduleInput
      updateSelectInput(session, "tripInput",
                        choices = data335[(data335$route_no == input$routeInput & data335$schedule_no == input$scheduleInput), ]$trip_no,selected = tail(y, 1)
                        )
    }
  )


}
shinyApp(ui = ui, server = server)

所需的输入csv文件为here

每当我尝试运行这个看似简单的代码时,尽管UI出现,当我尝试在下拉列表中选择输入时,RShiny会崩溃。

你能告诉我这是什么造成的吗?

1 个答案:

答案 0 :(得分:1)

问题正在发生,因为您没有将唯一值作为选择。 data335[data335$route_no == input$routeInput, ]$schedule_no具有导致崩溃的重复值。

此外,您在input$routeInput中选择了scheduleInput的值,但未在选项中列出可能是导致崩溃的另一个原因。

只需评论这两个语句并为您的选择添加唯一解决方案就可以解决崩溃问题。

同样@parth在他的评论中指出为什么你在代码中到处都使用<<-,这没有必要。虽然它不是导致崩溃的原因,但除非你想在sessions之间共享变量,否则在服务器内使用<<-并不是一个好习惯。

以下是带有注释部分的代码,其中添加了两个selected个参数并添加了unique

library(shiny)
library("plotly")
library(lubridate)
require(rgl)
require(akima)
library(dplyr)
library(DT)

data335 <<- read.csv("final335eonly.csv", stringsAsFactors = FALSE)


routes <<- as.vector(unique(data335[,'route_no']))

ui <- fluidPage(
  titlePanel("Demand Analysis"),

  selectInput("routeInput", "Select the route", choices = routes),
  selectInput("scheduleInput", "Select the schedule", c("")),
  selectInput("tripInput", "Select the trip", c(""))



)


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

  observeEvent(input$routeInput,
               {

                 x <<- input$routeInput
                 updateSelectInput(session, "scheduleInput",
                                   choices =unique(data335[data335$route_no == input$routeInput, ]$schedule_no),#selected = tail(x, 1)
                 )
               }
  )
  observeEvent(input$scheduleInput,
               {
                 y <<- input$scheduleInput
                 updateSelectInput(session, "tripInput",
                                   choices = unique(data335[(data335$route_no == input$routeInput & data335$schedule_no == input$scheduleInput), ]$trip_no),#selected = tail(y, 1)
                 )
               }
  )


}
shinyApp(ui = ui, server = server)