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)
Related
I am trying to use modules while developing a shinyApp and I am failing to add a sidebarPanel that change when I change a tabPanel in the mainPanel. For example, when the user is on "Tab1" a h4() element should be added to the sidebarPanel with "Title" and when the user is on "Tab2" the sidebarPanel should show a selectInput(). This is the code I am using. Any idea on what I am doing wrong?
library(shiny)
# Module UI ####
modUI = function(id) {
ns = NS(id)
tabPanel("Dummy Panel",
sidebarPanel("SibeBarPanel",
conditionalPanel("input.ns(mainpanel) == 1",
h4("Title")),
conditionalPanel("input.ns(mainpanel) == 2",
selectInput(ns("s_1"), "Label1", choices = c("A","B")))
),
mainPanel(
tabsetPanel(id=ns("mainpanel"),
tabPanel("Tab1", value = 1),
tabPanel("Tab2", value = 2))))
}
# Module Server ####
modServer <- function(id) {
moduleServer(id, function(input, output, session) {
})
}
server = function(input, output, session) {
modServer("v1")
}
ui = shinyUI(
navbarPage("Dummy",
navbarMenu("This",
modUI("v1")))
)
server = function(input, output, session) {
modServer("v1")
}
shinyApp(ui, server)
By now conditionalPanel has a ns argument:
The namespace() object of the current module, if any.
Please check the following:
library(shiny)
# Module UI ####
modUI = function(id) {
ns = NS(id)
tabPanel("Dummy Panel",
sidebarPanel("SibeBarPanel",
conditionalPanel("input.mainpanel == 1",
h4("Title"), ns = ns),
conditionalPanel("input.mainpanel == 2",
selectInput(ns("s_1"), "Label1", choices = c("A","B")), ns = ns)
),
mainPanel(
tabsetPanel(id=ns("mainpanel"),
tabPanel("Tab1", value = 1),
tabPanel("Tab2", value = 2))))
}
# Module Server ####
modServer <- function(id) {
moduleServer(id, function(input, output, session) {
})
}
server = function(input, output, session) {
modServer("v1")
}
ui = shinyUI(
navbarPage("Dummy",
navbarMenu("This",
modUI("v1")))
)
server = function(input, output, session) {
modServer("v1")
}
shinyApp(ui, server)
Result:
<div data-display-if="input.mainpanel == 1" data-ns-prefix="v1-">
<h4>Title</h4>
</div>
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)
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)
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)
)
}
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