我正在尝试使用id为“invar”的用户选择来填充动态数量的小部件/井面板。该想法是为每个用户选择的变量生成小部件/井面板,然后允许用户定义其概率分布和概率分布参数。 在定义其概率分布之后,这些变量将用于计算中。以下是代码:
library(shiny)
library(triangle)
library(readxl)
library(relaimpo)
library(data.table)
library(XLConnect)
library(xlsx)
ui <- fluidPage(
titlePanel("Sensitivity & Uncertainty Analysis"),
sidebarLayout(position = "left",
sidebarPanel(
conditionalPanel(condition = "input.tabs1==1",
tags$style(type='text/css', ".well { max-width: 20em; }"),
# Tags:
tags$head(
tags$style(type="text/css", "select[multiple] { width: 100%; height:10em}"),
tags$style(type="text/css", "select { width: 100%}"),
tags$style(type="text/css", "input { width: 19em; max-width:100%}")
),
# Select filetype:
selectInput("readFunction", "Function to read data:", c(
# Base R:
"read.table",
"read.csv",
"read.csv2",
"read.delim",
"read.delim2",
"readWorksheet",
"read_excel",
"read.xlsx"
)),
# Argument selecter:
htmlOutput("ArgSelect"),
# Argument field:
htmlOutput("ArgText"),
# Upload data:
fileInput("file", "Upload data-file:"),
# Variable selection:
htmlOutput("varselect"),
br(),
uiOutput("invar"),
br(),
uiOutput("outvar"),
textInput("name","Dataset name:","Data")),
conditionalPanel(condition = "input.tabs1==2",
sliderInput("sampleSize","Please Select Sample Size:",min = 0,max = 5000,value = 1000,step = 100),
uiOutput("distinvar"))
),
mainPanel(
tabsetPanel(id="tabs1",
tabPanel("Data File",value = 1,tableOutput("table")),
tabPanel("Monte Carlo",value=2,plotOutput("Histogram"))
)
)
))
server<-function(input, output) {
options(shiny.maxRequestSize=30*1024^2)
### Argument names:
ArgNames <- reactive({
Names <- names(formals(input$readFunction)[-1])
Names <- Names[Names!="..."]
return(Names)
})
# Argument selector:
output$ArgSelect <- renderUI({
if (length(ArgNames())==0) return(NULL)
selectInput("arg","Argument:",ArgNames())
})
## Arg text field:
output$ArgText <- renderUI({
fun__arg <- paste0(input$readFunction,"__",input$arg)
if (is.null(input$arg)) return(NULL)
Defaults <- formals(input$readFunction)
if (is.null(input[[fun__arg]]))
{
textInput(fun__arg, label = "Enter value:", value = deparse(Defaults[[input$arg]]))
} else {
textInput(fun__arg, label = "Enter value:", value = input[[fun__arg]])
}
})
### Data import:
Dataset <- reactive({
if (is.null(input$file)) {
# User has not uploaded a file yet
return(data.frame())
}
args <- grep(paste0("^",input$readFunction,"__"), names(input), value = TRUE)
argList <- list()
for (i in seq_along(args))
{
argList[[i]] <- eval(parse(text=input[[args[i]]]))
}
names(argList) <- gsub(paste0("^",input$readFunction,"__"),"",args)
argList <- argList[names(argList) %in% ArgNames()]
Dataset <- as.data.frame(do.call(input$readFunction,c(list(input$file$datapath),argList)))
return(Dataset)
})
# Select variables:
output$varselect <- renderUI({
if (identical(Dataset(), '') || identical(Dataset(),data.frame())) return(NULL)
# Variable selection:
selectInput("vars", "Variables to use:",
names(Dataset()), names(Dataset()), multiple =TRUE)
})
# Show table:
output$table <- renderTable({
if (is.null(input$vars) || length(input$vars)==0) return(NULL)
return(Dataset()[,input$vars,drop=FALSE])
})
#################################################################################
varnames<-reactive({
names(input$readFunction)
})
output$invar<-renderUI({
selectizeInput('invar',"Select Regression Input Variables", choices = names(Dataset()), multiple = TRUE)
})
output$outvar<-renderUI({
selectizeInput('outvar',"Select Regression Output Variable", choices = names(Dataset()), multiple = TRUE)
})
d.f<-Dataset
output$distinvar<-renderUI({
numvar<- length(input$invar())
lapply(1:numvar, function(i) {
selectInput("distinvar","Please Select Probability Distribution of Input Variable:",
choices = c("Normal","Uniform","Triangular"))
conditionalPanel(condition = "input.distinvar=='Normal'",
textInput("invarpdfmean","Please Select Input Variable Mean:",0.25),
textInput("invarpdfsd","Please Select Input Variable Standard Deviation", 0.02))
conditionalPanel(condition = "input.distinvar=='Uniform'",
textInput("invarpdfmin","Please Select Minimum Input Variable Value:",0.18),
textInput("invarpdfmax","Please Select Maximum Input Variable Value", 0.3))
conditionalPanel(condition = "input.distinvar=='Triangular'",
textInput("invarpdfmin","Please Select Minimum Input Variable Value:",0.18),
textInput("invarpdfmax","Please Select Maximum Input Variable Value:", 0.3))
conditionalPanel(condition = "input.distinvar=='Log Normal'",
textInput("invarpdfmeanlog","Please Select Mean Log of Input Variable:",0.18),
textInput("invarpdfsdlog","Please Select Standard Deviation Log of Input Variable:", 0.3))
})
output$MonteCarlo <- renderPlot({
set.seed(1)
n <- input$sampleSize
if(distinvar=="Normal"){
invarpdfVec <- rnorm(n,mean = as.numeric(input$invarpdfmean),sd= as.numeric(input$invarpdfsd))
}
if(distinvar=="Uniform"){
invarpdfVec <- runif(n,min = as.numeric(input$invarpdfmin),max = as.numeric(input$invarpdfmax))
}
if(distinvar=="Triangular"){
invarpdfVec <- rltriangle(n,a = as.numeric(input$invarpdfmin),b = as.numeric(input$invarpdfmax))
}
if(distinvar=="Log Normal"){
invarpdfVec <- rlnorm(n,meanlog = as.numeric(input$invarpdfmeanlog),sdlog = as.numeric(input$invarpdfsdlog))
}
for (n in 1:input$sampleSize){
h<- (0.1*distinvar+100)
}
hist(h)
})})
}
shinyApp(ui = ui, server = server)
我的方法是否正确,我不理解/做错了什么,因为我无法让它发挥作用。任何帮助将不胜感激。
编辑: 我添加了可重复的示例。 input $ invar是一个用户选择的变量,允许用户从上传数据的列表中选择一些变量。
答案 0 :(得分:2)
我尝试过使用您的代码,这是mtcars
数据集的结果:
library(shiny)
ui= fluidPage(
sidebarLayout(
sidebarPanel(
selectizeInput(inputId= "invar", label= "invar",
choices= names(mtcars),
selected= names(mtcars)[1],
multiple=T),
uiOutput("distinvar"),
uiOutput("distinvar2")
),
mainPanel(
tableOutput("tab")
)
))
server= function(input, output,session) {
sorted <- reactive({
data <- mtcars[ ,c(input$invar)]
#print(input$invar)
data})
output$distinvar<-renderUI({
numvar<- length(input$invar) # not input$ivar()!
#print(numvar)
lapply(1:numvar, function(i) {
selectInput(inputId=paste0("distinvar",input$invar[i]),paste0("Please Select Probability Distribution of ", input$invar[i]),
choices = c("Normal","Uniform","Triangular"))})})
output$distinvar2<-renderUI({
numvar<- length(input$invar) # not input$ivar()!
lapply(1:numvar, function(i) {
if(eval(parse(text=paste0("input$",paste0("distinvar",input$invar[i])))) == "Normal"){
textInput(paste0("invarpdfmean",input$invar[i]),"Please Select Input Variable Mean:",0.25)
}
else if(eval(parse(text=paste0("input$",paste0("distinvar",input$invar[i])))) == "Uniform"){
textInput(paste0("invarpdfmin",input$invar[i]),"Please Select Minimum Input Variable Value:",0.18)
}
else{
textInput(paste0("invarpdfmin",input$invar[i]),"Please Select Minimum Input Variable Value:",0.18),
}
})})
output$tab= renderTable(sorted())
}
shinyApp(ui, server)
此代码仍需通过一个额外textInput
max
值的函数进行改进!