R 如果填充了多个选项，则selectInput将不会激发（以闪亮方式）

我有一个闪亮的应用程序，可以很好地工作，但是当有多个应用程序可供选择时，selectInput值不起作用

“闪亮”的设计理念是： 我选一个学生 选择一个学生参加考试的日期 3.找出学生的年龄 4将学生的分数与过去参加测试的年龄相似的人群进行对比

该应用程序如下所示：

它工作正常，但在创建selectInput下拉列表并根据年龄调整滑块后，当有多个选项时，它不会启动：

问题是我不知道在哪里输入$dates来选择ID

我以前也遇到过类似的问题，但这是一个新问题

编辑 对于任何通过谷歌或诸如此类的方式来到这里的人，我只想说，@Andriy Tkachenko下面的答案是一个很好的工作示例，可以扩展到您正在从事的任何项目中。假设您的项目可能需要选择有多个ID且每个ID都有相应日期的行

应用程序R

---

这是修改后的代码。我已经突出显示了我更改内容的部分。看一看:

library('shiny')
library('plyr')
library('ggplot2')
library('data.table')

new_students <- data.frame(id=c(1,2,2,3), date=c('1/1/2011', '2/2/2012', '2/2/2022', '3/3/2013')
                           , age=c(15, 25, 35, 45), score=c(-0.80,  0.21, 1.0, -0.07))
new_students$date <- as.character(new_students$date)
historic_students <- 
  data.frame(age=c(11,12,15,16,19,21,22,25,26,29,31,32,35,36,39,41,42,45,46,49)
             , score=(rnorm(20)))

# we must deal with the fact that Shiny barfs on duplicates. 
# we need to append a visit number (eg,  'C1)' ) to the end of the `date` string.
DT_new_students <- data.table(new_students)
DT_new_students[, .id := sequence(.N), by = "id"]
new_students$date <- paste(new_students$date, '   (', DT_new_students$.id, ')', sep='')



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

  get_selected_student <- 
    reactive({student <- new_students[which(new_students$id==input$id), ]
    #------------------------------------------------!
    ########## here I return all subseted data
    #------------------------------------------------!
    return(student)
    #------------------------------------------------!

    })

  output$dates<-renderUI({
    # print("HI")
    selectInput('dates', 'Select Date'
                #------------------------------------------------!
                ########## here take 1 row from get_selected_student because it is the same in all rows
                #------------------------------------------------!
                , choices=new_students[new_students$id ==  input$id, "date"]
                , selected = 1
                #------------------------------------------------!

                , selectize = FALSE)
  })

  output$age_input <- renderUI({

    new_cust <- get_selected_student()

    new_cust <- new_cust[new_cust$date == input$dates,]

    new_min <- round_any(new_cust$age, 10, floor)
    new_max <- new_min+9

    if(is.na(new_min)){  # before any PIDN is selected, the observe still runs. 
      # Thus we needed to prevent an NA here
      # , which was appearing on the lower bound of the slider.
      new_min <- min_age
    }
    if(is.na(new_max)){
      new_max <- max_age
    }

    sliderInput(inputId="age", "Age of historic students:", min=0
              , max = 55, value=c(new_min, new_max), step=1, ticks=TRUE)
  })


  subset_historic_students <- reactive({
    DF <- historic_students[which((input$age[1] <= historic_students$age) & 
                                    (input$age[2] >= historic_students$age)), ]
    return(DF)
  })


  ## age text output
  output$print_age <- renderText({
    selected_student <- get_selected_student()
    if (is.numeric((selected_student[1, 'age'])) &&
        !is.na((selected_student[1, 'age']))){
      paste("Age of selected student: ", selected_student[1, 'age'])
    }
  })


  output$distPlot <- renderPlot({
    plotme <<- subset_historic_students()
    p <- ggplot(data=plotme, aes(x=plotme$age, y=plotme$score))+ geom_point()
    my_cust_age <- data.frame(get_selected_student())

    #------------------------------------------------!
    ########## here is where dates input plays
    #------------------------------------------------!
    my_cust_age <- my_cust_age[my_cust_age$date == input$dates,]
    #------------------------------------------------!

    p <- p + geom_vline(data=my_cust_age, aes(xintercept=age))
    print(p)
  })



}

ui <- fluidPage( headerPanel(title = ""),
                 sidebarLayout(
                   sidebarPanel(
                     #------------------------------------------------!
                     ########## add min and max values to a input
                     #------------------------------------------------!
                     numericInput(inputId="id", label="Select new student:", value=1
                                  , min = 1, max = 3),
                     #------------------------------------------------!
                     uiOutput("dates"),
                     textOutput("print_age"),
                     htmlOutput("age_input")
                   ),
                   mainPanel(plotOutput("distPlot"))
                 )
)

shinyApp(ui = ui, server = server)

---

你是说选择日期输入不起作用吗？@Matt O'Brien当我试图更改“选择新学生”NumericiInput对象中的值时，上面发布的代码立即崩溃。您确定这就是您描述上述问题的代码吗？我不能改变这个学生！我想您需要使用updateSelectInput来解决上述问题@是的，当我尝试为第一个学生选择第二个可用日期时，应用程序不会执行。你知道为什么会这样吗？“@Shiva:你能再试一次吗？我将代码复制并粘贴回RStudio中的空白脚本中，并执行了它，它工作正常。您是否安装了data.table？应该有3个学生可供选择…第二个学生在选择他/她的第二个可用日期时遇到问题。好的，我正在努力。希望在几分钟内发布答案这真的很有趣。原来我没有必要用我放进去的观察块。输入的$日期显示在进行绘图的块中。谢谢

library('shiny')
library('plyr')
library('ggplot2')
library('data.table')

new_students <- data.frame(id=c(1,2,2,3), date=c('1/1/2011', '2/2/2012', '2/2/2022', '3/3/2013')
                           , age=c(15, 25, 35, 45), score=c(-0.80,  0.21, 1.0, -0.07))
new_students$date <- as.character(new_students$date)
historic_students <- 
  data.frame(age=c(11,12,15,16,19,21,22,25,26,29,31,32,35,36,39,41,42,45,46,49)
             , score=(rnorm(20)))

# we must deal with the fact that Shiny barfs on duplicates. 
# we need to append a visit number (eg,  'C1)' ) to the end of the `date` string.
DT_new_students <- data.table(new_students)
DT_new_students[, .id := sequence(.N), by = "id"]
new_students$date <- paste(new_students$date, '   (', DT_new_students$.id, ')', sep='')



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

  get_selected_student <- 
    reactive({student <- new_students[which(new_students$id==input$id), ]
    #------------------------------------------------!
    ########## here I return all subseted data
    #------------------------------------------------!
    return(student)
    #------------------------------------------------!

    })

  output$dates<-renderUI({
    # print("HI")
    selectInput('dates', 'Select Date'
                #------------------------------------------------!
                ########## here take 1 row from get_selected_student because it is the same in all rows
                #------------------------------------------------!
                , choices=new_students[new_students$id ==  input$id, "date"]
                , selected = 1
                #------------------------------------------------!

                , selectize = FALSE)
  })

  output$age_input <- renderUI({

    new_cust <- get_selected_student()

    new_cust <- new_cust[new_cust$date == input$dates,]

    new_min <- round_any(new_cust$age, 10, floor)
    new_max <- new_min+9

    if(is.na(new_min)){  # before any PIDN is selected, the observe still runs. 
      # Thus we needed to prevent an NA here
      # , which was appearing on the lower bound of the slider.
      new_min <- min_age
    }
    if(is.na(new_max)){
      new_max <- max_age
    }

    sliderInput(inputId="age", "Age of historic students:", min=0
              , max = 55, value=c(new_min, new_max), step=1, ticks=TRUE)
  })


  subset_historic_students <- reactive({
    DF <- historic_students[which((input$age[1] <= historic_students$age) & 
                                    (input$age[2] >= historic_students$age)), ]
    return(DF)
  })


  ## age text output
  output$print_age <- renderText({
    selected_student <- get_selected_student()
    if (is.numeric((selected_student[1, 'age'])) &&
        !is.na((selected_student[1, 'age']))){
      paste("Age of selected student: ", selected_student[1, 'age'])
    }
  })


  output$distPlot <- renderPlot({
    plotme <<- subset_historic_students()
    p <- ggplot(data=plotme, aes(x=plotme$age, y=plotme$score))+ geom_point()
    my_cust_age <- data.frame(get_selected_student())

    #------------------------------------------------!
    ########## here is where dates input plays
    #------------------------------------------------!
    my_cust_age <- my_cust_age[my_cust_age$date == input$dates,]
    #------------------------------------------------!

    p <- p + geom_vline(data=my_cust_age, aes(xintercept=age))
    print(p)
  })



}

ui <- fluidPage( headerPanel(title = ""),
                 sidebarLayout(
                   sidebarPanel(
                     #------------------------------------------------!
                     ########## add min and max values to a input
                     #------------------------------------------------!
                     numericInput(inputId="id", label="Select new student:", value=1
                                  , min = 1, max = 3),
                     #------------------------------------------------!
                     uiOutput("dates"),
                     textOutput("print_age"),
                     htmlOutput("age_input")
                   ),
                   mainPanel(plotOutput("distPlot"))
                 )
)

shinyApp(ui = ui, server = server)