基于R语言的shiny网页工具开发基础系列-05

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