Shiny-cheatsheet
作者：周彦通
1.安装
install.packages("shinydashboard")
2.基础知识
仪表盘有三个部分:标题、侧边栏,身体。下面是最最小的仪表面板页面的UI：
# ui.R #library(shinydashboard)
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody())
通过shinyApp()函数可以快速查看R控制台：
# app.R #
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody())
server <- function(input, output) { }
shinyApp(ui, server)
添加实用部分：
## app.R ##
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Basic dashboard"),
dashboardSidebar(),
dashboardBody(
# Boxes need to be put in a row (or column)
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata[seq_len(input$slider)]
hist(data)
})
}
shinyApp(ui, server)
添加侧边栏：
下面将添加性能像tabs的菜单项，这与shiny中的tabPanels相似，当点击菜单栏的时候，将在main body中显示设置的不同的内容。为了实现这种功能，需要做到两点，第一，在侧边栏dashboardSidebar 的sidebarMenu中添加menuItem，并用tabName设置其名称，如下所示：
## Sidebar content
dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", tabName = "widgets", icon = icon("th"))
)
)
第二，在dashboardBody中添加tabItem和tabItems，并设置tabName:
## Body content
dashboardBody(
tabItems(
# First tab content第一个标签内容
tabItem(tabName = "dashboard",
fluidRow(
box(plotOutput("plot1", height = 250)),
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
),
# Second tab content第二个标签内容
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
默认显示为“Dashboard”菜单：
当点击“Widgets”时：
3.结构---Shiny and HTML
To understand how the parts of a dashboard work together, we first need to know how a Shiny UI is built, and how it relates to the HTML of a web page.在Shiny中的HTML标签函数,比如div()和p()返回的对象可以呈现为HTML。例如,当您在R控制台运行这些命令,它将打印HTML:
# A basic div
div(class = "my-class", "Div content")
## <div class="my-class">Div content</div>
# Nested HTML tags
div(class = "my-class", p("Paragraph text"))
## <div class="my-class">
## <p>Paragraph text</p>
## </div>
一些函数返回更复杂的HTML片段,他们使用户不必知道所有的所需的HTML来龙去脉创建诸如文本输入或者侧边栏:
textInput("Id", "Label")
## <div class="form-group shiny-input-container">
## <label for="Id">Label</label>
## <input id="Id" type="text" class="form-control" value=""/>
## </div>
sidebarPanel(
div("First div"),
div("Second div")
)
## <div class="col-sm-4">
## <form class="well">
## <div>First div</div>
## <div>Second div</div>
## </form>
## </div>
Shiny app的UI构建这些HTML。shinydashboard包提供了一组函数用来创建HTML,将生成一个仪表板。如果你复制一个仪表板页面的UI代码(上图)粘贴到R控制台,它将打印仪表板的HTML代码。
3.1结构概述
仪表盘dashboardPage()函数三个组件:头,侧边栏,身体:
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
对于更复杂的APP,APP划分成块可以让它更可读:
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody()
dashboardPage(header, sidebar, body)
下面分别介绍上面的三个部分
3.2Header
标题可以有一个标题和下拉菜单,例子:
设置该标题比较简单，仅需要使用title参数：
dashboardHeader(title = "My Dashboard")
dropdownMenu()函数生成下拉菜单。有三种类型的菜单——消息message、通知notification和任务tasks,每个菜单必须用相应类型的项填充。
3.2.1消息message菜单
在dropdownMenu()函数中添加messageItem()函数，messageItem()中包含消息菜单需要的值（from和message，form指的是消息来源，message指的是消息内容）。您还可以控制图标和通知时间字符串。默认情况下,图标是一个人的轮廓。(关于如何设置icon图标，在后面的外观中会有详细的介绍)字符串可以是任何文本。例如,它可能是一个相对的日期/时间像“5分钟”,“今天”,或“昨天中午12:30”,或者一个绝对时间,像“2014-12-01 13:45”。
dropdownMenu(type = "messages",
messageItem(
from = "Sales Dept",
message = "Sales are steady this month."
),
messageItem(
from = "New User",
message = "How do I register?",
icon = icon("question"),
time = "13:45"
),
messageItem(
from = "Support",
message = "The new server is ready.",
icon = icon("life-ring"),
time = "2014-12-01"
)
)
显示动态内容
在大多数情况下,你会想要动态的内容。这意味着在服务器端生成HTML内容,发送到客户端表现。在UI代码,可以使用dropdownMenuOutput是这样的:
dashboardHeader(dropdownMenuOutput("messageMenu"))
在服务器端,您在renderMenu中会生成整个菜单,如下:
output$messageMenu <- renderMenu({
# 此处生成每一个messageItems到list. This assumes
# 假设messageData是一个带有两列的数据框(data frame),两列显示的内容分别是'from' and 'message'.
msgs <- apply(messageData, 1, function(row) {
messageItem(from = row[["from"]], message = row[["message"]])
})
# 这相当于调用:
# dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...)
dropdownMenu(type = "messages", .list = msgs)
})
对于交互式的例子,使用帮助?renderMenu.
动态显示sliderbarMenu:
library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody()
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Menu item", icon = icon("calendar"))
)
})
}
shinyApp(ui, server)
动态显示dropdownMenu:
library(shiny)
library(shinydashboard)
# ========== Dynamic dropdownMenu ==========
# Example message data in a data frame
messageData <- data.frame(
from = c("Admininstrator", "New User", "Support"),
message = c(
"Sales are steady this month.",
"How do I register?",
"The new server is ready."
),
stringsAsFactors = FALSE
)
ui <- dashboardPage(
dashboardHeader(
title = "Dynamic menus",
dropdownMenuOutput("messageMenu")
),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
output$messageMenu <- renderMenu({
msgs <- apply(messageData, 1, function(row) {
messageItem(
from = row[["from"]],
message = paste(row[["message"]], input$slider)
)
})
dropdownMenu(type = "messages", .list = msgs)
})
}
shinyApp(ui, server)
下面是一个Shiny定制版本的动态UI，更多关于使用动态UI,看到这个例子：
UI.R
library(shiny)
shinyUI(fluidPage(
titlePanel("Dynamically generated user interface components"),
fluidRow(
column(3, wellPanel(
selectInput("input_type", "Input type",
c("slider", "text", "numeric", "checkbox",
"checkboxGroup", "radioButtons", "selectInput",
"selectInput (multi)", "date", "daterange"
)
)
)),
column(3, wellPanel(
# This outputs the dynamic UI component
uiOutput("ui")
)),
column(3,
tags$p("Input type:"),
verbatimTextOutput("input_type_text"),
tags$p("Dynamic input value:"),
verbatimTextOutput("dynamic_value")
)
)
))
server.R
library(shiny)
shinyServer(function(input, output) {
output$ui <- renderUI({
if (is.null(input$input_type))
return()
# Depending on input$input_type, we'll generate a different # UI component and send it to the client.
switch(input$input_type,
"slider" = sliderInput("dynamic", "Dynamic",
min = 1, max = 20, value = 10),
"text" = textInput("dynamic", "Dynamic",
value = "starting value"),
"numeric" = numericInput("dynamic", "Dynamic",
value = 12),
"checkbox" = checkboxInput("dynamic", "Dynamic",
value = TRUE),
"checkboxGroup" = checkboxGroupInput("dynamic", "Dynamic",
choices = c("Option 1" = "option1",
"Option 2" = "option2"),
selected = "option2"
),
"radioButtons" = radioButtons("dynamic", "Dynamic",
choices = c("Option 1" = "option1",
"Option 2" = "option2"),
selected = "option2"
),
"selectInput" = selectInput("dynamic", "Dynamic",
choices = c("Option 1" = "option1",
"Option 2" = "option2"),
selected = "option2"
),
"selectInput (multi)" = selectInput("dynamic", "Dynamic",
choices = c("Option 1" = "option1",
"Option 2" = "option2"),
selected = c("option1", "option2"),
multiple = TRUE
),
"date" = dateInput("dynamic", "Dynamic"),
"daterange" = dateRangeInput("dynamic", "Dynamic")
)
})
output$input_type_text <- renderText({
input$input_type
})
output$dynamic_value <- renderPrint({
str(input$dynamic)
})
})
显示如下：
3.2.2通知notification
在dropdownMenu()函数中添加notificationItem()来包含一个文本通知。您还可以控制图标和状态的颜色。关于如何控制在后面会详细介绍。
dropdownMenu(type = "notifications",
notificationItem(
text = "5 new users today",
icon("users")
),
notificationItem(
text = "12 items delivered",
icon("truck"),
status = "success"
),
notificationItem(
text = "Server load at 86%",
icon = icon("exclamation-triangle"),
status = "warning"
)
)
动态交互：
library(shiny)
library(shinydashboard)
# ========== Dynamic dropdownMenu ==========
# Example message data in a data frame
messageData <- data.frame(
text = c("5 new users today", "12 items delivered", "Server load at 86%"),
status = c(
"success",
"warning",
"warning"
),
stringsAsFactors = FALSE
)
ui <- dashboardPage(
dashboardHeader(
title = "Dynamic menus",
dropdownMenuOutput("notificationsMenu")
),
dashboardSidebar(),
dashboardBody(
fluidRow(
box(
title = "Controls",
sliderInput("slider", "Number of observations:", 1, 100, 50)
)
)
)
)
server <- function(input, output) {
output$notificationsMenu <- renderMenu({
msgs <- apply(messageData, 1, function(row) {
notificationItem(
text = row[["text"]],
status = row[["status"]]
)
})
dropdownMenu(type = "notifications", .list = msgs)
})
}
shinyApp(ui, server)
3.2.3任务tasks菜单
任务项有一个进度条和一个文本标签。您还可以指定进度条的颜色，你可以使用? validColors列出可以有效的颜色。
|
red yellow aqua blue light-blue green navy teal olive lime orange fuchsia purple maroon black |
代码如下：
dropdownMenu(type = "tasks", badgeStatus = "success",
taskItem(value = 90, color = "green",
"Documentation"
),
taskItem(value = 17, color = "aqua",
"Project X"
),
taskItem(value = 75, color = "yellow",
"Server deployment"
),
taskItem(value = 80, color = "red",
"Overall project"
)
)
3.2.4禁用标题头
如果你不想显示标题栏,您可以禁用它:
dashboardHeader(disable = TRUE)
3.3Sidebar
侧边栏通常用于快速导航，它包含像tabPanel标签的菜单项,、以及shiny的输入,如滑块和文本输入等，如下图所示：
3.3.1侧边栏菜单项和选项卡
侧边栏中的链接可以像shiny中的tabPanels使用。也就是说,当你点击一个链接,它将在仪表板的主体中显示不同的内容。下面是一个tabPanel的简单例子:
当用户单击其中一个菜单项,它转换显示在主体中的内容：
这些菜单项都放在sidebarMenu()方法中,如下所示。利用tabItem匹配一个menuItem,确保他们有可以匹配的tabName值。
## ui.R ##
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
# Put them together into a dashboardPage
dashboardPage(
dashboardHeader(title = "Simple tabs"),
sidebar,
body
)
menuItem有一个图标icon选项, 由shiny的icon ()函数创建。(更多信息在后面会详细介绍。)badgeLabel和badgeColor为选项标记，分别是表示名和标记显示颜色。一个menuItem除了控制标签可以做其他的事情;它还可以包含一个外部链接的内容,如果你为href提供一个值。默认情况下,这些外部链接打开一个新的浏览器标签或窗口;这可以通过newtab选项达到效果。
menuItem("Source code", icon = icon("file-code-o"),
href = "https://github.com/rstudio/shinydashboard/")
下面为示例：
library(shiny)
library(shinydashboard)
# ========== Dynamic dropdownMenu ==========
# Example message data in a data frame
messageData <- data.frame(
text = c("5 new users today", "12 items delivered", "Server load at 86%"),
status = c(
"success",
"warning",
"warning"
),
stringsAsFactors = FALSE
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green"),
menuItem("百度搜索", icon = icon("file-code-o"),
href = "http://www.baidu.com")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
ui <- dashboardPage(
dashboardHeader(
title = "Dynamic menus",
dropdownMenuOutput("notificationsMenu")
),
sidebar,
body
)
server <- function(input, output) {
output$notificationsMenu <- renderMenu({
msgs <- apply(messageData, 1, function(row) {
notificationItem(
text = row[["text"]],
status = row[["status"]]
)
})
dropdownMenu(type = "notifications", .list = msgs)
})
}
shinyApp(ui, server)
3.3.2动态内容
侧边栏菜单可以动态生成,renderMenu和sidebarMenuOutput。下面是一个示例应用程序与一个侧边栏,是在服务器端生成的。
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenuOutput("menu")
),
dashboardBody()
)
server <- function(input, output) {
output$menu <- renderMenu({
sidebarMenu(
menuItem("Menu item", icon = icon("calendar"))
)
})
}
shinyApp(ui, server)
也可以动态生成个人物品:
ui <- dashboardPage(
dashboardHeader(title = "Dynamic sidebar"),
dashboardSidebar(
sidebarMenu(
menuItemOutput("menuitem")
)
),
dashboardBody()
)
server <- function(input, output) {
output$menuitem <- renderMenu({
menuItem("Menu item", icon = icon("calendar"))
})
}
shinyApp(ui, server)
3.3.3侧边栏加入输入项
侧边栏也可以包含普通的输入,如sliderInput和textInput：
shinydashboard还包括一个特殊类型的输入,sidebarSearchForm,如上面的截图所示，有一个搜索项。这本质上是一个特殊格式化的文本输入和actionButton动作按钮，它显示为一个放大镜图标(图标可以通过icon改变)。
sidebarSearchForm(textId = "searchText", buttonId = "searchButton",
label = "Search...")
对于这个搜索表单,相应的值在服务器端代码输入，分别是inputsearchText和inputsearchText和input searchButton。
library(shiny)
library(shinydashboard)
ui<-dashboardPage(
dashboardHeader(title = "Sidrbar inputs"),
dashboardSidebar(
sidebarSearchForm(textId = "searchText", buttonId = "searchButton",
label = "Search..."),
sliderInput("slider", "Slider:", 1, 100, 50),
textInput("text", "Text input:")
),
dashboardBody(
h2("鸢尾花数据集作图")
)
)
server <- function(input, output){}
shinyApp(ui,server)
3.3.4隐藏侧边栏
dashboardSidebar(disable = TRUE)
3.4Body
仪表板页面的主体可以包含任何常规的shiny内容。然而,如果你创建一个仪表板你可能会想要更加结构化的东西。大部分仪表板的基本构建块是box。box反过来可以包含任何内容。
Boxes
boxes是主要的仪表板页面的构建块。box()函数可以创建一个基本的框,box的内容可以(大多数)是任何shiny的UI内容。
在一个典型的仪表板中,这些boxes将被放置在一个fluidRow()函数体中(稍后我们会看到更多关于仪表板布局介绍):
# This is just the body component of a dashboard
dashboardBody(
fluidRow(
box(plotOutput("plot1")),
box(
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)
)
)
完整程序如下：
library(shiny)
library(shinydashboard)
ui<-dashboardPage(
dashboardHeader(title = "Sidrbar inputs"),
dashboardSidebar(
sidebarSearchForm(textId = "searchText", buttonId = "searchButton",
label = "Search..."),
sliderInput("slider", "Slider:", 1, 100, 50),
textInput("text", "Text input:")
),
dashboardBody(
fluidRow(
box(plotOutput("plot1")),
box(
"Box content here",br(),"More box content",
sliderInput("slider","Slider input:",1,100,50),
textInput("text","Text input:")
)
)
)
)
server <- function(input, output){
set.seed(122)
histdata <- rnorm(500)
output$plot1<-renderPlot({
hist(histdata)
})
}
shinyApp(ui,server)
boxes可以使用title和status设置标题和标题条颜色
box(title = "Histogram", status = "primary", plotOutput("plot1", height = 250)),
box(
title = "Inputs", status = "warning",
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)
可以通过solidHeader = TRUE设置固体头（长度一定的solid header）,并通过collapsible=TRU在右上角显示一个最小化按钮（或者称折叠按钮）
box(
title = "Histogram", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "Inputs", status = "warning", solidHeader = TRUE,
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)
如果你想要boxes在顶部没有灰色或彩色栏,使用solidHeader = TRUE，但不设置status参数，即可将上部分的灰色条或者彩色条去掉:
box(
title = "Histogram", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "Inputs", solidHeader = TRUE,
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)
最后，还可以使用background选项设置固定的背景：
box(
title = "Histogram", background = "maroon", solidHeader = TRUE,
plotOutput("plot1", height = 250)
),
box(
title = "Inputs", background = "black",
"Box content here", br(), "More box content",
sliderInput("slider", "Slider input:", 1, 100, 50),
textInput("text", "Text input:")
)