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

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

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

enter image description here

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

ОТВЕТЫ

Ответ 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=, (до этого параметра использовался только текст),

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

Теперь метод теперь:

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()
)

Ответ 2

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

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
)