Question

我制作了一个有三个菜单的Shiny App：

数据：用于上传数据，选择变量并显示表格。
结果：只有在“数据”选项卡中按下“继续”按钮时才会显示。经过一些计算，结果将显示在此处。
绘图：从结果选项卡中选择结果中的变量并显示一些绘图。只有在“数据”选项卡中按下“继续”按钮时，才能使用选择变量的选项。

我已成功完成菜单1和2，但在结果选项卡中选择变量形式结果时遇到一些问题。

您可以从此链接http://en.osdn.jp/projects/sfnet_irisdss/downloads/IRIS.csv/获取Iris数据进行上传。

这是代码

library(shiny)
library(shinydashboard)
library(DT)
library(shiny)

ui <- dashboardPage(
  dashboardHeader(title = "Dashboard"),
  dashboardSidebar(sidebarMenu(
    menuItem("Data", tabName = "data", icon = icon("table")),
    menuItem("Results", tabName = "results", icon = icon("tasks")),
    menuItem("Plots", tabName = "plots", icon = icon("line-chart"))

  )),
  dashboardBody(
    tabItems(
      # First tab content
      tabItem(tabName = "data",
              fluidPage(
                fluidRow(
                  column(3,h3("Upload Your Data"),
                         fileInput('file1', 'Choose CSV File',
                                   accept=c('text/csv', 
                                            'text/comma-separated-values,text/plain', 
                                            '.csv')),
                         tags$hr(),
                         uiOutput('opts1')
                  ),

                  column(9,
                         uiOutput('box1')
                  )
                )
              )
      ),
      # Second tab content
      tabItem(tabName = "results",
              conditionalPanel("input.submit", 
                               fluidPage(box(title = "Results", solidHeader = TRUE, width = NULL, status = "primary",
                                             div(DT::dataTableOutput("showresults")))),
                                  tags$hr())

      ),
      # Third tab content
      tabItem(tabName = "plots",
              uiOutput('opts2')     
      )
    )
  )
)

server.R

shinyServer(function(input, output, session) {

  ## upload data

  theData <- reactive({
    infile <- input$file1        
    if(is.null(infile))
      return(NULL)        
    d <- read.csv(infile$datapath, header = T)
    d        
  })

  ## display data

  output$contents <- DT::renderDataTable({
    data1 <- theData()
    datatable(data1,
              options = list(searching = FALSE, filter = "top",
                             lengthMenu = list(c(10, 20, -1), c('10', '20', 'All')),
                             pageLength = 10)
    )
  })

  # dynamic box display
  output[["box1"]] <- renderUI({

    if(is.null(theData()))return()
    box(
      title = "Data", solidHeader = TRUE, width = NULL, status = "primary",
      div(style = 'overflow-x: scroll;', DT::dataTableOutput('contents'))
    )

  })

  ## dynamic input selection in Results tab
  output[["opts1"]] <- renderUI({

    if(is.null(theData())) return()
    fluidRow(selectInput('y', 'Y Variable', '---'),
             tags$hr(),
             actionButton("submit", "Proceed"))
  })

  # dynamic variable names
  observe({
    data<-theData()
    updateSelectInput(session, 'y', choices = names(data))
    #     updateSelectInput(session, 'yImp', yImp1)

  })

  resultOut <- eventReactive(input$submit,{
    var <-input$y
    data0 <- theData()
    yData <- data0[,match(var, colnames(data0))]
    data1 <- data0[,sapply(data0, is.numeric)]

    ## Some calculation
    dataOut <- colSums(data1*yData)
    dataOut <- dataOut[order(dataOut)]
    dataOut <- data.frame(Rank = 1:length(dataOut),
                             Variable = names(dataOut),
                             Sum = dataOut)
  })

  ## display result in result tab
  output$showresults <- DT::renderDataTable({
    dispRes <- resultOut()
    datatable(dispRes, rownames = F,
              options = list(lengthMenu = list(c(10, 20, -1), c('10', '20', 'All')),
                             pageLength = 10))
  })

  ## take input of variable in result Out in tab Plots

  output[["opts2"]] <- renderUI({

    if(!input$submit) return()
    fluidRow(selectInput('yOut', 'Y Variable', '---'),
             tags$hr(),
             actionButton("submit", "Proceed"))
  })

  # dynamic variable names
  observe({
    dataOut<-resultOut()
    yList <- dataOut$Variable
    updateSelectInput(session, 'yOut', choices = yList)
    #     updateSelectInput(session, 'yImp', yImp1)

  })

})

Answer 1

看起来事件似乎没有对resultOut变量做出反应，或者它在渲染选择输入之前运行。有趣的问题。我所遇到的唯一解决方案是在输出[[“opts2”]]中呈现完整的selectInput（包括选项）。这是代码：

output[["opts2"]] <- renderUI({

            if(is.null(resultOut)) return()
            dataOut <- resultOut()
            yList <- dataOut$Variable
            fluidRow(selectInput('yOut', 'Y Variable', choices = yList),
                     tags$hr(),
                     actionButton("submit1", "Proceed")
            )
    })

并移除最后一个观察者。

这个讨论可能与此有关。 R shiny Observe running Before loading of UI and this causes Null parameters

闪亮app中的动态输入选择

1 个答案: