R Shiny Background color changes with each tab

Question

I have a few tabs in the navbar (Home, Tab1, Tab2, etc). I want the Home page background color to be white, while all other navbar pages are light blue. Is this possible? It seems like there can only be one background color.

Thanks

Answer 1

You need to pass the color from R to JS like this:

library(shiny)

ui <- tagList(tags$head(
  tags$script("
      Shiny.addCustomMessageHandler('background-color', function(color) {
        document.body.style.backgroundColor = color;
      });
    ")
),
navbarPage(title = "App Title", id = "navbarID",
  tabPanel("Home"),
  tabPanel("Tab1"),
  tabPanel("Tab2")
))

server <- function(input, output, session) {
  observeEvent(input$navbarID, {
    if(input$navbarID == "Home"){
      session$sendCustomMessage("background-color", "white")
    } else {
      session$sendCustomMessage("background-color", "lightblue")
    }
  })
}

shinyApp(ui, server)

Please also see this related article.

Also worth mentioning here is this.

Answer 2

Based on this post (the second answer, Mike's one) you can find below a working example of ui.R and server.R files of a sample shiny webapp.

The code portion that manage tabs color is:

 tags$style(HTML("
                .tabbable > .nav > li > a[data-value='Summary'] {background-color: aqua;   color:black}
                .tabbable > .nav > li > a[data-value='Table'] {background-color: aqua;  color:black}
            ")),

ui.R

# Define UI for random distribution app ----
ui <- fluidPage(

    # App title ----
    titlePanel("Tabsets"),

    # Sidebar layout with input and output definitions ----
    sidebarLayout(

        # Sidebar panel for inputs ----
        sidebarPanel(

            # Input: Select the random distribution type ----
            radioButtons("dist", "Distribution type:",
                         c("Normal" = "norm",
                           "Uniform" = "unif",
                           "Log-normal" = "lnorm",
                           "Exponential" = "exp")),

            # br() element to introduce extra vertical spacing ----
            br(),

            # Input: Slider for the number of observations to generate ----
            sliderInput("n",
                        "Number of observations:",
                        value = 500,
                        min = 1,
                        max = 1000)

        ),

        # Main panel for displaying outputs ----
        mainPanel(

            tags$style(HTML("
                .tabbable > .nav > li > a[data-value='Summary'] {background-color: aqua;   color:black}
                .tabbable > .nav > li > a[data-value='Table'] {background-color: aqua;  color:black}
            ")),

            # Output: Tabset w/ plot, summary, and table ----
            tabsetPanel(type = "tabs",
                        tabPanel("Plot", plotOutput("plot")),
                        tabPanel("Summary", verbatimTextOutput("summary")),
                        tabPanel("Table", tableOutput("table"))
            )

        )
    )
)

server.R

# Define server logic for random distribution app ----
server <- function(input, output) {

    # Reactive expression to generate the requested distribution ----
    # This is called whenever the inputs change. The output functions
    # defined below then use the value computed from this expression
    d <- reactive({
        dist <- switch(input$dist,
                       norm = rnorm,
                       unif = runif,
                       lnorm = rlnorm,
                       exp = rexp,
                       rnorm)

        dist(input$n)
    })

    # Generate a plot of the data ----
    # Also uses the inputs to build the plot label. Note that the
    # dependencies on the inputs and the data reactive expression are
    # both tracked, and all expressions are called in the sequence
    # implied by the dependency graph.
    output$plot <- renderPlot({
        dist <- input$dist
        n <- input$n

        hist(d(),
             main = paste("r", dist, "(", n, ")", sep = ""),
             col = "#75AADB", border = "white")
    })

    # Generate a summary of the data ----
    output$summary <- renderPrint({
        summary(d())
    })

    # Generate an HTML table view of the data ----
    output$table <- renderTable({
        d()
    })

}