当侧边栏在 Shiny

时间:2021-04-01 19:28:00

标签: r shiny shinydashboard shinyapps shinyjs

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

enter image description here enter image description here

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

1 个答案:

答案 0 :(得分:3)

因为您使用的是 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')")
        }
        
    })