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)
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)
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
andproduct["title"]
toproduct
- change
labels
tolabel
inradioGroupButtons
- 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 observeEvent
s 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
How to Use Aggregate Function in R
Transfer Values from One Dataframe to Another
R/Ggplot2: Collapse or Remove Segment of Y-Axis from Scatter-Plot
How to Turn the Numeric Output of Boxplot (With Plot=False) into Something Usable
Rotate Labels in a Chorddiagram (R Circlize)
Convert Lat/Lon to Zipcode/Neighborhood Name
More Efficient Strategy for Which() or Match()
Match.Call with Default Arguments
R: How to Select Files in Directory Which Satisfy Conditions Both on the Beginning and End of Name
Import Multiple Text Files in R and Assign Them Names from a Predetermined List
How to Use 'Assign()' or 'Get()' on Specific Named Column of a Dataframe
How to Save Interactive Charts from Dygraph
Add Image (Png File) to Header of PDF File Created with R
Create Multiple Data Frames from One Based Off Values with a for Loop
How to Replace Numeric Codes with Value Labels from a Lookup Table