Using columns to control tabBox content in Shiny dashboard - r

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.

Related

R Shiny shinyjs window.scrollTo scroll distance limited to active tab

I have a shiny app with a sidebar menue and several different tabs. Within each tab, there is a lot of content that is supposed to be seen together, so the tabs are quite lengthy and navigating can be a pain because a lot of scrolling is needed. However, spliting the content into sub-tabs is not an option.
I have thus tried to implement "location markers" as fake sub-tabs to navigate through.
This works fine, except when you are on another tab and you want to switch directly to the bottom of another tab, i.e. from subtab_1_1 directly to subtab_2_2.
In that case, the tab switches over correctly to subtab_2_1 but the scrollposition() afterwards does not actually scroll the full 50000 pixels, but to the maximum distance of the active tab (i.e. the bottom of Tab 1).
As #YBS pointed out, one solution would be to add lines to each Tab so that they all share the same length. However, that would make using the scroll bar to scroll manualy very unintuitive, as some tabs would go on for much longer as the content of the tab.
Is there any way to circumvent this limitation of window.scrollTo()?
Here is a minimal working example:
library(shiny)
library(shinydashboard)
library(shinyjs)
ui <- dashboardPage(
title = "Title",
dashboardHeader(title = "Header", titleWidth = 350),
skin = "blue",
dashboardSidebar(
width = 350,
disable = FALSE,
sidebarMenu(
id = "tabs",
menuItem(
text = "Tab 1",
tabName = "Tab_1",
icon = icon("database"),
hidden(menuSubItem(
text = "Subtab 1.1",
tabName = "Subtab_1_1",
icon = icon("angle-right")
)),
menuSubItem(
text = "Proxy Subtab 1.1",
tabName = "Proxy_Subtab_1_1",
icon = icon("angle-right")
),
menuSubItem(
text = "Subtab 1.2",
tabName = "Subtab_1_2",
icon = icon("angle-right")
)
),
menuItem(
text = "Tab 2",
tabName = "Tab_2",
icon = icon("database"),
hidden(menuSubItem(
text = "Subtab 2.1",
tabName = "Subtab_2_1",
icon = icon("angle-right")
)),
menuSubItem(
text = "Proxy Subtab 2.1",
tabName = "Proxy_Subtab_2_1",
icon = icon("angle-right")
),
menuSubItem(
text = "Subtab 2.2",
tabName = "Subtab_2_2",
icon = icon("angle-right")
)
)
)
),
dashboardBody(
useShinyjs(),
extendShinyjs(
text = "shinyjs.scrollposition = function(y) {window.scrollTo(0, y)};",
functions = c("scrollposition")
),
tags$script(HTML("$('body').addClass('fixed');")),
tabItems(
tabItem(
tabName = "Subtab_1_1",
fluidPage(
h1("This is Subtab 1_1"),
HTML(rep("<br/><br/><br/>↓<br/>", 10)),
h1("This is supposed to be Subtab 1_2")
)
),
tabItem(
tabName = "Subtab_2_1",
fluidPage(
h1("This is Subtab 2_1"),
plotOutput("Plot_1"),
plotOutput("Plot_2"),
plotOutput("Plot_3"),
plotOutput("Plot_4"),
plotOutput("Plot_5"),
plotOutput("Plot_6"),
h1("This is supposed to be Subtab 2_2")
)
)
)
)
)
server <- function(input, output, session) {
observeEvent(input$tabs, {
if(sum(c("Proxy_Subtab_1_1", "Proxy_Subtab_2_1","Subtab_1_2", "Subtab_2_2") %in% input$tabs) > 0) {
updateTabsetPanel(session, "tabs", switch(input$tabs,
"Proxy_Subtab_1_1" = "Subtab_1_1",
"Proxy_Subtab_2_1" = "Subtab_2_1",
"Subtab_1_2" = "Subtab_1_1",
"Subtab_2_2" = "Subtab_2_1")
)
js$scrollposition(case_when(input$tabs == "Proxy_Subtab_1_1" ~ 0,
input$tabs == "Proxy_Subtab_2_1" ~ 0,
input$tabs == "Subtab_1_2" ~ 50000,
input$tabs == "Subtab_2_2" ~ 50000)
)
}
})
output$Plot_1 <- output$Plot_2 <- output$Plot3 <-
output$Plot_4 <- output$Plot_5 <- output$Plot6 <- renderPlot(
ggplot(data.frame(
x = c(1, 2, 3),
y = c(1, 2, 3),
labels = c(
"",
"Some plots",
""
)
)
) +
geom_text(aes(x = x, y = y, label = labels), size = 6)
)
}
shinyApp(ui = ui, server = server)

Delay in tabPanel content update when Sidebar control is updated

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.

Conditional display in box based on tabbox selected in shinydashboard

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.

tabBox width doesn't expand to contain plot

Starting with the code on this page: enter link description here, I would like to be able to control the size of the box plot on Tab 1 of the First tabBox. Hacking in a couple of sliders, and a uiOuput call in the code below, I can now easily control the height and width of the boxplot. But, while the tabBox nicely expands in height to contain the plot, it does not expand in width. At high values of width, the plot extends over the boundary of the box. I see similar results using a simple Box to contain the plot.
Is there a way to change the width of the Box/tabBox to get the desired effect?
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", uiOutput('UI_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.",
sliderInput('sldHt', 'Height', min=100, max=500,
value=200, step=10),
sliderInput('sldWd', 'Width', min=100, max = 500,
value=200, step=10)
)
)
),
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$UI_test = renderUI({
plotOutput('test',
height = input$sldHt,
width = input$sldWd)
})
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"))
}
)

R Shiny Dashboard - equivalent to navbarPage?

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
})
}
)

Resources