Census app views

在Shiny App中需要加载数据、R脚本和包。

# #数据

counties.rds 是美国每个州的人口数据集，收集在R 包 UScensus2010，也可以直接下载：here.

counties.rds数据：

• 每个州的名字
• 每个州的总人口
• 每个州居民中白人、黑人、西班牙裔或亚裔的百分比

如果当前要创建一个census-app Shiny app

• 在census-app下创建一个data文件夹，放置数据

  App folder with data subfolder

数据导入：

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可以绘制一个人口分布地图，使用颜色展示人口的变化。

# Note: percent map is designed to work with the counties data set
# It may not work correctly with other data sets if their row order does 
# not exactly match the order in which the maps package plots counties
percent_map <- function(var, color, legend.title, min = 0, max = 100) {

  # generate vector of fill colors for map
  shades <- colorRampPalette(c("white", color))(100)
  
  # constrain gradient to percents that occur between min and max
  var <- pmax(var, min)
  var <- pmin(var, max)
  percents <- as.integer(cut(var, 100, 
    include.lowest = TRUE, ordered = TRUE))
  fills <- shades[percents]

  # plot choropleth map
  map("county", fill = TRUE, col = fills, 
    resolution = 0, lty = 0, projection = "polyconic", 
    myborder = 0, mar = c(0,0,0,0))
  
  # overlay state borders
  map("state", col = "white", fill = FALSE, add = TRUE,
    lty = 1, lwd = 1, projection = "polyconic", 
    myborder = 0, mar = c(0,0,0,0))
  
  # add a legend
  inc <- (max - min) / 4
  legend.text <- c(paste0(min, " % or less"),
    paste0(min + inc, " %"),
    paste0(min + 2 * inc, " %"),
    paste0(min + 3 * inc, " %"),
    paste0(max, " % or more"))
  
  legend("bottomleft", 
    legend = legend.text, 
    fill = shades[c(1, 25, 50, 75, 100)], 
    title = legend.title)
}

helpers.R下载：here

helpers.R中需要调用 maps 和mapprojR 包。

install.packages(c("maps", "mapproj"))

helpers.R中有一个percent_map函数，参数如下：

Argument	Input
var	a column vector from the counties.rds dataset
color	any character string you see in the output of colors()
legend.title	A character string to use as the title of the plot’s legend
max	A parameter for controlling shade range (defaults to 100)
min	A parameter for controlling shade range (defaults to 0)

library(maps)
library(mapproj)
source("census-app/helpers.R")
counties <- readRDS("census-app/data/counties.rds")
percent_map(counties$white, "darkgreen", "% White")

Percent white map

#加载文件和文件路径

• 在上面的代码中，首先导入了需要的r包：

library(maps)
library(mapproj)

调用helpers.R

source("census-app/helpers.R")

• 导入数据：

counties <- readRDS("census-app/data/counties.rds")
percent_map(counties$white, "darkgreen", "% White")

注：在运行server.R，默认的工作路径是server.R保存的位置，所以上面运行source("helpers.R")也可以

#执行

第一次调用runApp时，Shiny会运行整个脚本。

Run once

每当新的用户访问应用程序,Shiny 就会运行server一次，为每个用户构建一组不同的响应对象。

Run once per user

当用户使用工具交互并更改值时，Shiny将会重新运行分配给每个反应对象的R表达式，这些反应对象依赖于值被改变的工具。如果用户非常活跃，这些表达式可能会在一秒钟内多次重新运行。

Run many times

程序运行的额规律：

• 当启动应用时，shinyApp函数会运行一次
• 每当用户访问应用程序时，server就会运行一次
• render*函数内的R表达式会运行很多次。每当用户更改小部件的值时，Shiny就会运行它们一次。

这些信息对构建程序有很大的帮助：

• 运行R脚本、加载库和读取数据集在app.R中的位置应该是在server外，Shiny将只运行这段代码一次。
• 定义与用户特定的对象在server中，应该在render*外。
• render中代码运行次数最多，shiny app每一次改变都会运行一次。通常应该避免在render函数中放置不需要的代码。这样做会减慢整个应用程序的速度。

#census-app展示

# 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)

Census app

#总结：

• 放置app.R的位置将会是Shiny app的工作目录
• server前的代码只会在Shiny 中运行一次
• server中的代码会多次运行，代码太多会使程序运行速度减慢

系列文章：
R shiny教程-1：一个 Shiny app的基本组成部分
R shiny教程-2：布局用户界面
R shiny教程-3：添加小部件到Shiny App
R shiny教程-4：Shiny app响应式结果展示
Shiny Server安装