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 width
To 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) { }
)