#'Compare performance between Liberal Democratic Party of Japan and Democratic Party of Japan
#'
#'@param No parameter
#'
#'@return dpj ldp compareData timeSeries
#'
#'@encoding UTF-8
#'
#'@export
ldpvsdpj<-function(dataSource="",position=1,type=1){
if(exists("dataset")==F){valueswithleader()}
tmp<-dataset
dpj<-subset(tmp,as.Date("2009-09-16")<=tmp[,1] & as.Date("2012-12-25")>=tmp[,1])
ldp<-subset(tmp,as.Date("2012-12-26")<=tmp[,1])
#dbp:MINSHUTOU , ldp:JIMINTOU
performance<<-function(x){(last(x)/first(x)-1)*100}
functionList<-list("length","mean","median","max","min","sd","first","last","performance")
tmp<-sapply(functionList,get)
FUNdpj<-function(x){x(dpj[,2])}#MINSHUTOU
FUNldp<-function(x){x(ldp[,2])}#JIMINTOU
compareData<-data.frame(sapply(tmp,FUNdpj),sapply(tmp,FUNldp),row.names=unlist(functionList),check.names=F)
colnames(compareData)<-c("Democratic Party of Japan","Liberal Democratic Party of Japan")
compareData<-format(compareData,scientific=F)
compareData<<-compareData
if(type==1){
tmp1<-data.frame(dpj,color="red",check.names=F)
}else{
tmp1<-data.frame(dpj,color=c(rep("red",length.out=nrow(dpj)-1),"blue"),check.names=F)
}
tmp2<-data.frame(ldp,color="blue",check.names=F)
tmp<-rbind(tmp1,tmp2)
eventDate<-c(
"2011-3-11",
"2012-11-14",
"2012-12-26",
"2013-4-4",
"2014-4-1",
"2014-10-31",
"2016-1-29"
)
event<-c(
"Tohoku earthquake\nand tsunami",
"Question-time debate\nbetween Noda(PM) vs Abe",
"Change of government",
"1st bazooka\nfired by KURODA",
"Consumption tax\nfrom 5% to 8%",
"2nd bazooka\nfired by KURODA",
"BOJ adapts\nnegative interest rates"
)
if(position==1){
eventPosition<-head(rep(c(max(tmp[,2]),mean(tmp[,2]),min(tmp[,2])),ceiling(length(eventDate)/3)),length(eventDate))
}else if(position==2){
eventPosition<-head(rep(c(quantile(tmp[,2])[4],quantile(tmp[,2])[3],quantile(tmp[,2])[2]),ceiling(length(eventDate)/3)),length(eventDate))
}else{
eventPosition<-head(rep(c(quantile(tmp[,2])[4],median(tmp[,2]),min(tmp[,2])),ceiling(length(eventDate)/3)),length(eventDate))
}
#for ggplot
tmp<<-tmp
event<<-event
eventDate<<-eventDate
eventPosition<<-eventPosition
#for ggplot
g<-ggplot()
if(nrow(tmp%>%filter(tmp[,2]<0))==0 | nrow(tmp%>%filter(tmp[,2]>=0))==0){
g<-g+geom_line(data=tmp,aes(x=tmp[,1],y=tmp[,2]),color=tmp[,5])
}else{
g<-g+geom_bar(data=tmp,aes(x=tmp[,1],y=tmp[,2]),stat="identity",position="identity",fill=tmp[,5],width=5,col=tmp[,5],alpha=0.3)
}
g<-g+geom_vline(xintercept=as.numeric(as.Date(eventDate)),color="dimgray")
g<-g+geom_text(aes(x=as.Date(eventDate),y=eventPosition,label=paste(eventDate,"\n",event)),vjust=0,hjust=1,size=3.5)
g<-g+ggtitle(paste(colnames(tmp)[2],"\nRed:MINSHUTOU , BLUE:JIMINTOU\nSource:",dataSource,sep=""))
g<-g+theme(axis.text.x=element_text(size=15,face="plain",angle=0,hjust=1,vjust=0.5))
g<-g+theme(axis.text.y=element_text(size=15,face="plain"))
g<-g+theme(title =element_text(size=15,face="plain"))
g<-g+xlab("")+ylab("")+scale_y_continuous(labels=comma)+scale_x_date(labels=date_format("%Y-%m"))
print(g)
timeSeries<<-tmp[,-5]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.