Rev. | d67578432c50a383efce7b892964f6bb925ad2e7 |
---|---|
大小 | 9,216 字节 |
时间 | 2014-04-07 21:30:39 |
作者 | Lorenzo Isella |
Log Message | More queries and plotting added. Careful! The code is under development! |
rm(list=ls())
library(SmarterPoland)
library(ggplot2)
library(grid)
library(reshape2)
library(RJSDMX)
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=.4),
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) )
}
list2df <- function(x){
res <- data.frame(x = c(x), time = c(time(x)))
return(res)
}
grep_country <- function(country, namevec){
country <- paste(".", country, sep="")
country_pos <- grep(country, namevec)
return(country_pos)
}
sum_by_country <- function(country_data_list, country_pos){
temp <- country_data_list[[country_pos[1]]]
mylen <- nrow(list2df(temp))
ini <- rep(0, mylen )
for (i in seq(length(country_pos))){
temp <- country_data_list[[country_pos[i]]]
temp <- list2df(temp)$x
#set to zero the non-available contributions
temp[is.na(temp)] <- 0
ini <- ini+temp
}
return(ini)
}
########################################################
#Example query
## myquery <- getSDMX('EUROSTAT', 'rd_e_berdindr2/A.TOTAL.MIO_EUR.DE')
country_list <- c("EU27", "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" )
## cl2 <-paste(country_list, collapse="|")
## berd_rev1 <- getTimeSeries('EUROSTAT',
## 'rd_e_berdind.A.C.MIO_NAC.',cl2)
berd_rev1 <- getTimeSeries('EUROSTAT',
'rd_e_berdind.A.DM34|DM351|DM352|DM353|DM354_DM355|I60-I64|G.MIO_EUR.EU27|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')
berd_rev2 <- getTimeSeries('EUROSTAT',
'rd_e_berdindr2.A.C29|C30|H49|H50|H51|H52|H53.MIO_EUR.EU27|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')
## berd_isic4 <- getTimeSeries('OECD', 'BERD_INDUSTRY_ISIC4.AUT|CZE|DEU|DNK|ESP|EST|FIN|FRA|GBR|GRC|HUN|IRL|ITA|LUX|NLD|POL|PRT|ROU|SVK|SVN|SWE.29|301|302|303|304|309|49|50|51|52|53.NC6.MAIN_ACT')
## berd_rev2 <- getTimeSeries('EUROSTAT',
## 'rd_e_berdindr2.A.C29|C30|H.MIO_EUR.EU27|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')
gbaord07 <- getTimeSeries('EUROSTAT',
'gba_nabsfin07.A.NABS04.MIO_EUR.EU27|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')
#For some reason I need to remove Croatia (HR) from the query.
gbaord92 <- getTimeSeries('EUROSTAT',
'gba_nabsfin92.A.NBS0204|NBS0705.MIO_EUR.EU27|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')
#########################
berd1data <- c()
berd2data <- c()
gbaord07data <- c()
gbaord92data <- c()
namevec <- names(berd_rev1)
sel_country <- c()
counter <- 0
for (country in country_list ){
## print("The country is, ")
## print(country)
country_pos <- grep_country(country, namevec)
if (length(country_pos)>0){
mysum <- sum_by_country(berd_rev1, country_pos)
berd1data <- cbind(berd1data,mysum)
## print("mysum is, ")
## print(mysum)
counter <- counter+1
sel_country <- c(sel_country, counter)
}
}
time <- list2df(berd_rev1[[1]])$time
berd1data <- as.data.frame(berd1data)
names(berd1data) <- country_list
berd1data$time <- time
#################à
namevec <- names(berd_rev2)
sel_country <- c()
counter <- 0
for (country in country_list ){
print("The country is, ")
print(country)
country_pos <- grep_country(country, namevec)
if (length(country_pos)>0){
mysum <- sum_by_country(berd_rev2, country_pos)
berd2data <- cbind(berd2data,mysum)
print("mysum is, ")
print(mysum)
counter <- counter+1
sel_country <- c(sel_country, counter)
}
}
berd2data <- as.data.frame(berd2data)
names(berd2data) <- country_list
time <- list2df(berd_rev2[[1]])$time
berd2data$time <- time
#############################à
namevec <- names(gbaord07)
sel_country <- c()
counter <- 0
for (country in country_list ){
print("The country is, ")
print(country)
country_pos <- grep_country(country, namevec)
if (length(country_pos)>0){
mysum <- sum_by_country(gbaord07, country_pos)
gbaord07data <- cbind(gbaord07data,mysum)
print("mysum is, ")
print(mysum)
counter <- counter+1
sel_country <- c(sel_country, counter)
}
}
gbaord07data <- as.data.frame(gbaord07data)
names(gbaord07data) <- country_list
time <- list2df(gbaord07[[1]])$time
gbaord07data$time <- time
#########################################à
namevec <- names(gbaord92)
sel_country <- c()
counter <- 0
for (country in country_list ){
print("The country is, ")
print(country)
country_pos <- grep_country(country, namevec)
if (length(country_pos)>0){
mysum <- sum_by_country(gbaord92, country_pos)
gbaord92data <- cbind(gbaord92data,mysum)
print("mysum is, ")
print(mysum)
counter <- counter+1
sel_country <- c(sel_country, counter)
}
}
gbaord92data <- as.data.frame(gbaord92data)
names(gbaord92data) <- country_list[sel_country]
time <- list2df(gbaord92[[1]])$time
gbaord92data$time <- time
###########################################################à
#Now get ready for some plotting
data <- berd1data
data <- melt(data, id=c("time"))
sel <- which(data$value==0)
## data$value[sel] <- NA
data <- data[-sel, ]
gpl <- ggplot(data, aes(x=time, y=value)) +
my_ggplot_theme(c(0.13, 0.8))+
geom_point(size=2,
colour="black",
fill="blue")+
facet_wrap(~ variable, nrow=6)+
## geom_line(data=data, aes(x=x, y=pred), size=1.5, color="blue", alpha=0.7)+
xlab("Time")+
ylab("BERD [MIO EUR] in Transport")
pdf("aggregated_berd_rev1.pdf", width=25, height=30)
print(gpl)
dev.off()
################################à
data <- berd2data
data <- melt(data, id=c("time"))
sel <- which(data$value==0)
## data$value[sel] <- NA
data <- data[-sel, ]
gpl <- ggplot(data, aes(x=time, y=value)) +
my_ggplot_theme(c(0.13, 0.8))+
geom_point(size=2,
colour="black",
fill="blue")+
facet_wrap(~ variable, nrow=6)+
## geom_line(data=data, aes(x=x, y=pred), size=1.5, color="blue", alpha=0.7)+
xlab("Time")+
ylab("BERD [MIO EUR] in Transport")
pdf("aggregated_berd_rev2.pdf", width=25, height=30)
print(gpl)
dev.off()
##############à
gpl <- ggplot(data, aes(x=time, y=value)) +
my_ggplot_theme(c(0.13, 0.8))+
geom_point(size=2,
colour="black",
fill="blue")+
facet_wrap(~ variable, nrow=6, scales="free_y"
)+
## geom_line(data=data, aes(x=x, y=pred), size=1.5, color="blue", alpha=0.7)+
xlab("Time")+
ylab("BERD [MIO EUR] in Transport")
pdf("aggregated_berd_rev2_free_y.pdf", width=25, height=30)
print(gpl)
dev.off()
#######################################################
data <- gbaord07data
data <- melt(data, id=c("time"))
sel <- which(data$value==0)
## data$value[sel] <- NA
data <- data[-sel, ]
gpl <- ggplot(data, aes(x=time, y=value)) +
my_ggplot_theme(c(0.13, 0.8))+
geom_point(size=2,
colour="black",
fill="blue")+
facet_wrap(~ variable, nrow=6, scales="free_y"
)+
## geom_line(data=data, aes(x=x, y=pred), size=1.5, color="blue", alpha=0.7)+
xlab("Time")+
ylab("GBAORD07 [MIO EUR] in Transport")
pdf("gbaord07_free_y.pdf", width=25, height=30)
print(gpl)
dev.off()
#################################################################à
print("Here I am")
data <- gbaord92data
data <- melt(data, id=c("time"))
sel <- which(data$value==0)
## data$value[sel] <- NA
data <- data[-sel, ]
gpl <- ggplot(data, aes(x=time, y=value)) +
my_ggplot_theme(c(0.13, 0.8))+
geom_point(size=2,
colour="black",
fill="blue")+
facet_wrap(~ variable, nrow=6, scales="free_y"
)+
## geom_line(data=data, aes(x=x, y=pred), size=1.5, color="blue", alpha=0.7)+
xlab("Time")+
ylab("GBAORD92 [MIO EUR] in Transport")
pdf("gbaord92_free_y.pdf", width=25, height=30)
print(gpl)
dev.off()
print("So far so good")