Question

我正在尝试在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符号）：

更新的代码：

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

要叠加在mainPanel顶部的sideBar

将sideBar的高度与mainPanel相同。

library(shiny)
library(shinydashboard)


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

  body <- dashboardBody(
    useShinyjs(),
    fluidRow(
      div(id = "TimingBox",
          tabBox(id = "Timing",
                 tabPanel("Tab 1", 
                    sidebarLayout(
                      div(id = "Sidebar",
                          style = "z-index: 1000;",
                          sidebarPanel("There are currently 20 overdue here", width = 6)
                      ),

                      mainPanel(plotOutput("plot1"), width = 12)
                    )
                 ),
                 tabPanel("Tab 2"),
                 title = p("Status",actionLink("Link", NULL, icon = icon("plus-square-o")),actionLink("Link2", NULL, icon = icon("search"))), 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)

Answer 1

这是使用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)

Shinydashboard：tabBox内的tabPanel侧栏

1 个答案: