首页 > 代码库 > [读书笔记]机器学习：实用案例解析（9）

[读书笔记]机器学习：实用案例解析（9）

2024-08-17 13:51:15   217人阅读

第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届分化程度较轻，因为这种情况很有可能是其他因素（比如观察值的数量等）影响的。

　

[读书笔记]机器学习：实用案例解析（9）


联系
我们