For some reason using a selectInput in a module is not reacting to changes of the input value. I added a minimum example to demonstrate my issue. If I write the same code without a module, i.e. pasting the ui and server code of the module to the main server and ui functions without the namespace function works.
I don't really see the issue with my code.
require(shiny)
ui <- function(){
dummyUI("test")
}
server <- function(input, output, session) {
callModule(dummy, "test")
}
dummyUI <- function(id) {
ns <-NS(id)
uiOutput(width = 6, ns("selectMaterial"))
}
dummy <- function(input, output, session) {
# render UI for the filters
output$selectMaterial <- renderUI({
selectInput(
inputId = "selectMaterial",
label = "Choose Materials" ,
choices = c("a","b"),
multiple = TRUE)
})
observeEvent(input$selectMaterial ,{print("hi")})
}
shinyApp(ui(), server)
As mentioned in this article (section "Using renderUI within modules
"), you need to use the namespace function in renderUI.
require(shiny)
ui <- function(){
dummyUI("test")
}
server <- function(input, output, session) {
callModule(dummy, "test")
}
dummyUI <- function(id) {
ns <-NS(id)
uiOutput(width = 6, ns("selectMaterial"))
}
dummy <- function(input, output, session) {
# render UI for the filters
output$selectMaterial <- renderUI({
selectInput(
inputId = session$ns("selectMaterial"), ## <= namespace here
label = "Choose Materials" ,
choices = c("a","b"),
multiple = TRUE)
})
observeEvent(input$selectMaterial ,{print("hi")})
}
shinyApp(ui(), server)
Related
Let's say I have 4 sets of UI/Server modules in 4 different directories ("./X1/Y1/", "./X1/Y2/", "./X2/Y1/", "./X2/Y2/"). I want to load the selected set based on the input in the sidebar.
I tried using source() within dashboardBody(), but I was not successful.
library(shiny)
library(shinydashboard)
# path to modules
in_path <- "C:/a/b/c/"
# ui
ui <- dashboardPage(
dashboardHeader(title = "test"),
dashboardSidebar(
br(),
selectInput('f1', 'Folder 1', choices = c("X1", "X2")),
helpText(""),
selectInput('f2', 'Folder 2', choices = c("Y1", "Y2")),
br(),
actionButton("load", "Load", icon("thumbs-up"), width = "85%")
),
dashboardBody(
# UI module here from, e.g., "C:/a/b/c/X1/Y2/my_UI.R"
)
)
# server
server <- function(input, output, session) {
# server module here from, e.g., "C:/a/b/c/X1/Y2/my_Server.R"
}
shinyApp(ui, server)
As shiny modules are simply functions, I'd source them in the beginning, and use uiOutput to display the differnt modules.
Here's a working example of the general idea (sample module code proudly stolen from the official Shiny documentation):
<mod1.R>
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
count
}
)
}
<mod2.R>
csvFileUI <- function(id, label = "CSV file") {
ns <- NS(id)
tagList(
fileInput(ns("file"), label),
checkboxInput(ns("heading"), "Has heading"),
selectInput(ns("quote"), "Quote", c(
"None" = "",
"Double quote" = "\"",
"Single quote" = "'"
))
)
}
csvFileServer <- function(id, stringsAsFactors = TRUE) {
moduleServer(
id,
## Below is the module function
function(input, output, session) {
# The selected file, if any
userFile <- reactive({
# If no file is selected, don't do anything
validate(need(input$file, message = FALSE))
input$file
})
# The user's data, parsed into a data frame
dataframe <- reactive({
read.csv(userFile()$datapath,
header = input$heading,
quote = input$quote,
stringsAsFactors = stringsAsFactors)
})
# We can run observers in here if we want to
observe({
msg <- sprintf("File %s was uploaded", userFile()$name)
cat(msg, "\n")
})
# Return the reactive that yields the data frame
return(dataframe)
}
)
}
<app.R>
library(shiny)
source("mod1.R")
source("mod2.R")
my_mods <- list("Counter Button" = list(ui = counterButton,
server = counterServer),
"CSV Uploader" = list(ui = csvFileUI ,
server = csvFileServer))
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
selectInput("mod_sel",
"Which Module should be loaded?",
names(my_mods))
),
mainPanel(
uiOutput("content"),
verbatimTextOutput("out")
)
)
)
server <- function(input, output) {
uuid <- 1
handler <- reactiveVal()
output$content <- renderUI({
my_mods[[req(input$mod_sel)]]$ui(paste0("mod", uuid))
})
observeEvent(input$mod_sel, {
handler(my_mods[[req(input$mod_sel)]]$server(paste0("mod", uuid)))
uuid <<- uuid + 1
})
output$out <- renderPrint(req(handler())())
}
shinyApp(ui, server)
Some Explanation
You put the module code in mod[12].R and it is rather straight forward.
In your main app, you load both(!) source files and for housekeeping reasons, I put both modules functions (ui and server) in a list, but this is not strictly necessary, but facilitates future extension.
In your UI you have an uiOutput which renders dynamically according to the selected module.
In your server you put the code to dynamically render the UI and call the respective server function.
The uid construct is basically there to force a fresh render, whenever you change the selection. Otherwise, you may see still some old values whenever you come back to a module which you have rendered already.
My shinyapp is build using modules, the radioBox component inputId = modelling_type is created in the server, using a renderUI function and stored under outputId = modelling_type_ui
As I'm using modules, I have name spaced my IDs in the mod_ui, and then in order to (attempt!) to use the same name space function in the mod_server I have called it via ns <- parentsession$ns. This doesn't throw an error. But I would now expect to access the value of the RadioBox via input$modelling_type
This isn't working! So I must be calling the value incorrectly.
Here is the code:
library(shiny)
library(shinyalert)
library(shinydashboard)
library(shinyjs)
library(tidyverse)
# modules ------------------------------------------
mod_ui <- function(id){
ns <- NS(id)
fluidPage(
uiOutput(outputId = ns("modelling_type_ui")),
textOutput(outputId = ns("capture"))
)
}
mod_server <- function(id, parentsession){
moduleServer(id,
function(input, output, server){
ns <- parentsession$ns
output$modelling_type_ui = renderUI({
print(input$modelling_type) # this should not be null
radioButtons(
inputId = ns("modelling_type"),
label = "Choose a modelling technique",
choices = c("OLS",
"Bayesian"),
selected = "OLS")
})
output$capture = renderText({ paste0("modelling type selected:", input$modelling_type) })
})
}
# call app ---------------------------------------
# run app
ui <- function(){ mod_ui("mt") }
server <- function(input, output, session){ mod_server("mt", session) }
shinyApp(ui = ui, server = server)
Any help appreciated. Usually I would just call radioButtons in the UI, and use updateradioButtons function in the server, but I'm dealing with a legacy app which uses the below method repeatedly.
To expand on my comment above, here is a MWE that I believe does what you want.
I'm not sure why you're using uiOutput and renderUI. I assume it's needed in your actual use case, but it's not needed here. Also, there's no need to muck about with parentsession and the like.
One reason why your debug print prints NULL is that you haven't defined the radio group at the time you try to print its value.
library(shiny)
library(tidyverse)
mod_ui <- function(id){
ns <- NS(id)
fluidPage(
uiOutput(outputId = ns("modelling_type_ui")),
textOutput(outputId = ns("capture"))
)
}
mod_server <- function(id) {
moduleServer(
id,
function(input, output, session){
ns <- session$ns
output$modelling_type_ui = renderUI({
radioButtons(
inputId = ns("modelling_type"),
label = "Choose a modelling technique",
choices = c("OLS","Bayesian"),
selected = "OLS"
)
})
output$capture <- renderText({
paste0("modelling type selected: ", input$modelling_type)
})
rv <- reactive({
input$modelling_type
})
return(rv)
}
)
}
ui <- function() {
fluidPage(
mod_ui("mt"),
textOutput("returnValue")
)
}
server <- function(input, output, session) {
modValue <- mod_server("mt")
output$returnValue <- renderText({
paste0("The value returned by the module is ", modValue())
})
}
shinyApp(ui = ui, server = server)
Suppose I have the following Shiny module, which doesn't work as I intend:
library(shiny)
# module
module_ui <- function(id) {
ns <- NS(id)
uiOutput(ns("choose"))
}
module_server <- function(input, output, session) {
output$choose <- renderUI({
selectInput(inputId = "option",
label = "choose your option",
choices = c("a", "b", input$entered_text))
})
}
# ui and server
ui <- fluidPage(
textInput("entered_text", label = "Enter a custom option:"),
module_ui("xyz")
)
server <- function(input, output, session) {
callModule(module_server, "xyz")
}
shinyApp(ui, server)
How can I pipe the global input, input$entered_text (Line 10), into the module so that the text that the user entered shows up as a choice on the selectInput UI?
I think I am supposed to use reactive(), but I must be doing something wrong.
Indeed, you are supposed to use reactive() and pass the result of the entered_text to your module, as such:
library(shiny)
# module
module_ui <- function(id) {
ns <- NS(id)
uiOutput(ns("choose"))
}
module_server <- function(input, output, session, et) {
output$choose <- renderUI({
selectInput(inputId = "option",
label = "choose your option",
choices = c("a", "b", et()))
})
}
# ui and server
ui <- fluidPage(
textInput("entered_text", label = "Enter a custom option:"),
module_ui("xyz")
)
server <- function(input, output, session) {
et <- reactive(input$entered_text)
callModule(module_server, "xyz", et)
}
shinyApp(ui, server)
Because my shiny app has become quite large I've recently put some code into modules (also to reuse the code multiple times in different places). Somehow parts of the code do not work anymore as expected.
In this example I have a module which filters data according to input elements and return a reactive data.frame. In the mainPanel I have a module which creates a dataTable from the filtered data. But the reactivity does not work, when I change the selectInput, the dataTable does not update.
library(shiny)
library(DT)
filtersUI <- function(id) {
ns <- NS(id)
selectizeInput(
ns("Species"), label = "Species",
choices = levels(iris$Species),
selected = "virginica"
)
}
filters <- function(input, output, session, .data) {
inputs <- reactive({
list("Species" = input[["Species"]])
})
reactive({
.data[.data$Species %in% inputs()[["Species"]], ]
})
}
dataTableUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("data.table"))
}
dataTable <- function(input, output, session, .data) {
output$data.table <- DT::renderDataTable({
DT::datatable(.data)
})
}
appUI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
filtersUI(ns("filter"))
),
mainPanel(
dataTableUI(ns("data.table"))
)
)
}
app <- function(input, output, session, .data) {
data.subset <- callModule(filters, "filter", .data = .data)
callModule(dataTable, "data.table", .data = data.subset())
}
ui <- fluidPage(
appUI("app")
)
server <- function(input, output, session) {
callModule(app, "app", .data = iris)
}
shinyApp(ui, server)
But when copying the code from the subModules into the app module, the code works fine:
library(shiny)
library(DT)
appUI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
selectizeInput(
ns("Species"), label = "Species",
choices = levels(iris$Species),
selected = "virginica"
)
),
mainPanel(
DT::dataTableOutput(ns("data.table"))
)
)
}
app <- function(input, output, session, .data) {
inputs <- reactive({
list("Species" = input[["Species"]])
})
data.subset <- reactive({
.data[.data$Species %in% inputs()[["Species"]], ]
})
output$data.table <- DT::renderDataTable({
DT::datatable(data.subset())
})
}
ui <- fluidPage(
appUI("app")
)
server <- function(input, output, session) {
callModule(app, "app", .data = iris)
}
shinyApp(ui, server)
I know the modular structure looks like overkill in this simple example, but in my real app I have lots of code in the modules, which I deleted to make this example minimal. So it would be nice to have a solution using the same modular structure as in the first code snippet. Any ideas why it fails?
You did a very nice job creating a repoducible example with submodules. However, the issue does in fact not have anything to do with submodules. You just need to pass the reactive object data.subset differently. Instead of
callModule(dataTable, "data.table", .data = data.subset())
you should use
callModule(dataTable, "data.table", .data = data.subset)
to pass the reactive itself rather than its current value. The value can then be "resolved" in DT::renderDataTable like this
output$data.table <- DT::renderDataTable({
DT::datatable({.data()})
})
The way you coded it, the data at "construction time" i.e. the unfiltered dataset is sent to the module and it can't be observed along the way.
To be clear: The commented lines (## remove parantheses here and ## add parantheses here) are the only ones I changed from your original code.
library(shiny)
library(DT)
filtersUI <- function(id) {
ns <- NS(id)
selectizeInput(
ns("Species"), label = "Species",
choices = levels(iris$Species),
selected = "virginica"
)
}
filters <- function(input, output, session, .data) {
inputs <- reactive({
list("Species" = input[["Species"]])
})
reactive({
.data[.data$Species %in% inputs()[["Species"]], ]
})
}
dataTableUI <- function(id) {
ns <- NS(id)
DT::dataTableOutput(ns("data.table"))
}
dataTable <- function(input, output, session, .data) {
output$data.table <- DT::renderDataTable({
DT::datatable({.data()}) ## add parantheses here
})
}
appUI <- function(id) {
ns <- NS(id)
sidebarLayout(
sidebarPanel(
filtersUI(ns("filter"))
),
mainPanel(
dataTableUI(ns("data.table"))
)
)
}
app <- function(input, output, session, .data) {
data.subset <- callModule(filters, "filter", .data = .data)
callModule(dataTable, "data.table", .data = data.subset) ## remove parantheses here
}
ui <- fluidPage(
appUI("app")
)
server <- function(input, output, session) {
callModule(app, "app", .data = iris)
}
shinyApp(ui, server)
To sum things up, here is a quote from Joe Cheng to a similar issue
Hi Mark, the code in linkedScatter itself is correct; but when calling callModule, you want to pass the reactive itself by name (car_data) without reading it (car_data()).
callModule(linkedScatter, "scatters", car_data)
This is similar to how you can pass a function by name to something like lapply:
lapply(letters, toupper) # works
lapply(letters, toupper()) # doesn't work
Can you provide a MWE of modularized shiny code that uses renderUI? I'd like an example to follow.
There is an excellent tutorial that discusses this here: https://shiny.rstudio.com/articles/modules.html however, it doesn't show how to integrate the modularization of renderUI components in the ui nor in the server.
Here's what I've tried so far:
In my ui code, I had:
htmlOutput("selectionUI")
In my server code, I had:
output$selectionUI <- renderUI({
req(input$Filter)
selectInput(
inputId = "Selection",
label = "Selection",
choices = get("qlist", envir = get(input$source))[[input$Filter]]$responses)
})
Now I would like to modularize this becuase it's a sometimes repeated element, but I'm not sure how to actually insert it into my ui/server code once I'm done.
Here's what I've tried:
selectionChooserUI <- function(id) {
ns <- NS(id)
uiOutput(ns('controls'))
}
selectionChooser <- function(input, output, session, data, sourcedata, filter) {
output$selectionUI <- renderUI({
req(input$Filter)
ns <- session$ns
selectInput(
inputId = ns('Selection'),
label = 'Selection',
choices = get('qlist', envir = get(input[[sourcedata()]]))[[input[[filter()]]]]$responses
)
})
}
What do I have to put into my ui code to get it to diplay, currently I'm getting complaints that "output" is missing with no default?
I'm calling it presently in my ui code, using:
selectionChooserUI("selection")
It's probably something like this. I haven't test it out since I don't have your data ..
library(shiny)
ui <- fluidPage(
h1("Get me a Module!"),
selectInput("source", "Some source", choices = letters[1:4]),
selectInput("filter", "Some filter", choices = letters[1:4]),
selectionChooserUI("id_of_me")
)
server <- function(input, output, session) {
get_me_choices <- reactive({
get("qlist", envir = get(req(input$source)))[[req(input$filter)]]$responses })
callModule(module = selectionChooser, id = "id_of_me", choices = get_me_choices)
}
selectionChooserUI <- function(id) {
ns <- NS(id)
uiOutput(ns('selection'))
}
selectionChooser <- function(input, output, session, choices) {
ns <- session$ns
output$selection <- renderUI({
selectInput(
inputId = ns('selection'),
label = 'Selection',
choices = choices
)
})
}