Можно ли динамически добавить новый предмет в блестящую гармошку?

Question

Можно ли динамически добавить новый предмет в блестящую гармошку, например, при нажатии на кнопку?

ниже нерабочего примера с использованием dq_accordion из пакета dqshiny

Спасибо !

library(shiny)
library(dqshiny)

shinyApp(

  ui = fluidPage(
    fluidRow(
      actionButton("add", "+"),
      dq_accordion("myAccordion", 
                   titles = paste0("input",1:3), 
                   contents = list(textInput(inputId = "txt1",
                                             label = ""),
                                   textInput(inputId = "txt2",
                                             label = ""),
                                   textInput(inputId = "txt3",
                                             label = "")),
                   bg_color = NULL, 
                   options = list(animate = 200, collapsible = TRUE),
                   icons = c(open = "hand-point-down", closed = "hand-point-right")),
      actionButton("delete", "-")
    )
  ), 

  server = function(input, output) {

    observeEvent(input$add, {
      # how to add a new item in myAccordion ?
    })
    observeEvent(input$delete, {
      # how to delete a new item in myAccordion ?
    })
  }

)

Answer 1

У меня есть решение с модулями и с функцией render_dq_box_group, я думаю, это то, что вы пытаетесь сделать:

library(shiny)
library(dqshiny)


selectorUI <- function(id){
  ns = NS(id)

  tags$div(
    fluidRow(
      column(6, uiOutput(ns('new_ui')))
      ),
    id = paste0('ui', id)
  )
}

selectorServer <- function(input, output, session){
  ns = session$ns

  output$new_ui <- render_dq_box_group({
    dq_accordion(ns("foo"), 
                 titles = ns("input"), 
                 contents = list(textInput(inputId = ns("txt"),
                                           label = "")),
                 bg_color = NULL, 
                 options = list(animate = 200, collapsible = TRUE),
                 icons = c(open = "hand-point-down", closed = "hand-point-right")
    )
  })
}


shinyApp(

  ui = fluidPage(
    fluidRow(
      actionButton("add", "+"),
      selectorUI(1),
      selectorUI(2),
      selectorUI(3),
      tags$div(id = 'placeholder'),
      actionButton("delete", "-")
    )
  ), 

  server = function(input, output) {

    callModule(selectorServer, 1)
    callModule(selectorServer, 2)
    callModule(selectorServer, 3)

    counter <- reactiveValues(value = 3) # number of inputs already present

    observeEvent(input$add, {
      counter$value <- counter$value + 1
      insertUI(
        selector = "#placeholder",
        ui = selectorUI(counter$value)
      )
      callModule(selectorServer, counter$value)
    })

    observeEvent(input$delete, {
      removeUI(
        selector = paste0("#ui", counter$value)
      )
      counter$value <- counter$value - 1
    })

  }

)

Я использовал этот ответ , чтобы сделать это решение.

Answer 2

Я переключился на tabsetPanel и функции appendTab / removeTab. Он работает безупречно, но это не аккордеон, поэтому не совсем то поведение, которое я хотел бы видеть в своем блестящем приложении ...

вот решение с tabsetPanel:

library("shiny")

ui <- shinyUI(
  fluidPage(
    fluidRow(
      actionLink("add", "add"),
      tabsetPanel(id="tab", type="pills"),
      actionLink("delete", "delete")
    )
))

server <- shinyServer(function(input, output) {

  # initialization
  counter <- reactiveVal(0) 

  observeEvent(input$delete, {
    # remove current (input$tab contains the current tabPanel)
    removeTab("tab", target=input$tab)
  })

  observeEvent(input$add, {
    counter(counter() + 1) # set the counter 
    # add a new input
    appendTab(inputId = "tab", 
              tab = tabPanel(title = paste0("input", counter()), 
                             textInput(inputId = paste0("input", counter()),
                                       label = paste0("input", counter()))
                             ), 
              select=TRUE)
  })
})

shinyApp(ui, server)