- A+
2016年末最火的新闻莫过于美国总统大选了,各种社交媒体都被疯狂刷屏。
虽然已经过去好几个月了,但是本小编还是决定来凑个热闹,用R语言来复盘希拉里阿姨和川普大叔各州选票及支持率的分布情况。
本篇内容不涉及深入的文字分析(前天已经推送过一篇报道了),主要以讲解美国选举结果的可视化地图为主,是很干的干货,所以接下来准备好接受眼花缭乱的代码轰炸吧哈哈~_~
加载所需包:
- library("ggplot2")
- library("RColorBrewer")
- library("maptools")
- library("plyr")
- library("rJava")
地图数据读取:
- 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")
以上步骤中前两句代码是我初次练习时使用地图数据提取的美国各州州名及简称数据,导出后用于添加大选的各州选票信息,最后再次导入,整理过的投票信息数据文件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")
接下来将会以四个数据地图的形式向大家展示美国总统大选结果中,各州选票分布,以及各州对希拉里、川普的支持率可视化信息。
美国总统大选各州选举人票数分布:
- 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"
- )
1.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"
- )
希拉里各州选票支持率统计:
- 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
- )
川普各州选票支持率统计:
- 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
- )
支付宝打赏
微信打赏
赏