disable does not work for downloadButton when using uiOutput/renderUI - r

I have a simple ui/server modules. When I try using uiOutput/renderUI, the disable/enable function does not work. But, if I call ui module directly in the ui, it works fine.
library(shiny)
library(shinyjs)
library(shinydashboard)
my_UI <- function(id = "xyz") {
ns <- NS(id)
tagList(
downloadButton(ns("dl"), "Download")
)
}
my_Server <- function(id = "xyz") {
moduleServer(id,
function(input, output, session) {
disable("dl")
}
)
}
ui <- dashboardPage(
dashboardHeader(title = "test"),
dashboardSidebar(disable = TRUE),
dashboardBody(
useShinyjs(),
uiOutput("app_ui")
# my_UI()
)
)
server <- function(input, output, session) {
output$app_ui <- renderUI({
my_UI()
})
my_Server()
}
shinyApp(ui, server)

That's because the download button is not rendered yet when disable is executed. You can use shinyjs::delay to delay the execution. Actually this works with a delay of 0ms, because this function also puts the expression it executes in a queue.
my_Server <- function(id = "xyz") {
moduleServer(
id,
function(input, output, session) {
delay(0, disable("dl"))
}
)
}

We can also start with the button already disabled using shinyjs::disabled()
my_UI <- function(id = "xyz") {
ns <- NS(id)
tagList(
shinyjs::disabled(downloadButton(ns("dl"), "Download"))
)
}

Related

Shiny server function finds module when using fixed IDs but not when using ns()

I have a shiny app, each module is it's own file. Each module get's an ns <- NS(id). When I adress an Element, say a button from one of those modules with observeEvent it works if I just hardcode an ID in the module, but not if I use ns(). What am I doing wrong?
Module:
mod_add_element_ui <- function(id){
ns <- NS(id)
tagList(
shiny::actionButton(ns("add_element"), "add new element", icon = icon("plus-square"))
)
}
mod_add_element_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
})
}
app_ui:
app_ui <- function(request) {
tagList(
fluidPage(
mod_add_element_ui("add_element_ui_1"),
div(id="add_here")
)
)
}
app_server:
app_server <- function( input, output, session ) {
mod_add_element_server("add_element_ui_1")
observeEvent(input$add_element,
{
mod_add_element_server(id="mod")
insertUI(selector = "#add_here", ui = mod_add_element_ui("mod"))
}
)
}
Try this
mod_add_element_ui <- function(id){
ns <- NS(id)
tagList(
shiny::actionButton(ns("add_element"), "add new element", icon = icon("plus-square"))
)
}
mod_add_element_server <- function(id){
moduleServer( id, function(input, output, session){
ns <- session$ns
return(reactive(input$add_element))
})
}
app_ui <- function(request) {
tagList(
fluidPage(
mod_add_element_ui("add_element_ui_1"),
div(id="add_here")
)
)
}
app_server <- function( input, output, session ) {
added_element <- mod_add_element_server("add_element_ui_1")
observeEvent(added_element(),
{
mod_add_element_server(id="mod")
insertUI(selector = "#add_here", ui = mod_add_element_ui("mod"))
}
)
}
shinyApp(app_ui, app_server)

Understanding R Shiny modules: Error in shiny::NS(id) : argument "id" is missing, with no default

I am trying to understand the concept of shiny modules. I am attempting to modularize this very simple shinydashboard app:
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(uiOutput("box"))
)
server <- function(input, output, session) {
output$box <- renderValueBox({
valueBox(
subtitle = "Hi",
value = 2
)
})
}
shinyApp(ui, server)
which works as desired.
However, when modularizing I keep getting the following mistake:
Error in shiny::NS(id) : argument "id" is missing, with no default.
#### Modules ####
costumizedValueBox <- function(id) {
ns <- shiny::NS(id)
uiOutput(ns("box"))
}
costumizedValueBoxServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
output$box <- renderValueBox({
valueBox(
subtitle = "Hi",
value = 2
)
})
}
)
}
#### App ####
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(costumizedValueBox())
)
server <- function(input, output, session) {
costumizedValueBoxServer()
}
shinyApp(ui, server)
I have tried different modifications of the modularized code, none of which worked, e. g. changing the output (to textOutput) or the general setup. The error message suggests a problem with the NS function but I am not able to figure it out.
Thanks!
This is what #Limey describes in the comments: To learn in detail see here https://shiny.rstudio.com/articles/modules.html
library(shiny)
#### Modules ####
costumizedValueBox <- function(id, label = "ValueBox_custom") {
ns <- shiny::NS(id)
uiOutput(ns("box"))
}
costumizedValueBoxServer <- function(id) {
moduleServer(
id,
function(input, output, session) {
output$box <- renderValueBox({
valueBox(
subtitle = "Hi",
value = 2
)
})
}
)
}
#### App ####
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(costumizedValueBox("ValueBox_custom1"))
)
server <- function(input, output, session) {
costumizedValueBoxServer("ValueBox_custom1")
}
shinyApp(ui, server)
Modules (i.e., costumizedValueBoxServer and costumizedValueBox) are functions with a required argument.
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(costumizedValueBox("my_id")) # pass in an ID
)
server <- function(input, output, session) {
costumizedValueBoxServer("my_id") # pass in the same ID
}
Yeah just when you call your module, make sure to assign an id for it in quotes. Job well done, I've been learning about this too. Make sure your id matches your module calls in both server and UI sections of your app.
Here is a youtube link, you've probably already seen, but the timestamp shows what I am talking about.
https://www.youtube.com/watch?v=oOYaHsPXLvs
dashboardHeader(),
dashboardSidebar(),
dashboardBody(costumizedValueBox("VBox_id_1")) # pass in an ID
)
server <- function(input, output, session) {
costumizedValueBoxServer("VBox_id_1") # pass in the same ID
}```

How do you have different server execution based on selected tabItem() in shiny?

Background
I am using {brochure} and {golem} to build a shiny app. I have one outer module grid that consists of inner modules subGrid2 which displays the same module UI on two tabs.
GOAL
have a module subGrid2 that can be used for repeating graph
visualizations on multiple tabs.
in the REPREX --> fake graph generated from {shinipsum} to
be displayed on the "Home" tab + "Portfolio" tab
use observeEvent to look at the slected tab and generate server response respectivley
Problem
The observeEvent reactive expr. fails to recognize when the corresponding tab is selected to generate the correct server response.
-using the reprex below replicates my issue-
TL/DR
Why wont the observeEvent reactive generate the correct server response per the selected tab?
REPREX
uncomment observeEvent to see error
#22.2.22
library(brochure)
library(shiny)
library(shinipsum)
library(shinydashboard)
library(shinydashboardPlus)
mod_subGrid2_ui <- function(id) {
ns <- NS(id)
tagList(
plotOutput(ns("plot"))
)
}
mod_subGrid2_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot <- renderPlot({
shinipsum::random_ggplot()
})
})
}
#Setup dashboard
mod_Grid_ui <- function(id) {
ns <- NS(id)
shinydashboardPlus::dashboardPage(
skin = "midnight",
header = dashboardHeader(title = "test"),
sidebar = dashboardSidebar(
shinydashboard::sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Home", tabName = "home", icon = icon("tachometer-alt")),
menuItem("Portfolio", tabName = "portfolio", icon = icon("chart-line"), badgeLabel = "new",
badgeColor = "green")
)
),
body = shinydashboard::dashboardBody(
# Enable shinyjs
shinyjs::useShinyjs(),
shinydashboard::tabItems(
shinydashboard::tabItem("home",
shiny::tagList(
div(p("Content for 1st tab goes here -- GRID MODULE")),
mod_subGrid2_ui(ns("subGrid2_ui_1"))
)
),
shinydashboard::tabItem("portfolio",
shiny::tagList(
div(p("Content for 2nd goes here -- GRID MODULE (2x)")),
titlePanel(title = "The same module UI goes here"),
mod_subGrid2_ui(ns("subGrid2_ui_2"))
)
)
)
)
)
}
mod_Grid_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
mod_subGrid2_server("subGrid2_ui_1")
mod_subGrid2_server("subGrid2_ui_2")
## uncomment to try
# observeEvent(input$tabs,{
# if(input$tabs == "home"){
# # <subGrid> server fragment
# mod_subGrid2_server("subGrid2_ui_1")
# } else if(input$tabs == "portfolio"){
# mod_subGrid2_server("subGrid2_ui_1")
# }
# }, ignoreNULL = TRUE, ignoreInit = TRUE)
})
}
brochureApp(
page(
href = "/",
ui = tagList(
mod_Grid_ui("grid_1")
),
server = function(input, output, session) {
mod_Grid_server("grid_1")
}
),
wrapped = shiny::tagList
)
When using a module nested inside another module, you need to ns() the id of the nested UI function.
So here, mod_subGrid2_ui(ns("subGrid2_ui_1")).
Here is a minimal reprex:
mod_subGrid2_ui <- function(id) {
ns <- NS(id)
tagList(
plotOutput(ns("plot"))
)
}
mod_subGrid2_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
output$plot <- renderPlot({
shinipsum::random_ggplot()
})
})
}
mod_Grid_ui <- function(id) {
ns <- NS(id)
tagList(
mod_subGrid2_ui(ns("subGrid2_ui_1"))
)
}
mod_Grid_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
mod_subGrid2_server("subGrid2_ui_1")
})
}
brochureApp(
page(
href = "/",
ui = tagList(
mod_Grid_ui("grid_1")
),
server = function(input, output, session) {
mod_Grid_server("grid_1")
}
)
)

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.

shiny module selectInput is not reactive

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)

Resources