I would like to set up my Shiny app to dynamically enable/disable UI modules based on user input. I am accustomed to using ShinyJS to do this in a non-modular app by passing the ID of the UI element into the enable() or disable() functions. However, with the UI now being generated inside of a module, I no longer have access to the same ID.
Here is an example app which increments by 1 each time the "counter1" button is clicked. The "counterButton" function is contained in an external module called "counterModule.R", and I would like the "toggleButton" to toggle the state of the "counterButton" between enabled and disabled. The call to toggleState() currently does nothing I assume because the "counter1" ID is not found. What would be the best way of going about this?
app.R
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
mainPanel(actionButton(inputId = "toggleButton", label = "Toggle counter button"),
sidebarPanel(counterButton("counter1", "+1")))
)
server <- function(input, output, session) {
observeEvent(input$toggleButton, {
print("clicked toggle button")
shinyjs::toggleState("counter1")
})
counterServer("counter1")
}
shinyApp(ui, server)
R/counterModule.R
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
count
}
)
}
You have 2 possibilities. The namespacing of the shiny modules works in the following format: namespace-elementid. This means that your button in the module has the id counter1-button which is globally unique (and within in the module, you can just use button).
Therefore, you can use the namespaced id in your main server function:
observeEvent(input$toggleButton, {
print("clicked toggle button")
shinyjs::toggleState("counter1-button")
})
However, this somehow breaks the separation of ui/logic defined in the module and in the main server function. Therefore, the second option is to define the toggle button in the main app, but have the toggle logic in the module:
library(shiny)
library(shinyjs)
##########################
# code of the module
counterButton <- function(id, label = "Counter") {
ns <- NS(id)
tagList(
actionButton(ns("button"), label = label),
verbatimTextOutput(ns("out"))
)
}
counterServer <- function(id, toggle_action) {
moduleServer(
id,
function(input, output, session) {
count <- reactiveVal(0)
observeEvent(input$button, {
count(count() + 1)
})
output$out <- renderText({
count()
})
observeEvent(toggle_action(), {
print("clicked toggle button")
shinyjs::toggleState("button")
})
count
}
)
}
##########################
# code of the main app
ui <- fluidPage(
shinyjs::useShinyjs(),
mainPanel(actionButton(inputId = "toggleButton", label = "Toggle counter button"),
sidebarPanel(counterButton("counter1", "+1")))
)
server <- function(input, output, session) {
counterServer("counter1", toggle_action = reactive({input$toggleButton}))
}
shinyApp(ui, 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'm trying to build an application, where the user can add a piece of UI (in this case an input text field) by clicking a button. As this is only part of a bigger application, I wish to use modules to keep structure in my project.
However, my text field won't show after clicking the action button. I'm using the new function moduleServer() that was recently introduced by shiny.
Here is a reprex
library(shiny)
ModularizedUI <- function(id) {
ns <- NS(id)
fluidPage(
# Input: Action button to add text field
actionButton(inputId = ns("add_text"),
label = "Add text field"),
)
}
ModularizedServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
ns <- session$ns
# Track the number of input boxes to render for test training
counter_text <- reactiveVal(0)
# Input/Output fields for start dates test training
observeEvent(input$add_text, {
counter_text(counter_text() + 1)
# Add UI if this button is clicked
insertUI(
selector = "#add",
where = "afterEnd",
ui = textInput(inputId = ns(paste0("textfield_", counter_text())),
label = "New text")
)
})
}
)
}
ui <- navbarPage("Dashboard",
tabPanel("Text fields",
ModularizedUI(id = "Text_Fields")
)
)
server <- function(input, output, session) {
ModularizedServer("Text_Fields")
}
shinyApp(ui = ui, server = server)
Any help is appreciated!
You gave insertUI the selector #add, which defines where the new elements have to be inserted. But there is no element with id #add in your UI.
Add div(id = '#add') after your actionButton and it should work.
(I would then use where = beforeEnd, so that all Inputs are inside that new div and can be easily targeted using CSS or JS, or....)
Complete example:
library(shiny)
ModularizedUI <- function(id) {
ns <- NS(id)
fluidPage(
# Input: Action button to add text field
actionButton(inputId = ns("add_text"),
label = "Add text field"),
div(id = "add")
)
}
ModularizedServer <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
# Track the number of input boxes to render for test training
counter_text <- reactiveVal(0)
# Input/Output fields for start dates test training
observeEvent(input$add_text, {
counter_text(counter_text() + 1)
# Add UI if this button is clicked
insertUI(
selector = "#add",
where = "beforeEnd",
ui = textInput(inputId = ns(paste0("textfield_", counter_text())),
label = "New text")
)
})
}
)
}
ui <- navbarPage("Dashboard",
tabPanel("Text fields",
ModularizedUI(id = "Text_Fields")))
server <- function(input, output, session) {
ModularizedServer("Text_Fields")
}
shinyApp(ui = ui, server = server)
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.
I'm developing an app in which I use modules to display different tab's ui content. However it seems like the module does not communicate with the main (or parent) app. It displays the proper ui but is not able to execute the observeEvent function when an actionButton is clicked, it should update the current tab and display the second one.
In my code I have created a namespace function and wrapped the actionButton's id in ns(), however it still does not work. Does anyone knows what's wrong?
library(shiny)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one",moduleUI("first")),
tabPanel("two",moduleUI("second"))
))
server <- function(input, output, session){
callModule(module,"first")
callModule(module,"second")
}
shinyApp(ui = ui, server = server)
The observeEvent works, but since modules only see and know the variables given to them as input parameters, it does not know the tabsetPanel specified and thus cannot update it. This problem can be solved using a reactive Value, which is passed as parameter and which is changed inside the module. Once it's changed, it is known to the main app and can update the tabsetPanel:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "click")
)
}
module <- function(input, output, session, tabsPanel, openTab){
observeEvent(input$action1, {
if(tabsPanel() == "one"){ # input$tabsPanel == "one"
openTab("two")
}else{ # input$tabsPanel == "two"
openTab("one")
}
})
return(openTab)
}
ui <- fluidPage(
h2("Currently open Tab:"),
verbatimTextOutput("opentab"),
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
observe({ openTab(input$tabsPanel) }) # always write the currently open tab into openTab()
# print the currently open tab
output$opentab <- renderPrint({
openTab()
})
openTab <- callModule(module,"first", reactive({ input$tabsPanel }), openTab)
openTab <- callModule(module,"second", reactive({ input$tabsPanel }), openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)
I want to use a rating Input in conjunction with the shinyjs::reset()function. Everthing works fine except the reset functionality. Any hints?
Here is my minimal example:
library(shiny)
devtools::install_github("stefanwilhelm/ShinyRatingInput")
library(ShinyRatingInput)
library(shinyjs)
ui <- shinyUI(bootstrapPage(
useShinyjs(),
ratingInput("movieRating", label="Rate this movie...", dataStop=5),
htmlOutput("movieRatingout"),
actionButton("resetbtn", "reset")
))
#the corresponding server.R
server <- shinyServer(function(input, output, session) {
output$movieRatingout <- renderText({
paste("The movie was rated ",input$movieRating)
})
observeEvent(input$resetbtn, {
reset("movieRating")
})
})
shinyApp(ui, server)
You can create reset action manualy
1) Add js to reset icons ( set width of foreground ==0)
jsCode <-"shinyjs.reset_1 = function(params){$('.rating-symbol-foreground').css('width', params);}"
2) add this js to app using extendShinyjs
3) add session$sendInputMessage to reset input ( set value == NULL)
Working example
jsCode <-"shinyjs.reset_1 = function(params){$('.rating-symbol-foreground').css('width', params);}"
ui <- shinyUI(bootstrapPage(
useShinyjs(),
extendShinyjs(text = jsCode),
ratingInput("movieRating", label="Rate this movie...", dataStop=5),
htmlOutput("movieRatingout"),
actionButton("resetbtn", "reset")
))
#the corresponding server.R
server <- shinyServer(function(input, output, session) {
output$movieRatingout <- renderText({
paste("The movie was rated ",input$movieRating)
})
observeEvent(input$resetbtn, {
session$sendInputMessage("movieRating", list(value = NULL))
js$reset_1(0)
})
})