메뉴 건너뛰기

웹에서 하는 R 통계

ggBidirectionalBar.R

2016.05.22 20:18

cardiomoon 조회 수:2643

require(XML)
require(reshape2)
require(ggplot2)
require(plyr)
require(scales)
require(grid)
require(cowplot)
source("ggplot2_formatter.R")


# Modified from the source: rpubs.com/walkerke/pyramids_ggplot2
get_popdata <- function(country, year) {
        c1 <- "http://www.census.gov/population/international/data/idb/region.php?N=%20Results%20&T=10&A=separate&RT=0&Y="  
        c2 <- "&R=-1&C="
        url <- paste0(c1, year, c2, country)
        df <- data.frame(readHTMLTable(url))
        keep <- c(2, 4, 5)
        df <- df[,keep]  
        names(df) <- c("Age", "Male", "Female")
        cols <- 2:3
        df[,cols] <- apply(df[,cols], 2, function(x) as.numeric(as.character(gsub(",", "", x))))
        df <- df[df$Age != 'Total', ]  
        df
}

ggBidirectionalBar=function(data,left=NULL,right=NULL,label=NULL,mode=1,title=""){
        
        # mode == 1 :
        # mode == 2 :two separate plot
        data[[left]] <- -1 * data[[left]]
        data[[label]] <- factor(data[[label]],levels=data[[label]])
        longdf <- melt(data,id.vars=label )
        if(mode){
                p<- ggplot(longdf, aes_string(y = "value", x = label, fill = "variable")) + 
                        geom_bar(data=subset(longdf, variable == left), stat = "identity",alpha=0.7) + 
                        geom_bar(data=subset(longdf, variable == right), stat = "identity",alpha=0.7)+  
                        coord_flip() + 
                        scale_fill_brewer(palette = "Set1") + 
                        theme_bw()+theme(legend.position=c(0.15,0.92))+
                        guides(fill=guide_legend(title=NULL,reverse=TRUE))+
                        scale_y_continuous(labels=human_num2)+ylab("")+ggtitle(title)
                p
        } else{
                p1<- ggplot(data=subset(longdf, variable == left), aes_string(y = "value", x = label)) + 
                        geom_bar(stat = "identity",alpha=0.7,fill="blue") +coord_flip()+  
                        annotate("text",x=Inf,y=-Inf,hjust=-0.2,vjust=2,label=left,color="blue")+
                        theme_bw()+
                        theme(axis.text.y=element_blank(),axis.ticks.y=element_blank(),
                              axis.title.y=element_blank(),axis.title.x=element_blank())
                p1<-p1+ scale_fill_brewer(palette = "Set1") + 
                        scale_y_continuous(labels=human_num2)   
                #p1<-ggdraw(switch_axis_position(p1+theme_bw()+theme(axis.text.y=element_blank())+xlab("")+ylab(""), axis = 'y'))
                
                p2<- ggplot(data=subset(longdf, variable == right), aes_string(y = "value", x = label)) + 
                        geom_bar(stat = "identity",alpha=0.7,fill="red")+  
                        annotate("text",x=Inf,y=Inf,hjust=1.2,vjust=2,label=right,color="red")+
                        coord_flip() + 
                        scale_fill_brewer(palette = "Set1") + 
                        theme_bw()+
                        theme(legend.position=c(0.15,0.92),axis.ticks.y=element_blank(),
                              axis.title.y=element_blank(),axis.title.x=element_blank())+
                        guides(fill=guide_legend(title=NULL,reverse=TRUE))+
                        scale_y_continuous(labels=human_num2)+ylab("")
                
                wid=c(0.46,0.55)
                
                p=list(p1,p2)
                vp=list()
                vp[[1]]=viewport(x=wid[1]/2,y=0.46,width=wid[1],height=0.92)
                vp[[2]]=viewport(x=wid[1]+wid[2]/2-0.01,y=0.46,width=wid[2],height=0.92)
                multiggplot(p=p,vp=vp,title=title)
        }
}

multiggplot=function(p,vp,title){
        fsize=20
        grid.newpage()
        for(i in 1:length(p))  print(p[[i]],vp=vp[[i]])
        grid.text(title,x=0.5,
                  y=0.96,just=c("centre"),gp=gpar(fontsize=fsize))
}

PopPyramid=function(country,year,mode=1){
        popdata=get_popdata(country,year)
        ggBidirectionalBar(data=popdata,left="Male",right="Female",label="Age",mode=mode,
                title=paste("Population",country,year))
}

KS2016=get_popdata("KS",2016)
KS2016
# data=popdata;left="Male";right="Female";label="Age"
#ggBidirectionalBar(data=KS2016,left="Male",right="Female",label="Age",mode=0)

PopPyramid("KS",2016,mode=0)
##ggsave("Nigeria2016.png")
# PopPyramid("NI",2015)
# PopPyramid("JA",2015)
# PopPyramid("VQ",2015)