最近迷上了动态可视化,突然发现shiny真是个好东西,能够将我之前所学都完美的结合在一起,形成一个集成的动态仪表盘!
今天做一个小小的案例,算是shiny动态可视化的小开端……
这个案例是之前发过的中国人口结构动态金字塔图,这个图还是蛮不错,数据取自UN的官网,非常有现实意义的人口性别结构数据。
library(ggplot2) library(animation) library(dplyr) library(tidyr) library(xlsx) library(ggthemes) library(shiny) library(shinythemes)
做简单的数据清洗工作,为shiny提供可用的数据源:
setwd("D:/R/File") windowsFonts(myfont=windowsFont("微软雅黑")) female<-read.xlsx("Population.xlsx",sheetName="Female",header=T,encoding='UTF-8',check.names = FALSE) male<-read.xlsx("Population.xlsx",sheetName="Male",header=T,encoding='UTF-8',check.names = FALSE) female<-female%>%gather(Year,Poputation,-1) male<-male%>%gather(Year,Poputation,-1) female$Poputation<-female$Poputation*-1 male$sex<-"male";female$sex<-"female" China_Population<-rbind(male,female)%>%mutate(abs_pop=abs(Poputation)) China_Population$agegroup<-factor(China_Population$agegroup, levels=c("0-4","5-9","10-14","15-19","20-24","25-29","30-34","35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74","75-79","80+") ,order=T) China_Population_dd<-filter(China_Population,Year==1995)
定制shinyapp的ui:
ui <-shinyUI(fluidPage( theme=shinytheme("cerulean"), titlePanel("Population Structure Data"), sidebarLayout( sidebarPanel( selectInput("var1", "x-axis",c("agegroup"="agegroup","Poputation"="Poputation","sex"="sex"),selected="agegroup"), selectInput("var2", "y-axis",c("agegroup"="agegroup","Poputation"="Poputation","sex"="sex"),selected="Poputation"), selectInput("var3", "Gender",c("agegroup"="agegroup","Poputation"="Poputation","sex"="sex"),selected="sex"), selectInput("theme", "Choose a ShinyTheme:",choices ("cerulean","cosmo","cyborg","darkly","flatly","journal","lumen","paper", "readable","sandstone","simplex","slate","spacelab","superhero","united","yeti")), sliderInput("var4","Year",min=1950,max=2015,value=5,step=5) ), mainPanel(h2('Dynamic pyramid of population structure in China'),plotOutput("distPlot")) ) ))
定制shiny的输出服务端:
server<-shinyServer(function(input,output){ output$distPlot <- renderPlot({ mydata=filter(China_Population,Year==input$var4) argu1<-switch(input$var1,agegroup=mydata$agegroup,Poputation=mydata$Poputation,sex=mydata$sex) argu2<-switch(input$var2,agegroup=mydata$agegroup,Poputation=mydata$Poputation,sex=mydata$sex) argu3<-switch(input$var3,agegroup=mydata$agegroup,Poputation=mydata$Poputation,sex=mydata$sex) ggplot(data=mydata,aes(x=argu1,y=argu2,fill=argu3))+ coord_fixed()+ coord_flip() + geom_bar(stat="identity",width=1) + scale_y_continuous(breaks = seq(-70000,70000,length=9), labels = paste0(as.character(c(abs(seq(-70,70,length=9)))), "m"), limits = c(-75000,75000)) + theme_economist(base_size=14)+ scale_fill_manual(values=c('#D40225','#374F8F')) + labs(title=paste0("Population structure of China:",input$var4), caption="Data Source:United Nations Department of Economic and Docial Affairs\nPopulation Division\nWorld Population Prospects,the 2015 Revision" ,y="Population",x="Age") + guides(fill=guide_legend(reverse=TRUE))+ theme( text=element_text(family="myfont"), legend.position =c(0.8,0.9), legend.title = element_blank(), plot.title = element_text(size=20), plot.caption = element_text(size=12,hjust=0) ) }) })
运行app:
shinyApp(ui=ui,server=server)
动态视频展示:
此外,shiny的两个组成部件:
ui.R和server.R我已经打包成文件夹了,里面有需要的数据集文件,有执行app的gobal文件,如需可在魔方学院群贡献文件中下载