This question delas with the combination of navbarMenus and the shinyjs package. I've build a shiny app and I also added an user-login following this suggestion: https://gist.github.com/withr/9001831.
So I know, which user is logged in. Now I'd like to show and hide both a whole navbarMenu and single tabPanels, depending on which user is logged in. Let's say, there are two users, 'admin' and 'custom', and for 'admin' all navbarMenus and all tabPanels should be shown, while 'custom' only gets navbarMenu 2 and within this menu only tabPanel 22 to see.
library(shiny)
library(shinyjs)
# Define UI
ui <-
fluidPage(
titlePanel("NAVBARPAGE"), # title
br(),
################### NAVBAR ############################
navbarPage(
"", # title
################### TABS THEMA #######################
hidden(div(id='m1',
navbarMenu("Menu1",
tabPanel('tab11',plotOutput('tab_11')),
tabPanel('tab12',uiOutput('tab_12'))))),
navbarMenu("Menu2",
tabPanel('tab21',uiOutput('tab_21')),
hidden(div(id='xxx',tabPanel('tab22',uiOutput('tab_22')))))
#######################################################
))
###### SERVER #####
server <- function(input, output,session) {
#Define user
user<-'admin'
observe({
if (user=='admin') {
show('xxx')
show('m1')
}
else {
hide('xxx')
hide(m1)
}
})
# Run the application
shinyApp(ui = ui, server = server)
In this minimal example, the tabPanel ('tab22') is hidden, but is does not show up, when I define
user<-'custom'
Plus, the appearance of the first navbarMenu 'm1' is strange - it is actually not hidden, it is only only empty.
Does anyone know help?
Your code has some errors, missing } at the end of your server function, calling the hide funciton with m1 instead of "m1", and not initialize shinyjs with shinyjs::useShinyjs(). In addition, you can not use a div around navbarMenu or tabPanel, they will not be rendered. Lastly, it would be very easy for any user to show/hide the content.
A better option is to create the navbar according to the user using a uiOutput and control what to render using the user name. Below is an example based on your code to show content based on the users.
library(shiny)
library(shinyjs)
ui <- fluidPage(
selectInput("userSL", 'Users:', c('admin', 'custom')),
titlePanel("NAVBARPAGE"),
br(),
uiOutput("navbarPageUI")
)
server <- function(input, output,session) {
output$navbarPageUI <- renderUI({
user <- input$userSL
if (user == 'admin') {
navbarPage("",
navbarMenu("Menu1",
tabPanel('tab11',plotOutput('tab_11')),
tabPanel('tab12',uiOutput('tab_12'))
),
navbarMenu("Menu2",
tabPanel('tab21',uiOutput('tab_21')),
tabPanel('tab22',uiOutput('tab_22'))
)
)
} else {
navbarPage("",
navbarMenu("Menu2",
tabPanel('tab21',uiOutput('tab_21'))
)
)
}
})
}
shinyApp(ui = ui, server = server)
Related
I have been trying to make a login for a single tabPanel in Shiny. I have used the shinyAlert method, (as described here: How to access Shiny tab ids for use with shinyalerts?) which works, but unfortunately, it shows parts of the tabPanel's content before the user is logged in.
Is there a way to change this? I am trying to figure out how to make the "backdrop" of the shinyAlert just a white page until the user is successfully logged in. I read that this might be possible with CSS, but it is unclear to me how.
Or is there another method to do this, that I haven't considered? I am pretty new to Shiny.
Edit: the relevant parts of the code.
ui <- fluidPage(navbarPage("Eksempel", theme = shinytheme("cerulean"),
tabPanel("Home", icon = icon("home"),
fluidRow(
box(
Title = "Welcome to the example layout",
width = 10,
solidHeader = TRUE,
"Welcome text")
)),
tabPanel("Prototype", icon = ("chart-line"),
fluidPage(tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets"))),
# other tabPanels
server <- function(input, output, session){
output$secrets <- renderUI({
req(input$user == "admin", input$password == "shiny")
fluidPage( #contents of tabPanel, containing different plots ect.
)
})
The contents of the fluidPage I am trying to hide works fine when I don't try to hide it.
You can use req in combination with a renderUI and uiOutput to hide stuff until someone authenticates.
library(shiny)
ui <- fluidPage(
tagList(
textInput("user", "User:"),
passwordInput("password", "Password:"),
uiOutput("secrets")
)
)
server <- function(input, output) {
output$secrets <- renderUI({
req(input$user == "admin", input$password == "stackoverflow")
wellPanel("Hello admin! These are the secrets!")
})
}
shinyApp(ui = ui, server = server)
If you want a more enterprise-ready approach, you can try ShinyProxy or Shiny-Server Pro.
I'm using modules within my shiny app to display the content of different tabPanels. I would like to be able to travel to the second tab by clicking one button. I have the following code:
library(shiny)
library(shinydashboard)
moduleUI <- function(id){
ns <- NS(id)
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")
)
}
module <- function(input, output, session, openTab){
observeEvent(input$action1, {
openTab("two")
})
return(openTab)
}
ui <- fluidPage(
navlistPanel(id = "tabsPanel",
tabPanel("one", moduleUI("first")),
tabPanel("two", moduleUI("second"))
))
server <- function(input, output, session){
openTab <- reactiveVal()
openTab("one")
openTab <- callModule(module,"first", openTab)
openTab <- callModule(module,"second", openTab)
observeEvent(openTab(), {
updateTabItems(session, "tabsPanel", openTab())
})
}
shinyApp(ui = ui, server = server)
However this only works once. The problem I think, is that the module does not know when a tab is changed in the app. Therefore I'm looking for a way to make sure the module knows which tab is opened so that the actionButton works more that once.
I have considered using input$tabsPanel but I don't know how to implement it.
Help would be greatly appreciated.
The problem is that once the user manually switches back to tab 1, the openTab() does not get updated. So therefore, when you click the actionButton a second time, openTab changes from "two" to "two" (i.e. it stays the same), and therefore your observeEvent is not triggered.
You could add:
observeEvent(input$tabsPanel,{
openTab(input$tabsPanel)
})
So the openTab reactiveVal is updated also when a user manually changes back to tab1 (or any other tab).
You don't need modules to do what you want by the way, but I assume you have a specific reason to use them. For anyone else who wants to achieve the same but does not need modules:
library(shiny)
library(shinydashboard)
ui <- fluidPage(
sidebarPanel(
actionButton(ns("action1"), label = "Go to tab 2")),
navlistPanel(id = "tabsPanel",
tabPanel("one"),
tabPanel("two")
))
server <- function(input, output, session){
observeEvent(input$action1, {
updateTabItems(session, "tabsPanel", "two")
})
}
shinyApp(ui = ui, server = server)
I used bsModal successfully in my code before. However, I can't seem to get a modal pop up to show just when the user visits an app's first page by default. I thought something like this would work, but not. Any idea how I can trigger a bsModal on page visit?
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
I simply need to alert the user with a message when they visit the app and then allow them to close the modal pop up and navigate the rest of the app freely. I am using Shinydashboard. So, eventually, this has to work with that.
You can use toggleModal to manually trigger the popup from the server.
library(shiny)
library(shinyBS)
ui <- fluidPage(
mainPanel(
bsModal(id = 'startupModal', title = 'Dum Dum', trigger = '',
size = 'large', p("here is my mumbo jumbo")),
width = 12
)
)
server <- function(input, output, session) {
toggleModal(session, "startupModal", toggle = "open")
}
shinyApp(ui = ui, server = server)
Here is a solution using JS to trigger bsModal when page load "onload" from ui without waiting for the server. Along with a solution proposed here to prevent end users from accidentally closing the modal by clicking outside the modal or press Esc
library(shiny)
library(shinyBS)
bsModalNoClose <-function(...) {
b = bsModal(...)
b[[2]]$`data-backdrop` = "static"
b[[2]]$`data-keyboard` = "false"
return(b)
}
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
bsModalNoClose("window", "Window",
title="Enter Login Details",size='small',
textInput('username', 'Username'),
passwordInput('pwInp', 'Password'),
actionButton('butLogin', 'Login', class = 'btn action-button btn-success', icon = icon('sign-in')),
footer = h4(actionLink('create_account','Create an account'),align='right'),
tags$head(tags$style("#window .modal-footer{display:none}
.modal-header .close{display:none}"),
tags$script("$(document).ready(function(){
$('#window').modal();
});")
))
)
,mainPanel()
))
server <- function(input, output, session) {}
shinyApp(ui, server)
I hope it may be helpful for future readers.
I am writing some Shiny code where the user will enter some inputs to the app and then click a an action button. The action button triggers a bunch of simulations to run that take a long time so I want once the action button is clicked for it to be disabled so that the user can't keep clicking it until the simulations are run. I came across the shinyjs::enable and shinyjs::disable functions but have been having a hard time utilizing them. Here is my server code:
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
shinyjs::enable("Button1")}
})
However, when I use this code, and click the action button nothing happens. I.e., teh action button doesn't grey out nor does the table get generated. However, when I take away the shinyjs::enable() command, i.e.,
output$button1= renderUI({
if(input$Button1 > 0) {
shinyjs::disable("Button1")
tableOutput("table")
}
})
The table gets generated first, and then the button goes grey, however I would have expected the button to go grey and then the table to generate itself.
What am I doing wrong here?
Here is my updated code based on Geovany's suggestion yet it still doesn't work for me
Button1Ready <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
RunButton1Ready$ok <- FALSE
RunButton1Ready$ok <- TRUE
})
output$SumUI1= renderUI({
if(Button1Ready$ok){
tableOutput("table")
shinyjs::enable("Button1")
}
})
where for clarification I have also:
output$table <- renderTable({
#My code....
)}
I think that you are using shinyjs::disable and shinyjs::enable in the same reactive function. You will only see the last effect. I will recommend you to split in different reactive functions the disable/enable and use an extra reactive variable to control the reactivation of the button.
I don't know how exactly your code is, but in the code below the main idea is illustrated.
library(shiny)
library(shinyjs)
ui <- fluidPage(
shinyjs::useShinyjs(),
sidebarLayout(
sidebarPanel(
actionButton("Button1", "Run"),
shinyjs::hidden(p(id = "text1", "Processing..."))
),
mainPanel(
plotOutput("plot")
)
)
)
server <- function(input, output) {
plotReady <- reactiveValues(ok = FALSE)
observeEvent(input$Button1, {
shinyjs::disable("Button1")
shinyjs::show("text1")
plotReady$ok <- FALSE
# do some cool and complex stuff
Sys.sleep(2)
plotReady$ok <- TRUE
})
output$plot <-renderPlot({
if (plotReady$ok) {
shinyjs::enable("Button1")
shinyjs::hide("text1")
hist(rnorm(100, 4, 1),breaks = 50)
}
})
}
shinyApp(ui, server)
I intended to have some optional extra buttons appearing in my shiny app using renderUI. I would prefer to have new buttons inserted in the one and same renderUI call. I wrote a renderUI expession were the second button only is rendered if input of fist button is not null and(&&) is TRUE. It does not work as first button rapidly unchecks itself again whenever checked. I made a solution by splitting into two renderUI calls.
My question are:
Why exactly does the first code piece fail?
Would it be possible to achieve what the second code piece does in only one renderUI call?
.
library(shiny)
ui = fluidPage(
uiOutput("checkUI")
)
server = function(input,output) {
output$checkUI = renderUI({
list(
checkboxInput('check1',"check me first"),
if(!is.null(input$check1)&&input$check1==T) {
checkboxInput('check2',"check me to win")
} else {
NULL
}
)
})
}
shinyApp(ui,server)
but this works...
ui = fluidPage(
uiOutput("checkUI"),
uiOutput("textUI")
)
server = function(input,output) {
#UI first button
output$checkUI = renderUI({
list(
checkboxInput('check1',"check me first")
)
})
#UI second button
output$textUI = renderUI({
list(
if(!is.null(input$check1) && input$check1)
checkboxInput('check2',"check me to win") else NULL
)
})
}
shinyApp(ui,server)
Your first piece of code fails because the renderUI runs every time there is a change in input, so when you check the first check box. Since you have:
checkboxInput('check1',"check me first")
The renderUI immediately resets the input$check1 and then the renderUI is run again, unsetting the checkbox. This is why the second checkbox briefly flashes.
Luckily this is a common problem, so there is a Shiny solution to this with conditionalPanels:
library(shiny)
ui = fluidPage(
checkboxInput('check1',"check me first"),
conditionalPanel(
condition = "input.check1 == true",
checkboxInput("check2", "check me to win")
)
)
server = function(input,output){
}
shinyApp(ui,server)