In the Shiny app below I am updating tabPanel content when the selection in sidebarMenu changes. However, there is a minor delay in the tabPanel content update when I change the selection in sidebarMenu.
For the small number of input values, this delay is negligible, but when I have a selectizeInput control in sidebarMenu and I load 1000 values there, then the content update in tabPanel is substantial. Is there a way to update tabPanel content instantly? Something like - content in all tabs is updated as soon as someone makes a selection in sidebarMenu, even before someone clicks at the tab?
library(shiny)
library(shinydashboard)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
radioButtons("select_by", "Select by:",
c("Food Type" = "Food",
"Gym Type" = "Gym",
"TV show" = "TV"))
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1", textOutput("tabset1Selected")),
tabPanel("Tab2", "Tab content 2", textOutput("tabset2Selected")),
tabPanel("Tab3", "Tab content 3", textOutput("tabset3Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- output$tabset2Selected <- output$tabset3Selected <- renderText({
input$select_by
})
}
)
Using the outputOptions to set suspendWhenHidden = FALSE updates the outputs also if they aren't visible:
library(shiny)
library(shinydashboard)
siderbar <- dashboardSidebar(
sidebarMenu(
# Add buttons to choose the way you want to select your data
selectizeInput(inputId = "select_by", label = "Select by:",
choices= as.character(1:1000))
)
)
body <- dashboardBody(
fluidRow(
tabBox(
side = "right",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1", textOutput("tabset1Selected")),
tabPanel("Tab2", "Tab content 2", textOutput("tabset2Selected")),
tabPanel("Tab3", "Tab content 3", textOutput("tabset3Selected"))
)
),
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
siderbar,
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- output$tabset2Selected <- output$tabset3Selected <- renderText({
input$select_by
})
lapply(list("tabset1Selected", "tabset2Selected", "tabset3Selected"), outputOptions, x = output, suspendWhenHidden = FALSE)
}
)
Furthermore you should consider using a server-side selectizeInput to enhance the performance for many choices.
Related
Reproducible code below. I have a shiny app with several tabs, including a "Home" tab. On the Home tab, I would like to include a box with a link to "Tab 2". Meaning when the box is clicked, it takes the user to Tab 2. Additionally, I would also love to have the box do some sort of highlight when a user hovers over it in order to make it easier to recognize that the box is a hyperlink to something. How do I make this work?
library(tidyverse)
library(DT)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- navbarPage(
useShinydashboard(),
tabPanel(
title = "Home",
box(
title = "Box to link to tab2",
status = "primary",
width = 3
)
),
tabPanel(
title = "Tab 1"
),
tabPanel(
title = "Tab 2",
dataTableOutput("mtcars_table")
)
)
server <- function(input, output) {
output$mtcars_table <- DT::renderDataTable({mtcars})
}
shinyApp(ui, server)
Yes I have see several examples related to this but I can't seem to make them work for this particular case.
You could use an actionLink along with updateTabItems. Please check the following:
library(DT)
library(shiny)
library(shinydashboard)
library(shinyWidgets)
ui <- navbarPage(
useShinydashboard(),
tabPanel(
title = "Home",
box(
title = actionLink("tab2link", label = "Box to link to tab2"),
status = "primary",
width = 3
)
),
tabPanel(
title = "Tab 1"
),
tabPanel(
title = "Tab 2",
dataTableOutput("mtcars_table")
),
id = "navbar_id"
)
server <- function(input, output, session) {
observeEvent(input$tab2link, {
updateTabItems(session, inputId = "navbar_id", selected = "Tab 2")
})
output$mtcars_table <- DT::renderDataTable({mtcars})
}
shinyApp(ui, server)
I want to display inputs (checkboxes, select input) in the sidebar of my shiny dashboard, but only when a certain tab is clicked.
Minimum reporducible example below. How can I get the checkboxes and select input to only show up when on Page 2?
#ui.R
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
shinyUI(dashboardPage(
dashboardHeader(title = "Test Application",
titleWidth = "400px"
),
dashboardSidebar(
id = "navbar",
menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"),
# THESE SHOW UP ALL THE TIME - HOW TO GET JUST ON PAGE 2?
checkboxGroupInput("outcome", "Select Outcome Variable(s):", choices = c("Box 1", "Box 2", "Box 3")),
selectInput("selectinput", label = "Select:", choices = c("Choice 1", "Choice 2", "Choice 2"))
),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
h1("This is page 1")
),
tabItem(
tabName = "page2",
h1("This is page 2")
)
)
)
))
I assume something is needed in here to make the inputs dynamic?
# server.R
library(shiny)
# Define server logic required to draw a histogram
shinyServer(function(input, output) {
})
ANSWER: use a conditional panel that queries the selected tab.
Credit: Mine at Rstudio
library(shiny)
library(shinydashboard)
# ui ---------------------------------------------------------------------------
ui <- dashboardPage(
# title ----
dashboardHeader(title = "Test Application"),
# sidebar ----
dashboardSidebar(
sidebarMenu(id = "sidebarid",
menuItem("Page 1", tabName = "page1"),
menuItem("Page 2", tabName = "page2"),
conditionalPanel(
'input.sidebarid == "page2"',
sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
selectInput("title", "Select plot title:", choices = c("Hist of x", "Histogram of x"))
)
)
),
# body ----
dashboardBody(
tabItems(
# page 1 ----
tabItem(tabName = "page1", "Page 1 content. This page doesn't have any sidebar menu items."),
# page 2 ----
tabItem(tabName = "page2",
"Page 2 content. This page has sidebar meny items that are used in the plot below.",
br(), br(),
plotOutput("distPlot"))
)
)
)
# server -----------------------------------------------------------------------
server <- function(input, output, session) {
output$distPlot <- renderPlot({
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "darkgray", border = "white", main = input$title)
})
}
# shiny app --------------------------------------------------------------------
shinyApp(ui, server)
If I understood your question correctly, all you need to do is the following:
When defining the dashboardSidebar if you just want it as a navigational panel add sidebarmenu() and then add your menu items.
Then to have the checkboxes and select input appear only for the main dashboard on page 2 add it under dashboardbody() with the tabItem = "page2". See below:
#ui.R
library(shiny)
library(shinydashboard)
# Define UI for application that draws a histogram
ui<- dashboardPage(
dashboardHeader(title = "Test Application",titleWidth = "400px"),
dashboardSidebar(
sidebarMenu( #Add sidebarMenu here!!!!!
menuItem("Page 1", tabName = "page1", icon = icon("dashboard")), # You can add icons to your menu if you want
menuItem("Page 2", tabName = "page2", icon = icon("dashboard")))),
dashboardBody(
tabItems(
tabItem(
tabName = "page1",
h1("This is page 1")),
tabItem( #Add checkboxGroupInput into this tabItem
tabName = "page2",
h1("This is page 2"),
checkboxGroupInput("outcome", "Select Outcome Variable(s):", choices = c("Box 1", "Box 2", "Box 3")),
selectInput("selectinput", label = "Select:", choices = c("Choice 1", "Choice 2", "Choice 2")))
)
))
server <- function(input,output,session) {
}
shinyApp(ui, server)
I would like to open a second dashboard by pressing the action button on the first dashboard. I was able to do that using the code below but the dashboards are connected to each other. E.g. if I close the sidebar on the second dashboard, the sidebar of the first one closes, too.
This is the server.R file:
function(input, output, session) {
# some more code
# react to clicking on button show2
observeEvent(input$show2, {
# here is some more code
showModal(settngsModal())
})
settngsModal <- function() {
modalDialog(
withTags({
dashboardPage(
dashboardHeader(
title = "Second Dashboard"
),
dashboardSidebar(
sidebarMenu(
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)),
dashboardBody(
tabItem(tabName = "widgets",
h1("Widgets tab content")
)
)
)
}),
title = "Settings",
fade = TRUE)
}
}
This is the ui.R file:
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(),
h1('Headline'),
actionButton("show2", "Show second dashboard", size = 'lg')
)
)
Is it possible to have an "independent" dashboard?
Maybe even having two dashboards that can be used side by side (because now the second dashboard is a popup and the first dashboard can only be used if the second one is closed)?
You could use shinyjs to toggle between the two dashBoardPage tags.
Below is an example of switching between two Dashboards, there's a decent issue thread around rendering UI dashboardPage elements reactively.
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- tagList(
useShinyjs(),
div(id = "dashboard_two",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "Second dashboard"
),
dashboardSidebar(collapsed = TRUE,sidebarMenu()),
dashboardBody(fluidRow(actionButton("show1", "Show first dashboard")),
fluidRow(box(title = "Dash Two", height = 300, "Testing Render")) )
)
),
div(id = "dashboard_one",
style = "display:none",
dashboardPage(
dashboardHeader(
title = "First dashboard"
),
dashboardSidebar(collapsed = TRUE, sidebarMenu()),
dashboardBody(actionButton("show2", "Show second dashboard")
)
)
)
)
server <- function(input, output) {
shinyjs::show("dashboard_one")
observeEvent({ input$show1; input$show2}, {
shinyjs::toggle("dashboard_one")
shinyjs::toggle("dashboard_two")
})
}
shinyApp(ui, server)
I use shiny with shinydashboard. I have one tabbox with two tabPanels. Then there is another box which should display either textOutput("a") if tab1 in tabbox is selected or textOutput("b") if tab2 is selected.
I provide whole code for reproducibility but watch out for comments which show where the important part is.
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
skin = "red",
dashboardHeader(title = "lalala", titleWidth = 450),
sidebar <- dashboardSidebar(width = 400,
sidebarMenu(
menuItem(
text = strong("First tab"),
tabName = "first",
icon = icon("dashboard")
)
)),
body <- dashboardBody(fluidRow(
tabBox(
title = "First tabBox",
id = "tabset1",
height = "250px",
############## based on which of this tab is selected
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
box(
title = "Selection criteria for chart",
height = "700px",
width = 4,
solidHeader = TRUE,
status = "danger",
############## I want in this box to display either textouput "a" or "b"
textOutput("a")
)
))
)
server <- function(input, output) {
output$a <- renderText(a <- "ahoj")
output$b <- renderText(b <- "cau")
}
input$tabset1 returns the id of the currently selected tab (so either Tab1 or Tab2). Then you can use an if/else statement to print the content you like depending on this return value.
I have made a shinydashboard in R to show all of my data, as looks better than standard shiny.
Trying to figure out how to do the equivalent of "navbarPage" in the dashboard (ie have multiple pages that show different data, rather than having all the data in different boxes on the same page).
I tried to do simply add "navbarPage(" to the code but this comes up with multiple errors)
The example at shiny dashboard get started page answers your question. For your convenience, here it is.
body <- dashboardBody(
fluidRow(
tabBox(
title = "First tabBox",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1", height = "250px",
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
tabBox(
side = "right", height = "250px",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1"),
tabPanel("Tab2", "Tab content 2"),
tabPanel("Tab3", "Note that when side=right, the tab order is reversed.")
)
),
fluidRow(
tabBox(
# Title can include an icon
title = tagList(shiny::icon("gear"), "tabBox status"),
tabPanel("Tab1",
"Currently selected tab from first box:",
verbatimTextOutput("tabset1Selected")
),
tabPanel("Tab2", "Tab content 2")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
dashboardSidebar(),
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
)