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) 

は、私は私はそれが動作するように取得することはできませんよと間違っている/理解していないのです何を、正しい私のアプローチです。どんな助けもありがとう。

EDIT： 再現可能な例を追加しました。 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と1つの以上の機能によって改善する必要があります！