在课程资源中下载作业素材“WHO数据集”，选取10个你认为具有典型性的国家/地区和10项指标变量，画出热力图展示这10个国家各项指标的情况。
答：
从WHO数据集筛选出如下10个变量：
| 列号 | 列名 | 中文含义 | 分类 |
|---|---|---|---|
| 6 | Gross national income per capita (PPP international $) | 人均GNI | 财富水平 |
| 249 | Income_growth | 收入增长率 | 经济增长 |
| 10 | Population annual growth rate (%) | 人口增长率 | 人口 |
| 130 | Life expectancy at birth (years) both sexes | 预期寿命 | 健康 |
| 5 | Adult literacy rate (%) | 成人识字率 | 教育 |
| 187 | CO2_intensity_of_economic_output | 碳排放率 | 环保 |
| 234 | Gross_capital_formation | 总资本形成率 | 投资 |
| 313 / 9 | Patents_granted / Population (in thousands) total | 千人中专利授予数 | 创新 |
| 217 | Democracy_score | 民主指数 | 政治制度 |
| 253 | Inequality_index | 社会不平等指数 | 社会平等 |
我们感兴趣的国家包括：
| 行号 | 国名 | 中文名 | 所在地区 | 分类 |
|---|---|---|---|---|
| 193 | United States of America | 美国 | 北美 | 发达国家 |
| 61 | Finland | 芬兰 | 欧洲 | 发达国家 |
| 88 | Japan | 日本 | 东亚 | 发达国家 |
| 150 | Russia | 俄罗斯 | 欧洲 | 转轨国家 |
| 37 | China | 中国 | 东亚 | 发展中国家 |
| 80 | India | 印度 | 南亚 | 发展中国家 |
| 25 | Brazil | 巴西 | 拉美 | 发展中国家 |
| 198 | Vietnam | 越南 | 东南亚 | 发展中国家 |
| 82 | Iran (Islamic Republic of) | 伊朗 | 西亚 | 发展中国家 |
| 91 | Kenya | 肯尼亚 | 非洲 | 发展中国家 |
1.抽取上述变量形成新的数据集：
# 读入WHO数据集
who <- read.csv("D:/Rworkspace/WHO.csv", header = T, stringsAsFactors = F)
# 按顺序列出要选取的行和列
rows <- c(193, 61, 88, 150, 37, 80, 25, 198, 82, 91)
cols <- c(1, 6, 249, 10, 130, 5, 187, 234, 313, 217, 253)
# 如果变量名使用中文，编译为HTML文件时会报错，但在R平台中运行则是可以的
# cn<-c('国家','人均国民收入','收入增长率','人口增长率','预期寿命','成人识字率','单位产出碳排放率','投资率','每千人中专利授予数','民主指数','社会不平等指数')
cnames <- c("country", "inc/pop", "inc.gr", "pop.gr", "life.exp", "lit.rate",
"CO2/output", "inv", "patent/pop", "democracy", "inequality")
# 给出国家名称的缩写
country <- c("US", "FI", "JP", "RU", "CN", "IN", "BR", "VN", "IR", "KE")
# 计算每千人中专利授予数
patent_pop <- who[rows, 313]/who[rows, 9]
# 将各组数据汇总于ten数据集中
ten <- cbind(country, who[rows, cols[2:8]], patent_pop, who[rows, cols[10:11]])
# 将原来冗长的变量名修改为简单的
colnames(ten) <- cnames #cn
ten
## country inc/pop inc.gr pop.gr life.exp lit.rate CO2/output inv
## 193 US 44070 2.24 1.0 78 NA 0.50 19.31
## 61 FI 33170 1.74 0.3 79 NA 0.42 20.58
## 88 JP 32840 2.59 0.0 83 NA 0.33 23.37
## 150 RU 12740 NA -0.5 66 99.4 0.95 20.12
## 37 CN 4660 9.50 0.6 73 90.9 1.04 43.86
## 80 IN 2460 7.75 1.5 63 61.0 0.60 33.35
## 25 BR 8700 0.93 1.3 72 88.6 0.22 16.00
## 198 VN 2310 7.17 1.4 72 90.3 0.60 35.57
## 82 IR 9800 NA 1.2 71 82.4 0.70 34.09
## 91 KE 1470 3.38 2.6 53 73.6 0.23 16.58
## patent/pop democracy inequality
## 193 0.552547 10 40.81
## 61 2.202813 10 26.88
## 88 0.937985 10 24.85
## 150 0.126476 7 39.93
## 37 0.016164 -7 46.90
## 80 0.001875 9 36.80
## 25 0.025037 8 56.60
## 198 0.008433 -7 37.05
## 82 0.012537 -6 38.35
## 91 0.002736 8 42.50
2.对数据集进行处理：
（1）补上缺失值：将inc.gr变量中的NA值替换为0（即认为俄罗斯和伊朗的收入增长率为0）；将lit.rate中的缺失值替换为100（即认为这几个发达国家的成人识字率为100%）；
ten[is.na(ten[, 3]), 3] <- 0
ten[is.na(ten[, 6]), 6] <- 100
ten
## country inc/pop inc.gr pop.gr life.exp lit.rate CO2/output inv
## 193 US 44070 2.24 1.0 78 100.0 0.50 19.31
## 61 FI 33170 1.74 0.3 79 100.0 0.42 20.58
## 88 JP 32840 2.59 0.0 83 100.0 0.33 23.37
## 150 RU 12740 0.00 -0.5 66 99.4 0.95 20.12
## 37 CN 4660 9.50 0.6 73 90.9 1.04 43.86
## 80 IN 2460 7.75 1.5 63 61.0 0.60 33.35
## 25 BR 8700 0.93 1.3 72 88.6 0.22 16.00
## 198 VN 2310 7.17 1.4 72 90.3 0.60 35.57
## 82 IR 9800 0.00 1.2 71 82.4 0.70 34.09
## 91 KE 1470 3.38 2.6 53 73.6 0.23 16.58
## patent/pop democracy inequality
## 193 0.552547 10 40.81
## 61 2.202813 10 26.88
## 88 0.937985 10 24.85
## 150 0.126476 7 39.93
## 37 0.016164 -7 46.90
## 80 0.001875 9 36.80
## 25 0.025037 8 56.60
## 198 0.008433 -7 37.05
## 82 0.012537 -6 38.35
## 91 0.002736 8 42.50
（2）对各变量值进行分段：先求出ten数据集中各列的五数总括，再据此将变量值分成4个区间。
# 去掉“country”列
data <- data.matrix(ten[, -1])
# 这里将data的各列逆序排列，是为了在作图时能够实现变量从上往下排列的效果
data <- data[, ncol(data):1]
# 这里必须用以下函数去掉向量中的重复值，否则五数总括里会出现重复值，导致对变量值的分组失败
get.breaks <- function(vec) {
vec = vec[!duplicated(vec)]
fivenum(vec)
}
# 得到与data数据集各列一一对应的五数总括矩阵cuts
cuts <- apply(data, 2, get.breaks)
cuts
## inequality democracy patent/pop inv CO2/output lit.rate life.exp
## [1,] 24.85 -7.0 0.001875 16.00 0.22 61.00 53
## [2,] 36.80 -6.0 0.008433 19.31 0.33 78.00 66
## [3,] 39.14 7.5 0.020600 21.98 0.50 89.45 72
## [4,] 42.50 9.0 0.552547 34.09 0.70 95.15 78
## [5,] 56.60 10.0 2.202813 43.86 1.04 100.00 83
## pop.gr inc.gr inc/pop
## [1,] -0.5 0.00 1470
## [2,] 0.3 1.74 2460
## [3,] 1.1 2.59 9250
## [4,] 1.4 7.17 32840
## [5,] 2.6 9.50 44070
# 根据cuts划分data的变量值，并以1~4的因子水平标记之
for (i in 1:ncol(data)) {
# findInterval(val,breaks)可以实现类似的功能，但生成的区间包括两端的趋于无穷的开区间
data[, i] <- cut(data[, i], cuts[, i], labels = F, include.lowest = T)
}
data
## inequality democracy patent/pop inv CO2/output lit.rate life.exp
## 193 3 4 3 1 2 4 3
## 61 1 4 4 2 2 4 4
## 88 1 4 4 3 1 4 4
## 150 3 2 3 2 4 4 1
## 37 4 1 2 4 4 3 3
## 80 1 3 1 3 3 1 1
## 25 4 3 3 1 1 2 2
## 198 2 1 1 4 3 3 2
## 82 2 1 2 3 3 2 2
## 91 3 3 1 1 1 1 1
## pop.gr inc.gr inc/pop
## 193 2 2 4
## 61 1 1 4
## 88 1 2 3
## 150 1 1 3
## 37 2 4 2
## 80 4 4 1
## 25 3 1 2
## 198 3 3 1
## 82 3 1 3
## 91 4 3 1
3.最后按照划分好的因子水平画出热力图，颜色越深，变量值越大（这里只有4个因子水平，但很容易将其扩展到更多的因子水平）：
# 引入颜色包，并生成所需的颜色
library(RColorBrewer)
pal = brewer.pal(4, "YlOrRd")
# 设置绘图区
par(mar = c(3, 17, 10, 2), oma = c(0.2, 0.2, 0.2, 0.2), mex = 0.5)
# 画出热力图
image(x = 1:nrow(data), y = 1:ncol(data), z = data, xlab = "", ylab = "", col = pal,
axes = FALSE, main = "Socioeconomic Statuses of Ten Countries")
# 画出坐标轴标签
text(x = 1:nrow(data) + 0.25, y = par("usr")[4] + 0.25, srt = 0, adj = 1, labels = ten[,
1], xpd = TRUE)
axis(2, at = 1:ncol(data), labels = colnames(data), col = "white", las = 1)
# 画出色块分割线
# 以下语句将讲义中的1:ncol(data)改为了0:ncol(data)，消除了图左上角和左下角左边未对齐的锯齿
abline(h = c(0:ncol(data)) + 0.5, v = c(0:nrow(data)) + 0.5, col = "white",
lwd = 2, xpd = F)
从图中可以看出，美国等发达国家的收入、寿命、专利、民主等的水平较高，中国则在收入增长、碳排放、投资、社会不平等方面水平较高。除了中国外，发展中国家人口增长都较快。越南投资率较高，巴西社会不平等水平较高，都与中国较为接近。