• 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. d67578432c50a383efce7b892964f6bb925ad2e7
大小 9,216 字节
时间 2014-04-07 21:30:39
作者 Lorenzo Isella
Log Message

More queries and plotting added. Careful! The code is under development!

Content

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