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