shiny儀錶盤應用——2016年美國大選數據可視化案例

這是很久以前寫過的一個代碼，內容關於美國大選結果。

當時因為水平有限，代碼寫的一團糟，如今回過頭來整理，結合最近學習的shiny動態儀錶盤，將其整合成了一個完整的在線app界面。

以下是數據整理過程和shinyapp的搭建過程：

library("ggplot2")

library("RColorBrewer")

library("ggthemes")

library("ggmapr")

library("shiny")

library("shinydashboard")

options(stringsAsFactors=FALSE,check.names=FALSE)

newdata<-read.csv("D:/R/File/President.csv")

ggplot(states,aes(long,lat,group=group))+

geom_polygon(fill=NA,col="grey")+

coord_map("polyconic")+

theme_map()

states<-states %>%

filter(NAME!="Puerto Rico") %>%

shift(NAME=="Hawaii",shift_by=c(52.5,5.5))%>%

scale(NAME=="Alaska",scale=0.25,set_to=c(-117,27))%>%

filter(lat>20)

states$NAME<-as.character(states$NAME)

這裡我用了最新發現的可以處理多邊形局部經緯度的包，大大簡化了對美國海外兩州（阿拉斯加和夏威夷）的經緯度移動。

ggplot(states,aes(long,lat,group=group))+

geom_polygon(fill=NA,col="grey")+

coord_map("polyconic")+

theme_map()

合併地圖數據和選舉結果數據：

American_data<-states %>% merge(newdata,by.x="NAME",by.y="STATE_NAME")

獲取各州物理位置中心：

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=15)+

scale_fill_gradient(low="white",high="#D73434")+

coord_map("polyconic") +

theme_map() %+replace% theme(legend.position ="none")

美國總統大選投票結果雙方獲勝州分布情況:

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_map() %+replace% theme(legend.position =c(.5,.9),legend.direction="horizontal")

希拉里各州選票支持率統計：

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_map() %+replace% theme(legend.position = c(0.80,0.05),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_map() %+replace% theme(legend.position = c(0.80,0.05),legend.text.align=1)

下面是shiny儀錶板的構建過程：

設定ui：

ui<-dashboardPage(

dashboardHeader(title="Basic dashboard"),

dashboardSidebar(

sidebarMenu(

menuItem("Electoral Vote", tabName = "dashboard1",icon =icon("dashboard")),

menuItem("Trump VS Clinton",tabName = "dashboard2",icon =icon("dashboard")),

menuItem("Hillarys Vote", tabName = "dashboard3",icon =icon("dashboard")),

menuItem("Trumps Vote", tabName = "dashboard4",icon =icon("dashboard")),

menuItem("Widgets", tabName = "widgets", icon =icon("th"))

)

),

dashboardBody(

tabItems(

tabItem(tabName = "dashboard1",

fluidRow(

box(title="Electoral Vote",plotOutput("plot1", width_=1000, height=750),width =12)

)

),

tabItem(tabName = "dashboard2",

fluidRow(

box(title="Trump VS Clinton",plotOutput("plot2", width_=1000, height=750),width =12)

)

),

tabItem(tabName = "dashboard3",

fluidRow(

box(title="Hillarys Vote",plotOutput("plot3", width_=1000, height=750),width =12)

)

),

tabItem(tabName = "dashboard4",

fluidRow(

box(title="Trumps Vote",plotOutput("plot4", width_=1000, height=750),width =12)

)

),

tabItem(tabName="widgets",

fluidRow(

box(title =h2("About Detials"),h3("In 2016, Donald trump won 290 votes and Hillary Clinton won 228. Donald trump finally won, becoming the 45th President of the United States"),width =12)

)

)

)

)

)

構建服務端代碼：

server <- shinyServer(function(input,output){

output$plot1 <- renderPlot({

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=15)+

scale_fill_gradient(low="white",high="#D73434")+

coord_map("polyconic") +

theme_map(base_size =15, base_family = "") %+replace%

theme(legend.position ="none")

})

output$plot2 <- renderPlot({

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_map(base_size =15, base_family = "") %+replace%

theme(legend.position =c(.5,.9),legend.direction="horizontal")

})

output$plot3 <- renderPlot({

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_map(base_size = 15, base_family = "") %+replace%

theme(legend.position = c(0.80,0.05),legend.text.align=1)

})

output$plot4 <- renderPlot({

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_map(base_size = 15, base_family = "") %+replace%

theme(legend.position = c(0.80,0.05),legend.text.align=1)

})

})

運行儀錶盤：

shinyApp(ui, server)

儀錶盤整體效果：

我已將該儀錶盤上傳至個人http://shinyapp.io的空間里，若感興趣可以點擊一下鏈接查看:

帥的人都關注了EasyCharts團隊^..^~

QQ交流群：553270834

微信公眾號：EasyCharts

更多信息敬請查看: http://easychart.github.io/post/Easycharts/