Login to single tabPanel in Shiny - r

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.

Related

Force input widget creation in Shiny even if widget has not yet been displayed in browser

In Shiny, one can use the following line to force displaying/refreshing an output even if not displayed within the ui:
outputOptions(output, "my_output", suspendWhenHidden = FALSE)
Is there a similar way to "force" input widget creation?
My context: I do have a button that pre-populate a textinput on another tab. Potentially, this textinput may not been generated yet if user didn't go to this specific tab. In such a case, the pre-population legitimely fails.
Good practice would probably be to use a reactiveValues, to feed it with the "pre-populate value" when clicking the button, and then to use this rv within the input widget creation. But I was wondering if a similar option as the above was available in Shiny.
Here’s a simple, working example of the situation I think you are describing.
That is, you don’t need to do anything special.
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", textInput("b_text", "Add some B text"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
}
shinyApp(ui, server)
If the input you want to update is generated with uiOutput() then you can
use outputOptions() to force evaluation, like you already mentioned:
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("A", actionButton("populate", "Populate B things")),
tabPanel("B", uiOutput("b_panel"))
)
)
server <- function(input, output, session) {
observeEvent(input$populate, {
updateTextInput(session, "b_text", value = "Updated from tab A")
})
output$b_panel <- renderUI({
textInput("b_text", "Add some B text")
})
outputOptions(output, "b_panel", suspendWhenHidden = FALSE)
}
shinyApp(ui, server)

R Shiny - Build a tabsetPanel from a list from selectizeInput

I have been trying to develop this tabsetpanel for a while but without success. The goal is to assemble the tabs dynamically. After the user click the search button, the tabs will be assembled from the user's selection in selectizeInput. Each tab will have a specific content. When the user presses the search button again, the tabs must be built again with the information from selectizeInput without duplication.
I appreciate any help.
the result should be like this image:
library(shiny)
ui <- fluidPage(
title = "Examples of DataTables",
sidebarLayout(
sidebarPanel(
selectizeInput(
'state', 'State', choices = state.name, multiple = TRUE
),
actionButton("search", "Search"),
),
mainPanel(
tabsetPanel(
id = 'dataset',
tabPanel("tab1", verbatimTextOutput("tab1"))
)
)
)
)
server <- function(input, output) {
output$tab1 <- renderPrint({
"tab1"
})
}
shinyApp(ui, server)
Well, I figure it out using insertUI and removeUI. To loop the tabsetPanel I used do.call method and voila!!!

How to hide navbarMenus with shinyjs?

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)

How to make sure the shiny app knows which tab is currently opened when using modules?

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)

opening a new empty shiny ui through actionbutton

My objective is to create a ShinyApp that opens a new empty UI whenever user clicks on submitButton.
Currently this is my code below. If the user types something in the text box and press Submit. The app shows what the user typed in the main panel. However I dont want to see the text, instead when the user clicks on the submit button , it should open a new empty UI.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
column(3, wellPanel(
textInput("text", "Text:", "text here"),
submitButton("Submit")
)),
verbatimTextOutput("text")
)
)
)
server = function(input, output) {
output$plot1 <- renderPlot({
hist(rnorm(input$n))
})
output$text <- renderText({
paste("Input text is:", input$text)
})
}
shinyApp(ui=ui, server=server)
Is this possible ? Any tips or pointers are appreciated.
Well, this is not yet very functional, but does what you asked for.
ui = shinyUI(fluidPage(
titlePanel("submitButton example"),
fluidRow(
uiOutput("newWindowContent", style = "display: none;"),
tags$script(HTML("
$(document).ready(function() {
if(window.location.hash != '') {
$('div:not(#newWindowContent)').hide();
$('#newWindowContent').show();
$('#newWindowContent').appendTo('body');
}
})
")),
a(href = "#NEW", target = "_blank",
actionButton("Submit", "Submit")
)
))
)
server = function(input, output) {
output$newWindowContent <- renderUI({
"Welcome to your new window!"
})
}
shinyApp(ui=ui, server=server)
The app is created, such that the ui created in newWindowContent is displayed in the new window. Sadly, new windows are somewhat cut off from the parent page, such that there is no easy way to configure each page independently. At the moment, all show the same content. None have reactivity features. I guess there can be initial configurations, if one uses the window's hash. But this works only client sided.
Nevertheless, it's a good start!

Resources