R语言Shiny应用美化：皮肤、注销面板与自定义CSS-优快云博客

本文介绍了如何使用R语言的Shiny和shinydashboard包来创建炫酷的用户界面，包括设置不同皮肤、添加注销面板以及自定义CSS调整标题和侧边栏宽度。示例代码展示了如何实现这些功能，如使用不同颜色主题、创建动态注销面板以及通过CSS改变标题字体和增加标题宽度。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Shiny-cheatsheet                                                                                                                 作者：贾慧   作品来源：百度百科
.炫酷外观皮肤skins仪表盘包括很多的主题或者皮肤。默认的为blue蓝色，此外，还有其他的颜色，包括：black黑色，purple紫色，green绿色，red红色，yellow黄色等。可以使用dashboardPage(skin = "blue"), dashboardPage(skin = "black")等进行设置。
ui <- dashboardPage(skin = "black",
  dashboardHeader(title = "Value boxes"),
  dashboardSidebar(),
  dashboardBody()
)
 
 
 
注销面板logout panel(这需要shinydashboard 0.5.1或更高版本显示。)当shinydashboard应用运行shiny服务器之前，需要经过身份验证的用户才能登录,面板在右上角显示用户名和注销链接。
 
注销面板与shinydashboard更很好地集成。正如你所看到的在上面的截图中,默认注销面板部分掩盖了下拉菜单图标。我们可以添加一个用户面板与动态UI(在服务器上生成)和隐藏默认注销面板,如下所示:
 
程序：
 
library(shiny)
library(shinydashboard)
library(httr)
library(jsonlite)
library(data.table)
library(dplyr)
library(rvest)
library(magrittr)
 
 
ui <- dashboardPage(
  dashboardHeader(
    title = "SSP logout",
    dropdownMenu(type = "messages", badgeStatus = "success",
                 messageItem("Message 1", "Content of a message.")
    )
  ),
  dashboardSidebar(
    # Custom CSS to hide the default logout panel
    tags$head(tags$style(HTML('.shiny-server-account { display: none; }'))),
    
    # The dynamically-generated user panel
    uiOutput("userpanel"),
    
    sidebarMenu(
      menuItem("Menu item 1", icon = shiny::icon("calendar"))
    )
  ),
  dashboardBody()
)
 
server <- function(input, output, session) {
  # Generate the dynamic UI for the logout panel
  output$userpanel <- renderUI({
    
    # session$user is non-NULL only in authenticated sessions
    if (!is.null(session$user)) {
      sidebarUserPanel(
        span("Logged in as ", session$user),
        subtitle = a(icon("sign-out"), "Logout", href="__logout__"))
    }
  })
}
 
shinyApp(ui, server)
 
其他程序：
 
library(shiny)
library(shinydashboard)
library(httr)
library(jsonlite)
library(data.table)
library(dplyr)
library(rvest)
library(magrittr)
 
header <- dashboardHeader(title="CYBER Dashboard")
 
sidebar <- dashboardSidebar()
 
body <- dashboardBody(
  fluidPage(
    fluidRow(
      a(href="http://isc.sans.org/",
        target="_blank", uiOutput("infocon")),
      a(href="http://www.symantec.com/security_response/threatcon/",
        target="_blank", uiOutput("threatcon")),
      a(href="http://webapp.iss.net/gtoc/",
        target="_blank", uiOutput("alertcon"))
    )
  )
)
 
ui <- dashboardPage(header, sidebar, body, skin="black")
 
server <- function(input, output) {
  
  output$infocon <- renderUI({
    
    infocon_url <- "https://isc.sans.edu/api/infocon?json"
    infocon <- fromJSON(content(GET(infocon_url)))
    
    valueBox(
      value="Yellow",
      subtitle="SANS Infocon",
      icon=icon("bullseye"),
      color=ifelse(infocon$status=="test", "blue", infocon$status)
    )
    
  })
  output$threatcon <- renderUI({
    
    pg <- html("http://www.symantec.com/security_response/#")
    pg %>%
      html_nodes("div.colContentThreatCon > a") %>%
      html_text() %>%
      extract(1) -> threatcon_text
    
    tcon_map <- c("green", "yellow", "orange", "red")
    names(tcon_map) <- c("Level 1", "Level 2", "Level 3", "Level 4")
    threatcon_color <- unname(tcon_map[gsub(":.*$", "", threatcon_text)])
    
    threatcon_text <- gsub("^.*:", "", threatcon_text)
    
    valueBox(
      value=threatcon_text,
      subtitle="Symantec ThreatCon",
      icon=icon("tachometer"),
      color=threatcon_color
    )
    
  })
  
  output$alertcon <- renderUI({
    
    pg <- html("http://xforce.iss.net/")
    pg %>%
      html_nodes(xpath="//td[@class='newsevents']/p") %>%
      html_text() %>%
      gsub(" -.*$", "", .) -> alertcon_text
    
    acon_map <- c("green", "blue", "yellow", "red")
    names(acon_map) <- c("AlertCon 1", "AlertCon 2", "AlertCon 3", "AlertCon 4")
    alertcon_color <- unname(acon_map[alertcon_text])
    
    valueBox(
      value=alertcon_text,
      subtitle="IBM X-Force",
      icon=icon("warning"),
      color=alertcon_color
    )
    
  })
  
}
 
shinyApp(ui, server)
 
 
 
CSS You can add custom CSS to your app by creating a www/ subdirectory to your app and adding a CSS file there. Suppose, for example, you want to change the title font of your dashboard to the same font as the rest of the dashboard, so that it looks like this:
 
To do this, first create a file named www/custom.css with the following:
.main-header .logo {
  font-family: "Georgia", Times, "Times New Roman", serif;
  font-weight: bold;
  font-size: 24px;
}
Then refer to that CSS file from the UI of your app:
 
## ui.R ##
dashboardPage(
  dashboardHeader(title = "Custom font"),
  dashboardSidebar(),
  dashboardBody(
    tags$head(
      tags$link(rel = "stylesheet", type = "text/css", href = "custom.css")
    )
  )
)
 
A second way to include CSS is to put it directly in the UI code for your app:
 
## ui.R ##
dashboardPage(
  dashboardHeader(title = "Custom font"),
  dashboardSidebar(),
  dashboardBody(
    tags$head(tags$style(HTML('      .main-header .logo {
        font-family: "Georgia", Times, "Times New Roman", serif;
        font-weight: bold;
        font-size: 24px;
      }
    ')))  )
)
 
4.4长标题 In some cases, the title that you wish to use won’t fit in the default width in the header bar. You can make the space for the title wider with the titleWidth option. In this example, we’ve increased the width for the title to 450 pixels, and also set the background color of the title area (using custom CSS) to be the same as the rest of the header bar.
 
 
 
shinyApp(
  ui = dashboardPage(
    dashboardHeader(
      title = "Example of a long title that needs more space",
      titleWidth = 450
    ),
    dashboardSidebar(),
    dashboardBody(
      # Also add some custom CSS to make the title background area the same
      # color as the rest of the header.
      tags$head(tags$style(HTML('        .skin-blue .main-header .logo {
          
        }
        .skin-blue .main-header .logo:hover {
          background-color: #3c8dbc;
        }
      ')))    )
  ),
  server = function(input, output) { }
)
 
侧边栏宽度sidebar widthTo change the width of the sidebar, you can use the width option. This example has a wider title and sidebar:
 
 
shinyApp(
  ui = dashboardPage(
    dashboardHeader(
      title = "Title and sidebar 350 pixels wide",
      titleWidth = 350
    ),
    dashboardSidebar(
      width = 350,
      sidebarMenu(
        menuItem("Menu Item")
      )
    ),
    dashboardBody()
  ),
  server = function(input, output) { }
)