前端之家

  1. 首页
  2. 问答

Shinydashboard：tabBox内的tabPanel侧栏

• 问答

我正在尝试在tabBox内为特定的tabPanel创建侧边栏效果（非常类似于shinyDashboardPlus仅用box来完成），但并非如此使用mainPanel和sidebarPanel可以达到预期效果。

代码：

library(shiny)
library(shinydashboard)


  header <- dashboardheader()
  sidebar <- dashboardSidebar()

  body <- dashboardBody(
    useShinyjs(),fluidRow(
      div(id = "TimingBox",tabBox(id = "Timing",tabPanel("Tab 1",mainPanel(
                            plotOutput("plot1")
                          ),div(id ="Sidebar",sidebarPanel(
                            "Look here"
                            )
                          )
                 ),tabPanel("Tab 2"),title = p("Status",actionLink("Link",NULL,icon = icon("plus-square-o"))),width = 4,selected = "Tab 1"
          )
      )
    )
  )

  ui <- dashboardPage(header,sidebar,body)

server <- function(input,output) {

  shinyjs::hide(id = "Sidebar")

  observeEvent(input$Link,{
    shinyjs::toggle(id = "Sidebar")
  })


  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(50)]
    hist(data)
  })


}

shinyApp(ui,server)

ShinyDashboardPlus带有侧边栏的框（单击i符号）：

Shinydashboard：tabBox内的tabPanel侧栏

Shinydashboard：tabBox内的tabPanel侧栏

更新的代码：

我已经做了一些工作，发现我缺少sidebarLayout（）。但是，我仍然希望

  1. 要叠加在mainPanel顶部的sideBar

  2. 将sideBar的高度与mainPanel相同。

    library(shiny)
library(shinydashboard)


  header <- dashboardheader()
  sidebar <- dashboardSidebar()

  body <- dashboardBody(
    useShinyjs(),sidebarLayout(
                      div(id = "Sidebar",style = "z-index: 1000;",sidebarPanel("There are currently 20 overdue here",width = 6)
                      ),mainPanel(plotOutput("plot1"),width = 12)
                    )
                 ),icon = icon("plus-square-o")),actionLink("Link2",icon = icon("search"))),server)
liync 回答：Shinydashboard：tabBox内的tabPanel侧栏

这是使用dropdownButton中的shinyWidgets的解决方案。我认为您可以通过使用一些其他CSS轻松使“状态”和按钮对齐。 

library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinyWidgets)


header <- dashboardHeader()
sidebar <- dashboardSidebar()

body <- dashboardBody(
  useShinyjs(),fluidRow(
    div(id = "TimingBox",tabBox(id = "Timing",tabPanel("Tab 1",plotOutput("plot1")

               ),tabPanel("Tab 2"),title = p("Status",div(id = "mybutton",# put the button in div so it can be hide/show with some shinyjs
                             dropdownButton(
                               "A title",textInput("id1","an input"),selectInput("id2","another input",choices = letters[1:5]),circle = TRUE,size = 'xs',right = TRUE,icon = icon("gear"),width = '100px'
                         ))),width = 4,selected = "Tab 1"
        )
    )
  )
)

ui <- dashboardPage(header,sidebar,body)

server <- function(input,output) {

  set.seed(122)
  histdata <- rnorm(500)

  output$plot1 <- renderPlot({
    data <- histdata[seq_len(50)]
    hist(data)
  })

  # Display button to show the sidebar only when tab 1 is active
  observe({
    print(input$Timing)
    if(input$Timing != "Tab 1"){
      shinyjs::hide(id = "mybutton")
    }else{
      shinyjs::show(id = "mybutton")
    }
    })
}

shinyApp(ui,server)
shinyshinydashboard
本文链接：https://www.f2er.com/3062527.html

大家都在问