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
})
}
)
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 am working on an App where the user needs to walk through many choices to get to where he/she wants to go with data analysis. The App needs to easily "funnel" the user through the myriad choices without confusing, without leading into dead ends, etc. For example, funneling a user from general to more specific choices:
Funnel 1: Very general choices (first and 2nd images image below: Tab 1 and Tab 2)
Funnel 2: Less general choices (first image below: in sidebar panel)(2nd image: in sub-tabs)
Funnel 3: Most specific choices (first image below: radio buttons along top of main panel)(2nd image: in sidebar panel)
First image:
Second image:
My question is, is it possible to create something like the sub-panels I drew in the 2nd image, to provide an easy funnel for user choices (albeit prettier than my drawing)? If not, in Shiny what are the other options for efficiently funneling a user through choices, if any? Where I'm heading is in the first image where the user goes from Tabs - sidebar - radio buttons across the top of the main panel.
Reproducible code for first image:
library(shiny)
library(shinyjs)
ui <-
pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
useShinyjs(),
fluidRow(helpText(h5(strong("Base Input Panel")),align="center")),
conditionalPanel(
condition="input.tabselected==1",
h5("Selections for Tab 1:")
),
conditionalPanel(
condition="input.tabselected==2",
h5("Selections for Tab 2:")
)
), # close sidebar panel
mainPanel(
useShinyjs(),
tabsetPanel(
tabPanel("Tab 1", value=1,helpText("Tab 1 outputs")),
conditionalPanel(condition = "input.tabselected==1",
fluidRow(helpText("Tab 1 things happen here")),
),
tabPanel("Tab 2", value=2,
fluidRow(
radioButtons(
inputId = 'mainPanelBtnTab2',
label = h5(strong(helpText("Functions to access:"))),
choices = c('Function 1','Function 2','Function 3'),
selected = 'Function 1',
inline = TRUE
) # close radio buttons
), # close fluid row
conditionalPanel(condition = "input.tabselected==2",
fluidRow(helpText("Tab 2 things happen here")),
conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Function 1'",
helpText("You pressed radio button 1")),
conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Function 2'",
helpText("You pressed radio button 2")),
conditionalPanel(condition = "input.mainPanelBtnTab2 == 'Function 3'",
helpText("You pressed radio button 3"))
) # close conditional panel
), # close tab panel
id = "tabselected"
) # close tabsetPanel
) # close mainPanel
) # close pageWithSidebar
server <- function(input,output,session)({})
shinyApp(ui, server)
You can nest a tabsetPanel() inside an existing tabPanel().
library(shiny)
shinyApp(
fluidPage(
sidebarLayout(
sidebarPanel(
"here is your sidebar",
uiOutput("tab_controls"),
uiOutput("subtab_controls")
),
mainPanel(
tabsetPanel(
tabPanel(
"Tab 1", br(),
tabsetPanel(
tabPanel("Function 1", "Here's the content for Tab 1, Function 1, with a `br()` between parents and sub-tab"),
tabPanel("Function 2", "Here's the content for Tab 1, Function 2, with a `br()` between parents and sub-tab"),
id = "subtab_1"
)
),
tabPanel(
"Tab 2",
tabsetPanel(
tabPanel("Function 1", "Here's the content for Tab 2, Function 1, with no space between tab levels"),
tabPanel("Function 2", "Here's the content for Tab 2, Function 2, with no space between tab levels"),
id = "subtab_2"
)
),
tabPanel("Tab 3", "Here's some orphaned content without sub-tabs"),
id = "parent_tabs"
)
)
)
),
function(input, output, session) {
output$tab_controls <- renderUI({
choices = if (input$parent_tabs == "Tab 1") {
c("choices", "for", "tab 1")
} else if (input$parent_tabs == "Tab 2") {
c("tab 2", "settings")
}
if (length(choices)) {
radioButtons(
"tab_controls",
"Controls",
choices = choices
)
}
})
output$subtab_controls <- renderUI({
if (input$parent_tabs == "Tab 2" & input$subtab_2 == "Function 1") {
radioButtons(
"subtab_controls",
"Additional controls for Tab 2, Function 1",
choices = letters[1:5]
)
} else if (input$parent_tabs == "Tab 2" & input$subtab_2 == "Function 2") {
selectInput(
"subtab_controls",
"Different input for Tab 2, Function 2",
choices = letters[6:10]
)
}
})
}
)
Here I've got three tabs at the top level, Tab 1-3. Inside Tab 1 and Tab 2, there are tabsetPanels that each have two tabs for Functions 1-2.
Also I showed two approaches (there are others, like update____Input functions) to changing the controls in the sidebar depending on which tab is selected. You should specify each tab set with tabsetPanel(..., id = "something"). Then you can check input$something's value, which will be the title of one of its tabs.
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.
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'm trying to build a Shiny dashboard page which will have tabbed pages with different types of plots, allow users to change settings dynamically, etc. Starting with the standard demo code from the Shiny Dashboards page, I can get a stacked version of the page (https://rstudio.github.io/shinydashboard/structure.html#tabbox):
library(shiny)
library(shinydashboard)
body <- dashboardBody(
fluidRow(
tabBox(
title = "First tabBox",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1",
tabPanel("Tab1", "First tab content", plotOutput('test')),
tabPanel("Tab2", "Tab content 2")
),
tabBox(
side = "right",
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
})
output$test = renderPlot(
boxplot(len ~ dose, data = ToothGrowth,
boxwex = 0.25, at = 1:3 - 0.2,
subset = supp == "VC", col = "yellow",
main = "Guinea Pigs' Tooth Growth",
xlab = "Vitamin C dose mg",
ylab = "tooth length",
xlim = c(0.5, 3.5), ylim = c(0, 35), yaxs = "i"))
}
)
If I modify line 10 to this:
tabPanel("Tab1", column(4,"First tab content"),
column(8, plotOutput('test'))
),
I get the heading and the boxplot split into columns, but the tabBox no longer expands to contain them.
Is there any way to control the contents of the tabPanel to allow columnar formatting of the output?
Just wrap your columns inside a fluidRow or fluidPage. Then the tabPanel gets the right size and stretches out to fit your columns.