当侧边栏在 Shiny

编程问答 2022-05-15

问题描述

我有一个可折叠侧边栏面板的切换开关；但是，当我这样做时，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",tabPanel("Navigation...")
      )
    }
    else if(input$radio==2){
      tabsetPanel(
        id="tabA",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",#tabPanel("Plot" ),tabPanel("etc.")
      ) 
    }
    else if(input$radio==4){
      tabsetPanel(
        id="tabA",tabPanel("Navigation",tabPanel("etc.")
      )
    }
    # Left last else in here but should not get called as is
    else{
      tabsetPanel(
        id="tabC",tabPanel("Global"),tabPanel("Performance" )
      ) 
    }
  })
}

shinyApp(ui,server)

enter image description here

enter image description here

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

解决方法

因为您使用的是 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",tabPanel("Navigation...")
            )
        }
        else if(input$radio==2){
            tabsetPanel(
                id="tabA",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",#tabPanel("Plot" ),tabPanel("etc.")
            ) 
        }
        else if(input$radio==4){
            tabsetPanel(
                id="tabA",tabPanel("Navigation",tabPanel("etc.")
            )
        }
        # Left last else in here but should not get called as is
        else{
            tabsetPanel(
                id="tabC",tabPanel("Global"),tabPanel("Performance" )
            ) 
        }
    })
}

shinyApp(ui,server)

我为主面板添加了一个 ID，以便我可以轻松选择它

mainPanel(
    id = "main_panel",uiOutput("tabers")
)

在服务器上，添加一些 javascript 以在隐藏侧边栏的同时进行切换：

    observeEvent(input$toggleSidebar,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')")
        }
        
    })
rrshinyshinyappsshinydashboardshinyjs