rshinyshinydashboardshinyappsshinyjs
how to automatically scale uiOutput() when sidebar collapses in Shiny
I have a toggle switch which collapses the sidebar panel; however, when I do that, the datatable in uiOutput() doesn't stretch accordingly. I don't know what argument I am missing.
I have changed the renderDatatable() arguments but nothing changed. Also, if possible, how can I change the render so that the datatable takes entire whitespace regardless of sidebard being collapsed?
library(shiny)
library(shinythemes)
library(shinyjs)
library(shinyWidgets)
#ui.r
ui <- fluidPage(
theme=shinytheme("flatly") ,
useShinyjs(),
dropdownButton(
tags$h3("Toggle"),
materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
value = TRUE, status = "success"),
circle = TRUE, status = "info",
icon = icon("gear"), width = "300px",
tooltip = tooltipOptions(title = "Choose for more options!")
),
# Sidebar layout with input and output definitions
sidebarLayout(
div( id ="Sidebar",
# Sidebar panel for inputs
sidebarPanel(
uiOutput("rad")
)),
# Main panel for displaying outputs
mainPanel(
uiOutput("tabers")
)
)
)
#server.r
server <- function(input, output) {
data_sets <- list(NULL, iris, mtcars, ToothGrowth)
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
})
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3,"ToothGrowth" = 4),
selected = character(0))
})
output$tabers<- renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Welcome!")
)
}
else if(input$radio==1){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation...")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
#tabPanel("Plot" ),
tabPanel("etc.")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
# Left last else in here but should not get called as is
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
shinyApp(ui, server)
I was wondering if I can get some assistance with that, please!
Solution
Since you are using shinyjs, it can easily be:
library(shiny)
library(shinyjs)
library(shinyWidgets)
#ui.r
ui <- fluidPage(
useShinyjs(),
dropdownButton(
tags$h3("Toggle"),
materialSwitch(inputId = "toggleSidebar",label = "Hide Table? ",
value = TRUE, status = "success"),
circle = TRUE, status = "info",
icon = icon("gear"), width = "300px",
tooltip = tooltipOptions(title = "Choose for more options!")
),
# Sidebar layout with input and output definitions
sidebarLayout(
div( id ="Sidebar",
# Sidebar panel for inputs
sidebarPanel(
uiOutput("rad")
)),
# Main panel for displaying outputs
mainPanel(
id = "main_panel",
uiOutput("tabers")
)
)
)
#server.r
server <- function(input, output) {
data_sets <- list(NULL, iris, mtcars, ToothGrowth)
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
output$rad<-renderUI({
radioButtons("radio", label = "",
choices = list("Navigation" = 1, "Iris" = 2, "Mtcars" = 3,"ToothGrowth" = 4),
selected = character(0))
})
output$tabers<- renderUI({
if(is.null(input$radio)) {
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Welcome!")
)
}
else if(input$radio==1){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation...")
)
}
else if(input$radio==2){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
else if(input$radio==3){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Data", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
#tabPanel("Plot" ),
tabPanel("etc.")
)
}
else if(input$radio==4){
tabsetPanel(
id="tabA",
type = "tabs",
tabPanel("Navigation", DT::renderDataTable({ data_sets[[as.integer(input$radio)]]}, filter = 'top',
options = list(scrollX = TRUE, lengthChange = TRUE, widthChange= TRUE))),
tabPanel("Summary",renderPrint({ summary(data_sets[[as.integer(input$radio)]]) }) ),
tabPanel("etc.")
)
}
# Left last else in here but should not get called as is
else{
tabsetPanel(
id="tabC",
type = "tabs",
tabPanel("Global"),
tabPanel("Performance" )
)
}
})
}
shinyApp(ui, server)
I added an ID for the main panel so I can easily select it
mainPanel(
id = "main_panel",
uiOutput("tabers")
)
On server, add some javascript to toggle the same time you hide the sidebar:
observeEvent(input$toggleSidebar, {
shinyjs::toggle(id = "Sidebar", condition = input$toggleSidebar)
if(!isTRUE(input$toggleSidebar)) {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-8').addClass('col-sm-12')")
} else {
shinyjs::runjs("$('#main_panel').removeClass('col-sm-12').addClass('col-sm-8')")
}
})
- Rcpp Rf_warningcall compiler warnings
- Modify the name of factor variables in lm function(summary function)
- Extreme value analysis and quantile estimation using log Pearson type 3 (Pearson III) distribution - R vs Python
- How to hide NAs when using xlsx::saveWorkbook?
- How do I retrieve a simple numeric value from a named numeric vector in R?
- Matching pair-wise columns from left to right across rows in one dataframe to another dataframe and adding new columns with matching values
- Income to outcome flow chart in Sankey plotly R
- color mapping in geom_conn_bundle not showing correctly
- Print R package startup message AFTER automatic package conflict messages instead of before
- Summing a set of R dataframe rows (column-wise), while retaining the first n columns
- Added variable / partial regression plots for groups in an interaction?
- how to make a topoplot in R with coordinates variable distribution
- List of all functions in base R?
- Plotting multiple plots for different initial conditions in one graph
- Printing repetitively on the same line in R
- Generating UI/Server based on initial selection
- Subset dataframe based on pickerInput
- How to let user pick the data in R-shiny?
- Couldn't show my simple bar charts separately on Shiny R dashboardBody
- How to programmatically filter contents of a second shiny app displayed via iframe
- How to select specific interesting groups for the boxplot in R Shiny app?
- Crosstable and Plot grouping with reactive values
- Is there a way to make multiple Shiny picker inputs where the selections must be disjoint?
- Delay/avoid duplication of shiny server side functions until after credentials
- Predictions only returns value "1"
- How to display a busy indicator in a shiny app?
- Append doesn't work when writing to CSV in R
- Changing the start date of a gantt chart in DiagrammeR
- Check for installed packages before running install.packages()
- Compare two columns element-wise