基于R语言的shiny网页工具开发基础系列-05
后起之秀奔涌而至，欢迎大家在《生信技能树》的舞台分享自己的心得体会！
上面是shiny团队的稿件
l5-更复杂的反应app
创建一个更复杂的依赖R脚本和额外数据的有灵魂的（能反应的）app
使用R脚本和数据
此篇旨在展示如何载入数据，R脚本，包，用来构建app。
构建一个复杂的数据，可视化美国的人口普查数据
看起来像下图
counties.rds
counties.rds是一个包含美国每个县人口统计数据的数据集，使用R包UScensus2010收集，也可从这下载
下载文件后
- 新建一个data文件夹于census-app文件夹中
- 将counties.rds放入data文件夹
目录结构看起来像这样
这个叫counties.rds的数据集包含以下内容
- 美国每个县的名字
- 每个县的总人口
- 该县白人，黑人，西班牙裔或亚裔居民的百分比
counties <- readRDS("census-app/data/counties.rds")
head(counties)
# name total.pop white black hispanic asian
# 1 alabama,autauga 54571 77.2 19.3 2.4 0.9
# 2 alabama,baldwin 182265 83.5 10.9 4.4 0.7
# 3 alabama,barbour 27457 46.8 47.8 5.1 0.4
# 4 alabama,bibb 22915 75.0 22.9 1.8 0.1
# 5 alabama,blount 57322 88.9 2.5 8.1 0.2
# 6 alabama,bullock 10914 21.9 71.0 7.1 0.2
helpers.R
helpers.R是一个帮助你使用地区分布图的R脚本，就像上面的图。地区分布图使用颜色展示变量的地区差异
此例中，helpers.R 将会创建一个percent_map ，一个设计用于匹配counties.rds数据的函数，下载
脚本将会使用maps和mapproj包，如果未安装请安装
install.packages(c("maps", "mapproj"))
helpers.R脚本应存于census-app目录下
helpers.R 脚本中的 percent_map 函数采用五个参数
你可以用percent_map 画各县数据的地区分布图，代码如下
library(maps)
library(mapproj)
source("census-app/helpers.R")
counties <- readRDS("census-app/data/counties.rds")
percent_map(counties$white, "darkgreen", "% White")
注意，上面的代码假设census-app 是工作路径的子目录。
percent_map 画县数据到地区分布图中，绿色的深度代表白人种族的百分比
载入文件和文件路径
如上代码，percent_map 的使用，需要先用 source 函数，然后用readRDS载入counties.rds，还载入了两个包library(maps)和 library(mapproj)
使用shiny也会这样调用这些函数，但是写法略有不同
source和readRDS需要文件路径，文件路径的使用方式在shiny中是不一样的
当shiny运行server中的函数时，会把所有文件路径的起始位置视为server.R所在的路径，换而言之，shiny app会把server.R所在的路径作为工作目录。
因为helpers.R于server.R在同一个路径，可以直接source("helpers.R")
而counties.rds在子目录data文件夹中
counties <- readRDS("data/counties.rds")
载入包可以使用
library(maps)
library(mapproj)
执行
你可以把上面的代码放到app.R脚本中，但是放置的位置会决定他们被运行多少次，进而影响app性能，应为app.R中的某些部分会被更频繁的运行。
第一次启动应用，Shiny会运行整个脚本，R会处理server函数
shiny会保存server函数直到下一个用户到达，每次新用户到来都会从新运行server函数。这个每个用户都有自己独特的反应对象。
当用户与小工具交互，并改变他们的值，shiny会重新运行R表达式，分配给每个依赖于被改变的小工具的值的反应对象，如果用户足够活跃，这些表达式会运行很多很多次。
小小节回顾
- 当启动app，shinyApp 会运行一次
- server函数会在每个用户访问时跑一次
- render*函数中的R表达式跑很多次，shiny在用户改变小工具的值时就会运行他们
通过以上信息，思考怎么写出高效的脚本
提高运行效率
source脚本，载入包，读取数据集应该放在app.R的开头，server函数之外。shiny只会运行这些代码一遍，包含了所有你在server函数中的表达式要调用的东西。
在server函数中定义用户特定的对象，当时不包含在render*函数之中，这种对象是每个用户都需要个人副本的。例如，一个对象包含用户的session information。这部分代码会被每个用户跑一次
只把shiny必须重新运行才能构建对象的代码放入render函数，每次在用户改变小工具的时候，Shiny 会返回render包含的所有相关代码，这将是很频繁的。
总之防止把不必要的代码放入render*函数，拖慢app的速度
练习1
尝试将如下代码插入到下面app.R脚本的正确位置
注意，此练习的结果还不是完整的app，所以无法运行，练习二才会完成
source("helpers.R")
counties <- readRDS("data/counties.rds")
library(maps)
library(mapproj)
# User interface ----
ui <- fluidPage(
titlePanel("censusVis"),
sidebarLayout(
sidebarPanel(
helpText("Create demographic maps with
information from the 2010 US Census."),
selectInput("var",
label = "Choose a variable to display",
choices = c("Percent White", "Percent Black",
"Percent Hispanic", "Percent Asian"),
selected = "Percent White"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(plotOutput("map"))
)
)
# Server logic ----
server <- function(input, output) {
output$map <- renderPlot({
percent_map( # some arguments )
})
}
# Run app ----
shinyApp(ui, server)
完成app
人口普查数据可视化软件有一个反应对象，一个名为"map"的图，有percent_map构建，采用五个参数
- 前三个参数，var, color, 和 legend.title, 取决于选择框小工具的值
- 后两个参数，max和min，取决于滑块小工具的最大值和最小值
下面的server函数展示了一个percent_map反应参数的框架。R的switch函数能随心所欲转换选择框的输出。但是这个脚本是不完整的，没有为color,legend.title,max或者min提供值
注意，此步的这个脚本还不能运行，将在练习二中完成
server <- function(input, output) {
output$map <- renderPlot({
data <- switch(input$var,
"Percent White" = counties$white,
"Percent Black" = counties$black,
"Percent Hispanic" = counties$hispanic,
"Percent Asian" = counties$asian)
percent_map(var = data, color = ?, legend.title = ?, max = ?, min = ?)
})
}
练习二
把上面残缺的代码补充完整
当app部署完成后，保存app.R， 运行 runApp("census-app") 命令，如果一切正常，结果将如下图所示
你将要决定
- 如何为percent_map构建参数值
- 如何放置这些设置参数的代码
赶紧先自己做做吧
回顾
如今，你已经可以使用R脚本，数据集，包创建复杂的app了
有几个要点
- 对于shiny app 来说，app.R脚本所在的路径就是工作目录
- 每次启动，shiny会运行app.R中的代码，server函数之前的部分只会在这个app启动时运行一次
- server之中的代码会运行多次，可能会拖慢app速度
switch是多选项小工具的实用辅助函数，把小工具的值转换成R表达式
我的答案
library(shiny)
source("helpers.R")
counties <- readRDS("data/counties.rds")
library(maps)
library(mapproj)
# User interface ----
ui <- fluidPage(
titlePanel("censusVis"),
sidebarLayout(
sidebarPanel(
helpText("Create demographic maps with
information from the 2010 US Census."),
selectInput("var",
label = "Choose a variable to display",
choices = c("Percent White", "Percent Black",
"Percent Hispanic", "Percent Asian"),
selected = "Percent White"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(plotOutput("map"))
)
)
# Server logic ----
server <- function(input, output) {
output$map <- renderPlot({
data <- switch(input$var,
"Percent White" = counties$white,
"Percent Black" = counties$black,
"Percent Hispanic" = counties$hispanic,
"Percent Asian" = counties$asian)
color <- switch(input$var,
"Percent White" = "#5aae61",
"Percent Black" = "black",
"Percent Hispanic" = "orange",
"Percent Asian" = "#762a83")
title <- switch(input$var,
"Percent White" = "White",
"Percent Black" = "Black",
"Percent Hispanic" = "Orange",
"Percent Asian" = "Purper")
percent_map(var = data, color = color, legend.title = title, max = input$range[2], min = input$range[1])
})
}
shinyApp(ui = ui,server = server)
参考答案
# Load packages ----
library(shiny)
library(maps)
library(mapproj)
# Load data ----
counties <- readRDS("data/counties.rds")
# Source helper functions -----
source("helpers.R")
# User interface ----
ui <- fluidPage(
titlePanel("censusVis"),
sidebarLayout(
sidebarPanel(
helpText("Create demographic maps with
information from the 2010 US Census."),
selectInput("var",
label = "Choose a variable to display",
choices = c("Percent White", "Percent Black",
"Percent Hispanic", "Percent Asian"),
selected = "Percent White"),
sliderInput("range",
label = "Range of interest:",
min = 0, max = 100, value = c(0, 100))
),
mainPanel(plotOutput("map"))
)
)
# Server logic ----
server <- function(input, output) {
output$map <- renderPlot({
data <- switch(input$var,
"Percent White" = counties$white,
"Percent Black" = counties$black,
"Percent Hispanic" = counties$hispanic,
"Percent Asian" = counties$asian)
color <- switch(input$var,
"Percent White" = "darkgreen",
"Percent Black" = "black",
"Percent Hispanic" = "darkorange",
"Percent Asian" = "darkviolet")
legend <- switch(input$var,
"Percent White" = "% White",
"Percent Black" = "% Black",
"Percent Hispanic" = "% Hispanic",
"Percent Asian" = "% Asian")
percent_map(data, color, legend, input$range[1], input$range[2])
})
}
# Run app ----
shinyApp(ui, server)
Reference：
Shiny - Use R scripts and data