R блестящий динамический интерфейс в insertUI

Question

У меня есть приложение Shiny, в котором я хотел бы добавить элемент пользовательского интерфейса с помощью кнопки действия, а затем вставить его в динамический интерфейс.

Вот мой текущий файл пользовательского интерфейса:

library(shiny)

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

и файл сервера:

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"))))
      })
  })

})

Если в конкретном элементе пользовательского интерфейса выбран choice1, я бы хотелдобавить textInput в строку.Если в элементе пользовательского интерфейса выбран choice2, я бы хотел добавить numericInput.

Хотя я обычно понимаю, как создавать реактивные значения, которые изменяются в ответ на ввод пользователя, я не знаю, что здесь делать, потому что я не знаю, как наблюдать элемент, который еще не был создан и которыйЯ не знаю имени.Любая помощь будет принята с благодарностью!

Answer 1

Код

Эту проблему легко решить с помощью модулей :

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)

Объяснение

Модуль - это модульный фрагмент кода, который вы можете использовать повторно столько раз, сколько захотите, не беспокоясь об уникальных именах, потому что модуль заботится об этом с помощью namespaces.

Модуль состоит из 2 частей:

1. A UI функция
2. A server функция

Они очень похожи на обычные функции UI и server, с некоторыми вещами, о которых следует помнить:

• namespacing: на сервере вы можете получить доступ к элементам из UI, как вы это делаете обычно, то есть, например, input$type_chooser. Однако в части UI вы должны namespace ваших элементов, используя NS, который возвращает функцию, которую вы можете удобно использовать в остальной части кода. Для этого функция UI принимает аргумент id, который можно рассматривать как (уникальное) пространство имен для любого экземпляра этого модуля. Элемент ids должен быть уникальным в модуле, и благодаря пространству имен они также будут уникальными во всем приложении, даже если вы используете несколько экземпляров вашего модуля.
• UI: так как ваш UI является функцией, которая имеет только one возвращаемое значение, вы должны обернуть свои элементы в tagList, если вы хотите вернуть более одного элемента (не нужно здесь).
• server: вам нужен аргумент session, который не является обязательным. Если вы хотите, чтобы ваш модуль связывался с основным приложением, вы можете передать (реактивный) аргумент, который вы можете использовать как обычно в вашем модуле. Точно так же, если вы хотите, чтобы ваше основное приложение использовало некоторые значения из модуля, вы должны вернуть реактивы, как показано в коде. Если вы хотите создать UI элементы из серверной функции, вам также необходимо указать их пространство имен, и вы не сможете получить доступ к функции пространства имен через session$ns, как показано.
• usage: чтобы использовать свой модуль, вы вставляете деталь UI в свое основное приложение, вызывая функцию с уникальным id. Затем вам нужно позвонить callModule, чтобы заставить серверную логику работать, где вы переходите в тот же id. Возвращаемое значение этого вызова - returnValue вашей серверной функции модуля и может использоваться для работы со значениями внутри модуля, также в основном приложении.

Это объясняет модули в двух словах. Очень хороший учебник, который объясняет модули более подробно и полно, можно найти здесь .

Answer 2

Вы можете использовать insertUI() или renderUI(). insertUI() замечательно, если вы хотите добавить несколько пользователей одного и того же вида, но я думаю, что это не относится к вам. Я думаю, что вы хотите добавить числовой или текстовый ввод, а не оба.

Поэтому я бы предложил использовать 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))))
  })

Если вы предпочитаете использовать insertUI(), вы можете использовать:

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
    })
})

и на стороне пользовательского интерфейса: div(id="placeholderInput").

Полный код:

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)