In my app, I have two modules (nested) for which I want to pass uiOuput. In the example below, the output named "screen1" (created in the outer module)has to be passed to the inner module where it will be displayed. But It doesn't work..
Passing such uiOutput work from the original shinyApp to one module but I can't make it works between two modules.
innerUI <- function(id){
ns <- NS(id)
tagList(
h4("Inner module"),
uiOutput(ns('displayScreens'))
)
}
inner <- function(input, output, session, params){
output$displayScreens <- renderUI({
params()
})
}
outerUI <- function(id){
ns <- NS(id)
innerUI(ns('test1'))
}
outer <- function(input, output, session){
rv <- reactiveValues(
test = uiOutput("screen1")
)
callModule(inner, 'test1', params= reactive({rv$test}))
output$screen1 <- renderUI({
h4("I am the screen 1 !")
})
}
ui <- fluidPage(
outerUI('test2')
)
server <- function(input, output, session){
callModule(outer, 'test2')
}
shinyApp(ui=ui, server=server)
Your problem seems to be one with namespaces. You are creating uiOutput("screen1") in outer and passing it to inner without a namespace. You could pass the uiOutput("screen1") in a reactive like this:
test <- reactive({
ns <- session$ns
uiOutput(ns("screen1"))
})
callModule(inner, 'test1', params=test)
This should work.
Related
I want to create a shiny app that uses navbarMenu() and tabPanel() to display data tables. Instead of writing all of the codes in one app.R file, I plan to use the concept of shiny modules creating R/tabUI.R and R/tabServer.R to generate these tables.
However, I run into an error and cannot figure it out. Any suggestions and help are appreciated!
My code:
### R/tabUI.R
tabUI <- function(id) {
tagList(
navbarMenu("display table",
tabPanel(NS(id, "mtcars table"),
DT::dataTableOutput("table")
)
)
)
}
### R/tabServer.R
tabServer <- function(id) {
moduleServer(id, function(input, output, session){
output$table <- DT::renderDataTable(mtcars)
})
}
### app.R
library(shiny)
ui <- navbarPage("dashboard",
tabUI("table1")
)
server <- function(input, output, session){
tabServer("table1")
}
shinyApp(ui=ui, server=server)
Error:
> runApp()
Error: Navigation containers expect a collection of `bslib::nav()`/`shiny::tabPanel()`s and/or `bslib::nav_menu()`/`shiny::navbarMenu()`s. Consider using `header` or `footer` if you wish to place content above (or below) every panel's contents.
You can't use tagList() inside navbarPage() so you need to remove it from the module.
As a sidenote, you should define ns <- NS(id) at the beginning of the module and then wrap all ids in ns(). In your code, the table id was not wrapped in ns() so it wasn't displayed.
Fixed code:
### R/tabUI.R
tabUI <- function(id) {
ns <- NS(id)
navbarMenu("display table",
tabPanel(ns("mtcars table"),
DT::dataTableOutput(ns("table"))
)
)
}
### R/tabServer.R
tabServer <- function(id) {
moduleServer(id, function(input, output, session){
output$table <- DT::renderDataTable(mtcars)
})
}
### app.R
library(shiny)
ui <- navbarPage("dashboard",
tabUI("table1")
)
server <- function(input, output, session){
tabServer("table1")
}
shinyApp(ui=ui, server=server)
What I want to achieve is to get access to the reactive value passed to a parent module from a child module. The reproducible example below shows the idea. When i click the button in mod_server_btn then its value should be printed out in the console (from within parent module):
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary')
))
}
mod_server_btn <- function(input, output, session) {
cond <- reactive({ input$confirm})
return(cond)
}
ui =fluidPage(
mod_ui_btn("test"),
uiOutput("example")
)
server=shinyServer(function(input, output, session) {
value <- callModule(mod_server_btn,"test")
print(value)
#print(value$cond) # these 3 don't work either
#print(value()$cond)
#print(value())
})
shinyApp(ui=ui,server=server)
However, it doesn't work. When I click the button then I got a text: reactive({input$confirm}) in the console and it's not what I want, I need to access button value. General question is - is it possible at all to get access to reactive value in a parent module?
EDIT: #rbasa, #YBS thanks for your answers. In fact in my real app I need to return more than one reactive value to parent module. Below is slightly changed code - I added second button in mod_ui_btn - now I need to return values from both buttons to the server module. I made a list of reactives but can't get access to them using observe or output$example <-:
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary'),
actionButton(ns("confirm2"), "Submit2", class='btn-primary')
))
}
mod_server_btn <- function(input, output, session) {
return(
list(
cond = reactive({ input$confirm}),
cond2 = reactive({ input$confirm2})
)
)
}
ui =fluidPage(
mod_ui_btn("test"),
verbatimTextOutput("example"),
verbatimTextOutput("example2")
)
server=shinyServer(function(input, output, session) {
value <- callModule(mod_server_btn,"test")
output$example <- renderPrint(value$cond)
output$example2 <- renderPrint(value$cond2)
observe({
print(value$cond) #this is how I usually catch reactives - by their name
print(value$cond2)
})
})
shinyApp(ui=ui,server=server)
I usually use return(list(..some reactive values)) to return more than one ractive value to other module and catch then using their names in parent module. Here it doesn't work even if I use observe. No value is returned.
You can access with value(). I would recommend to change your mod_server_btn to the one shown below, and notice the call in server. EDIT: updated for multiple variables. Try this
library(shiny)
mod_ui_btn <- function(id, label = "ui1UI") {
ns <- NS(id)
shinyUI(fluidPage(
actionButton(ns("confirm"), "Submit", class='btn-primary'),
actionButton(ns("confirm2"), "Submit2", class='btn-primary')
))
}
mod_server_btn <- function(id) {
moduleServer(id, function(input, output, session) {
return(
list(
cond = reactive(input$confirm),
cond2 = reactive(input$confirm2)
)
)
})
}
ui =fluidPage(
mod_ui_btn("test"),
verbatimTextOutput("example"),
verbatimTextOutput("example2")
)
server=shinyServer(function(input, output, session) {
# value <- callModule(mod_server_btn,"test")
value <- mod_server_btn("test")
output$example <- renderPrint(value$cond())
output$example2 <- renderPrint(value$cond2())
observe({
print(value$cond()) #this is how I usually catch reactives - by their name
print(value$cond2())
})
})
shinyApp(ui=ui,server=server)
I try to return some reactive expressions from one module and pass to another module. I know that such a thing is quite easy when passing inputs e.g.:
return(
list(
btn1 = reactive({input$buttonX}),
btn2 = reactive({input$buttonY}))
)
However, I can't return and pass reactive expressions this way, e.g.:
react1 <- reactiveVal()
react2 <- reactiveValues(state = TRUE)
return(
list(
x = react1,
y = react2
)
)
When I return reactives this way then in another module the outcome is just... plain text, in this case it's for example reactiveValues(state = TRUE). It's really strange. This method of returning reactives doesn't work in my case.
Is it possible to return already existing reactives in any sensible way?
EDIT:
I'm adding reproducible example below. In mod_1st_Nested_server I have 3 reactive expr and want to pass one of them to mod_2nd_Nested_server through mod_Parent_server. This is how it works in my real project and need to do it this way but don't know how:
library(shiny)
library(dplyr)
moduleServer <- function(id, module) {
callModule(module, id)
}
# UI 1 #
mod_1st_Nested_UI <- function(id) {
ns <- NS(id)
}
# Server 1 #
mod_1st_Nested_server <- function(id){
moduleServer(id, function(input, output, session) {
# here I have various reactives but want to pass only some of them to parent
btn <- reactive({input$btn})
info <- reactiveValues(logic = TRUE)
other <- reactiveVal()
other("XYZ")
return(list(yyy = info))
})
}
# Parent UI #
mod_Parent_UI <- function(id) {
ns <- NS(id)
tagList(
mod_1st_Nested_UI(ns('first')),
mod_2nd_Nested_UI(ns('second'))
)
}
# Parent Server #
mod_Parent_server <- function(id){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
returnReactive <- mod_1st_Nested_server("first")
mod_2nd_Nested_server('second', returnReactive$yyy) # here I'm passing reactive from module_1st
})
}
# UI 2 #
mod_2nd_Nested_UI <- function(id) {
ns <- NS(id)
tagList(
textOutput(ns("text"))
)
}
# Server 2 #
mod_2nd_Nested_server <- function(id, value){
moduleServer(id, function(input, output, session) {
ns <- NS(id)
output$text <- renderText({ # reactive value from 1st module should be printed here
print(value)
})
})
}
# FINAL App #
ui <- fluidPage(
tagList(
mod_Parent_UI("final")
))
server <- function(input, output, session) {
mod_Parent_server("final")
}
shinyApp(ui = ui, server = server)
I am having a shiny app that is heavily relying on modules. Basically it's a big navbarPage with different menus and tabs where every tab is wrapped as a module. Below I provided a minimal example with 2 tabs, but in reality there are more than 20.
# module 1 ------------------------------------------------
moduleOneUI <- function(id) {
ns = NS(id)
tagList(
h2("module1"),
textOutput(ns("text"))
)
}
moduleOne <- function(input, output, session) {
output$text <- renderText({"one yo"})
}
# module 2 ------------------------------------------------
moduleTwoUI <- function(id) {
ns = NS(id)
tagList(
h2("module2"),
textOutput(ns("text"))
)
}
moduleTwo <- function(input, output, session) {
output$text <- renderText({"two yo"})
}
# main app ------------------------------------------------
ui <- navbarPage(
"dashboard",
navbarMenu(
"#1",
tabPanel(
"mod1",
uiOutput("module_one")
)
),
navbarMenu(
"#2",
tabPanel(
"mod2",
uiOutput("module_two")
)
)
)
server <- function(input, output, session) {
output$module_one <- renderUI({
moduleOneUI("module_one")
})
callModule(moduleOne, "module_one")
output$module_two <- renderUI({
moduleTwoUI("module_two")
})
callModule(moduleTwo, "module_two")
}
shinyApp(ui, server)
As you might see the server function gets very large with this hard coded server function. So I tried to create it in a more dynamic way using a loop:
modules <- list(
module_one = c(ui = moduleOneUI, server = moduleOne),
module_two = c(ui = moduleTwoUI, server = moduleTwo)
)
server <- function(input, output, session) {
for (mod_id in names(modules)) {
module <- modules[[mod_id]]
ui_func <- module$ui
server_func <- module$server
output[[mod_name]] <- renderUI({
ui_func(mod_id)
})
callModule(server_func, mod_id)
}
}
However, this approach fails to work as expected. Now I see the moduleTwo code rendered in my module_one tab:
Does any1 know why this is happening and how I can fix it? I really need a dynamic approach to render all those modules.
The two renderUI expressions aren't evaluated until after the loop completes and mod_id = "module_two".
To get around this, you can create a local scope for each loop iteration:
for (mod_id in names(modules)) {
local({
mod_id <- mod_id
module <- modules[[mod_id]]
ui_func <- module$ui
server_func <- module$server
output[[mod_id]] <- renderUI({
ui_func(mod_id)
})
callModule(server_func, mod_id)
})
}
I seem to have found a solution for that problem. If I define a function that calls the module everything works as expected.
create_tab <- function(mod_id, output) {
module <- modules[[mod_id]]
ui_func <- module$ui
server_func <- module$server
output[[mod_id]] <- renderUI({
ui_func(mod_id)
})
callModule(server_func, mod_id)
}
server <- function(input, output, session) {
lapply(names(modules), create_tab, output = output)
}
However, I have no idea why this is working and the other approach isn't. I assume it has something to do with scoping in R.
I am trying to convert a section of code into a Shiny Module, but my renderPlot() functions generated within an lapply() don't seem to be working. I have created a simple example below to demonstrate the issue.
(Note: Here I'm using renderText() calls, but the same behavior applies.)
app_normal.R:
library(shiny)
ui <- fixedPage(
h2("Normal example"),
uiOutput("test")
)
server <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,renderText(paste("Line", val))))
})
})
}
shinyApp(ui, server)
app_module.R:
library(shiny)
myModuleUI <- function(id) {
ns <- NS(id)
uiOutput(ns("test"))
}
myModule <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,renderText(paste("Line", val))))
})
})
}
ui <- fixedPage(
h2("Module example"),
myModuleUI("test_module")
)
server <- function(input, output, session) {
callModule(myModule, "test_module")
}
shinyApp(ui, server)
All of the div elements are being created, but they just fail to contain the plots/text. How do I properly use the Shiny renderText() or renderPlot() functions within renderUI()/lapply() calls within a module?
It appears that the approach I was taking using the renderText() and renderPlot() functions directly in a renderUI() works fine in the normal case, i.e. when not operating within a Shiny Module. Shiny automatically calls the necessary textOutput() or plotOutput() to generate the HTML. Some how this automatic link is broken when you are performing the same operations within a Shiny Module. I suspect this is due to the mismatch between assigning and referencing items in the output list due to the introduction of the ns() call when assigning outputIds as is done manually in a call to outputPlot() or outputText().
To successfully use renderUI within a Shiny Module, you need to separately call textOutput() and renderText(): textOutput in the lapply() in the renderUI(), and renderText() in an lapply() in an observe(). This allows us to introduce an ns() into the generation of the outputId for the textOutput() call.
Below I've included a refactoring of both app_normal.R and app_module.R that demonstrates the disentanglement of these two calls.
app_normal_observe.R:
library(shiny)
ui <- fixedPage(
h2("Normal example"),
uiOutput("test")
)
server <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,textOutput(paste0("line_", val))))
})
})
observe({
lapply(1:3, function(val) {
output[[paste0("line_", val)]] <- renderText(paste("Line", val))
})
})
}
shinyApp(ui, server)
app_module_observe.R:
library(shiny)
myModuleUI <- function(id) {
ns <- NS(id)
uiOutput(ns("test"))
}
myModule <- function(input, output, session) {
output$test <- renderUI({
lapply(1:3, function(val) {
fluidRow(column(12,textOutput(session$ns(paste0("line_", val)))))
})
})
observe({
lapply(1:3, function(val) {
output[[paste0("line_", val)]] <- renderText(paste("Line", val))
})
})
}
ui <- fixedPage(
h2("Module example"),
myModuleUI("test_module")
)
server <- function(input, output, session) {
callModule(myModule, "test_module")
}
shinyApp(ui, server)