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)
Related
I struggle with making a dynamic selectInput() when working with Shiny modules.
I have the following app (without modules):
library(shiny)
ui <- fluidPage(
numericInput("n", "n", 10),
uiOutput("select"),
uiOutput("res")
)
server <- function(input, output, session) {
output$select <- renderUI(
selectInput("sample_size", "Sample size", choices = 1:input$n)
)
output$res <- renderUI(
renderPrint(rnorm(input$sample_size))
)
}
shinyApp(ui, server)
I am not sure how to properly use namespaces when modularizing this app. My current attempt looks like this:
library(shiny)
sampleUI <- function(id){
ns <- NS(id)
fluidPage(
numericInput("n", "n", 10),
uiOutput(ns("select")),
uiOutput("res")
)
}
sampleServer <- function(input, output, session) {
output$select <- renderUI(
selectInput("sample-size", "Sample size", choices = 1:input$n)
)
output$res <- renderUI(
renderPrint(rnorm(input$sample_size))
)
}
ui <- fluidPage(
sampleUI("mod1")
)
server <- function(input, output, session) {
callModule(sampleServer, "mod1")
}
shinyApp(ui, server)
When making new IDs in the server module, always use session$ns around the ID. This is the case here for your selectInput. Also fixed a typo, and an ns() in the UI function:
library(shiny)
sampleUI <- function(id){
ns <- NS(id)
fluidPage(
numericInput(ns("n"), "n", 10),
uiOutput(ns("select")),
uiOutput("res")
)
}
sampleServer <- function(input, output, session) {
output$select <- renderUI(
selectInput(session$ns("sample_size"), "Sample size", choices = 1:input$n)
)
output$res <- renderUI(
renderPrint(rnorm(input$sample_size))
)
}
ui <- fluidPage(
sampleUI("mod1")
)
server <- function(input, output, session) {
callModule(sampleServer, "mod1")
}
shinyApp(ui, server)
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 trying to write a shiny app where I produce a list and add and delete some elements.
I have a module to add somethind to my list.
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- list()
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue <<- append(queue, queue_append )})
queue_ret <- eventReactive(input$press,{return(list(queue=queue, add=input$press))})
}
Then I call it twice and connect the 2 different inputs. Now I want to choose the elements to delete but this doesn't work.
source('/cloud/project/Queue/find_input.R')
library(shiny)
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- eventReactive(input$combine, {
return(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq(1:length(appended()))),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended <<- appended()[-input$delete]
})
}
# Run the application
shinyApp(ui = ui, server = server)
Maybe anybody can tell me what's wrong so far?
Thanks in advance!
Below is an app which seems to work but I'm not sure to understand what your app is intended to do.
In general, prefer reactive values (reactiveVal) instaed of using the non-local assignment <<-.
The code appended <<- appended()[-input$delete] is not correct. It does not replace the output of appended() by its originalvalue minus the input$delete index.
library(shiny)
find_inputUI <- function(id){
ns <- NS(id)
tagList(
sliderInput(ns("first"), "Choose a number:", min=0, max=100, 30),
radioButtons(ns("second"), "Choose a colour:", choices=c("red", "green", "black")),
actionButton(ns("press"), "Add to queue"))
}
find_input <- function(input, output, session){
queue <- reactiveVal(list())
observeEvent(input$press, {
queue_append <- list(input$first, input$second)
queue(append(queue(), queue_append))
})
queue_ret <- eventReactive(input$press, {
list(queue=queue(), add=input$press)
})
}
ui <- fluidPage(
tagList(tabsetPanel(
tabPanel("INPUT 1",
find_inputUI("input1"),
verbatimTextOutput("test")),
tabPanel("INPUT 2",
find_inputUI("input2")
)
),
actionButton("combine", "Show combined input"),
verbatimTextOutput("combination"),
uiOutput("del")
)
)
server <- function(input, output, session) {
input_manual1 <- callModule(find_input,"input1")
input_manual2 <- callModule(find_input, "input2")
output$test <- renderPrint({input_manual1()$queue})
appended <- reactiveVal(list())
observeEvent(input$combine, {
appended(append(input_manual1()$queue, input_manual2()$queue))
})
output$combination <- renderPrint({appended()})
output$del <- renderUI({
input$combine
tagList(checkboxGroupInput("delete", "Choose do delete", seq_along(appended())),
actionButton("dodelete", "Delete selected"))
})
observeEvent(input$dodelete,{
appended(appended()[-as.integer(input$delete)])
})
}
# Run the application
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)