侧边栏在 Shiny 中折叠时如何自动缩放 uiOutput()

Question

我有一个可以折叠侧边栏面板的切换开关；但是，当我这样做时，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)

我想知道是否可以得到一些帮助，拜托了！

Answer 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，这样我就可以轻松 select 它

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

how to automatically scale uiOutput() when sidebar collapses in Shiny

r

shiny

shinydashboard

shinyapps

shinyjs