Cannot render plot inside dynamic UI, when using a shiny module - r

Normally, Shiny has no problem generating plots from within UIs that the user calls reactively, but I've noticed that when using a shiny module to dynamically generate the UI, the plot does not appear.
Below is a minimal example of a modularized shiny app that reproduces the problem; it is supposed to generate a ui with a plot in it when the user presses the "go" button:
library("shiny")
exampleUI <- function(id, label = "example") {
ns <- NS(id)
tagList( actionButton(ns("go"), "Go"), uiOutput(ns("ui")) )
}
ui <- fluidPage( exampleUI("example") )
example <- function(input, output, session) {
observeEvent(input$go, {
output$plot <- renderPlot( plot(1:5, 1:5) )
output$ui <- renderUI( plotOutput("plot") )
})
}
server <- function(input, output) { callModule(example, "example") }
shinyApp(ui, server)
By contrast, the non-modularized version works as expected:
ui <- fluidPage(
tagList( actionButton("go", "Go"), uiOutput("ui") )
)
server <- function(input, output) {
observeEvent(input$go, {
output$plot <- renderPlot( plot(1:5, 1:5) )
output$ui <- renderUI( plotOutput("plot") )
})
}
shinyApp(ui, server)
I would appreciate any pointers on how to make the first code block behave like the second.

library(shiny)
exampleUI <- function(id, label = "example") {
ns <- NS(id)
tagList( actionButton(ns("go"), "Go"), uiOutput(ns("ui")) )
}
example <- function(input, output, session) {
observeEvent(input$go, {
output$plot <- renderPlot( plot(1:5, 1:5) )
ns <- session$ns
output$ui <- renderUI( plotOutput(ns("plot")) )
})
}
ui <- fluidPage( exampleUI("example") )
server <- function(input, output, session) {
callModule(example, "example")
}
shinyApp(ui, server)
Two things:
You referred to exampleUI before defining it (In your actual example, you will probably source the module, so this shouldn't be a problem)
When using renderUI in modules which contain input/output you need to wrap it within ns. Read the section on Using renderUI within modules for more

Related

Dyamic input in Shiny modules

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)

Parse HTML inside renderUI

Is there a way to parse HTML inside renderUI. I tried below code, but it is taking as character and not a HTML. Basically, "Next Line" should be displayed in the next line?
library(shiny)
ui <- fluidPage(
uiOutput("text")
)
server <- function(input, output, session) {
output$text <- renderUI({
paste0("Filtered value are for ", as.character(br()),"Next line")
})
}
shinyApp(ui, server)
I'm not sure why you're using renderUI rather than renderText...
library(shiny)
ui <- fluidPage(
uiOutput("text")
)
server <- function(input, output, session) {
output$text <- renderText({
paste0("Filtered value are for ", br(),"Next line")
})
}
shinyApp(ui, server)
Gives
If you do need to use renderUI,
library(shiny)
ui <- fluidPage(
uiOutput("text")
)
server <- function(input, output, session) {
output$text <- renderUI({
tagList("Filtered value are for ", br(),"Next line")
})
}
shinyApp(ui, server)
gives the same result.

Shiny Action Button Not working from module

I have defined my action button from a module as shown bellow.
Now it cannot trigger an observe event when pressed.I had this thinking that modules are isolated and self sufficient but seems not .Putting this in my server it works well but i do not want to clutter my server.
Any Idea?
cool_UI <- function(id) {
ns <- NS(id)
tagList(
uiOutput(ns("myUi"))
)
}
cool <- function(input, output, session) {
observeEvent(input$butonid,{
print("Button from Module")
})
output$myUi <- renderUI({
tabsetPanel(
tabPanel(title = "sometitle",actionButton("butonid","My Button"))
)
})
}
library(shiny)
ui <- fluidPage(
cool_UI("myUi")
)
server <- function(input, output, session) {
callModule(cool,"myUi")
}
shinyApp(ui, server)
You need to namespace the ID of the button you create in your module server function.
cool <- function(input, output, session) {
ns <- session$ns
observeEvent(input$butonid,{
print("Button from Module")
})
output$myUi <- renderUI({
tabsetPanel(
tabPanel(title = "sometitle",actionButton(ns("butonid"),"My Button"))
)
})
}
Note the inclusion of ns <- session$ns at the top of the module server function.
input is namespaced in the module server function, but text strings used as widget IDs aren't.

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

Using shiny's renderUI in Module

this is my first question at stackoverflow. I have a problem with modules and renderUI in shiny (1.0.5).
When I use renderUI in
#### Main Part
ui <- bootstrapPage(
uiOutput("DynamicContent")
)
server <- function(input, output,session) {
S_A <- selectInput("S_A_Input" ,"Change Me for print message",choices=1:3 )
output$DynamicContent <- renderUI({
tagList(S_A)
})
observe({
print(input$S_A_Input)
})
}
shinyApp(ui = ui, server = server)
then changing the selectInput will cause changing input$S_A_Input, so the print will occur. That's fine.
On the other hand, input$S_A_Input seems not to work, if I work with modules:
### Module Part
Module_YYY_Server <- function(input, output, session){
S_A <- selectInput("S_A_Input" ,"Change Me for print message",choices=1:3 )
output$DynamicContent <- renderUI({
tagList(S_A)
})
observe({
print(input$S_A_Input)
})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput("DynamicContent" %>% ns)
)
}
And then calling the module.
#### Main Part
ui <- bootstrapPage(
Module_YYY_Ui("YYY")
)
server <- function(input, output,session) {
callModule(Module_YYY_Server,"YYY")
}
shinyApp(ui = ui, server = server)
I haven't found a solution to this behaviour.
Late to the party but this is another option to solve your problem using
session$ns("id")
Here how it looks like:
Module_YYY_Server <- function(input, output, session){
output$DynamicContent <- renderUI({
selectInput(session$ns("S_A_Input"), "Change Me for print message", choices = 1:3)
})
output$text <- renderText({
req(input$S_A_Input)
input$S_A_Input})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput(ns("DynamicContent")),
textOutput(ns("text"))
)
}
ui <- bootstrapPage(
Module_YYY_Ui("YYY")
)
server <- function(input, output,session) {
callModule(Module_YYY_Server,"YYY")
}
shinyApp(ui = ui, server = server)
This is based on the example here
While I am sure your example is simplified, If your input$S_A_Input is not changing based on what you are doing, as is the case in your example, I would not recommend using renderUI. Regardless of that, the reason that your input is not printing is because you are not generating it as an output.
Module_YYY_Server <- function(input, output, session){
output$DynamicContent <- renderUI({
ns <- session$ns
tagList(
selectInput("S_A_Input" %>% ns, "Change Me for print message",choices=1:3 )
)
})
output$text <- renderText({input$S_A_Input})
}
Module_YYY_Ui <- function(id){
ns <- NS(id) # Creates Namespace
tagList(
uiOutput("DynamicContent" %>% ns),
textOutput("text" %>% ns)
)
}

Resources