SelectInput 选择不会根据在 Shiny 中选择的 csv 文件动态填充

Question

在 dashboardBody 中，在 tabPanel-“tab2”title="plot" 中，我有一个 selectInput 对象，其选择基于服务器的 dataTable 输出“contents2”。这样做时，我没有在 selectInput 对象的下拉菜单中填充任何选项，而且当我尝试根据 selectInput 的选项绘制直方图时，我收到错误消息：“未找到对象 'contents2' “ 请有人指导我。

library(shinyWidgets)
library(shiny)
library(shinydashboard) 

ui <-  dashboardPage(
       dashboardHeader(title="Test"),

       dashboardSidebar(
         sidebarMenu(id = 'sbar', verbatimTextOutput("text1"),
            menuItem("File Selection", tabName = 'page1', icon = icon('line-chart'),
                     fileInput("file1", "Select CSV File", accept = c("text/csv","text/comma- 
            separated-values,text/plain",".csv")),
                     menuSubItem(actionButton(inputId="next1", label="NEXT"), tabName="next", 
                         icon="") ),
            menuItem('File Edit', tabName = 'page2',icon = icon('line-chart')),
            menuItem('Section 3',tabName = 'page3',icon = icon('line-chart')) )
          ),

     dashboardBody(
          tabItems( 
                 tabItem(tabName = "next",fluidRow(
                                     tabBox(id = "tabset1", height = "650px", width=12, 
                       tabPanel("Input Data", value="tab1", " ",
                              # fluidRow(tags$head(tags$style(HTML(" label {float:left;} "))),
                            radioGroupButtons("disp", "",label=NULL, 
                                              choices = c('Display head data'="head",'Display entire 
                                              data'="all"), selected=NULL),
                            fluidRow(DT::dataTableOutput("contents1"),style = "height:500px; 
                                     overflow-y: scroll;overflow-x: scroll;",
                                     title = "Dashboard example") ),
                   tabPanel("Plot", value="tab2", " ",  
                            selectInput("select1","Select Variable for display",choices = 
                                       c(colnames(DT::dataTableOutput("mydata")))),
                            fluidRow(plotOutput("plot1"))),
                   tabPanel("tab3 title", value='tab3', " ",
                            valueBoxOutput('tab3_valuebox'))
            ) ) ),
                 tabItem(tabName="page2", fluidRow(
                       tabBox(id = "tabset2", height = "650px", width=12, title = "My Page2 info",
                   tabPanel("Input Data", value="tab1", " ",
                            fluidRow(DT::dataTableOutput("contents2"))),
                   tabPanel("Plot", value="tab2", " ",
                            fluidRow(plotOutput("plot2")) )
            ) ) ) ) ) )

    server <- function(input, output, session) {
      
        observeEvent(input$next1, {
        updateTabItems(session, "sbar", "next")

       req(input$next1)
        if (input$next1 == 0) { 
        return(NULL)
          }else if (input$next1 == 1 & is.null(input$file1)) {
          return(NULL)
         }else { 
       inFile <- input$file1
       myfile <- read_csv(inFile$datapath)
     output$contents1 <- renderDataTable({
       if(input$disp == "head") {
       return(head(myfile))
       }else {
       return(myfile) }})
  
   output$contents2 <- renderDataTable({
    myfile }) }
  })
   observe(input$select1)
   output$text1 <- renderText(print(input$sbar))
   output$plot1 <- renderPlot({hist(contents2$input$select1)})
   output$plot2 <- renderPlot({hist(rnorm(20))})

  output$tab3_valuebox <- renderValueBox({
  valueBox('2020',subtitle = "Need to use this in future",icon = icon("car"),
         color = "red") })
  }  
 shinyApp(ui, server)

Answer 1

在服务器端处理 selectInput 并创建要使用的反应式数据框。下面的代码有效。

ui <-  dashboardPage(
  dashboardHeader(title="Test"),
  
  dashboardSidebar(
    sidebarMenu(id = 'sbar', verbatimTextOutput("text1"),
                menuItem("File Selection", tabName = 'page1', icon = icon('line-chart'),
                         fileInput("file1", "Select CSV File", accept = c("text/csv","text/comma- 
            separated-values,text/plain",".csv")),
                         menuSubItem(actionButton(inputId="next1", label="NEXT"), tabName="next", 
                                     icon="") ),
                menuItem('File Edit', tabName = 'page2',icon = icon('line-chart')),
                menuItem('Section 3',tabName = 'page3',icon = icon('line-chart')) )
  ),
  
  dashboardBody(
    tabItems( 
      tabItem(tabName = "next",fluidRow(
        tabBox(id = "tabset1", height = "650px", width=12, 
               tabPanel("Input Data", value="tab1", " ",
                        # fluidRow(tags$head(tags$style(HTML(" label {float:left;} "))),
                        radioGroupButtons("disp", "",label=NULL, 
                                          choices = c('Display head data'="head",'Display entire 
                                              data'="all"), selected=NULL),
                        fluidRow(DT::dataTableOutput("contents1"),style = "height:500px; 
                                     overflow-y: scroll;overflow-x: scroll;",
                                 title = "Dashboard example") ),
               tabPanel("Plot", value="tab2", " ",  uiOutput("selectvar"),
                        # selectInput("select1","Select Variable for display",choices = 
                        #               c(colnames(DT::dataTableOutput("mydata")))),
                        fluidRow(plotOutput("plot1"))),
               tabPanel("tab3 title", value='tab3', " ",
                        valueBoxOutput('tab3_valuebox'))
        ) ) ),
      tabItem(tabName="page2", fluidRow(
        tabBox(id = "tabset2", height = "650px", width=12, title = "My Page2 info",
               tabPanel("Input Data", value="tab1", " ",
                        fluidRow(DTOutput("contents2"))),
               tabPanel("Plot", value="tab2", " ",
                        fluidRow(plotOutput("plot2")) )
        ) ) ) ) ) )

server <- function(input, output, session) {
  
  observeEvent(input$next1, {
    updateTabItems(session, "sbar", "next")
    
    req(input$next1)
    if (input$next1 == 0) { 
      return(NULL)
    }else if (input$next1 == 1 & is.null(input$file1)) {
      return(NULL)
    }else { 
      inFile <- input$file1
      #myfile <- read_csv(inFile$datapath)
      myfile <- reactive(read_csv(inFile$datapath))
      output$contents1 <- renderDataTable({
        if(input$disp == "head") {
          return(head(myfile()))
        }else {
          return(myfile()) }})
      
      output$contents2 <- renderDT(myfile()) 
      
      output$selectvar <- renderUI({
        req(input$file1)
        selectInput("select1", "Select Variable for display",
                    choices = c(colnames(myfile())))
        
      })
      output$plot1 <- renderPlot({hist(myfile()[[input$select1]])})
    }
  })
  
  #observe(input$select1)
  output$text1 <- renderText(print(input$sbar))
  
  output$plot2 <- renderPlot({hist(rnorm(20))})
  
  output$tab3_valuebox <- renderValueBox({
    valueBox('2020',subtitle = "Need to use this in future",icon = icon("car"),
             color = "red") })
}  
shinyApp(ui, server)

SelectInput 选择不会根据在 Shiny 中选择的 csv 文件动态填充

SelectInput choices are not getting populated dynamically based on csv file chosen in Shiny

shiny

shinydashboard

shiny-server

shinyapps

shiny-reactivity