用R语言复盘美国总统大选结果~
这两天各种社交媒体都被美国大选的消息刷屏,各种段子满天飞,把平时不怎么关注政治的小编都吸引了。
美国大选的投票数据,给小编的写作提供了非常宝贵的案例数据,毕竟四年才一次哦,这次一定不能放过。
接下来我们用R语言来复盘一下,昨日投票结果吧。
本文将从以下几个方面全方位展示大选的形势:
- 克林顿与希拉里的选举人票结果及其占比;
- 二者的获胜州分布情况、各自在各州的支持率;
- 不同群体及阶层的支持率。
以上可视化图形均为R语言制作,在讲解过程中会共享代码;
library("ggplot2")
library("RColorBrewer")
library("maps")
library("mapdata")
library("maptools")
library("plyr")
library("Cairo")
library("reshape2")
1.1 二者的选举人票结果
data<-data.frame(x=c("Trump","Clinton"),y=c(290,232))
ggplot(data,aes(x,y,fill=x))+
geom_bar(stat="identity",width=0.7)+
geom_text(aes(label=y,vjust=-0.5,hjust=0.5))+
ggtitle("presidential results")+
scale_fill_manual(values=c("#FF5252","#2196F3"))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.line.x = element_line(),
axis.title = element_blank(),
plot.title=element_text(size=25),
legend.position = "none"
)
1.2 两者普选支持人数对比
data1<-data.frame(x=c("Trump","Clinton"),y=c(59698506,59926386))
p %+% data1 #给上图代码赋值为p,使用通道函数%+%简化代码
1.3 两者选举人票得票比例
data3<-data.frame(x=c("Trump","Clinton"),y=c(43,54))
mydata <- transform(data3, mid_y = ave(data3$y,data3$x, FUN = function(val) cumsum(val) - (0.5 * val)))
ggplot(mydata,aes(x=1,y=y,fill=x))+
geom_bar(stat="identity",col="white")+
coord_polar(theta="y",start=0,direction=1) +
geom_text(aes(label=paste(y,"%",sep="")),vjust=-0.5,hjust=0.5,size=10,color="white")+
ggtitle("presidential results")+
guides(fill=guide_legend(reverse=TRUE))+
scale_fill_manual(values=c("#FF5252","#2196F3"))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.line.x = element_line(),
axis.ticks.y = element_blank(),
axis.title = element_blank(),
plot.title=element_text(size=25),
legend.position = "none"
)
2. 二者的获胜州分布情况、各州的支持率;
数据准备:
American_map <-readShapePoly("C:/rstudy/USA_map/STATES.SHP")
AD1 <- American_map@data
AD2 <- data.frame(id=rownames(AD1),AD1)
American_map1 <- fortify(American_map)
American_map_data <- join(American_map1,AD2, type = "full")
American_map_data<-American_map_data[,1:12]
提取各州数据集:
mydata<-data.frame(STATE_NAME=unique(American_map_data$STATE_NAME),STATE_ABBR=unique(American_map_data$STATE_ABBR))
write.table (mydata, file ="D:\R\File\President.csv", sep =",", row.names =FALSE)
newdata<-read.csv("D:\R\File\President.csv")
分离大陆与夏威夷、阿拉斯加:
data1<-subset(American_map_data,STATE_NAME!='Alaska'& STATE_NAME!='Hawaii')
data2<-subset(American_map_data,STATE_NAME=="Hawaii")
data3<-subset(American_map_data,STATE_NAME=="Alaska")
更改阿拉斯加与夏威夷坐标并合并:
data2$long<-data2$long+65
data3$long<-data3$long+40
data3$lat<-data3$lat-42
data4<-rbind(data1,data2,data3)
合并地理信息数据与选举数据:
American_data <- join(data4, newdata, type="full")
提取各州中心经纬度指标:
midpos <- function(AD1){mean(range(AD1,na.rm=TRUE))}
centres <- ddply(American_data,.(STATE_ABBR),colwise(midpos,.(long,lat)))
mynewdata<-join(centres,newdata,type="full")
2.1 美国总统大选的各州选举人票数分布:
ggplot()+
geom_polygon(data=American_data,aes(x=long,y=lat,group=group),colour="grey",fill="white")+
geom_point(data=mynewdata,aes(x=long,y=lat,size=Count,fill=Count),shape=21,colour="black")+
scale_size_area(max_size=10)+
scale_fill_gradient(low="white",high="#D73434")+
coord_map("polyconic") +
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position ="none"
)
2.2 美国总统大选投票结果双方获胜州分布情况:
ggplot(American_data,aes(x=long,y=lat,group=group,fill=Results))+
geom_polygon(colour="white")+
scale_fill_manual(values=c("#19609F","#CB1C2A"),labels=c("Hillary", "Trump"))+
coord_map("polyconic") +
guides(fill=guide_legend(title=NULL))+
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position ="top"
)
2.3 希拉里各州选票支持率统计;
qa <- quantile(na.omit(American_data$Clinton), c(0,0.2,0.4,0.6,0.8,1.0))
American_data$Clinton_q<-cut(American_data$Clinton,qa,labels = c("0-20%", "20-40%","40-60%","60-80%", "80-100%"),include.lowest = TRUE)
ggplot(American_data,aes(long,lat,group=group,fill=Clinton_q))+
geom_polygon(colour="white")+
scale_fill_brewer(palette="Blues")+
coord_map("polyconic") +
guides(fill=guide_legend(reverse=TRUE,title=NULL))+
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position = c(0.18,0.75),
legend.text.align=1
)
2.4 川普各州选票支持率统计;
qb <- quantile(na.omit(American_data$Trump), c(0,0.2,0.4,0.6,0.8,1.0))
American_data$Trump_q<-cut(American_data$Trump,qb,labels = c("0-20%", "20-40%","40-60%","60-80%", "80-100%"),include.lowest = TRUE)
ggplot(American_data,aes(long,lat,group=group,fill=Trump_q))+
geom_polygon(colour="white")+
scale_fill_brewer(palette="Reds")+
coord_map("polyconic") +
guides(fill=guide_legend(reverse=TRUE,title=NULL))+
theme(
panel.grid = element_blank(),
panel.background = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
axis.title = element_blank(),
legend.position = c(0.18,0.75),
legend.text.align=1
)
3. 多维度统计二者支持率;
3.1 性别分布
gender<-data.frame(gender=c("male","female"),clinton=c(41,54),trump=c(53,42))
genderA<-melt(gender,id.vars="gender",variable.name="Name",value.name="level")
ggplot(genderA,aes(gender,level,fill=Name))+
geom_bar(stat="identity",width=0.7)+
geom_text(aes(label=level,vjust=5,hjust=0.5),position="stack",size=10,col="white",fontface="bold")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
从性别上来看,男性支持川普的多一点,女性支持希拉里的多一点,这应该算是性别效应吧~
3.2 年龄分布统计;
age<-data.frame(age=c("18~29","30~44","45~64","64~"),clinton=c(55,50,44,45),trump=c(37,42,53,53))
ageA<-melt(age,id.vars="age",variable.name="Name",value.name="level")
ggplot(ageA,aes(age,level,fill=Name))+
geom_bar(stat="identity",width=0.95)+
geom_text(aes(label=level,vjust=5,hjust=0.5),position="stack",size=10,col="white",fontface="bold")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
这个年龄段分布的也是相当有规律啊,川普大叔很得中老年选民的亲来,而希拉里阿姨则俘获了青少年的心。
3.3 种族分布统计;
race<-data.frame(race=c("white","black","latino","asian","other"),clinton=c(37,88,65,65,56),trump=c(58,8,29,29,37))
raceA<-melt(race,id.vars="race",variable.name="Name",value.name="level")
ggplot(raceA,aes(race,level,fill=Name))+
geom_bar(stat="identity",width=0.95)+
geom_text(aes(label=level,vjust=5,hjust=0.5),position="stack",size=10,col="white")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
从种族上来看,希拉里在black、latino、asian以及其他种族中占据绝对优势,川普则把控着white的选票。
3.4 选民受教育水平分布统计;
educ<-data.frame(educ=c("high","some","college","post"),clinton=c(45,43,49,58),trump=c(51,52,45,37))
educA<-melt(educ,id.vars="educ",variable.name="Name",value.name="level")
ggplot(educA,aes(educ,level,fill=Name))+
geom_bar(stat="identity",width=0.95)+ geom_text(aes(label=level,vjust=5,hjust=0.5),position="stack",size=10,col="white")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
scale_x_discrete(limits=c("high","some","college","post"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
从受教育水平看,希拉里阿姨的选民受教育水平相对较高(单也非绝对,因为这里是CNN做的抽样调查,样本只有24537个,范围较小,并不代表实际情况)。
3.5 选民收入分布统计;
Inco<-data.frame(inco=c("under $100K","above $100K"),clinton=c(49,47),trump=c(45,48))
IncoA<-melt(Inco,id.vars="inco",variable.name="Name",value.name="level")
ggplot(IncoA,aes(inco,level,fill=Name))+
geom_bar(stat="identity",position="dodge")+ geom_text(aes(label=level,vjust=5,hjust=0.5),position=position_dodge(width=0.9),size=10,col="white")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
scale_x_discrete(limits=c("under $100K","above $100K"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
3.6 选民政治倾向分布;
Ideo<-data.frame(ideo=c("liberal","moderate","conservative"),clinton=c(84,52,15),trump=c(10,41,81))
IncoA<-melt(Ideo,id.vars="ideo",variable.name="Name",value.name="level")
ggplot(IncoA,aes(ideo,level,fill=Name))+
geom_bar(stat="identity",position="dodge")+
geom_text(aes(label=level,vjust=5,hjust=0.5),position=position_dodge(width=0.9),size=10,col="white")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
scale_x_discrete(limits=c("liberal","moderate","conservative"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
上图还是比较能反映两党的政治主张的。
3.7 选民的婚姻状况统计分布;
Marl<-data.frame(marry=c("married men","married women","unmarried men","unmarried women"),clinton=c(37,49,46,62),trump=c(58,47,45,33))
MarlA<-melt(Marl,id.vars="marry",variable.name="Name",value.name="level")
ggplot(MarlA,aes(marry,level,fill=Name))+
geom_bar(stat="identity",position="dodge")+
geom_text(aes(label=level,vjust=5,hjust=0.5),position=position_dodge(width=0.9),size=10,col="white")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
scale_x_discrete(limits=c("married men","married women","unmarried men","unmarried women"))+
guides(fill=guide_legend(title=NULL))+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.line.x = element_line(),
axis.title = element_blank()
)
川普在已婚男性选民群体中的支持率有明显优势,而希拉里在未婚女性选民群体中优势明显。
3.8 宗教信仰分布统计;
Rellglon<-data.frame(rell=c("protestant","catholic","mormon","orther christian","jewish","other religon","no religion"),clinton=c(37,45,25,43,71,58,68),trump=c(60,52,61,55,24,33,26))
RellglonA<-melt(Rellglon,id.vars="rell",variable.name="Name",value.name="level")
ggplot(RellglonA,aes(rell,level,fill=Name))+
geom_bar(stat="identity",width=1,col="white")+
scale_fill_manual(values=c("#2196F3","#FF5252"))+
scale_x_discrete(limits=c("protestant","catholic","mormon","orther christian","jewish","other religon","no religion"))+
ylim(-20,100)+
guides(fill=guide_legend(title=NULL))+
coord_polar(theta="x",start=0,direction=1) +
facet_grid(.~Name)+
theme(panel.grid = element_blank(),
panel.background = element_blank(),
axis.text.y = element_blank(),
axis.ticks.length=unit(0.5,'cm'),
axis.ticks.y = element_blank(),
axis.ticks.x = element_line(),
axis.title = element_blank()
)
本文数据来源于CNN官网:http://edition.cnn.com/election/results
因为数据多源于小范围问卷调查(选票数据除外),限于样本范围和地域局限性,结果可能有偏颇。
- Do you kown Asp.Net Core -- 配置Kestrel端口
- 【翻译】在Visual Studio中使用Asp.Net Core MVC创建第一个Web Api应用(二)
- 微信快速开发框架(一)-- 对微信公众平台开发的消息处理
- 微信快速开发框架(二) -- 快速开发微信公众平台框架---简介
- LayoutInflater 布局渲染工具原理分析
- 使用Keras在训练深度学习模型时监控性能指标
- 微信快速开发框架(四)-- 体验微信公众平台快速开发框架
- AsyncTask源码解析
- 微信快速开发框架(五)-- 利用快速开发框架,快速搭建微信浏览博客园首页文章
- 对于小批量梯度下降以及如何配置批量大小的入门级介绍
- 数据结构之二叉树
- 微信快速开发框架(六)-- 微信快速开发框架(WXPP QuickFramework)V2.0版本上线--源码已更新至github
- 数据结构之数组
- Android资源动态加载以及相关原理分析
- JavaScript 教程
- JavaScript 编辑工具
- JavaScript 与HTML
- JavaScript 与Java
- JavaScript 数据结构
- JavaScript 基本数据类型
- JavaScript 特殊数据类型
- JavaScript 运算符
- JavaScript typeof 运算符
- JavaScript 表达式
- JavaScript 类型转换
- JavaScript 基本语法
- JavaScript 注释
- Javascript 基本处理流程
- Javascript 选择结构
- Javascript if 语句
- Javascript if 语句的嵌套
- Javascript switch 语句
- Javascript 循环结构
- Javascript 循环结构实例
- Javascript 跳转语句
- Javascript 控制语句总结
- Javascript 函数介绍
- Javascript 函数的定义
- Javascript 函数调用
- Javascript 几种特殊的函数
- JavaScript 内置函数简介
- Javascript eval() 函数
- Javascript isFinite() 函数
- Javascript isNaN() 函数
- parseInt() 与 parseFloat()
- escape() 与 unescape()
- Javascript 字符串介绍
- Javascript length属性
- javascript 字符串函数
- Javascript 日期对象简介
- Javascript 日期对象用途
- Date 对象属性和方法
- Javascript 数组是什么
- Javascript 创建数组
- Javascript 数组赋值与取值
- Javascript 数组属性和方法
- 答应我,用了这个jupyter插件,别再重复造轮子了
- 商业数据分析从入门到入职(9)Python网络数据获取
- 谈一谈还原解包后小程序页面wxss样式的若干方法
- 什么?不使用selenium爬京东评论?你是不是在骗我
- 骚操作,Python操作PPT,你会吗?
- 用了这个jupyter插件,我已经半个月没打开过excel了
- Mística:一款支持任意协议的应用程序通信工具
- 为什么阿里巴巴禁止使用BigDecimal的equals方法做等值比较?
- 原创 | codefroces中的病毒,这题有很深的trick,你能解开吗?
- 原创 | git的远程分支是干啥的,和本地的有什么区别?
- 京东技术主导:全新架构的分布式事务Hmily 2.1.1发布
- iOS音视频接入-TRTC接入前期key、秘钥等准备
- 你一定不知道的 Linux 使用技巧
- 当 Python 爬虫搭配起 Bilibili 唧唧,奇怪的生产力出现了
- 一个简单的小技巧,监控网页所有动态标签创建的调用处