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 생존분석
No. | Subject | Author | Date |
---|---|---|---|
25 | 2판 출판 예정일 문의 [2] | pslee | 2024.01.23 |
24 | 2판 혹시 언제쯤 출간 예정일지요? [1] | 니콜라오 | 2023.10.13 |
23 | 2판 [1] | rlagurrn | 2023.01.27 |
22 | mytable 문의 [2] | 떠도는고라니 | 2022.12.20 |
21 | 제2판 출간소식을 기다립니다.. [1] | swpapa | 2021.04.05 |
20 | 책 구매 하려고 하는데 품절이 되서 구매할수 있는지 궁금합니다. [1] | 기드온 | 2020.07.30 |
19 | 메타분석 강의록 | cardiomoon | 2020.05.31 |
18 | 설문조사데이터 | cardiomoon | 2020.05.08 |
17 | 데이터 전처리 예제 | cardiomoon | 2020.05.08 |
16 | moonbook package 설치에 문제가 있는 건가요? [2] | KCRS_LeeJM | 2017.03.14 |
15 | 해결되지 않는 레이텍, ztable, moonbook2에 대해 질문 드립니다. [1] | neurojang | 2017.01.04 |
14 | Interactive plot with ggplot2 and ggiraph [1] | cardiomoon | 2016.05.25 |
» | ggBidirectionalBar.R | cardiomoon | 2016.05.22 |
12 | 인구피라미드 : Bidirectional Barplot | cardiomoon | 2016.05.22 |
11 | Radar Chart | cardiomoon | 2016.05.20 |
10 | ggRadar.R | cardiomoon | 2016.05.20 |
9 | Rose plot with ggplot2 [1] | cardiomoon | 2016.05.10 |
8 | Pie plot과 Donut plot의 결합 [2] | cardiomoon | 2016.05.08 |
7 | 책에 있는 R code 만 추출한 R 파일입니다. [1] | cardiomoon | 2016.05.03 |
6 | 교재 예제자료 [2] | 통계마술사 | 2016.01.18 |