Shiny中的动态小部件/井面板

Question

我正在尝试根据 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 是一个用户选择的变量，它允许用户从上传数据的列表中选择多个变量。

Answer 1

我尝试过使用您的代码，这是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)

此代码仍然需要通过一个额外的函数来改进，为max 值添加额外的textInput！