Rev. | 1cbcf2c73c16ba0f57d8bba74bfb10f879809873 |
---|---|
大小 | 12,514 字节 |
时间 | 2016-04-06 21:35:59 |
作者 | Lorenzo Isella |
Log Message | I modified the geom_label_repel call by using the parameters illustrated here http://bit.ly/1MS4Hre . |
rm(list=ls())
library(ggrepel)
library(ggplot2)
library(grid)
library(reshape2)
library(RJSDMX)
require(gridExtra)
library(tikzDevice)
library(scales)
library(digest)
library(readr)
f <- function (x) ifelse(log10(x)<4,identity(x),trans_format("log10",math_format(10^.x))(x))
## f <- function (x) ifelse(x<10000,identity(x),trans_format(identity(x),math_format(10^.x))(x))
replace_country_code <- function(mylist){
eu_list <- c("BE", "BG","CZ", "DK", "DE", "EE", "IE", "EL",
"ES", "FR", "IT", "CY", "LV", "LT", "LU", "HU", "MT",
"NL", "AT","PL", "PT", "RO", "SI", "SK", "FI","SE","UK", "HR" )
eu_list <- sort(eu_list)
oecd_list <- c("AUT", "BEL", "BGR", "CYP", "CZE","DEU", "DNK", "EST", "GRC",
"ESP", "FIN", "FRA", "HRV", "HUN", "IRL", "ITA", "LTU",
"LUX", "LVA", "MLT", "NLD", "POL", "PRT", "ROU", "SWE",
"SVN", "SVK", "GBR"
)
for (i in seq(length(oecd_list))){
country <- oecd_list[i]
sel <- which(mylist==country)
mylist[sel] <- eu_list[i]
}
return(mylist)
}
replace_country_code_extended <- function(mylist, eu_list, eu_list_extended){
for (i in seq(length(eu_list_extended))){
country <- eu_list_extended[i]
sel <- which(mylist==country)
mylist[sel] <- eu_list[i]
}
return(mylist)
}
# see http://bit.ly/1zbvAti
integer_breaks <- function(n = 5, ...) {
breaker <- pretty_breaks(n, ...)
function(x) {
breaks <- breaker(x)
breaks[breaks == floor(breaks)]
}
}
fmt <- function(){
function(x) {
d <- log10(min(diff(x),na.rm=TRUE))
if(d < 0) format(x,nsmall = abs(round(d)),scientific = FALSE) else x
}
}
fmt2 <- function(n){
function(x) format(x,nsmall = n,scientific = FALSE)
}
drop_last_char <- function(t,n){
substr(t, 1, nchar(t)-n)
}
drop_ini_char <- function(t,n){
substr(t, (n+1), nchar(t))
}
substrRight <- function(x, n){
substr(x, nchar(x)-n+1, nchar(x))
}
substrLeft <- function(x, n){
substr(x,1, n )
}
compact_list <- function(data_rd, missing=0){
myseq <- seq(length(data_rd))
data2 <- c()
for (i in myseq){
temp <- as.data.frame(data_rd[[i]])
#remove the missing data
if (missing==1){
sel <- complete.cases(temp)
temp_year <- as.numeric(row.names(temp)[sel])
} else{
temp_year <- as.numeric(row.names(temp))
}
namevec <-rep(names(data_rd[i]), length(temp_year))
## temp <- temp[sel, ]
temp2 <- as.data.frame(cbind(temp, temp_year, namevec))
data2 <- rbind(data2, temp2)
}
#data2 <- as.data.frame(data2)
names(data2) <- letters[seq(ncol(data2))]
data2$a <- as.numeric(data2$a)
#print("ncol(data2) is, ")
#print(ncol(data2))
return(data2)
}
my_ggplot_theme <- function(legend_coord){ theme( panel.background = element_rect(fill="gray",
colour = "black", size = 0.5, linetype = 1),
panel.grid.minor = element_blank(),
axis.ticks = element_line(colour = "black", size=1),
axis.ticks.length = unit(0.15, "cm"),
strip.background = element_rect(colour = 'blue',
fill = 'white', size = 1, linetype=1),
strip.text.x = element_text(colour = 'red', angle = 0,
size = 12, hjust = 0.5,
vjust = 0.5, face = 'bold'),
axis.title.x = element_text(size = 20),
axis.title.y = element_text(size = 20, angle=90, vjust=1),
axis.text.x = element_text(size=15, colour="black", vjust=1),
axis.text.y = element_text(size=15, colour="black", hjust=1),
legend.text = element_text(size = 14, vjust=0.4),
legend.title = element_text(size = 24, hjust=0),
legend.position = legend_coord,
legend.title = element_blank(),
legend.background=element_rect(color=NA, fill=NA),
legend.key = element_rect(colour = NA, fill=NA) )
}
reshape_series <- function(data, year_cut){
data <- compact_list(data)
data$country <- substrRight(as.character(data$c),2)
names(data) <- c("value", "year", "indicator", "country")
data$indicator <- as.character(data$indicator)
data$value <- as.numeric(data$value)
data <- data[complete.cases(data), ]
sel <- which(data$year>year_cut)
data <- data[sel, ]
return(data)
}
###################################################################
###################################################################
###################################################################
###################################################################
options( scipen = 16 )
year_cut <- 2004
## download <- 0
eu_list <- c("BE", "BG","CZ", "DK", "DE", "EE", "IE", "EL",
"ES", "FR", "IT", "CY", "LV", "LT", "LU", "HU", "MT",
"NL", "AT","PL", "PT", "RO", "SI", "SK", "FI","SE","UK", "HR" )
eu_list_extended <- c("Belgium", "Bulgaria","Czech Republic", "Denmark",
"Germany", "Estonia", "Ireland", "Greece",
"Spain", "France", "Italy", "Cyprus", "Latvia",
"Lithuania", "Luxembourg", "Hungary", "Malta",
"Netherlands", "Austria","Poland", "Portugal",
"Romania", "Slovenia", "Slovakia", "Finland","Sweden",
"United Kingdom", "Croatia" )
eurozone <- c("BE", "DE", "IE", "EL",
"ES", "FR", "IT", "LU",
"NL", "AT", "PT", "FI" )
## eu_list <- c("SK")
## eu_list_extended <- c("Slovakia")
## eu_list <- c("HU")
## eu_list_extended <- c("Luxembourg")
## eu_list <- sort(eu_list)
############################################à
indirect_funding <- read_csv("indirect-support.csv")
indirect_funding$country <- replace_country_code(indirect_funding$country)
indirect_funding <- indirect_funding[indirect_funding$country %in% eu_list, ]
names(indirect_funding) <- c("country","value","year")
indirect_funding$value <- as.numeric(indirect_funding$value)
indirect_funding$indicator <- "indirect"
ameco <- read_csv('ameco-balance.csv')
ameco <- melt(ameco)
ameco$Country <- replace_country_code_extended(ameco$Country, eu_list, eu_list_extended)
ameco$Unit <- "pc_gdp"
names(ameco) <- c("country", "unit", "year", "value")
ameco <- ameco[ameco$country %in% eu_list, ]
ameco$year <- as.numeric(as.character(ameco$year))
data_gov <- getTimeSeries('EUROSTAT',
'rd_e_gerdfund.A.TOTAL.GOV.PC_GDP.BE|BG|CZ|DK|DE|EE|IE|EL|ES|FR|IT|CY|LV|LT|LU|HU|MT|NL|AT|PL|PT|RO|SI|SK|FI|SE|UK|HR')
data_ec <- getTimeSeries('EUROSTAT',
'rd_e_gerdfund.A.TOTAL.ABR_EC.PC_GDP.BE|BG|CZ|DK|DE|EE|IE|EL|ES|FR|IT|CY|LV|LT|LU|HU|MT|NL|AT|PL|PT|RO|SI|SK|FI|SE|UK|HR')
data_gov <- reshape_series(data_gov, year_cut)
data_ec <- reshape_series(data_ec, year_cut)
for (sel_country in eu_list){
print("the country is,")
print(sel_country)
indirect_temp <- indirect_funding[indirect_funding$country==sel_country, ]
ms <- sort(indirect_temp$year, decreasing=F, index.return=T)
indirect_temp <- indirect_temp[ms$ix, ]
sel <- which(ameco$country==sel_country)
ameco_temp <- ameco[sel, ]
ec <- data_ec[data_ec$country == sel_country, ]
gov <- data_gov[data_gov$country == sel_country, ]
if (nrow(ec)>0){
ec$indicator <- "ec_contr"
}
gov$indicator <- "gov_contr"
if (nrow(ec)>0){
common_years <- intersect(ec$year, gov$year)
## ec <- ec[ec$year %in% common_years , ]
## gov <- gov[gov$year %in% common_years , ]
## data_temp<-merge(ec, gov, by="year")
if (length(common_years)>0){
ec <- ec[ec$year %in% common_years, ]
ec$value <- ec$value+gov[gov$year %in% common_years, ]$value
data_tot <- rbind(gov,ec)
} ## else{
## data_tot <- gov
## }
} else{
data_tot <- gov
}
## print("len data-tot here is, ")
## print(nrow(data_tot))
if (nrow(indirect_temp)>0){
common_years <- intersect(gov$year, indirect_temp$year)
if (length(common_years)>0){
## print("here I am")
indirect_temp <- indirect_temp[indirect_temp$year %in% common_years, ]
## print("indirect_temp$value is, ")
## print(indirect_temp$value)
## print("gov[gov$year %in% common_years, ]$value")
## print(gov[gov$year %in% common_years, ]$value)
indirect_temp$value <- indirect_temp$value+gov[gov$year %in% common_years, ]$value
data_tot <- rbind(data_tot, indirect_temp)
}
}
print("len data tot here")
print(nrow(data_tot))
data2<-merge( ameco_temp, data_tot, by="year")
data2 <- subset(data2, select=c(year, value.x, value.y,indicator))
rm(data_tot)
title_exp <- paste(sel_country, ": GERD vs Structural Balance", sep="")
sel <- which(data2$indicator=="gov_contr")
data2$indicator[sel] <- "GERD funded by \n government\n"
sel <- which(data2$indicator=="ec_contr")
data2$indicator[sel] <- "GERD funded by \n government+EC\n"
sel <- which(data2$indicator=="indirect")
data2$indicator[sel] <- "GERD funded by \n government+indirect\n"
data2$indicator <- as.factor(data2$indicator)
lbls <- levels(data2$indicator)
col_seq <- seq(length(lbls))
data2$year <- as.character(data2$year)
data_save <- data2
print("len data2 is, ")
print(nrow(data2))
fname <- paste(sel_country, "_gerd_vs_structural1.csv", sep="")
data.out <- data2
names(data.out) <- c("year", "structural balance", "expenditure", "expenditure_type")
data.out$expenditure_type <- gsub("[\r\n]", " ", data.out$expenditure_type)
write.table(data.out,
fname,
row.names=FALSE, col.names=TRUE, sep=",")
## data2 <- data2[data2$year<2014,]
gpl <- ggplot(data2, aes(x=value.x, y=value.y, color=indicator,
shape= indicator
)) +
geom_point(size=3) +
## geom_text(aes(label=year),show.legend = F ,hjust=0.4, vjust=-0.7)+
## geom_label_repel(aes(label=year),show.legend = F, , segment.size = 0)+
## see http://bit.ly/1MS4Hre
geom_label_repel(aes(label=year),show.legend = F,
fontface = 'bold', ## color = 'white',
box.padding = unit(0.25, "lines"),
point.padding = unit(0.5, "lines") )+
scale_colour_manual("", breaks=lbls,
values=col_seq) +
scale_shape_manual("", breaks=lbls, values=col_seq) +
scale_y_continuous(breaks=pretty_breaks(n=5)
)+
scale_x_continuous(breaks=pretty_breaks(n=5))+
my_ggplot_theme(c(0.13, 0.))+
theme(legend.position = 'right')+
labs(title=title_exp)+
theme(plot.title = element_text(lineheight=.8, size=24, face="bold", vjust=1))+
theme(legend.text = element_text(vjust=2,lineheight=.8 ))+
xlab("Structural Balance Excluding Interest (%GDP)")+
ylab("GERD (%GDP)")
fname <- paste(sel_country, "_gerd_from_gov_and_structural_balance_pc_gdp.pdf", sep="")
ggsave(fname, gpl, width=10,height=5)
fname <- paste(sel_country, "_gerd_from_gov_and_structural_balance_pc_gdp1.png", sep="")
ggsave(fname, gpl, width=10,height=5)
## sel <- which((data2$indicator=="GERD funded by \n government\n") &
## (data2$year!="2014" ))
## data2 <- data2[(data)]
## if (length(sel)>0){
## data2 <- data2[-sel, ]
## }
## gpl <- ggplot(data2, aes(x=value.x, y=value.y, color=indicator,
## shape= indicator
## )) +
## geom_point(size=3) +
## ## geom_text(aes(label=year),show.legend = F ,hjust=0.4, vjust=-0.7)+
## geom_label_repel(aes(label=year),show.legend = F, segment.size = 0)+
## scale_colour_manual("", breaks=lbls,
## values=col_seq) +
## scale_shape_manual("", breaks=lbls, values=col_seq) +
## scale_y_continuous(breaks=pretty_breaks(n=5)
## )+
## scale_x_continuous(breaks=pretty_breaks(n=5))+
## my_ggplot_theme(c(0.13, 0.))+
## theme(legend.position = 'right')+
## labs(title=title_exp)+
## theme(plot.title = element_text(lineheight=.8, size=24, face="bold", vjust=1))+
## theme(legend.text = element_text(vjust=2,lineheight=.8 ))+
## xlab("Structural Balance Excluding Interest (%GDP)")+
## ylab("GERD (%GDP)")
## fname <- paste(sel_country, "_gerd_from_gov_and_structural_balance_pc_gdp_simple.pdf", sep="")
## ggsave(fname, gpl, width=10,height=5)
## fname <- paste(sel_country, "_gerd_from_gov_and_structural_balance_pc_gdp_simple1.png", sep="")
## ggsave(fname, gpl, width=10,height=5)
## rm(data2)
## rm(gpl)
}
print("So far so good")