Observeevent Shiny Function Used in a Module Does Not Work

observeEvent Shiny function used in a module does not work

The observeEvent works, but since modules only see and know the variables given to them as input parameters, it does not know the tabsetPanel specified and thus cannot update it. This problem can be solved using a reactive Value, which is passed as parameter and which is changed inside the module. Once it's changed, it is known to the main app and can update the tabsetPanel:

library(shiny)
library(shinydashboard)

moduleUI <- function(id){

ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}

module <- function(input, output, session, tabsPanel, openTab){

observeEvent(input$action1, {
if(tabsPanel() == "one"){ # input$tabsPanel == "one"
openTab("two")
}else{ # input$tabsPanel == "two"
openTab("one")
}
})

return(openTab)
}

ui <- fluidPage(
h2("Currently open Tab:"),
verbatimTextOutput("opentab"),
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))

server <- function(input, output, session){
openTab <- reactiveVal()
observe({ openTab(input$tabsPanel) }) # always write the currently open tab into openTab()

# print the currently open tab
output$opentab <- renderPrint({
openTab()
})

openTab <- callModule(module,"first", reactive({ input$tabsPanel }), openTab)
openTab <- callModule(module,"second", reactive({ input$tabsPanel }), openTab)

observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}

shinyApp(ui = ui, server = server)

Sample Image

Modularizing R Shiny code: ObserveEvent function in module

You need to wrap your input object into a reactive and use that as an input argument to your module. The other input argument is your leaflet proxy. Inside the module, you can use observe to change your proxy, which is then instantly updated:

library(shiny)
library(leaflet)
library(RColorBrewer)

# The module containing the observer. Input is the reactive handle of legend input and the proxy
mod <- function(input, output, session, legend, prox){

observe({
prox %>% clearControls()
if (legend()) {
prox %>% addLegend(position = "bottomright",
pal = colorNumeric("Blues", quakes$mag), values = ~mag
)
}
})

}

ui <- bootstrapPage(
checkboxInput("legend", "Show legend", TRUE),
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)

server <- function(input, output, session) {

output$map <- renderLeaflet({
pal <- colorNumeric("Blues", quakes$mag)
leaflet(quakes) %>% addTiles() %>%
addCircles(radius = ~10^mag/10, weight = 1, color = "#777777",
fillColor = ~pal(mag), fillOpacity = 0.7, popup = ~paste(mag)) %>%
fitBounds(~min(long), ~min(lat), ~max(long), ~max(lat))
})

# This is the handle for map
proxy <- leafletProxy("map", data = quakes)
callModule(mod, "mod", reactive(input$legend), proxy)

}

shinyApp(ui, server)

Sample Image

observeEvent with updateMaterialSwitch in shiny module not updating input

I think the problem comes from the lack of namespace specification, with the use of session$ns()

# mod_1_server
mod_1_server <- function(input, output, session, r) {

# namespace fonction
ns <- session$ns

output$switch_uncumulate_tagvals <- renderUI({
materialSwitch(
inputId = ns("uncumulate_tagvals"),
label = "label",
value = FALSE,
status = "warning"
)
})

observeEvent(req(r$is_load() == TRUE), {
updateMaterialSwitch(session = session,
inputId = "uncumulate_tagvals",
value = TRUE)
})

observeEvent(req(r$is_load() == FALSE), {
updateMaterialSwitch(session = session,
inputId = "uncumulate_tagvals",
value = FALSE)
})

}

If you need more information on how to transform as module, you can read this blog post: https://rtask.thinkr.fr/communication-between-modules-and-its-whims/

Why is an observeEvent of a button is triggered falsely (the second time)?

The option ignoreInit = TRUE should work. Try this

observeEvent(input$goBtn,  {
print(c(input$Number))
removeModal()
}, ignoreInit = TRUE)

shiny module with observeEvent updates based on previous inputs

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)

Calling shiny module a second time creates second observeEvent

One option to fix your issue would be to move the UI code to the module too and use two observeEvents inside the module server to handle the two events, i.e. showing the modal and showing the notification:

library(shiny)

modal_ui <- function(id) {
ns <- NS(id)

actionButton(ns("show_modal"), "Show Modal")
}

modal_server <- function(id) {
moduleServer(
id,
function(input, output, session) {
ns <- NS(id)

observeEvent(input$show_modal, {
showModal({
modalDialog(
actionButton(ns("show_notification"), "Show Notification")
)
})
})

observeEvent(input$show_notification, {
showNotification("hi")
})
}
)
}

ui <- fluidPage(
modal_ui("modal")
)

server <- function(input, output, session) {
modal_server(id = "modal")
}

shinyApp(ui = ui, server = server)


Related Topics



Leave a reply



Submit