使用 insertUI 的具有动态 bs_accordion_sidebar() 的闪亮应用

Question

我正在尝试构建一个在 bs_accordion_sidebar 中插入滑块的动态 Shiny 应用程序。

“添加”按钮运行良好，但我不知道应该在“删除”按钮代码中添加什么来更新条形图？

另外，当点击面板标题时，我认为它应该折叠并改变他的颜色但没有任何反应？

感谢您的帮助！

library(shiny)
library(bsplus)

# global button counter 
cpt <- 0

# function to create a new slider input
newinput <- function(ID, tag){ 

  div(id=ID,

      bs_append(
        tag = tag,
        title_side = ID,
        content_side = NULL,
        content_main = sliderInput( inputId = paste0("slider_",ID),
                                    label = paste0("slider_",ID),
                                    value = 0,
                                    min=0,
                                    max=10)
      )
  )

}

# UI
ui <- shinyUI(fluidPage(

  titlePanel("bs_append and insertUI"),

  sidebarPanel(

    fluidRow(
      actionButton("add", "+"),
      mytag <- bs_accordion_sidebar(id = "accordion",
                                     spec_side = c(width = 4, offset = 0),
                                     spec_main = c(width = 8, offset = 0)),
      div(id = "placeholder"),
      actionButton("delete", "-")
    )
  ),

  mainPanel(
    plotOutput('show_inputs')
  ),

  use_bs_accordion_sidebar() 

))

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

  # reactive function to collect all input values
  AllInputs <- reactive({
    myvalues <- sapply(names(input)[!names(input) %in% c("add", "delete")], function(x) input[[x]])
    print(myvalues)
    return(myvalues)
  })

  # simple output barplot 
  output$show_inputs <- renderPlot({
    barplot(AllInputs())
  })

  # take a dependency on 'add' button
  observeEvent(input$add, {

    cpt <<- cpt + 1 

    insertUI(
      selector ='#placeholder',
      where = "beforeEnd",
      ui = newinput(ID = cpt, 
                    tag = mytag)
    )
  })

  # take a dependency on 'delete' button
  observeEvent(input$delete, {

    removeUI(selector = paste0('#', cpt))

    cpt <<- cpt - 1

  })

})


shinyApp(ui, server)

Answer 1

我在这里找到了答案：https://stackoverflow.com/a/51517902/12812645 有必要使 removeUI 删除的输入无效

这里是使用 shinyjs 的更正代码：

library(shiny)
library(bsplus)
library(shinyjs)

# global button counter 
cpt <- 0

# function to create a new slider input
newinput <- function(ID, tag){ 

  div(id=ID,
      bs_append(
        tag = tag,
        title_side = ID,
        content_side = NULL,
        content_main = sliderInput( inputId = paste0("slider_",ID),
                                    label = paste0("slider_",ID),
                                    value = 0,
                                    min=0,
                                    max=10)
      )
  )

}

# UI
ui <- shinyUI(fluidPage(

  titlePanel("bs_append and insertUI"),

  sidebarPanel(

    fluidRow(
      actionButton("add", "+"),
      mytag <- bs_accordion_sidebar(id = "accordion",
                                     spec_side = c(width = 4, offset = 0),
                                     spec_main = c(width = 8, offset = 0)),
      div(id = "placeholder"),
      actionButton("delete", "-")
    )
  ),

  mainPanel(
    plotOutput('show_inputs')
  ),

  useShinyjs(debug = TRUE),
  use_bs_accordion_sidebar() 

))

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

  # reactive function to collect all input values
  AllInputs <- reactive({
    myvalues <- sapply(names(input)[!names(input) %in% c("add", "delete")], function(x) input[[x]])
    myvalues <- unlist(myvalues[!unlist(lapply(myvalues, is.null))])
    print(myvalues)
    return(myvalues)
  })

  # simple output barplot 
  output$show_inputs <- renderPlot({
    barplot(AllInputs())
  })

  # take a dependency on 'add' button
  observeEvent(input$add, {

    cpt <<- cpt + 1 

    insertUI(
      selector ='#placeholder',
      where = "beforeEnd",
      ui = newinput(ID = cpt, 
                    tag = mytag)
    )

  })

  # take a dependency on 'delete' button
  observeEvent(input$delete, {

    removeUI(selector = paste0('#', cpt))
    runjs(paste0('Shiny.onInputChange("slider_',cpt,'", null)'))
    cpt <<- cpt - 1

  })

})


shinyApp(ui, server)