Shiny: Start the App with Hidden Tabs, with No Delay

shiny: start the app with hidden tabs, with NO delay

You could use javascript with extendShinyjs() to hide the tabs you want on page load:

Javascript code:

shinyjs.init = function(){
$('#hello li a[data-value="tab3_val"]').hide();
$('#hello li a[data-value="tab2_val"]').hide();
}

R code:

ui <- fluidPage(useShinyjs(),
#Added this js
extendShinyjs(script = path_to_javascript_file),
navbarPage("hello", id="hello",
tabPanel("home", br(), h3("this is home"),passwordInput("pass", "enter 'password' to see the tabs: "),actionButton("enter", "enter")),
tabPanel("tab2", value = "tab2_val", br(), h4("this is tab2")),
tabPanel("tab3 with a lot of stuff in it", value = "tab3_val", br(), h4("this is tab3"))))

server <- function(input, output, session) {

observeEvent(input$enter, {
if (input$pass == "password"){
show(selector = '#hello li a[data-value="tab3_val"]')
show(selector = '#hello li a[data-value="tab2_val"]')
}})}
shinyApp(ui, server)

Alternatively the CSS actually isn't too complicated. If you wanted to go that route you could simply replace the extendShinyjs() call in the above with:

tags$head(tags$style(HTML("#hello li a[data-value = 'tab2_val'], #hello li a[data-value = 'tab3_val'] {
display: none;
}")))

The downside to this is that the formatting of the tabs appears to be off after un-hiding them.

How to show hidden tabs after clicking an actionButton?

Here is the code for hiding/showing the second tab. Code is similar for the other tabs.

library(shiny)

js <- "$(document).ready(function(){
var $tab2 = $('#hello li > a[data-value=tab2_val]').parent();
$tab2.removeClass('active').addClass('hide');
$('#enter').on('click', function(){
$tab2.removeClass('hide');
});
});
"

ui <- fluidPage(
tags$head(
tags$script(HTML(js))
),

# Application title
titlePanel("My app"),
sidebarLayout(
sidebarPanel(
tabsetPanel(
tabPanel(
"home", br(), h3("Click the button"), actionButton("enter", "enter")
),
tabPanel(
"tab2", value = "tab2_val", br(), h4("this is tab2")
),
tabPanel(
"tab3 with a lot of stuff in it", value = "tab3_val", br(),
h4("this is tab3")
),
id = "hello"
)
),
mainPanel()
)
)

server <- function(input, output, session) {
}

shinyApp(ui, server)

How I can hide a tab with shinyjs?

I'd use renderMenu instead of hiding the menuItem - otherwise users not allowed to access the contents can simply change the style of the UI element in their browser as explained here (I assume the contents of your tabItems are also generated on the server side).

library(shinymanager)
library(shinyjs)
library(shiny)
library(shinydashboard)

credentials <- data.frame(
user = c("shiny", "shiny2"), # mandatory
password = c("111", "111"), # mandatory
start = c("2015-04-15"), # optinal (all others)
expire = c(NA, "2032-12-31"),
admin = c(FALSE, TRUE),
comment = "Simple and secure authentification mechanism
for single ‘Shiny’ applications.",
stringsAsFactors = FALSE,
moreInfo = c("someData1", "someData2"),
level = c(2, 0)
)

header <- dashboardHeader()

sidebar <- dashboardSidebar(
shinyjs::useShinyjs(),
sidebarUserPanel("User Name",
subtitle = a(href = "#", icon("circle", class = "text-success"), "Online"),
# Image file should be in www/ subdir
image = "userimage.png"
),
sidebarSearchForm(label = "Enter a number", "searchText", "searchButton"),
sidebarMenu(
# Setting id makes input$tabs give the tabName of currently-selected tab
id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItemOutput("widgetsOutput"),
menuItem("Charts", icon = icon("bar-chart-o"),
menuSubItem("Sub-item 1", tabName = "subitem1"),
menuSubItem("Sub-item 2", tabName = "subitem2")
)
)
)

body <- dashboardBody(
tabItems(
tabItem("dashboard",
div(p("Dashboard tab content"))
),
tabItem("widgets",
"Widgets tab content"
),
tabItem("subitem1",
"Sub-item 1 tab content"
),
tabItem("subitem2",
"Sub-item 2 tab content"
)
)
)

shinyApp(
ui = secure_app(dashboardPage(header, sidebar, body)),
server = function(input, output, session) {

res_auth <- secure_server(
check_credentials = check_credentials(credentials)
)
# Create reactive values including all credentials
creds_reactive <- reactive({
reactiveValuesToList(res_auth)
})

output$widgetsOutput <- renderMenu({
if(creds_reactive()$user == "shiny"){
menuItem("Widgets", icon = icon("th"), tabName = "widgets", badgeLabel = "new", badgeColor = "green")
}
})

}
)

Can execution of hidden panel be forced in Shiny?

You can force execution of hidden output objects by setting suspendWhenHidden = FALSE with outputOptions

outputOptions(output, "even.or.odd", suspendWhenHidden = FALSE)

Shiny: update DT on inactive tabPanel

I have come up with two possible solutions.

  1. By using an observer, but with this solution the table will update when switching to the datatable tab, not before.

This was inspired by two videos that are really helpful to better understand how shiny works:

Shiny developer conference 2016 - firs two listed videos


  1. By using the proxy object, this option requires server side processing by setting the appropriate option when rendering the table (see code for this solution below)

Solution 1

    library(shiny)
library(DT)
shinyApp(

ui = fluidPage(

sidebarLayout(

sidebarPanel(
numericInput(
inputId = "random_val",
label = "pick random value",
value = 1
)
),

mainPanel(
tabsetPanel(
id = "tabset",
tabPanel(
title = "some_other_tab",
"Some other stuff"
),
tabPanel(
title = "test_render",
textOutput("echo_test"),
DTOutput("dt_test")
)
)
)
)
),

server = function(input, output) {

output$echo_test <- renderText({
cat("renderText called \n")
input$random_val
})
outputOptions(output, "echo_test", suspendWhenHidden = FALSE)

observeEvent(input$random_val, {
cat("renderDT called \n")
df <- data.frame(
a = 1:10^6,
b = rep(input$random_val, 10^6)
)
output$dt_test <- renderDT(df)
})
}
)

Solution 2

    library(shiny)
library(DT)
shinyApp(

ui = fluidPage(

sidebarLayout(

sidebarPanel(
numericInput(
inputId = "random_val",
label = "pick random value",
value = 1
)
),

mainPanel(
tabsetPanel(
id = "tabset",
selected = "test_render",
tabPanel(
title = "some_other_tab",
"Some other stuff"
),
tabPanel(
title = "test_render",
textOutput("echo_test"),
DTOutput("dt_test")
)
)
)
)
),

server = function(input, output, session) {

output$echo_test <- renderText({
cat("renderText called \n")
input$random_val
})
outputOptions(output, "echo_test", suspendWhenHidden = FALSE)
output$dt_test <- renderDT({
cat("renderDT called \n")
df <- data.frame(
a = 1:10^6,
b = rep(1, 10^6)
)
datatable(df)
}, server = TRUE)
observeEvent(input$random_val, {
df <- data.frame(
a = 1:10^6,
b = rep(input$random_val, 10^6)
)
dt_test_proxy <- dataTableProxy("dt_test", session = shiny::getDefaultReactiveDomain(),
deferUntilFlush = TRUE)
replaceData(dt_test_proxy, df)
cat("table updated \n")
})
updateTabsetPanel(session, "tabset", selected = "some_other_tab")
}
)

Let me know if this helps....



Related Topics



Leave a reply



Submit