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
)
})
}
Related
I have just gotten into modules and it seems like I have not figured it out yet. The following code does not run properly. The app closes immediately after it opens.
It seems like the id does not match. However, I am not quite sure what goes wrong.
I set up input and output for the UI in the module and then set up the server for the module. I then combine everything in the UI and Server for the app and run it.
SharePrepayInputUI<- function(id, vChoice){
ns <- NS(id)
tagList(
fluidRow(
column(2,
pickerInput(ns("navn"),"Select Segment", choices=vChoice, options = list(
"actions-box" = TRUE,
"live-search" = TRUE),
multiple = TRUE))
)
)
}
ShareOutpuitUI <- function(id){
ns <- NS(id)
tagList(
fluidRow(
column(6,
dataTableOutput(ns("cls"))),
column(4,
dataTableOutput(ns("dbl")))
)
)
}
ShareServer <- function(id){
moduleServer(id, function(input, output, session){
# Table for cash loan share
output$cls <- renderDataTable({
DT::datatable(mCls[mCls$Segment %in% input$navn,], container = sketch_cls, rownames = FALSE)
})
output$dbl <- renderDataTable({
DT:datatable(mDbl[mDbl$Segment %in% input$navn,], container = sketch_dbl, rownmaes = FALSE)
})
})
}
UdtrDebUI <- fluidPage(
SharePrepayInputUI(id = "module_1", vChoice = mCls$Segment),
ShareOutpuitUI(id = "module_1")
)
UdtrDebServer <- function(id){
ShareServer(id = "module_1")
}
shinyApp(UdtrDebUI, UdtrDebServer)
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)
I am currently having troubles making my module UI and server communicating whith an intermediate renderUI creating the layout. Here is a repex with and without the dynamic creation of the tabsetPanel. I guess the problem comes from namespace but I cannot figure out where and how to fix it.
DO NOT WORK :
mod_graphical_general_ui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("myselect"), "Select a choice", choices = NULL)
)}
mod_graphical_general_server <- function(id, choices = NULL) {
moduleServer( id, function(input, output, session){
ns <- session$ns
updateSelectInput(session, "myselect", choices = choices)
})
}
ui <- bootstrapPage(
uiOutput("mytabs")
)
server <- function(input, output) {
mod_graphical_general_server("mymodule", choices = c("aaa", "bbb"))
output$mytabs = renderUI({
number_of_tabs <- 3
names_tab <- paste0("Tab", 1:number_of_tabs)
myTabs = lapply(1: number_of_tabs, function(x) {tabPanel(names_tab[[x]], div(uiOutput(paste0("graphics_tab", x))))})
do.call(tabsetPanel, c(myTabs))
})
output$graphics_tab1 <- renderUI({
return(mod_graphical_general_ui("mymodule"))
})
}
shinyApp(ui = ui, server = server)
If I remove the step from calling the tabsetPanel, the code works .
mod_graphical_general_ui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("myselect"), "Select a choice", choices = NULL)
)}
mod_graphical_general_server <- function(id, choices = NULL) {
moduleServer( id, function(input, output, session){
ns <- session$ns
updateSelectInput(session, "myselect", choices = choices)
})
}
ui <- bootstrapPage(
#uiOutput("mytabs")
uiOutput("graphics_tab1")
)
server <- function(input, output) {
mod_graphical_general_server("mymodule", choices = c("aaa", "bbb"))
output$mytabs = renderUI({
number_of_tabs <- 3
names_tab <- paste0("Tab", 1:number_of_tabs)
myTabs = lapply(1: number_of_tabs, function(x) {tabPanel(names_tab[[x]], div(uiOutput(paste0("graphics_tab", x))))})
do.call(tabsetPanel, c(myTabs))
})
output$graphics_tab1 <- renderUI({
return(mod_graphical_general_ui("mymodule"))
})
}
shinyApp(ui = ui, server = server)
I already have asked the question in the community rstudio but with no luck.
Anyway, I fixed your code.
The thing is your mod server is run as the top-level shiny server starts. However, your mod UI is running later after the mod server. So this causes the updateSelectInput can't find the dynamic UI component to update. In your second example, the UI component is already there when app starts, so it doesn't have this issue.
We need to wait the render UI event is done when we can call the mod server. To understand this, you need to know how Shiny communicates with frontend javascript, not going into details here. You can read more on this issue.
mod_graphical_general_ui <- function(id){
ns <- NS(id)
tagList(
selectInput(ns("myselect"), "Select a choice", choices = NULL)
)}
mod_graphical_general_server <- function(id, choices = NULL) {
moduleServer(id, function(input, output, session){
ns <- session$ns
updateSelectInput(session, "myselect", choices = choices)
})
}
ui <- bootstrapPage(
uiOutput("mytabs")
)
server <- function(input, output, session) {
output$mytabs = renderUI({
number_of_tabs <- 3
names_tab <- paste0("Tab", 1:number_of_tabs)
myTabs = lapply(1:number_of_tabs, function(x) {tabPanel(names_tab[[x]], div(uiOutput(paste0("graphics_tab", x))))})
do.call(tabsetPanel, c(myTabs))
})
output$graphics_tab1 <- renderUI({
on.exit({
observeEvent(once = TRUE, reactiveValuesToList(session$input), {
mod_graphical_general_server("mymodule", choices = c("aaa", "bbb"))
}, ignoreInit = TRUE)
})
return(mod_graphical_general_ui("mymodule"))
})
}
shinyApp(ui = ui, server = server)
I'm creating a shiny module, where I wish to display some pop-up messages to the user via shinyalerts and include dropdown menus via htlm = TRUE and shinyWidgets::pickerInput. For each shinyalert the options should be different and the alerts should appear right after each other when the user has selected the relevant option.
However, when running the shinyalerts within a for loop, only the first alert shows the drop-down, the following does not. Please have a look at the example below and screenshots. Any ideas what I'm doing wrong?
Module UI:
mod_match_columns_ui <- function(id){
ns <- NS(id)
tagList(
shinyalert::useShinyalert(),
actionButton(ns("run"), label = "Start!")
)
}
Module server:
mod_match_columns_server <- function(input, output, session){
ns <- session$ns
options <- list(c("option_1","option_2"),
c("option_3","option_4"))
observeEvent(input$run, {
for(col in 1:2){
nms <- options[[i]]
output[[paste0("dropdown",col)]] <- renderUI({
shinyWidgets::pickerInput(
inputId = ns(paste0("options",col)),
label = "Options listed below",
choices = nms,
selected = "",
multiple = FALSE,
options = shinyWidgets::pickerOptions(size = 15)
)
})
shinyalert::shinyalert(
title = "Pick an option!",
html = TRUE,
text = tagList(
uiOutput(ns(paste0("dropdown", col)))
),
inputId = ns(paste0("modal", col))
)
}
})
}
Run module:
library(shiny)
ui <- fluidPage(
mod_match_columns_ui("match_columns_ui_1")
)
server <- function(input, output, session) {
callModule(mod_match_columns_server, "match_columns_ui_1")
}
shinyApp(ui = ui, server = server)
First iteration:
Second iteration:
Why is the dropdown not shown in the second iteration?? Thanks
Try this
library(shiny)
library(shinyalert)
mod_match_columns_ui <- function(id){
ns <- NS(id)
tagList(
shinyalert::useShinyalert(),
actionButton(ns("run"), label = "Start!")
)
}
mod_match_columns_server <- function(id) {
moduleServer(id,
function(input, output, session) {
ns <- session$ns
options <- list(c("option_1","option_2"),
c("option_3","option_4"))
lapply(1:2, function(col){
output[[paste0("dropdown",col)]] <- renderUI({
shinyWidgets::pickerInput(
inputId = ns(paste0("options",col)),
label = paste("Options",col,"listed below"),
choices = options[[col]],
selected = "",
multiple = FALSE,
options = shinyWidgets::pickerOptions(size = 15)
)
})
})
observeEvent(input$run, {
shinyalert::shinyalert(
title = "Pick an option!",
html = TRUE,
text = tagList(
lapply(1:2, function(i){uiOutput(ns(paste0("dropdown",i)))})
)
# callbackR = function(x) { message("Hello ", x) },
# inputId = ns(paste0("modal"))
)
})
observe({
print(input$options1)
print(input$options2)
print(input$shinyalert)
})
})
}
ui <- fluidPage(
tagList(
mod_match_columns_ui("match_columns_ui_1")
)
)
server <- function(input, output, session) {
mod_match_columns_server("match_columns_ui_1")
}
shinyApp(ui = ui, server = server)
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)