第9章 MDS：可视化地研究参议员相似性
基于相似性聚类：本章的主旨是，对不同的观测记录，如何理解用距离的概念来阐明它们之间的相似性和相异性。
多维定标技术（multidimensional scaling, MDS），目的是基于观察值之间的距离度量进行聚类。只通过所有点之间的距离度量对数据进行可视化。
MDS处理过程：输入一个包含数据集中任意两点之间距离的距离矩阵，返回一个坐标集合，这个集合可以近似反映每对数据点之间的距离（维度低时信息会有缺失，只能说近似）
下面是一个简单的例子：
#距离度量与多维定标简介#随机产生"用户"-"评分"矩阵set.seed(851982)ex.matrix <- matrix(sample(c(-1, 0, 1), 24, replace = TRUE), nrow = 4, ncol = 6)row.names(ex.matrix) <- c('A', 'B', 'C', 'D')colnames(ex.matrix) <- c('P1', 'P2', 'P3', 'P4', 'P5', 'P6')#将矩阵与本身的转置相乘，得到"用户"与"用户"之间的差异矩阵ex.mult <- ex.matrix %*% t(ex.matrix)#数据点之间的距离矩阵ex.dist <- dist(ex.mult)#classical (Metric) Multidimensional Scalingex.mds <- cmdscale(ex.dist)plot(ex.mds, type = 'n')text(ex.mds, c('A', 'B', 'C', 'D'))
通过记名投票记录对参议员进行聚类：
与上面思路一样，不同参议员之间对法案的赞成、反对、弃权进行分析，得到差异矩阵、距离矩阵、多维定标，进而可视化地展现出来。
加载数据：
library(foreign)library(ggplot2)data.dir <- "ML_for_Hackers/09-MDS/data/roll_call/"data.files <- list.files(data.dir)rollcall.data <- lapply(data.files, function(f) read.dta(paste(data.dir, f, sep = ""), convert.factors = FALSE))#查看行数与列数#dim(rollcall.data[[1]])
对数据进行简单的处理：删除投票数少的观测、简化投票情况：编码123简化为赞成票；编码456简化为反对票；编码7890简化为弃权票
rollcall.simplified <- function(df) { #state编号为99是副总统，因为投票数少所以删除 no.pres <- subset(df, state < 99) #编码1~3简化为赞成票；编码4~6简化为反对票；编码7890简化为弃权票 for (i in 10:ncol(no.pres)) { no.pres[, i] <- ifelse(no.pres[, i] > 6, 0, no.pres[, i]) no.pres[, i] <- ifelse(no.pres[, i] > 0 & no.pres[, i] < 4, 1, no.pres[, i]) no.pres[, i] <- ifelse(no.pres[, i] > 1, -1, no.pres[, i]) } return(as.matrix(no.pres[, 10:ncol(no.pres)]))}rollcall.simple <- lapply(rollcall.data, rollcall.simplified)
计算距离矩阵与多维定标：
多维定标时乘的(-1), 是为了直观，一般认为民主党为左派，共和党为右派
rollcall.dist <- lapply(rollcall.simple, function(m) dist(m %*% t(m)))rollcall.mds <- lapply(rollcall.dist, function(d) as.data.frame((cmdscale(d, k = 2)) * -1))
对rollcall.mds进行简单的处理，方便后续作图
congresses <- 101:111for (i in 1:length(rollcall.mds)) { names(rollcall.mds[[i]]) <- c("x", "y") congress <- subset(rollcall.data[[i]], state < 99) #为统一格式，name只取姓，存入congress.name中 congress.names <- sapply(as.character(congress$name), function(n) strsplit(n, "[, ]")[[1]][1]) #统一name,party转成因子变量，添加国会届数信息 rollcall.mds[[i]] <- transform(rollcall.mds[[i]], name = congress.names, party = as.factor(congress$party), congress = congresses[i])}
以第110届为例，对国会成员进行可视化处理：注意调用rollcall.mds时列表序号由1开始而不是0
这里先创建ggplot对象，存储了基本信息；后面画了两张图，一张是用点的形状表达，另一张用具体名字表达
cong.110 <- rollcall.mds[[10]]base.110 <- ggplot(cong.110, aes(x = x, y = y)) + scale_size(range = c(2,2), guide = "none") + scale_alpha(guide = "none") + theme_bw() + theme(axis.ticks = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(), panel.grid.major = element_blank()) + ggtitle("Roll Call Vote MDS Clustering for 110th U.S. Senate") + xlab("") + ylab("") + scale_shape(name = "Party", breaks = c("100", "200", "328"), labels = c("Dem.", "Rep.", "Ind."), solid = FALSE) + scale_color_manual(name = "Party", values = c("100" = "red", "200" = "blue", "328" = "black"), breaks = c("100", "200", "328"), labels = c("Dem.", "Rep.", "Ind."))print(base.110 + geom_point(aes(shape = party, alpha = 0.75, size = 2)))print(base.110 + geom_text(aes(color = party, alpha = 0.75, label = cong.110$name, size = 2)))
将所有届的图分别画出来，并放在一起比较(facet_wrap()函数可以根据congress将不同届的图分开来画)
all.mds <- do.call(rbind, rollcall.mds)all.plot <- ggplot(all.mds, aes(x = x, y = y)) + geom_point(aes(shape = party, alpha = 0.75, size = 2)) + scale_size(range = c(2,2), guide = "none") + scale_alpha(guide = "none") + theme_bw() + theme(axis.ticks = element_blank(), axis.text.x = element_blank(), axis.text.y = element_blank(), panel.grid.major = element_blank()) + ggtitle("Roll Call Vote MDS Clustering for U.S. Senate (101st - 111th Congress)") + xlab("") + ylab("") + scale_shape(name = "Party", breaks = c("100", "200", "328"), labels = c("Dem.", "Rep.", "Ind."), solid = FALSE) + facet_wrap(~ congress)all.plot
需要注意的是，虽然上图中，101届看起来距离比较近，但是并不能说明两党之间是不分化的，因为相同符号的点（相同的党派）仍然是各自聚在一起而彼此分离的。"看起来比其他图要近"仅仅是因为坐标轴的问题，因为这11张图采用同一尺度的坐标轴。同时，图与图的这些差异也不足以说明101届分化程度较轻，因为这种情况很有可能是其他因素（比如观察值的数量等）影响的。