闪亮的动态幻灯片数量

时间:2016-02-23 13:53:41

标签: r shiny

我正在尝试创建一个应用程序来对始终采用相同(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())
  })

})

1 个答案:

答案 0 :(得分:4)

如果要为所有变量添加滑块,无论您在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)