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

Question

我正在构建一个闪亮的应用程序，我想有一个静态的dashboardHeader()标题，右边有一个徽标。我已经查看了stackoverflow，想知道如何做到这一点，似乎这需要HTML标记。我不是一个计算机程序员，只是一个R用户，所以我真的不明白这些是如何工作的。但根据其他人的建议，我似乎需要tag$li()来设置标题栏和徽标的高度。当我运行该应用程序时，标题在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

经过一些尝试和错误以及大量的谷歌搜索，我认为基本上这个问题是，这是一个"破解"；(用程序员的话说(来了解shinydashboard是如何工作的。我发现，为了同时显示徽标和标题，使用tags$li(class = "dropdown")会创建一个下拉列表，因为标题是列表的第二个元素，所以它必须位于徽标下方。所以我"被黑的"；"；黑客"在对tags$h1()的调用中，我发现可以为裕度指定负值。通过将其设置为-50像素，我得到了所需的输出。我相信一个真正了解HTML和CSS的计算机程序员可以提供一个更优雅的解决方案。对于不是程序员的R用户来说，这里有我的"；黑客攻击"；解决方案关于下载图像、将其保存到www子目录以及将脚本保存为应用程序，同样需要注意。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)