当侧边栏在 Shiny 中折叠时如何自动缩放 uiOutput()
Posted
技术标签:
【中文标题】当侧边栏在 Shiny 中折叠时如何自动缩放 uiOutput()【英文标题】：how to automatically scale uiOutput() when sidebar collapses in Shiny 【发布时间】：2021-06-28 19:16:45 【问题描述】：我有一个可以折叠侧边栏面板的切换开关；但是，当我这样做时，uiOutput() 中的数据表不会相应地拉伸。我不知道我错过了什么论点。
我已经更改了 renderDatatable() 参数，但没有任何改变。另外，如果可能的话，如何更改渲染以使数据表占据整个空白，而不管侧边栏是否折叠？
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)
我想知道是否可以得到一些帮助！
【问题讨论】：
【参考方案1】：你使用shinyjs，很容易：
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)
我为主面板添加了一个 ID，以便我可以轻松选择它
mainPanel(
id = "main_panel",
uiOutput("tabers")
)
在服务器上，在隐藏侧边栏的同时添加一些 javascript 来切换：
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')")
)
【讨论】：
哇哦。谢谢朋友帮忙。我看到你做了什么。欣赏！以上是关于当侧边栏在 Shiny 中折叠时如何自动缩放 uiOutput()的主要内容，如果未能解决你的问题，请参考以下文章
esquisserUI 小部件因 Shiny 中 uiOutput 的自动缩放而错位
仅当使用 LayersControl 的缩放级别> 8 时，才在 Shiny 的传单地图中显示图层？