I wanted to see if it was possible to take the inputs from one instance of a Shiny App module and apply them as the default inputs for a separate instance of the same module on a different tab. I'm struggling with the right way to ask this question, but I have tried to create a reproducible example below. I have a shiny dashboard with ~5 tabs, each calling the same plotting module.
For example, in the code below I've created a simplified dashboard that generates a plot. If someone clicks to 'Tab Page 1" and changes the plot color to "deeppink", is it possible to now set that input as the default color option when the user clicks to "Tab Page 2"? Or will the user always have to re-select the color input?
I originally used tabs/modules intending to have independence among tabs, but received feedback from a colleague that it would help users navigate my app if they did not have to re-select all the input options as they switch tabs.
I found Some Examples of Getting Modules to communicate with each other, (also here), but have not found a solution that really addresses this issue.
Additional Context: My full app will have a different tab for each of 5 geographic locations. Each location will allow users to select a survey that was completed as well as a species to investigate data trends. So if a user (on tab 1) selects a survey and a species, it would be nice to have these as the first options selected when the user switches to tab 2 (new geographic region). In this way, the user could more quickly compare similar plots among geographic regions.
library(shiny)
library(shinydashboard)
# Module UI for simple plot
dataPlotUI <- function(id) {
ns <- NS(id) # create namespace for entered ID
fluidRow(
box(
plotOutput(ns("plot.1"), height = 400)
),
box(
selectInput(
ns("color.choice"), "Color:",
c("darkcyan", "darkolivegreen", "deeppink", "lightsalmon2", "slateblue2", "springgreen3")
),
sliderInput(ns("range"), label = "Range", min = 10, max = 100, value = 50)
) # end box
)
}
########################################
########################################
# Module for Server
#
serverModule <- function(input, output, session, site) {
output$plot.1 <- renderPlot({
x <- seq(1, input$range, 1) # use slider to set max of x
y <- x + rnorm(length(x), 0, 3)
par(mai = c(.6, .6, .1, .1), las = 1, bty = "l")
plot(y ~ x, pch = 20, col = input$color.choice)
})
}
########################################
########################################
# UI
ui <- dashboardPage(
# # Dashboard Header
dashboardHeader(title = "Menu"),
#
dashboardSidebar(
sidebarMenu(
id = "sidebar",
# Icons can be found: https://fontawesome.com/icons?d=gallery&m=free
menuItem("Tab Page 1", tabName = "tabA"),
menuItem("Tab Page 2", tabName = "tabB"),
menuItem("Tab Page 3", tabName = "tabC")
)
), # End Dashboard Sidebar
# Body of the dashboard
dashboardBody(
# Start with overall tabItems
tabItems(
tabItem(
tabName = "tabA",
dataPlotUI("tab_one")
),
#
tabItem(
tabName = "tabB",
dataPlotUI("tab_two")
),
tabItem(
tabName = "tabC",
dataPlotUI("tab_three")
)
)
) # end dashboard body
)
#######################################
#######################################
# Server
# Call modules
server <- function(input, output, session) {
callModule(serverModule, "tab_one")
callModule(serverModule, "tab_two")
callModule(serverModule, "tab_three")
}
shinyApp(ui = ui, server = server)
Yes, it is possible. Here's one way of doing it.
The important concepts are that
session$userData: the approach I've taken.)I think you knew that last one as you have a site argument in the module server, although you don't seem to use it.
So, taking each step in turn...
Allow the module to server to return a value
Add the following lines at the end of the module server function
rv <- reactive({input$color.choice})
return(rv)
This creates a reactive and returns it. Note that you return the reactive itself, not the reactive's value.
Monitor the modules' return values in the main server
Modify the callModule calls to
tab1 <- callModule(serverModule, "tab_one")
tab2 <- callModule(serverModule, "tab_two")
tab3 <- callModule(serverModule, "tab_three")
All I've done here is assign the modules' return values to local variables in the main server function. They're reactives, so we can monitor them. Add the following lines to the main server function:
session$userData$settings <- reactiveValues(chosenColour=NA)
observeEvent(tab1(), {session$userData$settings$chosenColour <- tab1()})
observeEvent(tab2(), {session$userData$settings$chosenColour <- tab2()})
observeEvent(tab3(), {session$userData$settings$chosenColour <- tab3()})
You can put print calls inside each observeEvent to see what's going on. I did that whilst testing. I think session$userData is a much underused feature of shiny. Unsurprisingly, it's a section of the session object that's writable by the user. The main server function and all module server functions share the same session$userData object, so it's a neat way of passing information between modules.
I've assumed that you'll want to do more than just change the colour of the dots in your real world case, so I've created a settings object. I've made it reactive so that modules can react to changes in it.
Make the modules react to changes
Add the following code to the module server function
observeEvent(
session$userData$settings$chosenColour,
{
if (!is.na(session$userData$settings$chosenColour))
updateSelectInput(
session,
"color.choice",
selected=session$userData$settings$chosenColour
)
}
)
[Again, put print calls in the observeEvent to check what's going on.]
And that's it.
As an aside, it's good practice always to add
ns <- session$ns
as the first line of your module server function. You don't need it right now, but it's likely you will. I've spent many hours chasing down a bug that's been due to "not needing" session$ns. Now I just do it by default to save the pain.
Here's the full listing of your modified MWE.
library(shiny)
library(shinydashboard)
dataPlotUI <- function(id) {
ns <- NS(id) # create namespace for entered ID
fluidRow(
box(plotOutput(ns("plot.1"), height = 400)),
box(
selectInput(
ns("color.choice"), "Color:",
c("darkcyan", "darkolivegreen", "deeppink", "lightsalmon2", "slateblue2", "springgreen3")
),
sliderInput(ns("range"), label = "Range", min = 10, max = 100, value = 50)
) # end box
)
}
# Module for Server
serverModule <- function(input, output, session, site) {
ns <- session$ns
output$plot.1 <- renderPlot({
x <- seq(1, input$range, 1) # use slider to set max of x
y <- x + rnorm(length(x), 0, 3)
par(mai = c(.6, .6, .1, .1), las = 1, bty = "l")
plot(y ~ x, pch = 20, col = input$color.choice)
})
observeEvent(session$userData$settings$chosenColour, {
if (!is.na(session$userData$settings$chosenColour)) updateSelectInput(session, "color.choice", selected=session$userData$settings$chosenColour)
})
rv <- reactive({input$color.choice})
return(rv)
}
# UI
ui <- dashboardPage(
dashboardHeader(title = "Menu"),
dashboardSidebar(
sidebarMenu(
id = "sidebar",
# Icons can be found: https://fontawesome.com/icons?d=gallery&m=free
menuItem("Tab Page 1", tabName = "tabA"),
menuItem("Tab Page 2", tabName = "tabB"),
menuItem("Tab Page 3", tabName = "tabC")
)
), # End Dashboard Sidebar
dashboardBody(
# Start with overall tabItems
tabItems(
tabItem(
tabName = "tabA",
dataPlotUI("tab_one")
),
#
tabItem(
tabName = "tabB",
dataPlotUI("tab_two")
),
tabItem(
tabName = "tabC",
dataPlotUI("tab_three")
)
)
) # end dashboard body
)
# Server
server <- function(input, output, session) {
session$userData$settings <- reactiveValues(chosenColour=NA)
tab1 <- callModule(serverModule, "tab_one")
tab2 <- callModule(serverModule, "tab_two")
tab3 <- callModule(serverModule, "tab_three")
# Module observers
observeEvent(tab1(), {session$userData$settings$chosenColour <- tab1()})
observeEvent(tab2(), {session$userData$settings$chosenColour <- tab2()})
observeEvent(tab3(), {session$userData$settings$chosenColour <- tab3()})
}
shinyApp(ui = ui, server = server)