我有一个创建盒子的应用程序。每个框都有一个触发模态的按钮。模态具有用户更改的输入，然后有一个基于这些输入触发操作的按钮（基本上只是上传到数据库）。因为每个盒子都有不同的规范，所以我编写了一个模块，然后遍历一个列表，为每个元素创建一个盒子。效果很好。
但是，模态和observeEvent中的流程有一个缺陷：第一次运行通过我得到了预期的结果，但是第二次在同一框中（相同的id模块），按下模态按钮进行更新后，不会使用新的输入，而是使用第一次运行时发生的情况。我猜想它与namespace / observeEvent组合有关，因为我可能会使用“存储的”命名空间触发事件？我是否需要在每次更新后以某种方式“刷新”命名空间？无论如何，感谢任何帮助，因为它很快就会与所有名称空间/模块组合混淆。
library(shiny)
library(shinyWidgets)
ui <- navbarPage(
'page', collapsible = TRUE,
tabPanel("test",
useSweetAlert(),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('all_products_ui')
)
)
)) # end navbar
server <- shinyServer(function(input, output) {
list_products <- c(1,2,3,4,5)
# Now, I will create a UI for all the products
output$all_products_ui <- renderUI({
r <- tagList()
progress_move <- 0
for(k in 1:length( list_products )){
r[[k]] <- ExistingProductUI(id = k, product = list_products[[k]] )
}
r
})
# handlers duplicate a call to module depending on the id of ExistingProductUI
handlers <- list()
observe(
handlers <<- lapply(seq.int(length( list_products )),
function(i) {
callModule(ExistingProductUpdate,
id = i,
product = list_products[[i]] )
})
)
handlers
}) # end of server ----
# UI module ------------------------------------------------------
ExistingProductUI <- function(id, product){
ns <- NS(id)
box(title = as.character(p$title),
product["title"],
footer = tagList(
actionBttn(
inputId = ns("change_selected"), label = "change"),
)
)
}
# server module ------------------------------------------------------
ExistingProductUpdate <- function(input, output, session, product){
ns <- session$ns
observeEvent(input$change_selected, {
# when box button is clicked for this product (id)
# FIRST: show a modal
showModal(
modalDialog(
title = "what do you want to change?",
tagList(
radioGroupButtons(inputId = ns("change_selected_choice"), labels = "change x", choices = c(1,2,3,4)),
sliderInput(ns("change_selected_pct"), "change y:", min = -50, max = 100, value = 0, step = 5)
),
easyClose = TRUE,
footer = tagList(
actionButton(ns("change_selected_submit"), "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
# SECOND: when change_selected_submit is clicked,
observeEvent(input$change_selected_submit, {
# do some calculations with product using what I inputed in modal ---
# then, update a table ----
functionToUploadThings(product, input$change_selected_choice)
# THIRD: Close with a confirmation
sendSweetAlert(
session,
title = "Success!",
type = "success",
btn_labels = "Ok",
closeOnClickOutside = TRUE,
width = NULL
)
})
})
}
答案 0 :(得分：1)
以下是有效的解决方案。问题是您将observeEvent嵌套在模块中。我不完全确定为什么会导致问题，某些值未正确处理。但是，您不需要嵌套observeEvent，第二个也可以由模式中的actionButton触发，如果它是自己的。此外，在显示成功通知之前，我还添加了removeModal：
library(shiny)
library(shinyWidgets)
library(shinydashboard)
ui <- navbarPage(
'page', collapsible = TRUE,
tabPanel("test",
useSweetAlert(),
sidebarLayout(
sidebarPanel(),
mainPanel(
uiOutput('all_products_ui')
)
)
)) # end navbar
server <- shinyServer(function(input, output) {
list_products <- c(1,2,3,4,5)
# Now, I will create a UI for all the products
output$all_products_ui <- renderUI({
r <- tagList()
progress_move <- 0
for(k in 1:length( list_products )){
r[[k]] <- ExistingProductUI(id = k, product = list_products[[k]] )
}
r
})
# handlers duplicate a call to module depending on the id of ExistingProductUI
handlers <- list()
observe(
handlers <<- lapply(seq.int(length( list_products )),
function(i) {
callModule(ExistingProductUpdate,
id = i,
product = list_products[[i]] )
})
)
handlers
}) # end of server ----
# UI module ------------------------------------------------------
ExistingProductUI <- function(id, product){
ns <- NS(id)
box(title = as.character(product),
product,
footer = tagList(
actionBttn(
inputId = ns("change_selected"), label = "change"),
)
)
}
# server module ------------------------------------------------------
ExistingProductUpdate <- function(input, output, session, product){
ns <- session$ns
observeEvent(input$change_selected, {
# when box button is clicked for this product (id)
# FIRST: show a modal
showModal(
modalDialog(
title = "what do you want to change?",
tagList(
radioGroupButtons(inputId = ns("change_selected_choice"), label = "change x", choices = c(1,2,3,4)),
sliderInput(ns("change_selected_pct"), "change y:", min = -50, max = 100, value = 0, step = 5)
),
easyClose = TRUE,
footer = tagList(
actionButton(ns("change_selected_submit"), "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
})
# SECOND: when change_selected_submit is clicked,
observeEvent(input$change_selected_submit, {
# do some calculations with product using what I inputed in modal ---
# then, update a table ----
# functionToUploadThings(product, input$change_selected_choice)
# THIRD: Close with a confirmation
removeModal()
sendSweetAlert(
session,
title = "Success!",
type = "success",
btn_labels = "Ok",
closeOnClickOutside = TRUE,
width = NULL
)
})
}
shinyApp(ui, server)
请注意：为了使您的MWE正常运行，我进行了一些修改：
library(shinydashboard) p$title和product["title"]至product labels中的label更改为radioGroupButtons functionToUploadThings(product, input$change_selected_choice) 我仍然不太确定嵌套observeEvents时会发生什么。我举了一个小玩具示例，并玩着reactlog。似乎嵌套的观察者会在每次单击button2时为button1生成一个新的观察者。这些观察者不会被删除，并会导致不良行为。相反，当使用单独的observeEvents时，button2的观察者仅创建一次。
library(shiny)
library(reactlog)
ui <- fluidPage(
actionButton("button1", "click")
)
server <- function(input, output, session) {
observeEvent(input$button1, {
print("from first observer")
print(input$button2)
showModal(
modalDialog(
title = "what do you want to change?",
"some text",
easyClose = TRUE,
footer = tagList(
actionButton("button2", "submit!", icon = icon("check")),
modalButton("never mind")
)
)
)
# nested observer -> leads to remaining observers
observeEvent(input$button2, {
print("from second observer")
print(input$button2)
removeModal()
})
})
# independent observer -> generates only one observer
# observeEvent(input$button2, {
# print("from second observer")
# print(input$button2)
# removeModal()
# })
}
shinyApp(ui, server)