shinydashboard与shiny_史上最全（三）

欢迎关注天善智能，我们是专注于商业智能BI，人工智能AI，大数据分析与挖掘领域的垂直社区，学习，问答、求职一站式搞定！

对商业智能BI、大数据分析挖掘、机器学习，python，R等数据领域感兴趣的同学加微信：tstoutiao，邀请你进入数据爱好者交流群，数据爱好者们都在这儿。

作者：李誉辉  

四川大学在读研究生

前言

这是shinydashboard与shiny_史上最全第三篇，

前文回顾：

shinydashboard与shiny_史上最全（一）

 

shinydashboard与shiny_史上最全（二）

第一部分： 

• 1 简介

• 2 shiny文件的创建和运行

• 3 shinydashboard

         3.1 标题栏(Header)

第二部分：

        3.2 输入与输出

        3.3 侧边栏

        3.4 主体(Body)

        3.5 布局(Layouts)

第三部分：

• 4 shiny框架

• 5 选项卡(tabset)

• 6 美化

• 7 CSS语法

第四部分：

• 8 与leaflet结合

• 9 web部署

3.5.3 混合布局

下面的例子是行内包含列，只能是行内含列，而不是列内含有行。
及fluidRow()内~box()与clomn()叠加。
UI端代码如下：

 1library(shiny)
 2library(shinydashboard)
 3
 4# 定义body
 5body <- dashboardBody(
 6  # 第1行
 7  fluidRow(
 8    box(
 9      title = "第1行第1个", width = 6, status = "primary",
10      "primary状态", br(), "宽6"),
11    box(
12      title = "第1行第2个", width = 6, status = "warning", 
13      "primary状态", br(), "宽6")),
14  # 第2行
15  fluidRow(
16    # 第2行第1列
17    column(width = 3, # 宽度为3
18           box(
19             title = "第2行第1列第1个", width = NULL, height = 100, 
20             solidHeader = TRUE, status = "primary",
21             "primary状态", br(), "高100"),
22           box(
23             title = "第2行第1列第2个", width = NULL, heigth = 150, 
24             background = "black",
25             "背景颜色：black", br(), "高150"),
26           box(
27             title = "第2行第1列第3个", width = NULL, heigth = 100, 
28             background = "fuchsia",
29             "背景颜色：fuchsia", br(), "高100")),
30    # 第2行第2列
31    column(width = 4, # 宽度为4
32           box(
33             title = "第2行第2列第1个", width = NULL, height = 150,
34             solidHeader = TRUE, status = "warning",
35             "warning状态", br(), "高150"),
36           box(
37             title = "第2行第2列第2个", width = NULL, height = 200, 
38             background = "light-blue",
39             "背景颜色：light-blue", br(), "高200")),
40    # 第2行第3列
41    column(width = 5, # 宽度为5
42           box(
43             title = "第2行第3列第1个", width = NULL, height = 300, 
44             solidHeader = TRUE,
45             "高度300"),
46           box(
47             title = "第2行第3列第2个", width = NULL, height = 200,
48             background = "maroon",
49             "背景颜色：maroon", br(), "高200")),
50    # 第3行
51    fluidRow(
52      box(
53        title = "第3行第1个", width = 4, status = "primary",
54        "primary状态", br(), "宽4"),
55      box(
56        title = "第3行第2个", width = 8, status = "warning", 
57        "primary状态", br(), "宽8"))
58  )
59)
60
61# 组合
62dashboardPage(
63  dashboardHeader(title = "混合布局"),
64  dashboardSidebar(disable = TRUE), # 
65  dashboardBody(body)
66)

server端代码如下：

1library(shiny)
2
3# 自定义服务器脚本，
4shinyServer(function(input, output) {})

运行结果如下：

4.shiny框架

shiny框架与shinydashboard有很大差别，这里我们将详细说明。

上面这幅图是shiny的主要结构，
panel内可以添加多个Output对象，但都是纵向排列的。
若要横向排列多个对象，需要Layout分列，
再在layout内添加多个panel,再在每个panel中纵向添加多个Output对象。
多个Panel可以嵌套。

布局：

flowLayout(), 表示行排列，前一行排不下的，将自动排列到下一行。

sidebarLayout(), 内含sidebarPanel()和mainPanel()。
相当于去掉标题栏的dashboardPage()。

splitLayout(), 表示水平等分排列，可以指定参数cellWidths(单个对象的宽度)。

verticalLayout(), 表示垂直排列，参数fluid为逻辑值,
TRUE表示长宽不固定，FALSE表示固定长宽。

1library(shiny)

5.选项卡（tabset）

5.1

shinydashboard中的选项卡

shinydashboard只支持1种选项卡：
在侧边栏dashboardSidebar()内，用sidebarMenu()添加一系列menuItem()。
menuItem()即是选项卡按钮，内有参数tabName。
同时，在主体中的tabItems()内，添加一系列tabItem(), tabItem()即选项页面。
内有参数tabName， menuItem()与tabItem()通过参数tabName进行匹配。
menuItem()还可以通过href参数添加网址进行跳转。

tabItem()内可以插入多个任意对象，包括input, box, fluidRow。
下面的例子是我们融合前面已经出现过的例子的代码：

UI端代码：

 1library(shiny)
 2library(shinydashboard)
 3
 4# 定义侧边栏
 5sidebar <- dashboardSidebar(
 6  sidebarMenu(
 7    menuItem(text = "绘图",  # item名字
 8             tabName = "someplots", # 传递到tab的变量名称
 9             icon = icon("images")),
10    menuItem(text = "箱子", 
11             tabName = "someboxes", # 传递到tab的变量名称
12             icon = icon("boxes"), 
13             badgeLabel = "新", badgeColor = "green"), # 徽章标签和颜色 
14    # 增加百度搜索
15    menuItem(text = "百度一下", icon = icon("search"), href = "https://www.baidu.com/")
16  )
17)
18
19# 定义第一个选项卡
20tab1 <- fluidRow(
21  box(plotOutput("gplot_1"), width = 8),
22  box(width = 4,
23      "随便打的文本", # 直接插入文本
24      br(), # 换行符
25      "随便码的文字", # 直接插入文本
26      sliderInput("slider", "请输入观测值数量：", 50, 500, 200), # 插入滑动条
27      textInput("text_1", "请输入标题：", value = "我是标题"), # 插入文本框
28      textInput("text_2", "输入横轴名称：", value = "我是x轴"), # 插入文本框
29      textInput("text_3", "输入纵轴名称：", value = "我是y轴"), # 插入文本框
30      submitButton("提交")) # ggplot2运算复杂，需增加提交按钮
31)
32
33# 定义第2个选项卡内容
34tab2_1 <-  fluidRow(
35  # 静态的infoBox
36  infoBox(title = "定单", value = 10 * 2, icon = icon("credit-card")),
37  # 动态的infoBoxes
38  infoBoxOutput("progressBox"),
39  infoBoxOutput("approvalBox")
40)
41
42tab2_2 <- fluidRow( # 全填充的infoBox, fill = TRUE
43  infoBox(title = "定单", value = 10 * 2, 
44          icon = icon("credit-card"), fill = TRUE),
45  infoBoxOutput("progressBox2"),
46  infoBoxOutput("approvalBox2")
47)
48
49tab2_3 <- fluidRow( # 计数按钮：点击这个会增加数量
50  box(width = 4, actionButton("addtion", label = "增加赞", icon = icon("plus"))),
51  box(width = 4, actionButton("minus", label = "减少赞", icon = icon("minus")))
52)
53
54# 定义主体
55body <- dashboardBody(
56  tabItems(
57    tabItem(tabName = "someplots", # 根据menuItem中的tabName进行联动
58            tab1), # 插入选项卡内容
59    tabItem(tabName = "someboxes", # 根据menuItem中的tabName进行联动
60            h2("随便码几个字"), br(), tab2_1, tab2_2, tab2_3) # 插入选项卡内容
61  )
62)
63
64# 组合在一起
65dashboardPage(
66  dashboardHeader(title = "选项卡"),
67  sidebar,
68  body
69)

服务器端脚本：

 1library(shiny)
 2library(ggplot2)
 3library(RColorBrewer)
 4library(showtext)
 5
 6# 自定义服务器脚本，
 7shinyServer(function(input, output) {
 8  # 定义反应表达式，产生数据
 9  datainput <- reactive({
10    data.frame(abc = sample(LETTERS[1:7], size = input$slider, replace = TRUE), 
11               stringsAsFactors = F)
12  })
13
14  # 定义反应表达式：计算点赞量
15  count_thumbs <- reactive({
16    comprehensive <- input$addtion - input$minus
17    if(comprehensive > 0) {
18      positive <- comprehensive 
19      negative <- 0
20    } else {
21      positive <- 0
22      negative <- comprehensive
23    }
24    thumbs_bind <- c(positive, negative)
25  })
26
27  # 添加图片对象
28  output$gplot_1 <- renderPlot({ # 内部可以插入计算代码
29    showtext_auto()
30    ggplot(data = datainput()) + # 注意datainput()括号不能少
31      geom_bar(aes(abc, fill = abc)) +
32      scale_fill_brewer(palette = "Set2") + 
33      labs(title = input$text_1, x = input$text_2, y = input$text_3) + 
34      theme_void() + 
35      theme(
36        plot.title = element_text(colour = "magenta", hjust = 0.5, size = 30),
37        axis.title.x = element_text(colour = "blue", hjust = 0.5, size = 20),
38        axis.title.y = element_text(colour = "blue", hjust = 0.5, angle = 90, size = 20),
39        axis.text = element_text(colour = "black", size = 10)
40      )
41  })
42
43  # 增加infobox
44  output$progressBox <- renderInfoBox({
45    infoBox(
46      title = "变化", value = paste0(25, "%"), 
47      icon = icon("list"), color = "purple")
48  })
49  output$approvalBox <- renderInfoBox({
50    infoBox(
51      title = "赞同", value = 25 + count_thumbs()[1], 
52      icon = icon("thumbs-up"), color = "yellow")
53  })
54
55  # 与上面一样，除了fill=TRUE全填充
56  output$progressBox2 <- renderInfoBox({
57    infoBox(
58      title = "变化", value = paste0(25, "%"), 
59      icon = icon("list"),color = "purple", fill = TRUE)
60  })
61
62  output$approvalBox2 <- renderInfoBox({
63    infoBox(
64      title = "不赞同", value = 25 - count_thumbs()[2], 
65      icon = icon("thumbs-down"), color = "yellow", fill = TRUE)
66  })
67
68})

运行结果：

5.2

shiny中的选项卡

shiny中有3种选项卡类型：

tabsetPanel()，主体顶侧选项卡。函数内含多个tabPanel()对象。

navlistPanel(), 左侧列表选项卡。函数内含多个tabPanel()对象。

navbarPage()，标题栏选项卡。函数内含多个tabPanel()对象。

5.2.1 tabsetPanel()

tabsetPanel()内含多个tabPanel()，1个tabPanel表示一个选项卡。选项卡按钮在页面顶端。
UI端代码如下：

 1library(shiny)
 2
 3# 自定义UI界面，
 4shinyUI(pageWithSidebar(
 5  # 主标题
 6  headerPanel("选项卡"),
 7  # 定义侧边栏,以选择随机分布类型,观测值数量
 8  sidebarPanel(
 9    # 新增单选按钮
10    radioButtons("dist", "分布类型:",  
11                 list("正态分布" = "norm", # 选项卡内容，列表传递，
12                      "均匀分布" = "unif",
13                      "对数正态分布" = "lnorm",
14                      "指数分布" = "exp")),
15    # 使用br()函数以换行，新增滑动条
16    br(),
17    # 新增滑动条
18    sliderInput("n", 
19                "观测值数量:", 
20                value = 500,min = 1, max = 1000)),
21
22  # 自定义输出面板
23  mainPanel(
24    tabsetPanel( # tabsetPanel相当于一种布局
25      tabPanel("绘图", plotOutput("plot")), # 第1个选项卡为"plot"变量图片输出
26      tabPanel("概况", verbatimTextOutput("summary")), # 文本打印输出"summary"变量
27      tabPanel("表格", tableOutput("table")) # 表格输出"table"变量
28    )
29  )
30))

server端代码如下：

 1library(shiny)
 2
 3# 自定义服务器脚本，产生随机分布
 4shinyServer(function(input, output) {
 5  # 定义反应表达式，计算随机分布
 6  data <- reactive({  
 7    dist <- switch(input$dist, # 将单选按钮传入的变量添加到input对象
 8                   norm = rnorm, # 左边是传入变量，右边是赋值给input的变量
 9                   unif = runif,
10                   lnorm = rlnorm,
11                   exp = rexp,
12                   rnorm)
13
14    dist(input$n) # 根据观测值数量，计算距离矩阵
15  })
16
17  # 给output对象增加变量plot
18  output$plot <- renderPlot({ # 内部可以插入计算代码
19    dist <- input$dist
20    n <- input$n
21    # 直方图
22    hist(data(), # 呼应反应表达式，data()括号不能少
23         main=paste('r', dist, '(', n, ')', sep='')) # 标题为分布类型，括号内为观测值数量
24  })
25
26  # 给output对象增加变量summary
27  output$summary <- renderPrint({
28    summary(data())
29  })
30
31  # 给output对象增加变量table
32  output$table <- renderTable({
33    data.frame(x=data())
34  })
35})

运行结果如下：

5.2.2 navlistPanel()

navlistPanel()同样内含几个tabPanel()， 选项卡按钮在页面左侧。
UI端代码如下：

 1library(shiny)
 2
 3shinyUI(fluidPage(
 4  navlistPanel(widths = c(2, 10), # 左边导航条宽度2，右侧主体宽为10
 5    tabPanel("图表", 
 6             splitLayout( # 横向等分面板
 7               mainPanel(
 8                 plotOutput("plot1", height = "400px"), # 默认纵向排列
 9                 plotOutput("plot3", height = "400px")),
10               mainPanel(
11                 plotOutput("plot2", height = "400px"),
12                 plotOutput("plot4", height = "400px")))
13
14    ),
15    tabPanel("概况", verbatimTextOutput("summary")) # 文本打印输出"summary"变量
16  )
17))

server端代码如下：

 1library(shiny)
 2
 3# 自定义服务器脚本，产生随机分布
 4shinyServer(function(input, output) {
 5
 6  # 给output对象增加变量plot1
 7  output$plot1 <- renderPlot({ # 内部可以插入计算代码
 8    dist <- dist(rnorm(1000))
 9    # 直方图
10    hist(dist, main = "正态分布") 
11  })
12
13  # 给output对象增加变量plot2
14  output$plot2 <- renderPlot({ # 内部可以插入计算代码
15    dist <- dist(runif(1000))
16    # 直方图
17    hist(dist, main = "均匀分布") 
18  })
19
20  # 给output对象增加变量plot3
21  output$plot3 <- renderPlot({ # 内部可以插入计算代码
22    dist <- dist(rlnorm(1000))
23    # 直方图
24    hist(dist, main = "对数指数分布") 
25  })
26
27  # 给output对象增加变量plot4
28  output$plot4 <- renderPlot({ # 内部可以插入计算代码
29    dist <- dist(rexp(1000))
30    # 直方图
31    hist(dist, main = "指数分布") 
32  })
33
34  # 给output对象增加变量summary
35  output$summary <- renderPrint({
36    summary(dist(rnorm(1000)))
37  })
38
39})

运行结果如下：

5.2.3 navbarPage()

navbarPage()同样内含几个tabPanel()， 选项卡按钮可以设置在顶部或底部，默认顶部。
UI端代码如下：

 1library(shiny)
 2
 3shinyUI(navbarPage(title = "导航选项卡", 
 4                   selected = "panel2",  # 与tabPanel的value匹配，默认显示哪一个panel
 5                   position = "fixed-bottom", # 设置选项卡按钮在底部。  
 6  tabPanel("图表", value = "panel1",
 7           splitLayout( # 横向等分面板
 8             mainPanel(
 9               plotOutput("plot1", height = "400px"), # 默认纵向排列
10               plotOutput("plot3", height = "400px")),
11             mainPanel(
12               plotOutput("plot2", height = "400px"),
13               plotOutput("plot4", height = "400px")))
14
15  ),
16  tabPanel("概况", value = "panel2", verbatimTextOutput("summary")) # 文本打印输出"summary"变量
17))

server端代码与前小节一样。
运行结果如下：

6.美化

6.1

主题(skin)

shinydashboard的美化非常简单，内置很多主题，或者称为皮肤。
dashboardPage()内含参数skin，用于指定主题颜色。
自带6种主题颜色：“red”, “blue”, “black”, “purple”, “green”, “yellow”。
我们在前面的infobox小节的基础上，进行修改代码。

UI端代码如下：

 1library(shiny)
 2library(shinydashboard)
 3
 4dashboardPage(skin = "green", # 主题颜色为绿色
 5  dashboardHeader(title = "infoBox"),
 6  dashboardSidebar(disable = FALSE), # 以下拉菜单形式输出myMenu变量
 7  dashboardBody(
 8    # 半填充的infoBox, fill=FALSE
 9    fluidRow(
10      # 静态的infoBox
11      infoBox(title = "定单", value = 10 * 2, icon = icon("credit-card")),
12      # 动态的infoBoxes
13      infoBoxOutput("progressBox"),
14      infoBoxOutput("approvalBox")
15    ),
16
17    # 全填充的infoBox, fill = TRUE
18    fluidRow(
19      infoBox(title = "定单", value = 10 * 2, 
20              icon = icon("credit-card"), fill = TRUE),
21      infoBoxOutput("progressBox2"),
22      infoBoxOutput("approvalBox2")
23    ),
24
25    fluidRow(
26      # 计数按钮：点击这个会增加数量
27      box(width = 4, actionButton("addtion", label = "增加赞", icon = icon("plus"))),
28      box(width = 4, actionButton("minus", label = "减少赞", icon = icon("minus")))
29    )
30  )
31)

server端代码与前面一样。
运行结果如下：




skin = "purple"修改为紫色主题：




skin= "red"修改为红色主题：

6.2

侧边栏宽度

在dashboardSidebar()中，有参数width,用来指定侧边栏宽度,用数字指定，单位为像素。
如：dashboardSidebar(width = 350,...)。

6.3

长标题

默认标题的宽度与侧边栏一致，很多时候，我们需要长标题。
在dashboardHeader中，有参数titleWidth用来指定标题宽度，同样是数字，单位是像素。
这样就能将标题宽度与侧边栏宽度解耦。
如：

1dashboardHeader(title = "我是一个long-long-long-long-long-long-long标题", 
2                  titleWidth = 500)

结果如下：

6.4

颜色




7.CSS语法

shiny::tags
shiny自带：

p(), 插入一段文字。

h1(), h2(), h3(), h4(), h5(), h6()。 一级标题到六级标题。

a(), 插入超链接。

br(), 换行符。

div(), 插入统一风格的一段文字(可以是彩色的)。

span(), 用于div()内，风格不一样的文字。

pre(), 固定文字宽度。不会压缩空格之类的。

code(), 插入代码块。

imag(), 插入图片。

stong(), 粗体。

em(), 强调字体。

tags$i(), 斜体。

hr(), 插入一条水平线。

HTML(), 插入需要执行的HTML代码。

7.1

 简单文字，代码，超链接

UI端代码如下：

 1library(shiny)
 2
 3shinyUI(fluidPage(
 4    mainPanel(
 5      h1("一级标题, 水平居中", align = "center"), # 
 6      h2("二级标题, 左对齐", align = "left"),
 7      h3("三级标题，右对齐", align = "right"),
 8      h4("四级标题，水平居中，因为我指定了参数align = center,center需要加双引号", 
 9         align = "center"),
10      h5("五级标题"),
11      h6("六级标题"),
12      p("使用函数p插入一段文字"),
13      strong("使用stong函数插入粗体文字"),
14      em("使用em函数插入斜体文字"),
15      hr(style = "color:red"), # 插入一条红色水平线
16      code("this is a code box, created by code function"),
17      div(paste("div函数插入一段风格统一的文字，这段文字是蓝色的",
18          "因为我在div内设定了参数`style = color:blue`", sep = ""),
19          style = "color:blue"),
20      hr(style = "color:red"),# 插入一条红色水平线
21      br(),
22      p("span函数用于p内，可以插入风格不一样的文字，通过指定style参数", 
23           span("我在span函数内，我的风格不一样,我是红色的", style = "color:red"), 
24        "我在p内，在span后面，我的颜色与span前面一样"), 
25      br(),
26      pre("我用  pre函数  执行,  没有  空格压缩,  我指定了  宽度参数  width=67", 
27          width = 40),
28      p("我用  p函数  执行,  存在  空格压缩, "),
29      br(),
30      a(href = "https://www.baidu.com/", # 前面需要加https://,否在为打开子网页
31        target = "_blank", #target参数表示点击后，超链接的相应方式，_blank表示默认打开新标签页
32        "我是超链接，a创建，百度一下"),
33      br(), 
34      HTML(paste("<p><font color = '#FF00FF' font size = '5' font face = 'Comic sans MS'>",
35                 "我是紫色的5号Comic sans MS字体，用HTML函数插入",
36                 "</font>",
37                 "<br />", # 插入换行符
38                 "<font color = 'red'>",
39                 "我是红色的，用HTML插入",
40                 "</font><p>"), sep = ""),
41      br(),
42      span("我是蓝色粗体字", style = "color:green;font-weight:bold") # 分号隔开
43  )
44))

server端代码如下：

1library(shiny)
2
3shinyServer(function(input, output) {
4})

运行结果如下：

7.2

插入引用

1library(shiny)
2
3shinyUI(fluidPage(
4  mainPanel(
5    tags$blockquote("没想到你个浓眉大眼的，也叛变了革命", cite = "鲁迅")
6  )
7))

7.3

插入图片

插入图片有2种方式：
一种是使用img()嵌入简单的图片，另一种是使用renderImage()后台插入图片。
UI端代码如下：
img嵌入图片，只能用浏览器打开，R自带的打不开。

 1library(shiny)
 2
 3shinyUI(fluidPage(
 4  mainPanel(
 5      img(src = "https://upload.wikimedia.org/wikipedia/commons/thumb/1/1b/R_logo.svg/2000px-R_logo.svg.png", 
 6          height = "200px", width = "200px", align = "center"),
 7      br(),
 8      img(src = "https://i.stack.imgur.com/eddZp.png", 
 9          height = "400px", width = "600px", align = "right", 
10          alt = "图像显示不出来就显示该文本")
11  )
12))

运行结果如下：

7.4

插入框架

插入视频音频都需要插入框架iframe()。

参数如下：

src, HTML内容来源链接。

srcdoc, 嵌入原始HTML文档,直接通过原始的HTML代码生成框架。

scrolling, 框架内是否显示滚动条(yes,no,auto)。

seamless, 是否需要框架看起来像是网页的一部分。

height, width, 指定框架尺寸。

name, 指定框架名称。

下面使用网易云音乐插入框架：

复制其中的src参数。

 1library(shiny)
 2
 3shinyUI(fluidPage(
 4  mainPanel(
 5   strong("一期一会，网易云音乐外链"),
 6   br(),
 7   tags$iframe(src="https://music.163.com/outchain/player?type=2&id=479850552&auto=0&height=66",
 8               height = 80, width = 400, scrolling = "no", seamless = FALSE)
 9  )
10))

7.5

插入音频

 1library(shiny)
 2
 3shinyUI(fluidPage(
 4  mainPanel(
 5   strong("Because of you，临时外链，可能失效"),
 6   br(),
 7   # 后缀为音频后缀格式,使用audio函数
 8   tags$audio(src = "http://other.web.nc01.sycdn.kuwo.cn/resource/n3/95/92/2685144667.mp3", 
 9              type = "audio/mp3", autoplay = FALSE, controls = TRUE),
10   br(),
11   strong("一期一会----周深， 网盘永久外链"),
12   br(),
13   # 后缀不是音频格式，使用
14   tags$iframe(src = "https://www.opendrive.com/player/NDVfOTY5NTY5Ml9BN1ZCbg", 
15               height = 25, width = 297, scrolling = "no", seamless = FALSE),
16   br(),
17   strong("一期一会，网易云音乐外链"),
18   br(),
19   tags$iframe(src="https://music.163.com/outchain/player?type=2&id=479850552&auto=0&height=66",
20               height = 80, width = 400, scrolling = "no", seamless = FALSE)
21  )
22))

浏览器运行结果如下：

——————————————

往期精彩：

你不理解苏大强的作，AI 能吗？

R语言ETL工程：分组（group_by）

使用dplyr进行数据操作（30个实例）

R语言中文社区2018年终文章整理（作者篇）

R语言中文社区2018年终文章整理（类型篇）