ShinyDashboard 仪表板 Header 与浏览器中的徽标不一致

Question

我正在构建一个闪亮的应用程序，我想要一个静态 dashboardHeader() 标题，其右侧有一个徽标。我查看了 Whosebug 以弄清楚如何执行此操作，这似乎需要 HTML 标签。我不是计算机程序员 - 只是 R 用户，所以我不太了解这些是如何工作的。但是根据其他人的建议，我似乎需要 tag$li() 来设置 header 栏和徽标的高度。当我运行应用程序时，header 出现在 RStudio 闪亮的查看器中，但当我在浏览器中查看它时 (Chrome)，标题凹陷在徽标下方，并且隔断。下面是一个可重现的例子。您首先需要下载 [R 徽标] https://www.r-project.org/logo/Rlogo.png 并将其另存为“Rlogo.png”，保存在与以下代码相同的目录中名为“www”的子目录中（必须另存为"app.R"):

library(shiny)
library(shinydashboard)
library(plyr)
library(tmap)
library(tmaptools)
library(sp)
library(rgdal)

Projects<-c("Test", "Test", "Example", "Example", "Exhibit B", "Exhibit B")
Units<-c("A1", "A2", "B1", "B2", "C1", "C2")
CHOICE<-data.frame(PROJECTS = Projects, UNITS = Units)

P1<-sample(Projects, 100, replace=TRUE)
U1<-sample(Units, 100, replace=TRUE)
V1<-runif(100, 44.000, 45.900)
V2<-runif(100, -120.5, -118.0)

Data<-data.frame(Project = P1, Unit = U1, Value_1 = V1, Value_2 = V2)

ui<-dashboardPage(title = "Example",# Start Dashboard Page
                  header = dashboardHeader(
                    tags$li(class = "dropdown",
                            tags$style(".main-header {max-height: 100px}"),
                            tags$style(".main-header .logo {height: 100px} .primary-title height {100px}"),
                            tags$style(".sidebar-toggle {height: 20px; padding-top: 1px !important;}"),
                            tags$style(".navbar {min-height:20px !important}")
                    ),
                    titleWidth='100%',
                    title = span(
                      tags$img(src="Rlogo.png", width = '5%', align='right'), 
                      column(12, class="title-box", 
                             tags$h1(class="primary-title", style='margin-top:5px;', 'EXAMPLE SHINY DASHBOARD APP')
                      ))),#End Header,
  dashboardSidebar(
                selectInput(inputId = "Prj", "Select a Project", choices = unique(CHOICE$PROJECTS), selected = unique(CHOICE$PROJECTS)[1]),
                selectInput(inputId = "Unit", "Select a Unit", choices = NULL)
  ),
  dashboardBody(
    tmapOutput(outputId = "map"),
    tableOutput(outputId = "TABLE")
  )
)

server<-function(input, output, session){
  observeEvent(input$Prj,{
    updateSelectInput(session, "Unit", 
                      choices = unique(CHOICE$UNITS[CHOICE$PROJECTS==input$Prj]), 
                      selected = unique(CHOICE$UNITS[CHOICE$PROJECTS==input$Prj])[1])
  })
  output$TABLE<-renderTable({
    Data2<-subset(Data, Project == input$Prj & Unit == input$Unit)
    tbl<-ddply(Data2, c("Project", "Unit"), summarize, VALUE = max(Value_1), OTHER_VALUE=mean(Value_2))
    return(tbl)
  })
  output$map<-renderTmap({
    Data2<-subset(Data, Project == input$Prj & Unit == input$Unit)
    WGS84<-CRS("+init=epsg:4326")
    Pts<-SpatialPointsDataFrame(Data2[,c(4,3)], Data2[,c(1:2)], proj4string = WGS84)
    tmap_mode("view")
    tm_shape(Pts)+
      tm_dots("Project")+
      tm_basemap(server=providers$Esri.WorldImagery)
  })
}

shinyApp(ui = ui, server = server)

Answer 1

经过反复试验和大量谷歌搜索后，我认为这个问题基本上是一个“hack”（用程序员的说法）来解决 shinydashboard 的工作原理。我发现要同时显示徽标和标题，使用 tags$li(class = "dropdown") 创建一个下拉列表，并且因为标题是列表的第二个元素，所以它必须位于徽标下方。所以我“黑”了那个“黑”！在对 tags$h1() 的调用中，我发现可以为边距指定一个负值。通过将它设置为 -50px，我得到了我想要的输出。我相信真正理解 HTML 和 CSS 的真正的计算机程序员可以提供更优雅的解决方案。对于不是程序员的 R 用户，这里是我的“hacking-the-hack”解决方案的可重现代码。关于下载图像、将其保存到 www 子目录并将脚本另存为 app.R 的相同警告适用于我的问题：

library(shiny)
library(shinydashboard)
library(plyr)
library(tmap)
library(tmaptools)
library(sp)
library(rgdal)

Projects<-c("Test", "Test", "Example", "Example", "Exhibit B", "Exhibit B")
Units<-c("A1", "A2", "B1", "B2", "C1", "C2")
CHOICE<-data.frame(PROJECTS = Projects, UNITS = Units)

P1<-sample(Projects, 100, replace=TRUE)
U1<-sample(Units, 100, replace=TRUE)
V1<-runif(100, 44.000, 45.900)
V2<-runif(100, -120.5, -118.0)

Data<-data.frame(Project = P1, Unit = U1, Value_1 = V1, Value_2 = V2)

ui<-dashboardPage(title = "Example",# Start Dashboard Page
                  header = dashboardHeader(
                    tags$li(class = "dropdown",
                            tags$style(".main-header {max-height: 100px}"),
                            tags$style(".main-header .logo {height: 100px} .primary-title height {100px}"),
                            tags$style(".sidebar-toggle {height: 20px; padding-top: 1px !important;}"),
                            tags$style(".navbar {min-height:20px !important}")
                    ),
                    titleWidth='100%',
                    title = span(
                      tags$img(src="Rlogo.png", width = '5%', align='right'), 
                      column(12, class="title-box", 
                             tags$h1(class="primary-title", style='margin-top:-50px;', 'EXAMPLE SHINY DASHBOARD APP')
                      ))),#End Header,
  dashboardSidebar(
                selectInput(inputId = "Prj", "Select a Project", choices = unique(CHOICE$PROJECTS), selected = unique(CHOICE$PROJECTS)[1]),
                selectInput(inputId = "Unit", "Select a Unit", choices = NULL)
  ),
  dashboardBody(
    tmapOutput(outputId = "map"),
    tableOutput(outputId = "TABLE")
  )
)

server<-function(input, output, session){
  observeEvent(input$Prj,{
    updateSelectInput(session, "Unit", 
                      choices = unique(CHOICE$UNITS[CHOICE$PROJECTS==input$Prj]), 
                      selected = unique(CHOICE$UNITS[CHOICE$PROJECTS==input$Prj])[1])
  })
  output$TABLE<-renderTable({
    Data2<-subset(Data, Project == input$Prj & Unit == input$Unit)
    tbl<-ddply(Data2, c("Project", "Unit"), summarize, VALUE = max(Value_1), OTHER_VALUE=mean(Value_2))
    return(tbl)
  })
  output$map<-renderTmap({
    Data2<-subset(Data, Project == input$Prj & Unit == input$Unit)
    WGS84<-CRS("+init=epsg:4326")
    Pts<-SpatialPointsDataFrame(Data2[,c(4,3)], Data2[,c(1:2)], proj4string = WGS84)
    tmap_mode("view")
    tm_shape(Pts)+
      tm_dots("Project")+
      tm_basemap(server=providers$Esri.WorldImagery)
  })
}

shinyApp(ui = ui, server = server)

ShinyDashboard 仪表板 Header 与浏览器中的徽标不一致

ShinyDashboard Dashboard Header Not in line with logo in Browser

html

css

r

shiny

shinydashboard