I would like to use an eventReactive-function in a shiny module. However that does not work as expected. What is wrong with my code or what do I have to add?
I have already tried observers but I want to use eventReactive because I need the return-value.
mod_test_UI <- function(id) {
ns <- NS(id)
actionButton(ns("test"), "Test")
}
mod_test <- function(input, output, session) {
ns <- session$ns
observe({
print(input$test)
})
result<- eventReactive(input$test, {
print("ABC")
})
}
ui <- tagList(
mod_test_UI("test-mod")
)
server <- function(input, output, session) {
callModule(mod_test, "test-mod")
}
# app
shinyApp(ui = ui, server = server)
You need to return a value within eventReactive as below:
mod_test_UI <- function(id) {
ns <- NS(id)
actionButton(ns("test"), "Test")
}
mod_test <- function(input, output, session) {
ns <- session$ns
observe({
print(input$test)
})
result<- eventReactive(input$test, {
return("ABC")
})
observe({
print(result())
})
}
ui <- tagList(
mod_test_UI("test-mod")
)
server <- function(input, output, session) {
callModule(mod_test, "test-mod")
}
# app
shinyApp(ui = ui, server = server)
The second observe just prints the value now contained in result() to the screen to prove that it works.
The return() in this case is not necessary and it could just be "ABC" as below:
result<- eventReactive(input$test, {
"ABC"
})
Related
I can create a module that inserts a button and triggers a browser() call inside an observeEvent() when the button is clicked:
library(shiny)
mod_ui <- function(id){
ns <- NS(id)
actionButton(ns("test"), "Test")
}
mod_server <- function(id) {
moduleServer(id, function(input, output, session){
ns <- session$ns
observeEvent(input$test, {
browser()
})
})
}
ui <- fluidPage(
mod_ui("mod_top")
)
server <- function(input, output, session){
mod_server("mod_top")
}
shinyApp(ui = ui, server = server)
But if I insert this module inside another module using insertUI, the browser call is no longer triggered:
library(shiny)
mod_ui <- function(id) {
ns <- NS(id)
div(
id = ns("place_here"),
actionButton(ns("add"), "Add")
)
}
mod_server <- function(id) {
moduleServer(id, function(input, output, session){
ns <- session$ns
observeEvent(input$add, {
insertUI(
immediate = TRUE,
selector = paste0("#", ns("place_here")),
where = "beforeEnd",
ui = mod_ui2(ns("mod_inner"))
)
mod_server2(ns("mod_inner"))
})
})
}
mod_ui2 <- function(id){
ns <- NS(id)
actionButton(ns("test"), "Test")
}
mod_server2 <- function(id) {
moduleServer(id, function(input, output, session){
ns <- session$ns
observeEvent(input$test, {
browser()
})
})
}
ui <- fluidPage(
mod_ui("mod_top")
)
server <- function(input, output, session){
mod_server("mod_top")
}
shinyApp(ui = ui, server = server)
How do I trigger the browser call?
Just needed to remove the namespacing of the nested server module:
mod_server2("mod_inner")
Here is the full working app:
library(shiny)
mod_ui <- function(id) {
ns <- NS(id)
div(
id = ns("place_here"),
actionButton(ns("add"), "Add")
)
}
mod_server <- function(id) {
moduleServer(id, function(input, output, session){
ns <- session$ns
observeEvent(input$add, {
insertUI(
immediate = TRUE,
selector = paste0("#", ns("place_here")),
where = "beforeEnd",
ui = mod_ui2(ns("mod_inner"))
)
mod_server2("mod_inner")
})
})
}
mod_ui2 <- function(id){
ns <- NS(id)
actionButton(ns("test"), "Test")
}
mod_server2 <- function(id) {
moduleServer(id, function(input, output, session){
ns <- session$ns
observeEvent(input$test, {
browser()
})
})
}
ui <- fluidPage(
mod_ui("mod_top")
)
server <- function(input, output, session){
mod_server("mod_top")
}
shinyApp(ui = ui, server = server)
Now I understand what you were trying to do. Needed to remove the ns() from mod_server2. Also, as pointed out in previous response, needed to correct for input$test.
library(shiny)
mod_ui <- function(id) {
ns <- NS(id)
div(
id = ns("place_here"),
actionButton(ns("add"), "Add")
)
}
mod_server <- function(id) {
moduleServer(id, function(input, output, session){
observeEvent(input$add, {
ns <- session$ns
insertUI(
immediate = TRUE,
selector = paste0("#", ns("place_here")),
where = "beforeEnd",
ui = mod_ui2(ns("mod_inner"))
)
mod_server2("mod_inner")
})
})
}
mod_ui2 <- function(id){
ns <- NS(id)
actionButton(ns("test"), "Test")
}
mod_server2 <- function(id) {
moduleServer(id, function(input, output, session){
observeEvent(input$test, {
browser()
})
})
}
ui <- fluidPage(
mod_ui("mod_top")
)
server <- function(input, output, session){
mod_server("mod_top")
}
shinyApp(ui = ui, server = server)
I have a shiny application for which I have reproduced a simple example here.
It is a modular shiny application. This one is deployed on shinyapp.io
My problem is that when I open 2 instances of my deployed application, the actions done on one of the windows are applied to the other window
It seems that the problem is caused by the reactiveValues (r_global <- reactiveValues() ) in the server part.
Here is the reproduction of the code.
library(shiny)
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# MODULE ----
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
counterButton = function(id, label = "Counter") {
ns = NS(id)
tagList(actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out")),
dataTableOutput(ns("table")))
}
counterServer <- function(id, r_global) {
moduleServer(id,
function(input, output, session) {
r_global$count = 0
observeEvent(input$button, {
r_global$count = r_global$count + 1
if (input$button == 3) {
output$table <- renderDataTable({
mtcars
})
} else{
output$table <- renderDataTable({
iris
})
}
})
output$out <- renderText({
r_global$count
})
})
}
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# UI ----
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ui = fluidPage(h1("test"), counterButton("counter1", "Counter #1"))
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
# SERVER ----
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
server <- function(input, output, session) {
r_global <- reactiveValues()
counterServer("counter1", r_global = r_global)
}
shinyApp(ui, server)
I've got two shiny modules, with updateTextInput() in the first one. I want to update textInput() in the second module, when button from the first is clicked. I know it's because those modules are in different namespaces but I can't figure out how to communicate modules.
Reprex below :)
library(shiny)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
})
}
ui <- fluidPage(
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
firstServer("module_one")
secondServer("module_two")
}
shinyApp(ui, server)
You can do it by making the first input$update reactive, then returning that value and making it reactive to the second server module. This way the second server module is "listening" to the change in the first one.
library(shiny)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
reactive(input$update)
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id, clear) {
moduleServer(id, function(input, output, session) {
observeEvent(clear(), {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = session,"second", value = "")
})
})
}
ui <- fluidPage(
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
clear <- reactive(firstServer("module_one"))
secondServer("module_two", clear())
}
shinyApp(ui, server)
A roundabout way would be to use shinyjs to trigger the updating manually.
library(shiny)
library(shinyjs)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
runjs('document.getElementById("module_two-second").value = ""')
})
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id) {
moduleServer(id, function(input, output, session) {
# Code not needed in here for now
})
}
ui <- fluidPage(
useShinyjs(),
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
firstServer("module_one")
secondServer("module_two")
}
shinyApp(ui, server)
Shiny modules work by giving each element a unique id by pasting [module_name]-[element_id] together in the html frontend, so each module server can correctly identify which it should be talking to. The first server can find and talk to module_two-second when passed that id directly. Ideally there might be a way of doing this within the Shiny code itself though.
Edit: fix within Shiny by passing parent_session (without shinyjs)
The updateTextInput call can indeed find module_two-second itself if it can look outside of its own session environment. To achieve this, you can pass the parent_session as the argument to updateTextInput (defined in firstServer function definition and passed as parent_session = session in the server body):
library(shiny)
firstUI <- function(id) {
ns <- NS(id)
tagList(
actionButton(ns("update"), "Update 1st and 2nd module"),
textInput(ns("first"), "Update me pls1", value = "Clear me!")
)
}
firstServer <- function(id, parent_session) {
moduleServer(id, function(input, output, session) {
observeEvent(input$update, {
updateTextInput(session = session, "first", value = "")
updateTextInput(session = parent_session, "module_two-second", value = "")
})
})
}
secondUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("second"), "Update me pls", value = "Clear me!")
)
}
secondServer <- function(id) {
moduleServer(id, function(input, output, session) {
# Code not needed in here for now
})
}
ui <- fluidPage(
firstUI("module_one"),
secondUI("module_two")
)
server <- function(input, output, session) {
firstServer("module_one", parent_session = session)
secondServer("module_two")
}
shinyApp(ui, server)
Version 1 below is a toy module that asks for a user input txt, and return the input to the main Shiny app. The main Shiny app then render the text and output it to the screen.
Here I store the return value of the module in a variable called mytxt and I called it through renderText({ mytxt() }).
However, what I actually want to do is to store the returned value to reactiveValues in the main Shiny app. (It doesn't matter if I output it or not as I want to do further evaluations on that value.) But sadly I found no way in making it works. I'm showing my failed codes in Version 2 below.
Version 1 (Correct)
app.R
library(shiny)
source("module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
mytxt <- callModule(returnServer, "returntxt")
output$mytxt <- renderText({ mytxt() })
}
shinyApp(ui, server)
module_1.R
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
mytxt <- reactive({
input$txt
})
return(mytxt)
}
Version 2 (Need help!)
app.R
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
myvals$txt <- isolate(mytxt())
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
module.R is the same as Version 1.
I just found the answer by returning reactiveValues from the module and use observe :) Woohoo!
app.R
library(shiny)
source("modules/module_1.R")
ui <- fluidPage(
returnUI("returntxt"),
textOutput("mytxt")
)
server <- function(input, output, session) {
myvals <- reactiveValues(
txt = NULL
)
mytxt <- callModule(returnServer, "returntxt")
observe({
myvals$txt <- mytxt$txt
print(myvals$txt)
})
output$mytxt <- renderText({ myvals$txt })
}
shinyApp(ui, server)
module_1.R
returnUI = function(id) {
ns <- NS(id)
tagList(
textInput(ns("txt"), "Write something")
)
}
returnServer = function(input, output, session) {
myreturn <- reactiveValues()
observe({ myreturn$txt <- input$txt })
return(myreturn)
}
this is my first question at stackoverflow. I have a problem with modules and renderUI in shiny (1.0.5).
When I use renderUI in
#### Main Part
ui <- bootstrapPage(
uiOutput("DynamicContent")
)
server <- function(input, output,session) {
S_A <- selectInput("S_A_Input" ,"Change Me for print message",choices=1:3 )
output$DynamicContent <- renderUI({
tagList(S_A)
})
observe({
print(input$S_A_Input)
})
}
shinyApp(ui = ui, server = server)
then changing the selectInput will cause changing input$S_A_Input, so the print will occur. That's fine.
On the other hand, input$S_A_Input seems not to work, if I work with modules:
### Module Part
Module_YYY_Server <- function(input, output, session){
S_A <- selectInput("S_A_Input" ,"Change Me for print message",choices=1:3 )
output$DynamicContent <- renderUI({
tagList(S_A)
})
observe({
print(input$S_A_Input)
})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput("DynamicContent" %>% ns)
)
}
And then calling the module.
#### Main Part
ui <- bootstrapPage(
Module_YYY_Ui("YYY")
)
server <- function(input, output,session) {
callModule(Module_YYY_Server,"YYY")
}
shinyApp(ui = ui, server = server)
I haven't found a solution to this behaviour.
Late to the party but this is another option to solve your problem using
session$ns("id")
Here how it looks like:
Module_YYY_Server <- function(input, output, session){
output$DynamicContent <- renderUI({
selectInput(session$ns("S_A_Input"), "Change Me for print message", choices = 1:3)
})
output$text <- renderText({
req(input$S_A_Input)
input$S_A_Input})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput(ns("DynamicContent")),
textOutput(ns("text"))
)
}
ui <- bootstrapPage(
Module_YYY_Ui("YYY")
)
server <- function(input, output,session) {
callModule(Module_YYY_Server,"YYY")
}
shinyApp(ui = ui, server = server)
This is based on the example here
While I am sure your example is simplified, If your input$S_A_Input is not changing based on what you are doing, as is the case in your example, I would not recommend using renderUI. Regardless of that, the reason that your input is not printing is because you are not generating it as an output.
Module_YYY_Server <- function(input, output, session){
output$DynamicContent <- renderUI({
ns <- session$ns
tagList(
selectInput("S_A_Input" %>% ns, "Change Me for print message",choices=1:3 )
)
})
output$text <- renderText({input$S_A_Input})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput("DynamicContent" %>% ns),
textOutput("text" %>% ns)
)
}