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)
Comment 0
- Total
- 의학논문 작성을 위한 R통계와 그래프
- R을 이용한 조건부과정분석
- 웹에서 클릭만으로 하는 R통계분석
- Learn ggplot2 Using Shiny App
- 일반화가법모형 소개
- 밑바닥부터 시작하는 ROC 커브 분석
- 웹R을 이용한 통계분석
- 의료인을 위한 R 생존분석