Shiny中滑块的动态数量

Question

我正在尝试创建一个应用程序来对始终采用相同 (csv) 格式的模拟结果数据集进行探索性分析：第一列包含运行编号，几列包含输入参数，一列包含时间步，然后包含感兴趣值的几列。输入参数和输出值的数量会发生变化，但分隔这些部分的列名始终相同。

典型数据如下：

[run number],capital,weekly,[step],report1
1,10000,100,0,0
1,10000,100,1,2
1,10000,100,2,3
1,10000,100,3,3

我希望用户能够使用输入参数上的滑块选择要分析的模拟运行子集。这意味着我需要创建适当数量的滑块，每个参数输入一个。

我让它读取文件并提取变量名，变量被正确列出。我也有一些代码可以获取包含我想要的所有变量的单个选择器（下面代码中的 inVarsChooser），因此变量名称构造都是正确的。但我不能让它创建多个滑块（下面代码中的restrictRuns）。

ui代码是：

library(shiny)

shinyUI(navbarPage("Test",

  # Choose dataset and display variables
  tabPanel("Input Data",
           sidebarLayout(

             sidebarPanel(
               uiOutput("restrictRuns"),
               br(),
               htmlOutput("inVarsChooser")
             ),

             mainPanel(
               fileInput(inputId = "bsFilename",
                         label = "Load file (table format)",
                         accept=c('text/csv', 'text/comma-separated-values,text/plain',
                                  '.csv'),
                         width = "800px"),

               column(width = 6,
                      h4("Simulation parameters"),
                      htmlOutput("inVarsDisplay")
                      ),

               column(width = 6,
                      h4("Simulation reporters"),
                      htmlOutput("outVarsDisplay")
               )
             )
           )
  )

))

服务器代码是：

library(shiny)

shinyServer(function(input, output, session) {

  bsData <- reactive({
    infile <- input$bsFilename
    if (is.null(infile)){
      return(NULL)      
    }
    read.csv(infile$datapath, stringsAsFactors = TRUE)
  })

  inVars <- reactive({
    df <- bsData()
    if (is.null(df)) return(NULL)
    bsVarnames <- names(df)
    inVars <- bsVarnames[(which(bsVarnames=="X.run.number.")+1):(which(bsVarnames=="X.step.")-1)]
  })

  outVars <- reactive({
    df <- bsData()
    if (is.null(df)) return(NULL)
    bsVarnames <- names(df)
    outVars <- bsVarnames[(which(bsVarnames=="X.step.")+1):length(bsVarnames)]
  })

  output$restrictRuns <- renderUI({
    for (ii in 1:length(inVars())) {
      sliderInput(inputId = paste("range", inVars()[ii], sep=""),
                  label = inVars()[ii],
                  min = 1, max = 1000, value = c(200,500))
    }
  })

  output$inVarsDisplay <- renderUI({
    HTML(paste(inVars(), collapse = '<br/>'))
  })

  output$outVarsDisplay <- renderUI({
    HTML(paste(outVars(), collapse = '<br/>'))
  })

  output$inVarsChooser <- renderUI({
    selectInput("dependent","Select ONE variable as dependent variable from:", inVars())
  })

})

Answer 1

如果要为所有变量添加滑块，无论您在restrictRuns 中选择哪一个，都将其添加到 server.R：

output$sliders <- renderUI({
  pvars <- inVars()
  lapply(seq(pvars), function(i) {
    sliderInput(inputId = paste0("range", pvars[i]),
                label = pvars[i],
                min = 1, max = 1000, value = c(200, 500))
  })

})

这个到你的sidebarPanel(...)中的ui.R：

uiOutput("sliders")

旁注：

如果你替换：

bsData <- reactive({
  infile <- input$bsFilename
  if (is.null(infile)){
    return(NULL)      
  }
  read.csv(infile$datapath, stringsAsFactors = TRUE)
})

与：

bsData <- reactive({
  validate(
    need(input$bsFilename, "Input a valid filepath.")
  )
  infile <- input$bsFilename
  read.csv(infile$datapath, stringsAsFactors = TRUE)
})

你可以摆脱所有的if (is.null(...)) return(NULL)