r - 在闪亮的应用程序中包含 insertUI 和 removeUI 的模块对操作按钮没有反应
问题描述
图片库的构建模块
我刚刚了解了 Shiny 模块，并且已经阅读了几个小时。但是，我似乎无法弄清楚如何让 insertUI 和 removeUI 与模块和操作按钮一起工作。
这是我正在努力解决的问题：
问题：“删除”按钮在模块内不起作用，我不知道为什么。一些代码来自这个优秀的教程：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)
解决方案
未经测试（没有可重复的示例），但据我所知，问题是您没有在模块内创建删除按钮，仅在主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，而不是每次插入新模块时
推荐阅读
- php - 无法发布/contact_process.php
- python - 如何在 django 中处理 PUT 请求？（不在 drf 中）
- python - Python中调用堆栈的内核可见性
- excel - 使用 VLookup 创建功能 DATE() 格式输出
- python - Python抓取bs4 TypeError：'NoneType'对象不可下标
- html - 为什么当我在 href 中添加双重映射时没有加载引导文件？
- sql - 多个一对一关系 - 插入新记录问题
- parse-platform - 如何使用 New Relic 跟踪 Parse Server 的类名？
- go - 更改 Gin 中间件中的 Content-Type 标头
- scala - 带有尾递归的除 Self 之外的数组的乘积