sourcing multiple modules R shiny - r

I have 5 separate files and I'm trying to source them all in the main app.R file but when I run app.R, I get this error:
Warning: Error in input_ui: could not find function "input_ui"
input_ui is defined in input_module.R and I source input_module.R so I'm not sure the error.
app.R
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
library(shinyjs)
library(shinyBS)
library(shinycssloaders)
# Read modules
modules <- dir("modules", full.names = TRUE, recursive = TRUE)
lapply(modules, source)
source('server.R')
source('ui.R')
shinyApp(ui, server)
ui.R
ui <- input_ui("data")
server.R
server <- function(input, output, session){
mydata <- callModule(data_module, "data")
callModule(input_module, "input_module", mydata)
}
input_module.R
input_ui <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
input_server <- function(input, output, session, mydata) {
output$plot <- renderPlot(
plot(mydata$data)
)
}
data_module.R
data_module <- function(input, output, session) {
vals <- reactiveValues()
vals$data <- mtcars
return(vals)
}

./modules/input_module.R
inputModuleUI <- function(id) {
ns <- NS(id)
plotOutput(ns("plot"))
}
inputModuleServer <- function(id, mydata) {
moduleServer(
id,
function(input, output, session) {
output$plot <- renderPlot(
plot(mydata()$data)
)
}
)
}
./modules/data_module.R
dataModuleUI <- function(id) {
ns <- NS(id)
NULL
}
dataModuleServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
vals <- reactiveValues()
vals$data <- mtcars
return(vals)
}
)
}
./ui.R
ui <- inputModuleUI("input_module")
./server.R
server <- function(input, output, session){
mydata <- dataModuleServer("data_module")
inputModuleServer("input_module", reactive(mydata))
}
And then running ./app.R should be fine.

Related

ObserveEvent not triggered in nested module inserted with insertUI

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)

Separate the `renderUI` in a module server

In some complex and large shiny apps, the UI parts are often rendered with renderUI and uiOutput. Consider this small app for illustration:
library(shiny)
modUI <- function(id) {
ns <- NS(id)
uiOutput(ns("theUI"))
}
modServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
output[["plot"]] <- renderPlot({
n <- input[["numb"]]
plot(rnorm(n), rnorm(n), pch = 19L)
})
ns <- session$ns
output[["theUI"]] <- renderUI({
tagList(
sliderInput(ns("numb"), "N", 10, 100, 50),
plotOutput(ns("plot"))
)
})
}
)
}
ui <- basicPage(
br(),
modUI("myapp")
)
server <- function(input, output, session) {
modServer("myapp")
}
shinyApp(ui, server)
Here modUI is ridiculously small. But in modServer, the renderUI could be large and there could be many other output components. Therefore it is desirable to split modServer:
renderPlotServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
output[["plot"]] <- renderPlot({
n <- input[["numb"]]
plot(rnorm(n), rnorm(n), pch = 19L)
})
}
)
}
renderUIServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
output[["theUI"]] <- renderUI({
tagList(
sliderInput(ns("numb"), "N", 10, 100, 50),
plotOutput(ns("plot"))
)
})
}
)
}
and to put them together one can use the same id:
modServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
renderPlotServer("mysubapp")
renderUIServer("mysubapp")
}
)
}
but then we need a nested namespace in the UI part of the module:
modUI <- function(id) {
ns <- NS(NS(id)("mysubapp"))
uiOutput(ns("theUI"))
}
This is not convenient.
A more convenient solution consists in using a NULL namespace, to avoid the nested namespace in the UI part:
modServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
renderPlotServer(NULL)
renderUIServer(NULL)
}
)
}
But this solution has a problem: it prevent to use the module multiple times.
So, what would be a convenient solution avoiding this problem?
I think I have one: one can nest the "main" id with itself:
modServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
renderPlotServer(id)
renderUIServer(id)
}
)
}
modUI <- function(id) {
ns <- NS(NS(id)(id))
uiOutput(ns("theUI"))
}
Do you have another nice solution?
So maybe I am overlooking some subtleties of your approach, but why would you need to use moduleServer in render(Plot|UI)Server in the first place? Rather you can go for a plain function and all the namespacing seems to work without any further ado?
library(shiny)
modUI <- function(id) {
ns <- NS(id)
uiOutput(ns("theUI"))
}
renderPlotServer <- function(input, output, session) {
output[["plot"]] <- renderPlot({
n <- input[["numb"]]
plot(rnorm(n), rnorm(n), pch = 19L)
})
}
renderUIServer <- function(input, output, session) {
ns <- session$ns
output[["theUI"]] <- renderUI({
tagList(
sliderInput(ns("numb"), "N", 10, 100, 50),
plotOutput(ns("plot"))
)
})
}
modServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
renderPlotServer(input, output, session)
renderUIServer(input, output, session)
}
)
}
ui <- basicPage(
br(),
modUI("myapp"),
br(),
modUI("myapp2") ## a second module works like a charm
)
server <- function(input, output, session) {
modServer("myapp")
modServer("myapp2")
}
shinyApp(ui, server)

Error in module(childScope$input, childScope$output, childScope, ...): unused arguments (childScope$output, childScope)

I'm trying to understand why I am getting this error. The goal is to have the module render mtcars with the new moduleServer() function. Many thanks.
library(shiny)
library(DT)
mod_summary_ui <- function(id){
ns <- NS(id)
tagList(
DT::DTOutput(ns("table"))
)
}
mod_summary_server <- function(id){
moduleServer( id, function(input, output, session){
output$table <- DT::renderDT({ data })
})
}
data <- mtcars
app_ui <- function(request) {
mod_summary_ui("summary_ui_1")
}
app_server <- function( input, output, session ) {
shiny::callModule(mod_summary_server,
"summary_ui_1")
}
shinyApp(app_ui, app_server)
#>
#> Listening on http://127.0.0.1:3245
#> Error in module(childScope$input, childScope$output, childScope, ...) :
#> unused arguments (childScope$output, childScope)
Created on 2021-07-15 by the reprex package (v2.0.0)
Change the following:
mod_summary_server <- function(id){
moduleServer( id, function(input, output, session){
output$table <- DT::renderDT({ data })
})
}
To as below:
mod_summary_server <- function(input,output,session){
output$table <- DT::renderDT({ data })
}

eventReactive in shiny module

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"
})

How to store the returned value from a Shiny module in reactiveValues?

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)
}

Resources