基于先前输入的带有 observeEvent 更新的闪亮模块

Question

我有一个创建盒子的应用程序。每个框都有一个触发模式的按钮。该模式具有用户更改的输入，然后是一个按钮，该按钮根据这些输入触发操作（基本上只是上传到数据库）。因为每个盒子都有不同的规格，所以我编写了一个模块，然后遍历一个列表，为每个元素创建一个盒子。这很好用。

但是，modal 和 observeEvent 中的流程有一个缺陷：第一次运行时我得到了想要的结果，但第二次在同一个框（相同的 id 模块）中，按下 modal 按钮进行更新后，它不会使用新的输入，而是使用第一次运行时发生的情况。我猜它与命名空间/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
      )
    }) 
    
  }) 
}

Answer 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
• 在radioGroupButtons 中将labels 更改为label
• 注释掉functionToUploadThings(product, input$change_selected_choice)

编辑

我仍然不确定嵌套observeEvents 时会发生什么。我做了一个小玩具示例，并玩弄了reactlog。似乎每次单击button1 时，嵌套观察者都会为button2 生成一个新的观察者。这些观察者不会被移除并导致不需要的行为。相反，当使用单独的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)