第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 Scaling ex.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:111 for (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届分化程度较轻,因为这种情况很有可能是其他因素(比如观察值的数量等)影响的。