R Блестящий цвет фона меняется с каждой вкладкой

Question

У меня есть несколько вкладок в панели навигации (Home, Tab1, Tab2 и т. Д. c). Я хочу, чтобы фоновый цвет домашней страницы был белым, тогда как все остальные страницы панели навигации светло-голубые. Это возможно? Кажется, что может быть только один цвет фона.

Спасибо

Answer 1

Вам нужно передать цвет от R до JS следующим образом:

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)

Пожалуйста, также смотрите это статья по теме.

Также стоит упомянуть здесь this .

Answer 2

Исходя из этого поста (второй ответ, от Майка), вы можете найти ниже рабочий пример ui.R и server.R файлов образца блестящего веб-приложения.

Часть кода, управляющая цветом вкладок:

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

}