shiny module with observeEvent updates based on previous inputs - r

Question

I have an app which creates boxes. Each box has a button that triggers a modal. The modal has inputs which the user changes and then a button which triggers an action based on those inputs (basically just uploading to a database). Because each box has a different specification, I wrote a module and then loop thru a list, creating a box for each element. This works fine.
However, the flow in the modal and observeEvent has a flaw: the first run thru I get the desired results, but on the second occasion in the same box (same id module), after pressing the modal button to update, it will not use the new inputs, but rather what happened in the first run. I am guessing it has something to do with the namespace/observeEvent combination as I might be triggering the event with a "stored" namespace? Would I need to somehow "flush" the namespace after every update? Anyway, any help appreciated as it gets confusing fast with all the namespace/modules combinations.
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

Below is a solution that works. The problem was that you nested your observeEvent in the module. I'm not entirely sure why this led to problems, some values weren't processed correctly. However, you don't need to nest the observeEvent, the second one gets also triggered by the actionButton in the modal when it is by its own. Additionally, I included a removeModal before the success notification is shown:
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)
Please note: I made some modifications to make your MWE work:
include library(shinydashboard)
p$title and product["title"] to product
change labels to label in radioGroupButtons
comment out functionToUploadThings(product, input$change_selected_choice)
Edit
I'm still not super sure what happens when nesting the observeEvents. I made a small toy example and played around with the reactlog. It seems that nesting the observers generates a new observer for button2 every time button1 is clicked. These observers are not removed and lead to unwanted behaviour. In contrast, when using separate observeEvents, the observer for button2 is only created once.
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)