R shiny dynamic UI in insertUI

问题

I have a Shiny application where I would like to add a UI element using an action button and then have that inserted ui be dynamic.

Here is my current ui file:

library(shiny)

shinyUI(fluidPage(
  div(id="placeholder"),
  actionButton("addLine", "Add Line")
))

and server file:

library(shiny)

shinyServer(function(input, output) {
  observeEvent(input$addLine, {
    num <- input$addLine
    id <- paste0("ind", num)
    insertUI(
      selector="#placeholder",
      where="beforeBegin",
      ui={
         fluidRow(column(3, selectInput(paste0("selected", id), label=NULL, choices=c("choice1", "choice2"))))
      })
  })

})

If choice1 is selected within the specific ui element, I would like to add a textInput to the row. If choice2 is selected within the ui element, I would like to add a numericInput.

While I generally understand how to create reactive values that change in response to user input, I don't know what to do here because I do not know how to observe an element that has not been created yet and that I do not know the name of. Any help would be very appreciated!

回答1:

Code

This can be easily solved with modules:

library(shiny)

row_ui <- function(id) {
  ns <- NS(id)
  fluidRow(
    column(3, 
           selectInput(ns("type_chooser"), 
                       label = "Choose Type:", 
                       choices = c("text", "numeric"))
    ),
    column(9,
           uiOutput(ns("ui_placeholder"))
    )
  )
} 

row_server <- function(input, output, session) {
  return_value <- reactive({input$inner_element})
  ns <- session$ns
  output$ui_placeholder <- renderUI({
    type <- req(input$type_chooser)
    if(type == "text") {
      textInput(ns("inner_element"), "Text:")
    } else if (type == "numeric") {
      numericInput(ns("inner_element"), "Value:", 0)
    }
  })

  ## if we later want to do some more sophisticated logic
  ## we can add reactives to this list
  list(return_value = return_value) 
}

ui <- fluidPage(  
  div(id="placeholder"),
  actionButton("addLine", "Add Line"),
  verbatimTextOutput("out")
)

server <- function(input, output, session) {
  handler <- reactiveVal(list())
  observeEvent(input$addLine, {
    new_id <- paste("row", input$addLine, sep = "_")
    insertUI(
      selector = "#placeholder",
      where = "beforeBegin",
      ui = row_ui(new_id)
    )
    handler_list <- isolate(handler())
    new_handler <- callModule(row_server, new_id)
    handler_list <- c(handler_list, new_handler)
    names(handler_list)[length(handler_list)] <- new_id
    handler(handler_list)
  })

  output$out <- renderPrint({
    lapply(handler(), function(handle) {
      handle()
    })
  })
}

shinyApp(ui, server)

Explanation

A module is, well, a modular piece of code, which you can reuse as often as you want without bothering about unique names, because the module takes care of that with the help of namespaces.

A module consists of 2 parts:

A UI function
A server function

They are pretty much like the normal UI and server functions, with some things to keep in mind:

namespacing: within the server you can access elements from the UI as you would do normally, i.e. for instance input$type_chooser. However, at the UI part, you have to namespace your elements, by using NS, which returns a function which you can conveniently use in the rest of the code. For this the UI function takes an argument id which can be seen as the (unique) namespace for any instance of this module. The element ids must be unique within the module and thanks to the namespace, they will be also unique in the whole app, even if you use several instances of your module.
UI: as your UI is a function, which only has one return value, you must wrap your elements in a tagList if you want to return more than one element (not needed here).
server: you need the session argument, which is otherwise optional. If you want your module to communicate with the main application, you can pass in a (reactive) argument which you can use as usual in your module. Similarly, if you want your main application to use some values from the module you should return reactives as shown in the code. If you ened to creat UI elements from your server function you also need to namespace them and you cann acces the namespacing function via session$ns as shown.
usage: to use your module you insert the UI part in your main app by calling the function with an unique id. Then you have to call callModule to make the server logic work, where you pass in the same id. The return value of this call is the returnValue of your module server function and can be sued to work with values from within the module also in the main app.

This explains modules in a nutshell. A very good tutorial which explains modules in much more detail and completeness can be found here.

回答2:

You could either use insertUI() or renderUI(). insertUI() is great if you want to add multiple uis of the same kind, but i think that doesnt apply to you. I think you either want to add a numeric or a text input not both.

Therefore, i would suggest using renderUI():

  output$insUI <- renderUI({
      req(input$choice)
      if(input$choice == "choice1") return(fluidRow(column(3,
         textInput(inputId = "text", label=NULL, "sampleText"))))
      if(input$choice == "choice2") return(fluidRow(column(3, 
         numericInput(inputId = "text", label=NULL, 10, 1, 20))))
  })

If you prefer to use insertUI() you can use:

observeEvent(input$choice, {
  if(input$choice == "choice1") insUI <- fluidRow(column(3, textInput(inputId 
                                = "text", label=NULL)))
  if(input$choice == "choice2") insUI <- fluidRow(column(3, 
                                numericInput(inputId = "text", label=NULL, 10, 1, 20)))

  insertUI(
    selector="#placeholderInput",
    where="beforeBegin",
    ui={
      insUI
    })
})

and on ui side: div(id="placeholderInput").

Full code reads:

library(shiny)

ui <- shinyUI(fluidPage(
  div(id="placeholderChoice"),
  uiOutput("insUI"),
  actionButton("addLine", "Add Line")
))


server <- shinyServer(function(input, output) {
  observeEvent(input$addLine, {
    insertUI(
      selector="#placeholderChoice",
      where="beforeBegin",
      ui={
        fluidRow(column(3, selectInput(inputId = "choice", label=NULL, 
                 choices=c("choice1", "choice2"))))
      })
  })

  output$insUI <- renderUI({
      req(input$choice)
      if(input$choice == "choice1") return(fluidRow(column(3,
         textInput(inputId = "text", label=NULL, "sampleText"))))
      if(input$choice == "choice2") return(fluidRow(column(3, 
         numericInput(inputId = "text", label=NULL, 10, 1, 20))))
  })

})

shinyApp(ui, server)

来源：https://stackoverflow.com/questions/55461532/r-shiny-dynamic-ui-in-insertui

标签

Shiny