问R Shiny:如何动态追加任意数量的输入小部件

EN

library(shiny)


LHSchoices <- c("X1", "X2", "X3", "X4")


#------------------------------------------------------------------------------#

# MODULE UI ----
variablesUI <- function(id, number) {

  ns <- NS(id)

  tagList(
    fluidRow(
      column(6,
             selectInput(ns("variable"),
                         paste0("Select Variable ", number),
                         choices = c("Choose" = "", LHSchoices)
             )
      ),

      column(6,
             numericInput(ns("value.variable"),
                          label = paste0("Value ", number),
                          value = 0, min = 0
             )
      )
    )
  )

}

#------------------------------------------------------------------------------#

# MODULE SERVER ----

variables <- function(input, output, session, variable.number){
  reactive({

    req(input$variable, input$value.variable)

    # Create Pair: variable and its value
    df <- data.frame(
      "variable.number" = variable.number,
      "variable" = input$variable,
      "value" = input$value.variable,
      stringsAsFactors = FALSE
    )

    return(df)

  })
}

#------------------------------------------------------------------------------#

# Shiny UI ----

ui <- fixedPage(
  verbatimTextOutput("test1"),
  tableOutput("test2"),
  variablesUI("var1", 1),
  h5(""),
  actionButton("insertBtn", "Add another line")

)

# Shiny Server ----

server <- function(input, output) {

  add.variable <- reactiveValues()

  add.variable$df <- data.frame("variable.number" = numeric(0),
                                "variable" = character(0),
                                "value" = numeric(0),
                                stringsAsFactors = FALSE)

  var1 <- callModule(variables, paste0("var", 1), 1)

  observe(add.variable$df[1, ] <- var1())

  observeEvent(input$insertBtn, {

    btn <- sum(input$insertBtn, 1)

    insertUI(
      selector = "h5",
      where = "beforeEnd",
      ui = tagList(
        variablesUI(paste0("var", btn), btn)
      )
    )

    newline <- callModule(variables, paste0("var", btn), btn)

    observeEvent(newline(), {
      add.variable$df[btn, ] <- newline()
    })

  })

  output$test1 <- renderPrint({
    print(add.variable$df)
  })

  output$test2 <- renderTable({
    add.variable$df
  })

}

#------------------------------------------------------------------------------#

shinyApp(ui, server)

library(shiny)
# remotes::install_github("ardata-fr/shinytools")
library(shinytools)

ui <- fluidPage(
  fluidRow(
    column(
      3,
      filterDataUI(id = "ex"),
      actionButton("AB", label = "Apply filters")
    ),
    column(
      3,
      tags$strong("Expression"),
      verbatimTextOutput("expression"),
      tags$br(),
      DT::dataTableOutput("DT")
    )
  )
)

server <- function(input, output) {

  x <- reactive({iris})

  res <- callModule(module = filterDataServer, id = "ex", x = x, return_data = FALSE)

  output$expression <- renderPrint({
    print(res$expr)
  })

  output$DT <- DT::renderDataTable({
    datatable(data_filtered())
  })

  data_filtered <- eventReactive(input$AB, {
    filters <- eval(expr = res$expr, envir = x())
    x()[filters,]

  })
}

shinyApp(ui, server)

filters <- lazyeval::lazy_eval(res$expr, data = x())
filters <- rlang::eval_tidy(res$expr, data = x())

  # Prevent dynamic inputs from resetting
  newInputValue <- "Option 1"
  if (newInputId %in% names(input)) {
    newInputValue <- input[[newInputId]]
  }
  # Define new input
  newInput <- selectInput(newInputId, newInputLabel, c("Option 1", "Option 2", "Option 3"), selected=newInputValue)

library(shiny)

shinyUI(pageWithSidebar(

  # Application title
  headerPanel("Dynamically append arbitrary number of inputs"),

  # Sidebar with a slider input for number of bins
  sidebarPanel(
    uiOutput("allInputs"),
    actionButton("appendInput", "Append Input")
  ),

  # Show a plot of the generated distribution
  mainPanel(
    p("This shows how to add an arbitrary number of inputs
      without resetting the values of existing inputs each time a new input is added.
      For example, add a new input, set the new input's value to Option 2, then add
      another input. Note that the value of the first input does not reset to Option 1.")
  )
))

shinyServer(function(input, output) {

  output$allInputs <- renderUI({
    # Get value of button, which represents number of times pressed (i.e. number of inputs added)
    inputsToShow <- input$appendInput
    # Return if button not pressed yet
    if(is.null(inputsToShow) || inputsToShow < 1) return()
    # Initialize list of inputs
    inputTagList <- tagList()
    # Populate the list of inputs
    lapply(1:inputsToShow,function(i){
      # Define unique input id and label
      newInputId <- paste0("input", i)
      newInputLabel <- paste("Input", i)
      # Prevent dynamic inputs from resetting
      newInputValue <- "Option 1"
      if (newInputId %in% names(input)) {
        newInputValue <- input[[newInputId]]
      }
      # Define new input
      newInput <- selectInput(newInputId, newInputLabel, c("Option 1", "Option 2", "Option 3"), selected=newInputValue)
      # Append new input to list of existing inputs
      inputTagList <<- tagAppendChild(inputTagList, newInput)
    })
    # Return updated list of inputs
    inputTagList
  })

})