通过选项卡使边栏中的输入持久化 [英] Make inputs in a sidebar persistent through tabs

查看:36
本文介绍了通过选项卡使边栏中的输入持久化的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!

问题描述

我想同时拥有一个持久的侧边栏(如 shinydashboard 布局)和一个带有选项卡的导航栏(如 shiny :: navbarPage 布局).我遇到了这个答案似乎与我想要的相对应.

I would like to have both a persistent sidebar (as in shinydashboard layout) and a navigation bar with tabs (as in shiny::navbarPage layout). I came across this answer that seems to correspond to what I want.

问题在于,侧边栏中的输入不能通过标签持久化,即,在切换标签时,侧边栏中的输入不再显示(例如,与 shinydashboard 侧边栏相反).这是一个示例,由于很多都是CSS,因此我无法真正将其最小化:

The problem is that inputs in the sidebar are not persistent through tabs, i.e when switching tabs, the inputs in the sidebar are not displayed anymore (at the contrary of shinydashboard sidebar for example). Here's an example I cannot really minimize more since a lot of it is CSS:

library(shiny)
library(bootstraplib)

# boot dash layout funs ---------------------------------------------------


boot_side_layout <- function(...) {
  div(class = "d-flex wrapper", ...)
}

boot_sidebar <- function(...) {
  div(
    class = "bg-light border-right sidebar-wrapper",
    div(class = "list-group list-group-flush", ...)
  )
}

boot_main <- function(...) {
  div(
    class = "page-content-wrapper",
    div(class = "container-fluid", ...)
  )
}

# css ---------------------------------------------------------------------

css_def <- "
body {
  overflow-x: hidden;
}

.container-fluid, .container-sm, .container-md, .container-lg, .container-xl {
    padding-left: 0px;
}

.sidebar-wrapper {
  min-height: 100vh;
  margin-left: -15rem;
  padding-left: 15px;
  padding-right: 15px;
  -webkit-transition: margin .25s ease-out;
  -moz-transition: margin .25s ease-out;
  -o-transition: margin .25s ease-out;
  transition: margin .25s ease-out;
}


.sidebar-wrapper .list-group {
  width: 15rem;
}

.page-content-wrapper {
  min-width: 100vw;
  padding: 20px;
}

.wrapper.toggled .sidebar-wrapper {
  margin-left: 0;
}

.sidebar-wrapper, .page-content-wrapper {
  padding-top: 20px;
}

.navbar{
  margin-bottom: 0px;
}

.navbar-collapse {
  font-size: 1.1rem
}

@media (max-width: 768px) {
  .sidebar-wrapper {
    padding-right: 0px;
    padding-left: 0px;

  }
}

@media (min-width: 768px) { 
  .sidebar-wrapper {
    margin-left: 0;
    position: fixed;
  }

  .page-content-wrapper {
    min-width: 0;
    width: 100%;
  }

  .wrapper.toggled .sidebar-wrapper {
    margin-left: -15rem;
  }
}

"


# app ---------------------------------------------------------------------
ui <- tagList(
  tags$head(tags$style(HTML(css_def))),
  bootstrap(),
  navbarPage(
    collapsible = TRUE,
    title = "",
    tabPanel(
      "Statistics",
      boot_side_layout(
        boot_sidebar(
          selectInput(
            "variables",
            "Variables",
            NULL
          )
        ),
        boot_main(
          fluidRow(
            dataTableOutput("statistics")
          )
        )
      )
    ),
    
    tabPanel(
      "Plots",
      boot_side_layout(
        boot_sidebar(
          
        ),
        boot_main(
        )
      )
    )
  )
)

server <- function(input, output, session) {
  
  output$statistics <- renderDataTable(mtcars[10, 10])
  
}

shinyApp(ui, server)

如何通过侧边栏使这些输入持久化?(如果有人知道将持久性侧边栏与导航栏混合的另一种简单方法,请同时显示).

How can I make these inputs persistent through sidebar? (If somebody knows of another simple way to mix persistent sidebar with navbar, please show it as well).

推荐答案

为什么不将 sidebarLayout mainPanel 中的 navbarPage 一起使用?/p>

Why not using a sidebarLayout with a navbarPage in mainPanel?

ui <- fluidPage(
  
  sidebarLayout(
    
    sidebarPanel(
      selectInput("select", "Select", c("a", "b", "c"))
    ),
    
    mainPanel(
      navbarPage(
        "App Title",
        tabPanel("Plot"),
        tabPanel("Summary"),
        tabPanel("Table")
      )    
    )
    
  )
)

shinyApp(ui, server)


编辑

还是类似的东西?


EDIT

Or something like this?

library(shiny)
library(ggplot2)

ui <- fluidPage(
  
  div(
    style = "display: flex; flex-direction: column;",
    div( #~~ Main panel ~~#
      navbarPage(
        "Old Faithful Geyser Data",
        tabPanel(
          "Plot",
          plotOutput("ggplot")
        ),
        tabPanel("Summary"),
        tabPanel("Table")
      )    
    ),
    wellPanel( #~~ Sidebar ~~#
      style = "width: 300px;",
      sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
    )
  )
)

server <- function(input, output) {
  output[["ggplot"]] <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
}

shinyApp(ui = ui, server = server)


编辑

像这样在左侧具有侧边栏:


EDIT

Like this to have the sidebar on the left:

library(shiny)
library(shinyjs)
library(ggplot2)

CSS <- "
.sidebar {
  min-width: 300px;
  margin-right: 30px;
}
#sidebar {
  width: 300px;
}
"

ui <- fluidPage(
  
  useShinyjs(),
  
  tags$head(tags$style(HTML(CSS))),
  
  div( #~~ Main panel ~~#
    navbarPage(
      "Old Faithful Geyser Data",
      tabPanel(
        "Plot",
        div(
          style = "display: flex;",
          div(class = "sidebar"),
          plotOutput("ggplot")
        )
      ),
      tabPanel(
        "Summary",
        div(
          style = "display: flex;",
          div(class = "sidebar"),
          verbatimTextOutput("summary")
        )
      ),
      tabPanel(
        "Table",
        div(
          style = "display: flex;",
          div(class = "sidebar"),
          tableOutput("table")
        )
      ),
      id = "navbar"
    )    
  ),
  wellPanel( #~~ Sidebar ~~#
    id = "sidebar", 
    sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30),
  )
)

server <- function(input, output) {
  output[["ggplot"]] <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
  output[["summary"]] <- renderPrint({
    list(a = 1:10, b = 1:10)
  })
  output[["table"]] <- renderTable({
    iris[1:10,]
  })
  observeEvent(input[["navbar"]], {
    selector <- 
      sprintf("$('div.tab-pane[data-value=\"%s\"] div.sidebar')", input[["navbar"]])
    runjs(paste0(selector, ".append($('#sidebar'));"))
  })
}

shinyApp(ui = ui, server = server)


编辑

这是上述方法的改进.我已经做了一些方便的函数 tabPanel2 sidebar 来帮助用户.我使用的是 fluidRow column ,而不是使用 display:flex; .这允许相对于屏幕尺寸具有侧边栏宽度.下面的示例还显示了如何在选项卡中不包括边栏(只需使用 tabPanel 而不是 tabPanel2 .


EDIT

Here is an improvement of the above way. I've made some convenient functions tabPanel2 and sidebar to help the user. And I use fluidRow and column instead of using a display: flex;. This allows to have a sidebar width relative to the screen size. The example below also shows how to not include the sidebar in a tab (simply use tabPanel and not tabPanel2.

library(shiny)
library(shinyjs)
library(ggplot2)

tabPanel2 <- function(title, ..., value = title, icon = NULL, sidebarWidth = 4){
  tabPanel(
    title = title, 
    fluidRow(
      column(
        width = sidebarWidth,
        class = "sidebar"
      ),
      column(
        width = 12 - sidebarWidth,
        ...
      )
    )
  )
}

sidebar <- function(...){
  div(
    style = "display: none;",
    tags$form(
      class = "well",
      id = "sidebar",
      ...
    )
  )
}

ui <- fluidPage(
  
  useShinyjs(),
  
  div( #~~ Main panel ~~#
    navbarPage(
      "Old Faithful Geyser Data",
      tabPanel2(
        "Plot",
        plotOutput("ggplot")
      ),
      tabPanel2(
        "Summary",
        verbatimTextOutput("summary")
      ),
      tabPanel(
        "Table",
        fluidRow(
          column(
            width = 4,
            wellPanel(
              tags$fieldset(
                tags$legend(h3("About")),
                p("This app is cool")
              )
            )
          ),
          column(
            width = 8,
            tableOutput("table")
          )
        )
      ),
      id = "navbar"
    )    
  ),
  
  sidebar( #~~ Sidebar ~~#
    sliderInput("bins", "Number of bins:", min = 1, max = 50, value = 30)    
  )

)

server <- function(input, output) {
  
  output[["ggplot"]] <- renderPlot({
    x    <- faithful[, 2] 
    bins <- seq(min(x), max(x), length.out = input$bins + 1)
    hist(x, breaks = bins, col = 'darkgray', border = 'white')
  })
  
  output[["summary"]] <- renderPrint({
    list(a = 1:10, b = 1:10)
  })
  
  output[["table"]] <- renderTable({
    iris[1:10,]
  })
  
  observeEvent(input[["navbar"]], {
    selector <- 
      sprintf("$('div.tab-pane[data-value=\"%s\"] div.sidebar')", input[["navbar"]])
    append <- "selector.append($('#sidebar'));"
    js <- sprintf("var selector=%s; if(selector.length){%s;}", selector, append)
    runjs(js)
  })
  
}

shinyApp(ui = ui, server = server)

这篇关于通过选项卡使边栏中的输入持久化的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!

查看全文
登录 关闭
扫码关注1秒登录
发送“验证码”获取 | 15天全站免登陆