动态添加 UI 元素并将其输入收集到闪亮的数据框中

Question

我的ui.R函数如下图。

library(shiny)

shinyUI(pageWithSidebar(
  headerPanel("Add Features"),
  sidebarPanel(width=4,
  fluidRow( 
  column(6,  selectInput("features", label = h3("Features"), 
  choices = list("Feature1","Feature2","Feature3"), selected = "Feature1")),    

  br(),
  br(),
  column(6,  numericInput("n", label="",min = 0, max = 100, value = 50)),
  br(),
  column(2, actionButton("goButton", "Add!"))
  #column(3, submitButton(text="Analyze"))
)),


mainPanel(
verbatimTextOutput("nText"),
textOutput("text2")
)
))

我的server.R函数如下：

library(shiny)

shinyServer(function(input, output) {
 selFeatures <- data.frame()
  valFeatures <- data.frame()
  # builds a reactive expression that only invalidates 
  # when the value of input$goButton becomes out of date 
  # (i.e., when the button is pressed)
  ntext <- eventReactive(input$goButton, {

    selFeatures <- rbind(selFeatures,input$features)
    valFeatures <- rbind(valFeatures,input$n)
    paste("The variables are",input$features,input$n)
    paste("The variables are",selFeatures,valFeatures)
    })

    output$nText <- renderText({
    ntext()
  })
   output$text2 <- renderText({ 
     paste("You have selected", input$features)
   })
})

我想要做的是要求用户输入一些变量。这里Feature1、Feature2 和Feature3。用户必须输入Feature1，但Feature2 和Feature3 是可选的。因此，这里用户选择一个特征，在numericInput 中输入它的值并按下按钮Add。在选择Feature1 后按下Add 时，用户可以选择提交表单或使用添加按钮添加功能2 和3。最后，我想用这三个变量来学习一个预测模型。如何收集数据框中的所有估算信息来处理它。此外，如果可能，在添加 selectBox 后将其从 Feature1 中删除。在按下添加按钮之前，我希望我的 UI 如下所示

按下添加按钮后应该如下所示。

这里的feature1不需要在选择框中，只是显示它已经添加的方式就可以了。

Answer 1

我不太清楚您为什么要使用 selectInputs 来设置变量值，所以这里有一个关于如何从动态生成的内容访问输入的一般示例：

library(shiny)

ui <- shinyUI(pageWithSidebar(
  headerPanel("Add Features"),
  sidebarPanel(width=4,
               fluidRow(column(12,
                               h3('Features'),
                               uiOutput('uiOutpt')
               )), # END fluidRow
               fluidRow(
                 column(4,div()),
                 column(4,actionButton("add", "Add!")),
                 column(4,actionButton('goButton',"Analyze"))
               ) # END fluidRow
  ), # END sidebarPanel
  mainPanel(
    verbatimTextOutput("nText"),
    textOutput("text2"),
    tableOutput('tbl')
  )
))

server <- shinyServer(function(input, output) {
  features <- reactiveValues(renderd=c(1))

  ntext <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      fv <- paste0('numInp_',i)
      vn <- paste0('Feature',i)
      # Get input values by namw
      sprintf( 'Variable: %s, Value: %5.3f',input[[vn]],input[[fv]] )
    })
    do.call(paste,c(out,sep="\n"))
  })

  df <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      fv <- paste0('numInp_',i)
      vn <- paste0('Feature',i)
      data.frame(Variable=input[[vn]], Value=input[[fv]] )
    })
    do.call(rbind,out)
  })

  output$nText <- renderText({
    ntext()
  })
  output$text2 <- renderText({ 
    sprintf("You have selected feature: %s", paste(features$renderd,collapse=", "))
  })

  output$tbl <- renderTable({
    df()
  })

  # Increment reactive values used to store how may rows we have rendered
  observeEvent(input$add,{
    if (max(features$renderd) > 2) return(NULL)
    features$renderd <- c(features$renderd, max(features$renderd)+1)
  })

  # If reactive vector updated we render the UI again
  observe({
    output$uiOutpt <- renderUI({
      # Create rows
      rows <- lapply(features$renderd,function(i){
        fluidRow(
          column(6,  selectInput(paste0('Feature',i), 
                                 label = "", 
                                 choices = list("Feature1","Feature2","Feature3"), 
                                 selected = paste0('Feature',i))),   
          column(6,  numericInput(paste0('numInp_',i), label="",min = 0, max = 100, value = runif(1,max=100)))
        )
      })
      do.call(shiny::tagList,rows)

    })
  })
})

shinyApp(ui=ui,server=server)  

我只是将动态生成的内容的 ID 存储在一个向量中，以帮助我跟踪我生成的内容。要访问这些值，我只需从存储在向量中的数字重构元素 ID。

Answer 2

对于我面临的类似挑战，Oskar 的回答对我非常有用；对于无限的功能，我想出了如何启用“删除”按钮并在按下“添加”按钮时保留值。为了后代，这是我对奥斯卡代码的修改：

library(shiny)

ui <- shinyUI(pageWithSidebar(
  headerPanel("Add Features"),
  sidebarPanel(width=4,
               fluidRow(column(12,
                               h3('Features'),
                               uiOutput('uiOutpt')
               )), # END fluidRow
               fluidRow(
                 column(4,div()),
                 column(4,actionButton("add", "Add!")),
                 column(4,actionButton("remove", "Remove!")),
                 column(4,actionButton('goButton',"Analyze"))
               ) # END fluidRow
  ), # END sidebarPanel
  mainPanel(
    textOutput("text2"),
    tableOutput('tbl')
  )
))

server <- shinyServer(function(input, output) {
  features <- reactiveValues(renderd=c(1),
                             conv=c(50),
                             inlabels=c('A'),
                             outlabels=c('B'))

  df <- eventReactive(input$goButton, {
    out <- lapply(features$renderd,function(i){
      fv <- paste0('numInp_',i)
      vn <- paste0('InLabel',i)
      data.frame(Variable=input[[vn]], Value=input[[fv]] )
    })
    do.call(rbind,out)
  })

  output$nText <- renderText({
    ntext()
  })
  output$text2 <- renderText({ 
    paste(sprintf("You have selected feature: %s", paste(features$renderd,collapse=", ")))
  })

  output$tbl <- renderTable({
    df()
  })

  # Increment reactive values array used to store how may rows we have rendered
  observeEvent(input$add,{
    out <- lapply(features$renderd,function(i){
      fv <- paste0('numInp_',i)
      vn <- paste0('InLabel',i)
      vo <- paste0('OutLabel',i)
      data.frame(inlabels=input[[vn]],outlabels=input[[vo]], conv=input[[fv]] )
    })
    df<-do.call(rbind,out)
    print(df)
    features$inlabels <- c(as.character(df$inlabels),' ')
    features$outlabels <- c(as.character(df$outlabels),' ')
    print(c(features$inlabels,features$outlabels))

    features$renderd <- c(features$renderd, length(features$renderd)+1)
    print(features$renderd)
    print(names(features))
    features$conv<-c(df$conv,51-length(features$renderd))
  })

  observeEvent(input$remove,{
    features$renderd <- features$renderd[-length(features$renderd)]
  })

  # If reactive vector updated we render the UI again
  observe({
    output$uiOutpt <- renderUI({
      # Create rows
      rows <- lapply(features$renderd,function(i){
        fluidRow(
          # duplicate choices make selectize poop the bed, use unique():
          column(4,  selectizeInput(paste0('InLabel',i), 
                                 label = 'Input Name',selected=features$inlabels[i],
                                 choices=unique(c(features$inlabels[i],features$outlabels[!features$outlabels %in% features$inlabels])),
                                 options = list(create = TRUE))),
          column(4,  sliderInput(paste0('numInp_',i), label="Conversion",min = 0, max = 100, value = features$conv[i])),
          column(4, selectizeInput(paste0('OutLabel',i), 
                                label = "Output Name", selected=features$outlabels[i],
                                choices=unique(c(features$inlabels,features$outlabels)),
                                options = list(create = TRUE)))
        )
      })
      do.call(shiny::tagList,rows)
    })
  })
})

shinyApp(ui=ui,server=server)