I want to create a UI module, insert it, and obtain an input object from the server module. I then want to observe events on this input object.
Currently, I return an input object as a reactive value from callModule. However, the observer I create only fires once (on initialisation).
Can anyone tell me if what I am trying to do is possible, and where I'm going wrong? Code attached. Thanks in advance.
John
app.R
library(shiny)
source("added.R")
source("addedUI.R")
# Define UI for application that draws a histogram
ui <- fluidPage(
actionButton("add_id", "Add"),
actionButton("print_id", "Print list"),
tags$hr(),
tags$div(id = "div"),
tags$hr()
)
# Define server logic required to draw a histogram
server <- function(input, output) {
id <- 0
rv <- list()
next_id <- function()
{
id <<- id + 1
return (as.character(id))
}
observeEvent(input$print_id,
{
print(rv)
})
observeEvent(input$add_id,
{
x <- next_id()
ui <- addedUI(x)
insertUI(selector = sprintf("#%s", "div"), where = "beforeEnd", ui = ui)
rv[[x]] <<- callModule(added, x)
observeEvent(rv[[x]],
{
print(sprintf("Observed %s: ", x))
})
print(rv)
})
}
# Run the application
shinyApp(ui = ui, server = server)
added.R
added <- function(input, output, session)
{
return (reactive(input$text_id))
}
addedUI.R
addedUI <- function(id)
{
ns <- NS(id)
tags$div(textInput(ns("text_id"), "Text", value = "Abc"))
}
You need to use observeEvent(rv[[x]](), ...) to read the current value from the reactive. Otherwise you recieve the reference to the reactive object, which is not observable. Same for the print_id observer.
library(shiny)
added <- function(input, output, session)
{
return (reactive(input$text_id))
}
addedUI.R
addedUI <- function(id)
{
ns <- NS(id)
tags$div(textInput(ns("text_id"), "Text", value = "Abc"))
}
# Define UI for application that draws a histogram
ui <- fluidPage(
actionButton("add_id", "Add"),
actionButton("print_id", "Print list"),
tags$hr(),
tags$div(id = "div"),
tags$hr()
)
# Define server logic required to draw a histogram
server <- function(input, output) {
id <- 0
rv <- list()
next_id <- function()
{
id <<- id + 1
return (as.character(id))
}
observeEvent(input$print_id,
{
print(lapply(rv, function(x){x()}))
})
observeEvent(input$add_id,
{
x <- next_id()
ui <- addedUI(x)
insertUI(selector = sprintf("#%s", "div"), where = "beforeEnd", ui = ui)
rv[[x]] <<- callModule(added, x)
observeEvent(rv[[x]](),
{
print(sprintf("Observed %s: ", x))
})
print(rv)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
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'd like to have an actionButton that cycles its class between "btn-success", "btn-warning", "btn-danger" based on the button click. Unfortunately I can't seem to figure out how to get that value into the class argument of the actionButton.
library(shiny)
v <- reactiveValues(btn_status = "btn-secondary")
ui <- fluidPage(
# Application title
titlePanel("Change Button Color on click"),
# Create an action button that cycles through 3 bootstrap colors and can be reset
mainPanel(
actionButton("run","L", class = isolate(v$btn_status)),
actionButton("reset", "Clear"),
textOutput("status"),
)
)
server <- function(input, output) {
observeEvent(input$run, {
v$btn_status <- "btn-success"
})
observeEvent(input$reset, {
v$btn_status <- "NULL"
})
output$status <- renderText({
v$btn_status
})
}
shinyApp(ui = ui, server = server)
It's not entirely clear to me what you're trying to do (see my comment above); but I think you're after something like this:
library(shiny)
valid_status <- c("btn-success", "btn-warning", "btn-danger")
ui <- fluidPage(
titlePanel("Change Button Color on click"),
mainPanel(
uiOutput("statusButton"),
actionButton("reset", "Clear"),
textOutput("status"),
)
)
server <- function(input, output, session) {
v <- reactiveValues(button_idx = 1)
get_button_idx <- reactive(v$button_idx)
output$statusButton <- renderUI({
idx <- get_button_idx()
actionButton("run", "L", class = valid_status[idx])
})
observeEvent(input$run, {
v$button_idx <- ifelse(v$button_idx < 3, v$button_idx + 1, 1)
})
observeEvent(input$reset, {
v$button_idx <- 1
})
output$status <- renderText({
valid_status[v$button_idx]
})
}
shinyApp(ui = ui, server = server)
producing
The key is to use a reactive value within renderUI to update the class of the actionButton. To align the buttons you could use fluidRow if necessary.
The app below contains a module that inserts a UI object each time the Add button is clicked. The UI object consists of two inputs:
Input 1 is a selectInput with choices A and B.
Input 2 is a textInput if the user chooses A and a
numericInput if they choose B.
However, when I click Add, the inserted UI only contains Input 1 (the selectInput) - Input 2 is not rendered, as shown below:
Whereas the desired output looks like this:
I'm not sure if this is a namespacing issue or if there is a problem in the scoping of the module. Printing the IDs to the console checks out:
The app is as follows:
library(shiny)
# module UI function
modUI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns('add'), 'Add'),
div(id = ns('placeholder'))
)
}
# module server function
modServer <- function(input, output, session) {
ns = session$ns
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
selectInput(Id()('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(Id()('input'))
)
)
})
observeEvent(ctn(), {
id <- Id()('input')
selection <- Id()('letter')
print(list(id = id, selection = selection))
req(input[[selection]])
output[[id]] <- renderUI({
req(input[[selection]])
switch(
input[[selection]],
'A' = textInput(Id()('text'), 'ENTER TEXT', ''),
'B' = numericInput(Id()('numeric'), 'ENTER NUMBER', '')
)
})
}, ignoreInit = TRUE)
}
# main ui
ui <- fluidPage(
modUI('mod1')
)
# main server
server <- function(input, output, session) {
callModule(modServer, "mod1")
}
# run app
shinyApp(ui, server)
I tried splitting the module up into an inner and outer module. The inner mod creates Input 1 and Input 2 and the outer mod inserts them into the main app using insertUI. This gives me the same outcome as before though. The code for this can be viewed below:
library(shiny)
# INNER MOD ---------------------------------------------------------------
innermodUI <- function(id) {
ns = NS(id)
tagList(
selectInput(ns('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(ns('names'))
)
}
innermodServer <- function(input, output, session) {
ns = session$ns
output$names <- renderUI({
selection = req(input$letter)
switch(
selection,
'A' = textInput(ns('text'), 'ENTER TEXT', ''),
'B' = numericInput(ns('numeric'), 'ENTER NUMBER', '')
)
})
}
# OUTER MOD ---------------------------------------------------------------
modUI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns('add'), 'Add'),
div(id = ns('placeholder'))
)
}
modServer <- function(input, output, session) {
ns = session$ns
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
filterId = Id()('filter')
insertUI(
selector = paste0('#', ns('placeholder')),
ui = innermodUI(filterId)
)
callModule(innermodServer, filterId)
})
}
# MAIN --------------------------------------------------------------------
ui <- fluidPage(
modUI('mod1')
)
server <- function(input, output, session) {
callModule(modServer, "mod1")
}
shinyApp(ui, server)
I also tried wrapping the renderUI in a shinyjs::delay() to no avail. I would really appreciate any help on this since I'm not well-versed in Shiny modules and don't know what to try next.
I've managed to make it work by multiple trials-errors. As I understand (I'm still new in Shiny modules), you have to use session$ns only for the inputs created in the server.
library(shiny)
# module UI function
modUI <- function(id){
ns <- NS(id)
tagList(
actionButton(ns('add'), 'Add'),
div(id = ns('placeholder'))
)
}
# module server function
modServer <- function(input, output, session) {
ns = session$ns
ctn <- reactiveVal(0)
Id <- reactive({
function(id){
paste0(id, ctn())
}
})
IdNS <- reactive({
function(id){
ns(paste0(id, ctn()))
}
})
observeEvent(input$add, {
ctn(ctn() + 1)
insertUI(
selector = paste0('#', ns('placeholder')),
ui = div(
id = Id()('div'),
selectInput(IdNS()('letter'), 'Letter:', LETTERS[1:2]),
uiOutput(IdNS()('input'))
)
)
})
observeEvent(ctn(), {
id <- Id()('input')
selection <- Id()('letter')
output[[id]] <- renderUI({
switch(
input[[selection]],
'A' = textInput(IdNS()('text'), 'ENTER TEXT', ''),
'B' = numericInput(IdNS()('numeric'), 'ENTER NUMBER', '')
)
})
}, ignoreInit = TRUE)
}
# main ui
ui <- fluidPage(
modUI('mod1')
)
# main server
server <- function(input, output, session) {
callModule(modServer, "mod1")
}
# run app
shinyApp(ui, server)
Following this answer I'm trying to create an app that will output a plot based on the value I will pass to the app via URL
library(shiny)
shinyApp(
ui = fluidPage(
mainPanel(
plotOutput("plot")
)
),
server = function(input, output, session) {
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['text']])) {
n <- query[['text']]
}
})
output$plot <- renderPlot({
# Add a little noise to the cars data
plot(cars[sample(nrow(cars), n), ])
})
}
)
Yet I don't know where/how I should store/pass the value of the variable n so to transfer it from observe() to renderPlot().
Try this. Note that n is defined as a per-session global variable, and notice the global assignment operator <<-
library(shiny)
shinyApp(
ui = fluidPage(
mainPanel(
plotOutput("plot")
)
),
server = function(input, output, session) {
n <- 5
observe({
query <- parseQueryString(session$clientData$url_search)
if (!is.null(query[['text']])) {
n <<- query[['text']]
}
})
output$plot <- renderPlot({
# Add a little noise to the cars data
plot(cars[sample(nrow(cars), n), ])
})
}
)
I a newbie in shiny and I want to add input$n widgets to my webpage, where input$n is a numeric given by another widget in my page?
Is it possible? And how?
Thank you very much for your help!
You can achieve this by using Shiny Modules. In the following example, the application dynamically creates N textInput from a numericInput.
library(shiny)
# Module UI containing a widget
widgetUI <- function(id, i) {
ns <- NS(id)
tagList(
textInput(inputId = ns("text"), label = paste("widget", i))
)
}
# Module server, unused here, just prints the widgets value in console
widgetServer <- function(input, output, session) {
observeEvent(input$text,{
print(input$text)
})
}
# Main UI page
ui <- fluidPage(
numericInput(inputId = "n", label = "Number of widgets", value = 2),
uiOutput("widgets")
)
# Main server
server <- function(input, output, session) {
output$widgets <- renderUI({
req(input$n)
# call the module UI n times
tagList(
lapply(1:input$n, function(i) {
widgetUI(id = paste0("widget", i), i)
})
)
})
observe({
# call the module server n times
lapply(1:input$n, function(i) {
callModule(widgetServer, id = paste0("widget", i))
})
})
}
shinyApp(ui, server)