1.Shiny和HTML
Shiny UI的構建方式和網頁HTML的對應關系。
div(class = "my-class", "Div content")
對應
<div class="my-class">Div content</div>
div(class = "my-class", p("Paragraph text"))
對應
<div class="my-class">
<p>Paragraph text</p>
</div>
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應用程序的UI是基於這些HTML代碼構建的，我們順便拷貝上面一段代碼到R控制台中運行，都會得到相應的HTML代碼：
2.結構
上一節已經講了有標題、側邊欄和正文三個結構嵌套在dashboardPage函數中：
dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody()
)
有些稍微復雜的程序，為了結構更清晰，可讀性更強（層次結構多，括號個數配對以及逗號經常出錯），可以將三部分拆開來寫：
header <- dashboardHeader()
sidebar <- dashboardSidebar()
body <- dashboardBody()
dashboardPage(header, sidebar, body)
3. 標題Header
dashboardHeader函數主要對標題title和下拉菜單dropdownMenu()函數（包含message/notification/task）進行設置。
## Only run this example in interactive R sessions
if (interactive()) {
library(shiny)
# A dashboard header with 3 dropdown menus
header <- dashboardHeader(
title = "Dashboard Demo",
# Dropdown menu for messages
dropdownMenu(type = "messages", badgeStatus = "success",
messageItem("Support Team",
"This is the content of a message.",
time = "5 mins"
),
messageItem("Support Team",
"This is the content of another message.",
time = "2 hours"
),
messageItem("New User",
"Can I get some help?",
time = "Today"
)
),
# Dropdown menu for notifications
dropdownMenu(type = "notifications", badgeStatus = "warning",
notificationItem(icon = icon("users"), status = "info",
"5 new members joined today"
),
notificationItem(icon = icon("warning"), status = "danger",
"Resource usage near limit."
),
notificationItem(icon = icon("shopping-cart", lib = "glyphicon"),
status = "success", "25 sales made"
),
notificationItem(icon = icon("user", lib = "glyphicon"),
status = "danger", "You changed your username"
)
),
# Dropdown menu for tasks, with progress bar
dropdownMenu(type = "tasks", badgeStatus = "danger",
taskItem(value = 20, color = "aqua",
"Refactor code"
),
taskItem(value = 40, color = "green",
"Design new layout"
),
taskItem(value = 60, color = "yellow",
"Another task"
),
taskItem(value = 80, color = "red",
"Write documentation"
)
)
)
shinyApp(
ui = dashboardPage(
header,
dashboardSidebar(),
dashboardBody()
),
server = function(input, output) { }
)
}
右上角分別對應三個下拉菜單，分別為message/notification/task。
如果要對上面的message進行動態顯示，需要用數據對它進行渲染：
## ui.R ##
dashboardHeader(dropdownMenuOutput("messageMenu"))
## server.R ##
output$messageMenu <- renderMenu({
# Code to generate each of the messageItems here, in a list. This assumes
# that messageData is a data frame with two columns, 'from' and 'message'.
msgs <- apply(messageData, 1, function(row) {
messageItem(from = row[["from"]], message = row[["message"]])
})
# This is equivalent to calling:
# dropdownMenu(type="messages", msgs[[1]], msgs[[2]], ...)
dropdownMenu(type = "messages", .list = msgs)
})
如果不想顯示標題Header，可用：
dashboardHeader(disable = TRUE)
4. 側邊欄Siderbar
通過使用側邊欄的菜單項sidebarMenu函數來設置，但要注意側邊欄中menuItem的tabName和主體中tabItem的tabName對應起來。
## ui.R ##
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Widgets", icon = icon("th"), tabName = "widgets",
badgeLabel = "new", badgeColor = "green"),
menuItem("Source code", icon = icon("file-code-o"), #建立超鏈接
href = "https://github.com/rstudio/shinydashboard/")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "dashboard",
h2("Dashboard tab content")
),
tabItem(tabName = "widgets",
h2("Widgets tab content")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "Simple tabs"),
sidebar,
body
),
server = function(input, output) { }
)
動態生成側邊欄菜單或者側邊欄中單個項目，做相應的渲染：
## 渲染sidebarMenu ##
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)
## 渲染menuItem ##
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)
側邊欄的輸入包括：
- silderInput
- textInput
- sidebarSearchForm （一種特殊格式的文本輸入）
禁用側邊欄：
dashboardSidebar(disable=TRUE)
5.主體/正文Body
可包含任何常規的shiny內容，大部分dashboard的基本單元是box，box可以包含任何內容。
box
一般box放在fuidRow內：
# 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:")
)
)
)
box可添加標題title和標題欄顏色status：
box(title = "Histogram", status = "primary", plotOutput("plot2", 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:")
)
box可固定標題solidHeader=TRUE，可顯示折疊按鈕collapsible=TRUE：
box(
title = "Histogram", status = "primary", solidHeader = TRUE,
collapsible = TRUE,
plotOutput("plot3", 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:")
)
box還可添加背景background：
box(
title = "Histogram", background = "maroon", solidHeader = TRUE,
plotOutput("plot4", 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:")
)
tabBox
與shiny中的tabsetPanel類似，用來顯示不同內容塊。以tabPanel函數輸入，分配一個id，比如id設為tabset1，則訪問時使用input$tabset1。還可設置高度，寬度和標題，以及選項卡出現在哪一側side，當side設為right時選項卡順序會變得從右到左。
body <- dashboardBody(
fluidRow(
tabBox(
title = "First tabBox",
# The id lets us use input$tabset1 on the server to find the current tab
id = "tabset1", height = "250px",
tabPanel("Tab1", "First tab content"),
tabPanel("Tab2", "Tab content 2")
),
tabBox(
side = "right", height = "250px",
selected = "Tab3",
tabPanel("Tab1", "Tab content 1"),
tabPanel("Tab2", "Tab content 2"),
tabPanel("Tab3", "Note that when side=right, the tab order is reversed.")
)
),
fluidRow(
tabBox(
# Title can include an icon
title = tagList(shiny::icon("gear"), "tabBox status"),
tabPanel("Tab1",
"Currently selected tab from first box:",
verbatimTextOutput("tabset1Selected")
),
tabPanel("Tab2", "Tab content 2")
)
)
)
shinyApp(
ui = dashboardPage(
dashboardHeader(title = "tabBoxes"),
dashboardSidebar(),
body
),
server = function(input, output) {
# The currently selected tab from the first box
output$tabset1Selected <- renderText({
input$tabset1
})
}
)
infoBox
一種顯示帶有圖標的簡單數字或文本的特殊框，可以是靜態也可是動態。我認為用得應該不是很多，但也把代碼和示意圖貼出，感興趣可看看infoBox的參數：
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Info boxes"),
dashboardSidebar(),
dashboardBody(
# infoBoxes with fill=FALSE
fluidRow(
# A static infoBox
infoBox("New Orders", 10 * 2, icon = icon("credit-card")),
# Dynamic infoBoxes
infoBoxOutput("progressBox"),
infoBoxOutput("approvalBox")
),
# infoBoxes with fill=TRUE
fluidRow(
infoBox("New Orders", 10 * 2, icon = icon("credit-card"), fill = TRUE),
infoBoxOutput("progressBox2"),
infoBoxOutput("approvalBox2")
),
fluidRow(
# Clicking this will increment the progress amount
box(width = 4, actionButton("count", "Increment progress"))
)
)
)
server <- function(input, output) {
output$progressBox <- renderInfoBox({
infoBox(
"Progress", paste0(25 + input$count, "%"), icon = icon("list"),
color = "purple"
)
})
output$approvalBox <- renderInfoBox({
infoBox(
"Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
color = "yellow"
)
})
# Same as above, but with fill=TRUE
output$progressBox2 <- renderInfoBox({
infoBox(
"Progress", paste0(25 + input$count, "%"), icon = icon("list"),
color = "purple", fill = TRUE
)
})
output$approvalBox2 <- renderInfoBox({
infoBox(
"Approval", "80%", icon = icon("thumbs-up", lib = "glyphicon"),
color = "yellow", fill = TRUE
)
})
}
shinyApp(ui, server)
valueBox
和infoBox類似，除了外觀有所不同。
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(title = "Value boxes"),
dashboardSidebar(),
dashboardBody(
fluidRow(
# A static valueBox
valueBox(10 * 2, "New Orders", icon = icon("credit-card")),
# Dynamic valueBoxes
valueBoxOutput("progressBox"),
valueBoxOutput("approvalBox")
),
fluidRow(
# Clicking this will increment the progress amount
box(width = 4, actionButton("count", "Increment progress"))
)
)
)
server <- function(input, output) {
output$progressBox <- renderValueBox({
valueBox(
paste0(25 + input$count, "%"), "Progress", icon = icon("list"),
color = "purple"
)
})
output$approvalBox <- renderValueBox({
valueBox(
"80%", "Approval", icon = icon("thumbs-up", lib = "glyphicon"),
color = "yellow"
)
})
}
shinyApp(ui, server)
Layouts
簡單理解就是對box進行排布。這里應用的是Bootstrap的網格布局系統，即將主體視為一個划分為12列的區域，這些區域具有相等的寬度和任意數量的行，高度可變。當在網格中放置一個框（或其他項）時，可以指定要占用的12列中有多少列。比如下圖中，第一行框的寬度為4列，第二列框的寬度設為6列。
廣義上講，有兩種布局框的方法：基於行的布局或基於列的布局。
基於行的布局
上圖就是典型的基於行的布局。在基於行的布局中，框box必須位於由創建的行中fluidRow()。行的網格寬度為12，因此具有的框width=4占據寬度的三分之一，具有width=6（默認值）的框占據寬度的一半。
使用基於行的布局時，每行中的框的頂部將對齊，但底部可能不對齊（由每個框的內容決定）。
貼出上圖的代碼：
body <- dashboardBody(
fluidRow(
box(title = "Box title", "Box content"),
box(status = "warning", "Box content")
),
fluidRow(
box(
title = "Title 1", width = 4, solidHeader = TRUE, status = "primary",
"Box content"
),
box(
title = "Title 2", width = 4, solidHeader = TRUE,
"Box content"
),
box(
title = "Title 1", width = 4, solidHeader = TRUE, status = "warning",
"Box content"
)
),
fluidRow(
box(
width = 4, background = "black",
"A box with a solid black background"
),
box(
title = "Title 5", width = 4, background = "light-blue",
"A box with a solid light-blue background"
),
box(
title = "Title 6",width = 4, background = "maroon",
"A box with a solid maroon background"
)
)
)
# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
dashboardHeader(title = "Row layout"),
dashboardSidebar(),
body
)
# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })
可以強制將框box設為相同的高度（這樣更美觀），即指定高度height的像素。（不同於Bootstrap，這里高度是以HTML/CSS來處理的），如將所有盒子都設為相同高度：
box(title = "Box title", height = 300, "Box content"),
基於列的布局
首先是創建一列，然后在這列中放置框。即先用column指定列寬，再設置每個框為width=NULL.
body <- dashboardBody(
fluidRow(
column(width = 4,
box(
title = "Box title", width = NULL, status = "primary",
"Box content"
),
box(
title = "Title 1", width = NULL, solidHeader = TRUE, status = "primary",
"Box content"
),
box(
width = NULL, background = "black",
"A box with a solid black background"
)
),
column(width = 4,
box(
status = "warning", width = NULL,
"Box content"
),
box(
title = "Title 3", width = NULL, solidHeader = TRUE, status = "warning",
"Box content"
),
box(
title = "Title 5", width = NULL, background = "light-blue",
"A box with a solid light-blue background"
)
),
column(width = 4,
box(
title = "Title 2", width = NULL, solidHeader = TRUE,
"Box content"
),
box(
title = "Title 6", width = NULL, background = "maroon",
"A box with a solid maroon background"
)
)
)
)
# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
dashboardHeader(title = "Column layout"),
dashboardSidebar(),
body
)
# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })
行列混合布局
也可以混合使用行和列的布局，如上圖中最上面兩個框按行，其余按列：
body <- dashboardBody(
fluidRow(
box(
title = "Box title", width = 6, status = "primary",
"Box content"
),
box(
status = "warning", width = 6,
"Box content"
)
),
fluidRow(
column(width = 4,
box(
title = "Title 1", width = NULL, solidHeader = TRUE, status = "primary",
"Box content"
),
box(
width = NULL, background = "black",
"A box with a solid black background"
)
),
column(width = 4,
box(
title = "Title 3", width = NULL, solidHeader = TRUE, status = "warning",
"Box content"
),
box(
title = "Title 5", width = NULL, background = "light-blue",
"A box with a solid light-blue background"
)
),
column(width = 4,
box(
title = "Title 2", width = NULL, solidHeader = TRUE,
"Box content"
),
box(
title = "Title 6", width = NULL, background = "maroon",
"A box with a solid maroon background"
)
)
)
)
# We'll save it in a variable `ui` so that we can preview it in the console
ui <- dashboardPage(
dashboardHeader(title = "Mixed layout"),
dashboardSidebar(),
body
)
# Preview the UI in the console
shinyApp(ui = ui, server = function(input, output) { })
Ref：
https://rstudio.github.io/shinydashboard/structure.html