ShinyDashboard Dashboard Header Not in line with logo in Browser

Question

I am building a shiny app and I want to have a static dashboardHeader() title with a logo to the right of it. I have looked through stackoverflow to figure out how to do this and it seems like this requires HTML tags. I am not a computer programmer - just an R user, so I don't really understand how these work. But following advice of others, it seems like I need tag$li() to set the the height of the header bar and the logo. When I run the app, the header appears as I want in the RStudio shiny viewer, but when I view it in a browser (Chrome), the title is sunken below the logo and cut off. Below is a reproducible example. You will first need to download the [R logo] https://www.r-project.org/logo/Rlogo.png and save it as "Rlogo.png" in a subdirectory called "www" in the same directory as the code below (which in turn must be saved as "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)

Sean McKenzie · Accepted Answer

After some trial and error and a lot of Googling, I think that basically this issue is that this is a "hack" (to use programmers' parlance) to get around how shinydashboard works. I found out that to get both the logo and the title to display the use of tags$li(class = "dropdown") creates a dropdown list, and because the title was the second element of the list it necessarily had to go below the logo. So I "hacked" that "hack!" In the call to tags$h1() I found out it is possible to specify a negative value for the margin. By setting this to -50px, I got my desired output. I am sure a real computer programmer who actually understands HTML and CSS can give a much more elegant solution. For fellow R users who aren't programmers, here is the reproducible code with my "hacking-the-hack" solution. Same caveats about downloading the image, saving it to the www subdirectory and saving the script as app.R as in my question apply here:

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 Dashboard Header Not in line with logo in Browser

Answers (1)

Related Questions