作者：杜雨
2016年末最火的新聞莫過于美國總統大選了，各種社交媒體都被瘋狂刷屏。
雖然已經過去好幾個月了，但是本小編還是決定來湊個熱鬧，用R語言來復盤希拉里阿姨和川普大叔各州選票及支持率的分布情況。
本篇內容不涉及深入的文字分析（前天已經推送過一篇報道了），主要以講解美國選舉結果的可視化地圖為主，是很干的干貨，所以接下來準備好接受眼花繚亂的代碼轟炸吧哈哈~_~
加載所需包：
library("ggplot2")
library("RColorBrewer")
library("maptools")
library("plyr")
library("rJava")
地圖數據讀?。?/strong>
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
)
標簽：
本站文章除注明轉載外，均為本站原創或翻譯。歡迎任何形式的轉載，但請務必注明出處、不得修改原文相關鏈接，如果存在內容上的異議請郵件反饋至chenjj@fc6vip.cn
金喜正規買球 
25次
金喜正規買球相關的文章 
微信
在線咨詢
渝公網安備
50010702500608號
客服熱線