在闪亮的应用程序中包含 insertUI 和 removeUI 的模块对操作按钮没有反应

Question

图库构建模块

我刚刚了解了 Shiny 模块，并且已经阅读了几个小时。 但是，我似乎无法弄清楚如何让 insertUI 和 removeUI 与模块和操作按钮一起工作。

这是我正在努力解决的问题：

我在 UI 上有 2 个操作按钮；一个从模块触发 insertUI，另一个触发 removeUI。后者旨在删除那些插入的 UI。

用户单击“添加”按钮会出现一个图库按钮，点击该按钮时会显示一些图像。

用户可以单击该图库中的任何图像以选择它。

图像选择会触发将显示图像名称的 renderText。

问题：“删除”按钮在模块内不起作用，我不知道为什么。 部分代码来自这个优秀的教程：https://www.r-bloggers.com/2020/02/shiny-add-removing-modules-dynamically/。

这是完整的代码。任何指导将不胜感激！

library(shiny)
library(dplyr)
library(ggplot2)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(stringr)
library(shinyanimate)
library(shinyjqui)

# Creating the Dataframe
datafofimages <- data.frame(Finance = c('Slide1.jpg', 'Slide2.jpg', 'Slide3.jpg', 'Slide4.jpg','Slide5.jpg', 'Slide6.jpg'),
                            Product = c('Slide2.jpg', 'Slide1.jpg', 'Slide3.jpg', 'Slide4.jpg','Slide5.jpg', 'Slide6.jpg'),
                            Customers = c('Slide3.jpg', 'Slide4.jpg', 'Slide1.jpg', 'Slide2.jpg','Slide5.jpg', 'Slide6.jpg'), 
                            stringsAsFactors = FALSE)

# Creating the Module UI
innerModUI <- function(id) {
  
  ns <- NS(id)

      
    dropMenu(placement = 'right',
             
             actionButton(
               inputId = ns("mydropdown1"),
               label = "Gallery of Slides",
               icon = icon("images")),
             
             br(),
             fluidRow(
               column(9,
                      column(3,
                             uiOutput(ns("picker"))),
                      column(3,
                             useShinyjs(),
                             textOutput(ns("dynamic"))),
                      column(3,
                             uiOutput(ns("remove"))))),
             
             fluidRow(
               column(10,
                      panel(style="background: #2e7c9e; width:100%; height:100%; margin:float-center;",
                            column(6, align = 'center',
                                   uiOutput(ns('img1'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                   uiOutput(ns('img2'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                   uiOutput(ns('img3'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center")),
                            column(6, align = 'center',
                                   uiOutput(ns('img4'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                   uiOutput(ns('img5'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                   uiOutput(ns('img6'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center")))))  
             
             )}

innerMod <- function(input, output, session) {
  
  ns <- session$ns
  
  tagList(
    
    output$picker <- renderUI({
      ns <- session$ns
      pickerInput(ns('selection') , choices = c('Finance', 'Product', 'Customers'))}),
    
    observeEvent(input$selection, {

    selectioned <- datafofimages %>% select(input$selection)
      
      output$img1 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('firstImage'),
                 src = paste0(selectioned[1,1]),
                 width = "90%", height = "100%") }) 
      
      output$img2 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('secondImage'),
                 src = paste0(selectioned[2,1]),
                 width = "90%", height = "100%")})
      
      output$img3 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('thirdImage'),
                 src = paste0(selectioned[3,1]),
                 width = "90%", height = "100%")})
      
      output$img4 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('fourthImage'),
           src = paste0(selectioned[4,1]),
           width = "90%", height = "100%")}) 
      
      output$img5 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('fifthImage'),
                 src = paste0(selectioned[5,1]),
                 width = "90%", height = "100%")}) 
      
      output$img6 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('sixthImage'),
                 src = paste0(selectioned[6,1]),
                 width = "90%", height = "100%")})
      
      output$dynamic <- renderText({
        req(input$selection)
        to_print <- paste0(unlist(str_remove_all(image_name(), '.jpg')))
        return(to_print)})
      })) 
  
  image_name <- reactiveVal()
  shinyjs::onclick("img1",  image_name(paste0(input$selection, ' ', 'Slide1.jpg')))
  shinyjs::onclick("img2",  image_name(paste0(input$selection, ' ', 'Slide2.jpg')))
  shinyjs::onclick("img3",  image_name(paste0(input$selection, ' ', 'Slide3.jpg')))
  shinyjs::onclick("img4",  image_name(paste0(input$selection, ' ', 'Slide4.jpg')))
  shinyjs::onclick("img5",  image_name(paste0(input$selection, ' ', 'Slide5.jpg')))
  shinyjs::onclick("img6",  image_name(paste0(input$selection, ' ', 'Slide6.jpg'))) }


ui <- fluidPage(
  
  fluidRow(
    column(12,
      actionButton("add_com",
                     style='padding:4px; font-size:80%;',
                     label = "Add", 
                     style = "fill",
                     color = "primary",
                     icon = icon("comment"),
                     size = "sm"),
        
        actionButton("rm_com",
                     style='padding:4px; font-size:80%;',
                     label = "Remove",
                     style = "fill",
                     color = "success",
                     icon = icon("comment-slash"),
                     size = "sm"))))


server <- function(input, output, session) {
  
  observeEvent(input$add_com, {
    
    i <- sprintf('%04d', input$add_com)
    id <- sprintf('lmModel%s', i)
    
    insertUI(
      selector = '#add_com',
      where = "beforeBegin",
      ui = innerModUI(id))

    callModule(innerMod, id)
    
    remove_shiny_inputs <- function(id, .input) {
      invisible(
        lapply(grep(id, names(.input), value = TRUE), function(i) {
          .subset2(.input, "impl")$.values$remove(i)
        })
      )}
    
    observeEvent(input[[paste0(id, '-rm_com')]], {
      removeUI(selector = sprintf('#%s', id))
      remove_shiny_inputs(id, input)})}) }
  

shinyApp(ui = ui, server = server)

Answer 1

未经测试（没有可重现的示例），但据我所知，问题是您没有在模块中创建删除按钮，仅在主 ui 函数中。

试试这个（虽然我还没有测试过）：

library(shiny)
library(dplyr)
library(ggplot2)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(stringr)
library(shinyanimate)
library(shinyjqui)

# Creating the Dataframe
datafofimages <- data.frame(Finance = c('Slide1.jpg', 'Slide2.jpg', 'Slide3.jpg', 'Slide4.jpg','Slide5.jpg', 'Slide6.jpg'),
                            Product = c('Slide2.jpg', 'Slide1.jpg', 'Slide3.jpg', 'Slide4.jpg','Slide5.jpg', 'Slide6.jpg'),
                            Customers = c('Slide3.jpg', 'Slide4.jpg', 'Slide1.jpg', 'Slide2.jpg','Slide5.jpg', 'Slide6.jpg'), 
                            stringsAsFactors = FALSE)

# creating helper function
remove_shiny_inputs <- function(id, .input) {
  invisible(
    lapply(grep(id, names(.input), value = TRUE), function(i) {
      .subset2(.input, "impl")$.values$remove(i)
    })
  )}

# Creating the Module UI
innerModUI <- function(id) {
  
  ns <- NS(id)
  
  
  dropMenu(placement = 'right',
           
           actionButton(
             inputId = ns("mydropdown1"),
             label = "Gallery of Slides",
             icon = icon("images")),
           
           br(),
           fluidRow(
             column(9,
                    column(3,
                           uiOutput(ns("picker"))),
                    column(3,
                           useShinyjs(),
                           textOutput(ns("dynamic"))),
                    column(3,
                           actionButton(ns("rm_com"),
                                        style='padding:4px; font-size:80%;',
                                        label = "Remove",
                                        style = "fill",
                                        color = "success",
                                        icon = icon("comment-slash"),
                                        size = "sm")))),
           
           fluidRow(
             column(10,
                    panel(style="background: #2e7c9e; width:100%; height:100%; margin:float-center;",
                          column(6, align = 'center',
                                 uiOutput(ns('img1'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                 uiOutput(ns('img2'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                 uiOutput(ns('img3'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center")),
                          column(6, align = 'center',
                                 uiOutput(ns('img4'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                 uiOutput(ns('img5'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center"),
                                 uiOutput(ns('img6'), style="cursor:pointer; margin-bottom:65px; margin-top:15px; align:center")))))  
           
  )}

innerMod <- function(input, output, session) {
  
  ns <- session$ns
    
    output$picker <- renderUI({
      ns <- session$ns
      pickerInput(ns('selection') , choices = c('Finance', 'Product', 'Customers'))})
    
    observeEvent(input$selection, {
      
      output$img1 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('firstImage'),
                 src = paste0(selectioned[1,1]),
                 width = "90%", height = "100%") }) 
      
      output$img2 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('secondImage'),
                 src = paste0(selectioned[2,1]),
                 width = "90%", height = "100%")})
      
      output$img3 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('thirdImage'),
                 src = paste0(selectioned[3,1]),
                 width = "90%", height = "100%")})
      
      output$img4 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('fourthImage'),
                 src = paste0(selectioned[4,1]),
                 width = "90%", height = "100%")}) 
      
      output$img5 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('fifthImage'),
                 src = paste0(selectioned[5,1]),
                 width = "90%", height = "100%")}) 
      
      output$img6 <- renderUI({
        ns <- session$ns
        tags$img(id = ns('sixthImage'),
                 src = paste0(selectioned[6,1]),
                 width = "90%", height = "100%")})
      
      output$dynamic <- renderText({
        req(input$selection)
        to_print <- paste0(unlist(str_remove_all(image_name(), '.jpg')))
        return(to_print)})
    }) 
  
  image_name <- reactiveVal()
  shinyjs::onclick("img1",  image_name(paste0(input$selection, ' ', 'Slide1.jpg')))
  shinyjs::onclick("img2",  image_name(paste0(input$selection, ' ', 'Slide2.jpg')))
  shinyjs::onclick("img3",  image_name(paste0(input$selection, ' ', 'Slide3.jpg')))
  shinyjs::onclick("img4",  image_name(paste0(input$selection, ' ', 'Slide4.jpg')))
  shinyjs::onclick("img5",  image_name(paste0(input$selection, ' ', 'Slide5.jpg')))
  shinyjs::onclick("img6",  image_name(paste0(input$selection, ' ', 'Slide6.jpg'))) }


ui <- fluidPage(
  
  fluidRow(
    column(12,
           actionButton("add_com",
                        style='padding:4px; font-size:80%;',
                        label = "Add", 
                        style = "fill",
                        color = "primary",
                        icon = icon("comment"),
                        size = "sm"))))


server <- function(input, output, session) {
  
  observeEvent(input$add_com, {
    
    i <- sprintf('%04d', input$add_com)
    id <- sprintf('lmModel%s', i)
    
    insertUI(
      selector = '#add_com',
      where = "beforeBegin",
      ui = innerModUI(id))
    
    callModule(innerMod, id)
    
    observeEvent(input[[paste0(id, '-rm_com')]], {
      removeUI(selector = sprintf('#%s', id))
      remove_shiny_inputs(id, input)})}) }


shinyApp(ui = ui, server = server)

• 我还删除了 tagList 函数中不需要的 server 函数
• 在开始时初始化辅助函数remove_shiny_inputs，而不是在每次插入新模块时初始化