如何修复 uiOutput 中 R 闪亮仪表板页脚的位置？

Question

`嗨，我需要仪表板页脚的可见性以某个数字为条件。

这段代码很好，除了参数

fixed = TRUE

（来自 bs4DashFooter）不起作用。

library(shiny)
library(bs4Dash)
library(reactable)

ui = dashboardPage(
  header = dashboardHeader(),
  sidebar = dashboardSidebar(
    sidebarMenu(id = "mmm",
                menuItem("Dashboard Tab 1", tabName = "tab1"),
                menuItem("Dashboard Tab 2", tabName = "tab2")
    )),

  footer = uiOutput("f"),
  
    body = dashboardBody(
    tabItems( 
      tabItem(
        tabName = "tab1",
        h6(("tab 1 content"), style="text-align: center;"),
        reactableOutput(outputId = "t")),
      tabItem(
        tabName = "tab2",
        h6("tab 2 content"), style="text-align: center;")
    )
  )
)
server = function(input, output, session) {
  a <- reactiveValues(q = 3)
  output$f <- renderUI({
    if (as.numeric(isolate(reactiveValuesToList(a)))[1] > 2){
    bs4DashFooter(
      right = "some foot",
      fixed = TRUE)
    }
  })
  
  output$t <- renderReactable({
    reactable(mtcars,
              defaultPageSize = 50)})
}
shinyApp(ui, server)

有人可以帮忙吗？

Answer 1

让我详细说明一下。

虽然闪亮仪表板非常适合较小的设备（智能手机），但在此类设备上，我相信带有链接到不同选项卡的图标+标签的底部栏/面板（页脚）非常有用（例如 miniUI 中的 miniTabstripPanel）。

然而，与 miniUI 一样，这个底部面板在桌面模式下看起来不太好。

因此，使用shinybrowser::get_width()，很容易设置一个阈值，超过该阈值面板不应显示

以下是一个工作示例，它使用shinydashboard并添加一个固定页脚，其中包含指向每个选项卡的链接以及一个条件面板，其条件等于设备的aspect_ratio。

library(shiny)
library(bs4Dash)
library(reactable)

#### UI ####
#### dashboardpage ####
ui = dashboardPage(
  title = "Basic Dashboard",
  header = dashboardHeader(),
  #### dashboardSidebar ####
  sidebar = dashboardSidebar(
    sidebarMenu(id = "mmm",
                menuItem("Dashboard Tab 1", tabName = "tab1", icon = icon("dashboard")),
                menuItem("Dashboard Tab 2", tabName = "tab2", icon = icon("chart-line"))
    )
  ), #### ____end dashboardSidebar ####
  
  #### controlbar ####
  controlbar = dashboardControlbar(), #### ____end controlbar ####
  
  #### bsDashFooter ####
  footer = bs4DashFooter(
    left = 
      tags$footer(
        class = "footer",
        div(
          style = "text-align: center;",
          div(
            style = "display: inline-block; margin-right: 5px;",
            icon("dashboard", class = "fa-1x", onclick = "Shiny.setInputValue('mmm', 'tab1')", style = "font-size: 20px"),
            h6(style = "margin-top: 0;", "tab 1")
          ),
          div(
            style = "display: inline-block; margin-left: 5px;",
            icon("chart-line", class = "fa-1x", onclick = "Shiny.setInputValue('mmm', 'tab2')", style = "font-size: 20px"),
            h6(style = "margin-top: 0;", "tab 2")
          )
        ))
      , #### ____end bs4DashFooter ####
    fixed = TRUE
  ),
  
  #### dashboardBody ####
  body = dashboardBody(
    
    #### tablItems ####
    tabItems( 
      tabItem(
        tabName = "tab1",
        shinybrowser::detect(),
        tableOutput("ar2"),

        conditionalPanel(
          condition = "output.aspect_ratio > '1' ", 
          textOutput("ar")),
        
        fluidRow(
           box(
             title = "Dashboard Tab 1 Content",
             "This is the content for Dashboard Tab 1.",
             reactableOutput(outputId = "t")
           )
        )
      ),
      tabItem(
        tabName = "tab2",
        fluidRow(
          box(
            title = "Dashboard Tab 2 Content",
            "This is the content for Dashboard Tab 2."
          )
        )
      )
    ), #### ____end tabItems ####
    
    #### tags$style ... main-footer ####    
    tags$style(
      HTML(
        ".main-footer {
              padding: 2px;
              height: 50px;
              /* background-color: blue; */
              color: green;
            }"
      )
    ) #### ____end tags ####
  ) #### ____end dashboardBody ####
) #### ____end UI dashboardPage ####

server = function(input, output, session) {
  
  observeEvent(input$mmm, {
    if (input$mmm == "tab1") {
      updateTabItems(session, "mmm", selected = "tab1")
    } else if (input$mmm == "tab2") {
      updateTabItems(session, "mmm", selected = "tab2")
    }
  })
  
  output$t <- renderReactable({
    reactable(mtcars,
              defaultPageSize = 50)})
  
  w <- reactive(shinybrowser::get_width())
  h <- reactive(shinybrowser::get_height())
  output$aspect_ratio <- reactive (w() / h())
  outputOptions(output, "aspect_ratio", suspendWhenHidden = FALSE)
    output$ar <- renderText({ paste0("width = ", w(), " height = ", h())
    })
}

shinyApp(ui, server)

这对于条件面板非常有效。但我不能对页脚应用相同的策略。

有什么帮助吗？ 提前致谢， 安东尼奥