Display different image as title of shiny dashboard based on different tabpanels

问题

Is it possible to display different image as title of the shiny dashboard based on the tabPanel() that you use. I want different image for the tab 'Front' and different for the tab 'Data'.

# app.R ##
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(shinyWidgets)
library(shinyjs)

dbHeader <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "gears",
  fixed = T,
  title = tags$a(href='http://mycompanyishere.com',
                                 tags$img(src='logo.png'))
)

ui <- dashboardPagePlus(
  dbHeader,
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    tags$hr(),
    tabsetPanel(
      id ="tabA",
      type = "tabs",
      tabPanel("Front",icon = icon("accusoft")),
      tabPanel("Data", icon = icon("table")
      )
    )
  ),
  rightsidebar = rightSidebar()
)

server <- function(input, output) {
  observe({
    if (input$tabA == "Front") {
      hide(selector = "body > div.wrapper > header > nav > div:nth-child(4) > ul")
      addClass(selector = "body", class = "sidebar-collapse")
      removeClass(selector = "body", class = "control-sidebar-open")
    } else {
      show(selector = "body > div.wrapper > header > nav > div:nth-child(4) > ul")
      removeClass(selector = "body", class = "sidebar-collapse")
      addClass(selector = "body", class = "control-sidebar-open")
    }
  })
}

shinyApp(ui = ui, server = server)

回答1:

So one way to achieve this is by using shinyjs and modify CSS in Shiny reactive output.

In order to do so, I've first "borrowed" this function

# This part is from the link below and will be used to modify CSS in reactive part
# https://stackoverflow.com/questions/31425841/css-for-each-page-in-r-shiny
modifyStyle <- function(selector, ...) {

  values <- as.list(substitute(list(...)))[-1L]
  parameters <- names(values)

  args <- Map(function(p, v) paste0("'", p,"': '", v,"'"), parameters, values)
  jsc <- paste0("$('",selector,"').css({", paste(args, collapse = ", "),"});")

  shinyjs::runjs(code = jsc)

}

And then using two functions below (inside observe() function in server side part) I've modified CSS in the reactive output using CSS code:

# Show one picture. 
# NOTE:if using your own picture modify the path inside url().. See the code below.
      modifyStyle(".logo img ", "content" = "url(https://dotunroy.files.wordpress.com/2015/05/happy-people.jpg)")
# Show another picture
  modifyStyle(".logo img ", "content" = "url(test.png)")

Note that, in order for me to show that the code works, first I needed to have some pictures. So I've saved one picture inside my www directory (the picture is called test.png (see the above code)). And another is available from this link https://dotunroy.files.wordpress.com/2015/05/happy-people.jpg.

So the whole code looks like this (again, in order for you to display images, replace the path of my images inside url() with your own)

library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(DT)
library(shinyWidgets)
library(shinyjs)
# Modify the CSS style of a given selector

# This part is from 
# https://stackoverflow.com/questions/31425841/css-for-each-page-in-r-shiny
modifyStyle <- function(selector, ...) {

  values <- as.list(substitute(list(...)))[-1L]
  parameters <- names(values)

  args <- Map(function(p, v) paste0("'", p,"': '", v,"'"), parameters, values)
  jsc <- paste0("$('",selector,"').css({", paste(args, collapse = ", "),"});")

  shinyjs::runjs(code = jsc)

}


dbHeader <- dashboardHeaderPlus(
  enable_rightsidebar = TRUE,
  rightSidebarIcon = "gears",
  fixed = T,
  title = tags$a(href='http://mycompanyishere.com',
# Modify the width and the height of the image as you like
                 tags$img(src='test.png', width ="50%", height = "70%"))
)

ui <- dashboardPagePlus(
  dbHeader,
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    tags$hr(),
    tabsetPanel(
      id ="tabA",
      type = "tabs",
      tabPanel("Front",icon = icon("accusoft")),
      tabPanel("Data", icon = icon("table")
      )
    )
  ),
  rightsidebar = rightSidebar()
)

server <- function(input, output) {
  observe({
    if (input$tabA == "Front") {
      hide(selector = "body > div.wrapper > header > nav > div:nth-child(4) > ul")
      addClass(selector = "body", class = "sidebar-collapse")
      removeClass(selector = "body", class = "control-sidebar-open")
      modifyStyle(".logo img ", "content" = "url(https://dotunroy.files.wordpress.com/2015/05/happy-people.jpg)")
      # shinyjs::toggleClass(selector = "head", class = "logo",
      #                      condition = (input$tabA == "Front"))
    } else {
      show(selector = "body > div.wrapper > header > nav > div:nth-child(4) > ul")
      removeClass(selector = "body", class = "sidebar-collapse")
      addClass(selector = "body", class = "control-sidebar-open")
      modifyStyle(".logo img ", "content" = "url(test.png)")


    }
  })
}

shinyApp(ui = ui, server = server)

And the output is:

UPDATE Note that if you want to modify the width and the height of the image, just add these two parameters in CSS, i.e.

   # Add a custom number of the percentage to width and height parameters
      modifyStyle(".logo img ", "content" = 
    "url(https://dotunroy.files.wordpress.com/2015/05/happy-people.jpg)",
     "width" = "100%", "height" = "100%")

来源：https://stackoverflow.com/questions/60895748/display-different-image-as-title-of-shiny-dashboard-based-on-different-tabpanels

标签

Shiny

shinydashboard