闪亮的动态选择输入错误

Question

我从 Rstudio 闪亮示例 (http://shiny.rstudio.com/gallery/update-input-demo.html) 中学会了在闪亮的应用程序中使用动态选择输入。一切似乎都很好，但发生了错误。我测试了很多，发现错误是由于使用了动态选择输入（server.R 中的观察函数）。但我不知道如何解决它。任何帮助将不胜感激。谢谢！ 为节省篇幅，部分代码未显示。

服务器.R

load("./data/genomicVar.RData")
load("./data/geneInfo.RData")

fetchInfoByMsu <- function(locus="") {...}
fetchSnpByMsu <- function(locus="") {...}
fetchIndelByMsu <- function(locus="") {...}
fetchSvByMsu <- function(locus="") {...}
fetchExpByMsu <- function(locus="") {...}
fetchInfoByBin <- function(binNumber="") {...}
fetchGeneByBin <- function(binNumber="") {...}

shinyServer(function(input, output, session) {
  output$mytable1 = renderDataTable({...})
  output$mytable2 = renderDataTable({...})
  output$mytable3 = renderDataTable({...})
  output$mytable4 = renderDataTable({...})
  output$mytable5 = renderDataTable({...})
  output$mytable6 = renderDataTable({...})
  output$mytable7 = renderDataTable({...})

  observe({
    c_bin <- input$bin
    c_gene <- fetchGeneByBin(input$bin)
    c_gene <- c_gene$locus

    # Select input 
    s_options <- list()
    for (i in c_gene) {
      s_options[[i]] <- i
    }

    # Change values for input$inSelect
    updateSelectInput(session, "inSelect",
                      choices = s_options,
                      selected = c_gene[1]
    )
  })

  output$mytable8 = renderDataTable({...})
  output$mytable9 = renderDataTable({...})
  output$mytable10 = renderDataTable({...})
  output$mytable11 = renderDataTable({...})
  output$mytable12 = renderDataTable({...})
})

UI.R

shinyUI(fluidPage(

  fluidRow(
    absolutePanel(
      textInput("msu", label = h4("MSU genomic locus:"), 
                value = "LOC_Os07g15770"),
      tabsetPanel(
        tabPanel(strong('Information'), dataTableOutput("mytable1")),
        tabPanel(strong('SNP'), dataTableOutput("mytable2")),
        tabPanel(strong('Indels'), dataTableOutput("mytable3")),
        tabPanel(strong('SVs'), dataTableOutput("mytable4")),
        tabPanel(strong('Expression'), dataTableOutput("mytable5"))
      ),

      br(),
      p(HTML("<b><div style='background-color:#FADDF2;border:1px solid
             blue;'></div></b>")),

      textInput("bin", label = h4("Bin ID:"), value = "Bin1078"),
      tabsetPanel(
        tabPanel(strong('Information'), dataTableOutput("mytable6")),
        tabPanel(strong('Gene'), dataTableOutput("mytable7"))
      ),

      wellPanel(
        selectInput("inSelect", strong("Select gene:"),
                    c("gene 1" = "option1",
                      "gene 2" = "option2"))
      ),

      tabsetPanel(
        tabPanel(strong('Information'), dataTableOutput("mytable8")),
        tabPanel(strong('SNP'), dataTableOutput("mytable9")),
        tabPanel(strong('Indels'), dataTableOutput("mytable10")),
        tabPanel(strong('SVs'), dataTableOutput("mytable11")),
        tabPanel(strong('Expression'), dataTableOutput("mytable12"))
      ),

      br(),
      p(HTML("<b><div style='background-color:#FADDF2;border:1px solid
             blue;'></div></b>")),


      right=5, left=10
    )
  )

))

Answer 1

我更喜欢将uiOutput 用于动态输入，请参阅这个最小示例：

ui.R

shinyUI(fluidPage(
  fluidRow(
    absolutePanel(
      #select bin
      textInput("bin", label = h4("Bin ID:"), value = 1),
      #dynamic options based on selected bin
      uiOutput("inSelect")
    )
  )
)
)

server.R

shinyServer(function(input, output, session){

  #genes dataframe
  df <- data.frame(bin=c(1,1,1,2,2,2),
                   gene=c(12,13,14,21,23,24))

  #dynamic select
  output$inSelect <- renderUI({
    selectInput("inSelect", strong("Select gene:"),
                choices = df[ df$bin==input$bin,"gene"])
  })
})