Добавление компании Logo в заголовок ShinyDashboard

Question

Так просто любопытно, есть ли способ добавить логотип компании в заголовок ShinyDashboard? Поскольку я смотрю на documentation, он описывает изменение «логотипа» в CSS, это просто настройка того, что находится в верхнем левом углу, хотя, насколько я могу судить, и я хотел бы сохранить там свой заголовок.

Я не использую раскрывающиеся меню, поэтому я хотел бы добавить логотип моей компании в верхнем правом углу, где находится красная коробка.

Кто-нибудь есть какие-либо идеи, как это может быть сделано с Shinydashboard? Благодарю.

Answer 1

Я работаю с немного хака для этого (и я знаю, что вы не просите об этом, но вот кликабельна логотип, а мы на него):

library(shiny) 
library(shinydashboard) 

dbHeader <- dashboardHeader() 
dbHeader$children[[2]]$children <- tags$a(href='http://mycompanyishere.com', 
              tags$img(src='logo.png',height='60',width='200')) 

dashboardPage(
     dbHeader, 
     dashboardSidebar(), 
     dashboardBody() 
) 

Таким образом, это гнездо shiny.tag внутри заголовка. Второй слот в данном блестящем объекте является слотом логотипа (Вы будете нуждаться в «logo.png» в ваших/WWW/папках в каталоге приложения)

EDIT:

Я только что проверил, и, как прямо сейчас, этот хак больше не нужен, вы можете вставить html непосредственно из функции dashboardHeader с помощью параметра title= (до этого параметра использовался только текст),

Я думаю, что ответ может по-прежнему быть полезным как метод для изменения существующих блестящих функций, где вещи ARE жестко закодированы.

Вот метод в настоящее время:

dashboardPage(
    dashboardHeader(title = tags$a(href='http://mycompanyishere.com', 
            tags$img(src='logo.png'))) 

или, добавив немного больше магии с логотипом (я также использовать свой логотип в качестве нагрузочного бар):

# Takes a location 'href', an image location 'src', a loading gif 'loadingsrc' 
# height, width and alt text, and produces a loading logo that activates while 
# Shiny is busy 
loadingLogo <- function(href, src, loadingsrc, height = NULL, width = NULL, alt = NULL) { 
    tagList(
    tags$head(
     tags$script(
     "setInterval(function(){ 
        if ($('html').attr('class')=='shiny-busy') { 
        $('div.busy').show(); 
        $('div.notbusy').hide(); 
        } else { 
        $('div.busy').hide(); 
        $('div.notbusy').show(); 
      } 
     },100)") 
), 
    tags$a(href=href, 
     div(class = "busy", 
      img(src=loadingsrc,height = height, width = width, alt = alt)), 
     div(class = 'notbusy', 
      img(src = src, height = height, width = width, alt = alt)) 
    ) 
) 
} 

dashboardBody(
    dashboardHeader(title = loadingLogo('http://mycompanyishere.com', 
             'logo.png', 
             'loader.gif'), 
    dashboardSidebar(), 
    dashboardBody() 
) 

Answer 2

Вот мой хак (поместите свой логотип, как уже упоминалось ранее, в подкаталог www вашего каталога приложений).
Поскольку dashboardHeader() ожидает тега элемента типа li и класса dropdown, мы можем передать такие элементы вместо dropdownMenu с:

library(shiny) 
library(shinydashboard) 

dbHeader <- dashboardHeader(title = "My Dashboard", 
          tags$li(a(href = 'http://shinyapps.company.com', 
             icon("power-off"), 
             title = "Back to Apps Home"), 
            class = "dropdown"), 
          tags$li(a(href = 'http://www.company.com', 
             img(src = 'company_logo.png', 
              title = "Company Home", height = "30px"), 
             style = "padding-top:10px; padding-bottom:10px;"), 
            class = "dropdown")) 

server <- function(input, output) {} 

shinyApp(
    ui = dashboardPage(
     dbHeader, 
     dashboardSidebar(), 
     dashboardBody() 
    ), 
    server = server 
)