I am using a shiny::conditionalPanel inside a shinyBS::bsCollapsePanel. I have logic in my app that depends on which shinyBS panel is active (i.e., expanded). This works fine until I activate the conditional panel. If I show the Shiny conditional panel, then the shinyBS collapse panel gets stuck as active even when the panel is inactive (i.e., closed).
How can I modify my code so that the collapsible panels only register as active if they are expanded?
In this example there is a text output indicating the active panel. Switching between panels works correctly unless the conditional panels are shown.
EDIT: It appears this bug may already be documented (https://github.com/ebailey78/shinyBS/issues/38) and there is a possible solution (https://github.com/ebailey78/shinyBS/pull/68/commits).
library(shiny)
library(shinyBS)
# Define UI logic
ui <- fluidPage(
htmlOutput("activePanel"),
shinyBS::bsCollapse(
id = "bsPanels",
shinyBS::bsCollapsePanel(
"Panel A",
value = "panelA",
checkboxInput("showPanelA",
"Show panel",
value = FALSE),
conditionalPanel(
condition = "input.showPanelA",
helpText("Panel A conditional content")
),
helpText("Panel A main content")
),
shinyBS::bsCollapsePanel(
"Panel B",
value = "panelB",
checkboxInput("showPanelB",
"Show panel",
value = FALSE),
conditionalPanel(
condition = "input.showPanelB",
helpText("Panel B conditional content")
),
helpText("Panel B main content")
)
)
)
# Define server logic
server <- function(input, output) {
output$activePanel <- renderText({
paste("<b>Active Panel:</b>", paste(input$bsPanels, collapse = ", "))
})
}
# Run the application
shinyApp(ui = ui, server = server)
There is some discussion of this issue on the shinyBS project page (https://github.com/ebailey78/shinyBS/issues/38). However, I had limited success with the proposed solutions.
The best solution I have found is to use shinyjs::showElement and shinyjs::hideElement.
library(shiny)
library(shinyBS)
library(shinyjs)
# Define UI logic
ui <- fluidPage(
useShinyjs(),
htmlOutput("activePanel"),
shinyBS::bsCollapse(
id = "bsPanels",
shinyBS::bsCollapsePanel(
"Panel A",
value = "panelA",
checkboxInput("showPanelA",
"Show panel",
value = FALSE),
uiOutput("condPanelA"),
helpText("Panel A main content")
),
shinyBS::bsCollapsePanel(
"Panel B",
value = "panelB",
checkboxInput("showPanelB",
"Show panel",
value = FALSE),
uiOutput("condPanelB"),
helpText("Panel B main content")
)
)
)
# Define server logic
server <- function(input, output) {
output$activePanel <- renderText({
paste("<b>Active Panel:</b>", paste(input$bsPanels, collapse = ", "))
})
# Logic for conditional panels
output$condPanelA <- renderUI({
helpText("Panel A conditional content")
})
observe({
if(input$showPanelA) {
show("condPanelA")
} else {
hide("condPanelA")
}
})
output$condPanelB <- renderUI({
helpText("Panel B conditional content")
})
observe({
if(input$showPanelB) {
show("condPanelB")
} else {
hide("condPanelB")
}
})
}
# Run the application
shinyApp(ui = ui, server = server)
Related
Good days, I am programming in Rstudio, using shiny, and I wanted to generate an alert that is activated only when I want to leave a tabPanel without completing a condition, but not if I do not enter the tabPanel before, this is the way I found. The problem is that every time that I leave the Panel 1 without fulfilling the condition of completing text, alerts are generated that are accumulating (1 alert the first time, two the second, three the third, etc.) I wanted to consult if somebody knows why it is this and how to avoid it.
thank you very much
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
observe({
req(input$tabselected == "Tab1")
observeEvent(
input$tabselected,
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE
)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
)
}
)
}
shinyApp(ui = ui, server = server)
Is this the behavior you desire? Your example was recursive so you had reoccurring popup event. We can create a reactiveValues variable to keep track of the events, like so:
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(
tabsetPanel(
id = "tabselected",
tabPanel("Tab2",""),
tabPanel("Tab1", textInput("requiredText", "Required Text"))
))
server <- function(input, output, session) {
v <- reactiveValues(to_alert = FALSE)
observeEvent(input$tabselected,{
if (input$tabselected != "Tab1" & !isTruthy(input$requiredText)) {
v$to_alert <- TRUE
}else{
v$to_alert <- FALSE
}
},ignoreInit = TRUE)
observeEvent(v$to_alert,{
if (v$to_alert){
shinyalert(title = "Save your work before changing tab", type = "warning",showConfirmButton = TRUE)
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
}
})
}
shinyApp(ui = ui, server = server)
I want a navigation menuItem in my shinydashboard to be conditional and shown depending on a condition evaluated in server.R.
To this end, I have a conditionalPanel containing a menuItem defined beside a regular sidebarMenu in ui.R (I use shinymanager to authenticate users):
sidebar <- dashboardSidebar(
width=280,
sidebarMenu(id = "sidebarmenu",
menuItem(...),
menuItem(...,
menuSubItem(...),
menuSubItem(...)
)
),
conditionalPanel(condition = "output.x === 1",
menuItem("title", tabName="tabname")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "id",
fluidPage(
titlePanel("Hello World")
)),
tabItem(tabName="tabname",
titlePanel("mytitle"),
fluidPage(
dataTableOutput(outputId = "table")
)
)
)
ui <- dashboardPage(
dashboardHeader(title = "Hello App", titleWidth=280),
sidebar,
body
)
ui <- secure_app(ui)
In server.R, I switch output.x depending on the logon details of the logged user:
server <- function(input, output, session) {
# login logic: call the server part, check_credentials returns a function to
# authenticate users
res_auth = secure_server(
check_credentials = check_credentials
)
# Define the logon details with a reactive variable
auth_output <- reactive({
reactiveValuesToList(res_auth)
})
output$x = reactive({
auth_output()$role
})
# Generate a data table from the DB to show conditionally
conn = ...
data = load_data(conn, ...)
disconnect(conn)
output$table = dt_render({data})
# All output variables that need to be transferred to the UI should have
# suspendWhenHidden = FALSE:
outputOptions(output, "x", suspendWhenHidden = FALSE)
The problem: the conditional table is shown only once, whenever I want. After this one time, once I navigate away from it, clicking on the conditional menuItem shows no content. The menuItem still appears, which means that output.x === 1 is evaluated properly, but its contents, i.e. the subsequent tabItem, remains hidden.
I have tried isolate to assign output.x, and even fixed it at 1 to no avail. Any leads?
Since the conditionalPanel cannot be put inside the default sidebarMenu, it must be in its stand-alone conditional sidebarMenu, so I must define two sidebarMenus under dashboardSidebar in this case. The following modification solves the problem:
sidebar <- dashboardSidebar(
width=280,
sidebarMenu(id = "sidebarmenu",
menuItem(...),
menuItem(...,
menuSubItem(...),
menuSubItem(...)
)
),
sidebarMenu(id = "conditional_sidebarmenu",
conditionalPanel(condition = "output.x === 1",
menuItem("title", tabName="tabname")
)
)
I am trying to implement something similar to this within the app and not at the browser level as described here.
After capturing the value of the new tab (tabPanel value) selected, could not display the confirmation message before switching to the newly selected tab to display its content.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(id = "tabselected",
tabPanel("Tab1"),
tabPanel("Tab2",plotOutput("plot"))
)
)
server <- function(input, output) {
observeEvent(input$tabselected, {
if(input$tabselected == "Tab2")
{
shinyalert(title = "Save your work before changing tab", type = "warning", showConfirmButton = TRUE)
output$plot <- renderPlot({ ggplot(mtcars)+geom_abline() })
}
})
}
shinyApp(ui = ui, server = server)
You can simply redirect to Tab1 via updateTabsetPanel as long as your desired condition is met.
Here is an example requiring the user to type something in the textInput before it's allowed to switch the tab.
library(shiny)
library(ggplot2)
library(shinyalert)
ui <- fluidPage(useShinyalert(),
tabsetPanel(
id = "tabselected",
tabPanel("Tab1", p(), textInput("requiredText", "Required Text")),
tabPanel("Tab2", p(), plotOutput("plot"))
))
server <- function(input, output, session) {
observeEvent(input$tabselected, {
if (input$tabselected == "Tab2" && !isTruthy(input$requiredText)) {
updateTabsetPanel(session, inputId = "tabselected", selected = "Tab1")
shinyalert(title = "Save your work before changing tab",
type = "warning",
showConfirmButton = TRUE)
output$plot <- renderPlot({
ggplot(mtcars) + geom_abline() + ggtitle(req(input$requiredText))
})
}
})
}
shinyApp(ui = ui, server = server)
By the way an alternative approach wpuld be using showTab and hideTab to display the tabs only if all conditions are fulfilled.
writing with a shiny question. I have a navbarPage, id = "navbar", and in the navbarMenu user can select one among several tabPanels. Each tabPanel is assigned a value (value = 1, value = 2, etc). So input$navbar is reactive value with the value of the selected tabPanel.
I have a reactive expression defined which reacts to the changing of the tabPanel (reacts based on input$navbar). What I actually want is for this to react to navigating to a particular tabPanel, but not navigating away from that tabPanel. So, when input$navbar changes from 1 to 2 I want a reaction, but when changing from 2 to 1 no reaction. How can I achieve this?
Here is relevant snippet of my code, I don't think I need a full reproducible example for this but let me know if I'm wrong.
#ui snippet
navbarPage(id = "navbar",
navbarMenu(title = "Title",
tabPanel(title = "tp1", value = 1),
tabPanel(title = "tp2", value = 2),
#more tabPanels and ui stuff...
#server snippet
rctvfx <- reactive({
#want this to react only when input$navbar changes from ==1 to ==2
input$navbar
isolate({
#do stuff
})
})
You can use an if statement. This makes sure the code only runs if the user navigated to the corresponding tab.
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
"----",
"Section header",
tabPanel("Table")
)
),
server = function(input, output){
observe({
if (req(input$navbar) == "Table")
message("Table has been selected")
if (req(input$navbar) == "Plot")
message("Plot has been selected")
})
}
)
I would recomment do use observe rather than reactive to make sure everything runs even if all observers for the reactive are idle.
Another example of the same answer as above
library(shiny)
shinyApp(
ui = navbarPage(
"App Title",
id = "navbar",
tabPanel("Plot"),
navbarMenu(
"More",
tabPanel("Summary"),
tabPanel("Table"),
mainPanel(dataTableOutput("d"))
)
),
server = function(input, output){
output$d = renderDataTable({
if ((input$navbar) == "Table") {
head(mtcars)
} else {
((input$navbar) == "Plot")
head(iris)
}
})
}
)
I need my Shiny module to hide/show a div outside of the namespace. I tried passing the div id to the module server function and using shinyjs to show/hide it but that is not working. I'm not getting an error, it just doesn't show/hide the div.
I know the Shiny module documentation says modules cannot access outputs outside the namespace. The docs do, though, give a way for the module to access inputs outside the namespace using reactives.
Does anyone know if there is a way for a Shiny module to access an output outside the namespace?
Here is what I'm trying to do:
### ui.R ###
header <- dashboardHeader(
title = a(href = 'http://google.com')
)
dashboardPage(
skin = 'black',
header,
dashboardSidebar(
sidebarMenu( id='tabs',
menuItem('Edit Existing Client', tabName = 'client-info')
)),
dashboardBody(
useShinyjs(),
fluidRow(
tabItems(
tabItem(tabName = "client-info",
div(selectClientModuleUI("clientinfons")),
div(id='editclientinfo', uiOutput('editclientstuff'))
)
)
)
)
)
### server.R ###
shinyServer(function(session,input, output) {
output$editclientstuff <- renderUI({
div(
fluidRow(
column(6,
textInput('editname', "Display name", value ='Testing name')
),
column(6,
numericInput('editastart','Start', value ='3')
)
)
)
})
callModule(selectClientModule, 'clientinfons', 'editclientinfo')
shinyjs::hide(id='editclientstuff')
})
### in global.R ###
selectClientModuleUI <- function(id){
ns <- NS(id)
clientlist = c(0, 1, 2)
names(clientlist) = c('Choose client', 'Fred', 'Kim')
div(
selectInput(ns('selectclient'), 'Select client to edit', choices = clientlist, selected = NULL, multiple = FALSE)
)
}
selectClientModule <- function(input, output, session, divtoshow = ''){
observeEvent(input$selectclient, {
if (!is.null(input$selectclient) && input$selectclient > 0){
print(paste0("showing ", divtoshow))
shinyjs::show(divtoshow)
}
})
}
That is possible by giving the value as a reactive (not as the value of the reactive) to the module. You can change the reactive Value in the module and return the reactive from the Module to the app (note, return the reactive itself, not its value). The following app switches the 'divtoshow' in the main app from inside the module. If nothing is selected, it's hidden, otherwise it's shown (note, I adjusted you code a little so it's working as a stand-alone app):
library(shinydashboard)
library(shinyjs)
# Module
selectClientModuleUI <- function(id){
ns <- NS(id)
clientlist = c(0, 1, 2)
names(clientlist) = c('Choose client', 'Fred', 'Kim')
div(
selectInput(ns('selectclient'), 'Select client to edit', choices = clientlist, selected = NULL, multiple = FALSE)
)
}
selectClientModule <- function(input, output, session, divtoshow){
observeEvent(input$selectclient, {
if (input$selectclient > 0){
print(paste0("showing editclientinfo"))
divtoshow("editclientinfo") # set the div to show to "editclientinfo", this will be visible outside the module
}else{
divtoshow("") # set the div to show to "", if nothing was chosen
}
})
# return the div to show as reactive to the main app
return(divtoshow)
}
# Main App
ui <- shinyUI(
dashboardPage(
skin = 'black',
dashboardHeader(
title = a(href = 'http://google.com')
),
dashboardSidebar(
sidebarMenu( id='tabs',
menuItem('Edit Existing Client', tabName = 'client-info')
)),
dashboardBody(
useShinyjs(),
fluidRow(
tabItems(
tabItem(tabName = "client-info",
div(selectClientModuleUI("clientinfons")),
div(id='editclientinfo', uiOutput('editclientstuff'))
)
)
)
)
))
server <- shinyServer(function(session,input, output) {
output$editclientstuff <- renderUI({
div(
fluidRow(
column(6,
textInput('editname', "Display name", value ='Testing name')
),
column(6,
numericInput('editastart','Start', value ='3')
)
)
)
})
# store the div to show in a reactive
divtoshow <- reactiveVal('')
# divtoshow can be changed in side this module, so it's a return value
divtoshow <- callModule(selectClientModule, 'clientinfons', divtoshow)
# observe the value of divtoshow and toggle the corresponding div
observeEvent(divtoshow(), {
if(divtoshow() == "editclientinfo"){
shinyjs::show("editclientinfo")
}else{
shinyjs::hide("editclientinfo")
}
})
})
shinyApp(ui, server)