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