有光泽的滑块的动态数目

I am trying to create an application to do exploratory analysis of simulation results datasets that are always in the same (csv) format: first column with run number, several columns that contain the input parameters, one column with the timestep and then several columns that contain the values of interest. The number of input parameters and output values change but the column names that separate these sections are always the same.

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

Typical data looks like:

典型的数据看起来像:

[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

I want the user to be able to select a subset of simulation runs to analyse, using sliders over the input parameters. This means that I need to create the appropriate number of sliders, one for each parameter input.

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

I have it reading the file and extracting the variable names, and the variables get listed properly. I also have some code working to get a single chooser with all the variables I want (inVarsChooser in code below), so the variable name construction is all correct. But I can't make it create multiple sliders (restrictRuns in code below).

我让它读取文件并提取变量名，然后正确列出变量。我也有一些代码可以使用我想要的所有变量(在下面的代码中使用inVarsChooser)来获得一个选择器，所以变量名称的构造是正确的。但是我不能让它创建多个滑动条(限制在下面的代码中)。

ui code is:

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")
               )
             )
           )
  )

))

server code is:

服务器代码是:

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())
  })

})

1 个解决方案

#1

If you want to add sliders for all variables, no matter which one you select in restrictRuns, add this to server.R:

如果您想为所有变量添加滑块，无论您在limittruns中选择哪个，请将此添加到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))
  })

})

and this to ui.R in your sidebarPanel(...):

这个ui。在你sidebarPanel R(…):

uiOutput("sliders")

Sidenote:

旁注:

If you replace:

如果你更换:

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

With:

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

You can get rid of all of the if (is.null(...)) return(NULL)

可以去掉if (is.null(…))返回(NULL)

#1