• R/O
  • SSH

标签
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-ccocoa誰得qtpythonphprubygameguibathyscaphec計画中(planning stage)翻訳omegatframeworktwitterdomtestvb.netdirectxゲームエンジンbtronarduinopreviewer

File Info

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 .

Content

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")