用R-Shiny打造一個美美的在線App

01-28

2017-05-27 杜雨 EasyCharts

最近迷上了動態可視化，突然發現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 Population Division World 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)
)
})
})