提交: 9126c779d33f363ad14177ae67e61c13d0ca44b3 - myprojects-hg-reborn (hg)

Commit MetaInfo

• 修订版: 9126c779d33f363ad14177ae67e61c13d0ca44b3 (tree)
• 时间: 2014-09-20 00:05:03
• 作者: Lorenzo Isella <lorenzo.isella@gmai...>
• Commiter: Lorenzo Isella

Log Message

Two codes to plot and download data. I also introduce a function to generate a colour palette with many (>9) colours.

更改概述

• add: R-codes/download-data-rjsdmx.R
• add: R-codes/plot-for-template.R

差异

diff -r 8876857c3d72 -r 9126c779d33f R-codes/download-data-rjsdmx.R
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R-codes/download-data-rjsdmx.R	Fri Sep 19 17:05:03 2014 +0200
@@ -0,0 +1,261 @@
+rm(list=ls())
+
+library(ggplot2)
+library(grid)
+library(reshape2)
+library(RJSDMX)
+require(gridExtra)
+library(tikzDevice)
+library(scales)
+library(digest)
+
+
+
+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)
+
+}
+
+
+# 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) )
+                                                 }
+
+
+
+
+################################################################
+################################################################
+################################################################
+################################################################
+
+data <- getTimeSeries('EUROSTAT',
+    'rd_e_berdindr2.A.TOTAL|C|D_E|G|H|J|K|M|N|Q.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 <- 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_rd$indicator <- "Total"
+
+data$indicator <- drop_ini_char(data$indicator,17)
+data$indicator <- drop_last_char(data$indicator,10)
+
+data$indicator <- as.factor(data$indicator)
+
+berd_all <- data
+
+#############################################################à
+#############################################################à
+#############################################################à
+#############################################################à
+
+
+data <- getTimeSeries('EUROSTAT',
+    'rd_e_berdindr2.A.C10_C11|C17|C19|C20|C22|C23|C25|C26|C27|C28|C29|C31|C32.MIO_NAC.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 <- 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$indicator <- drop_ini_char(data$indicator,17)
+data$indicator <- drop_last_char(data$indicator,11)
+
+data$indicator <- as.factor(data$indicator)
+
+
+berd_sect <- data
+
+#############################################################à
+#############################################################à
+#############################################################à
+
+
+
+## data_an <- getTimeSeries('OECD','ANBERD_REV4.AUT_MA|BEL_MA|CZE_MA|DEU_MA|DNK_MA|ESP_MA|EST_MA|FIN_MA|FRA_MA|GBR_MA|HUN_MA|ITA_MA|NLD_MA|POL_MA|PRT_MA|ROU_MA|SVK_MA|SVN_MA.NATCUR.DTOTAL|D01T03|D05T09|D10T33|D35T39|D41T43|D45T99')
+
+
+data <- getTimeSeries('OECD','ANBERD_REV4.AUT_MA|BEL_MA|CZE_MA|DEU_MA|DNK_MA|ESP_MA|EST_MA|FIN_MA|FRA_MA|GBR_MA|HUN_MA|ITA_MA|NLD_MA|POL_MA|PRT_MA|ROU_MA|SVK_MA|SVN_MA.NATCUR.DTOTAL|D19|D10T33')
+
+data <- compact_list(data)
+
+data$country <- drop_ini_char(as.character(data$c),12)
+data$country <- substrLeft(as.character(data$country),3)
+data$country <- replace_country_code(data$country)
+
+
+names(data) <- c("value", "year", "indicator", "country")
+
+data$indicator <- as.character(data$indicator)
+
+data$value <- as.numeric(data$value)
+data$indicator <- drop_ini_char(data$indicator,26)
+
+data$indicator <- as.character(data$indicator)
+
+anberd_sect <- data
+
+
+print("So far so good")

diff -r 8876857c3d72 -r 9126c779d33f R-codes/plot-for-template.R
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R-codes/plot-for-template.R	Fri Sep 19 17:05:03 2014 +0200
@@ -0,0 +1,223 @@
+source("download-data-rjsdmx.R")
+library(RColorBrewer)
+######################################
+
+sel_country <- "FI"
+
+temp <- berd_all
+
+sel <- which(temp$country==sel_country)
+
+temp <- temp[sel, ]
+
+sel <- which(temp$year>2004)
+temp <- temp[sel, ]
+
+temp <- temp[complete.cases(temp), ]
+
+lbls <- levels(temp$indicator)
+
+
+title_exp <- paste(sel_country, ": R&D Intensity per sector", sep="")
+
+# see http://bit.ly/1uhCvjk to understand how to create a large palette
+
+colourCount = length(lbls)
+getPalette = colorRampPalette(brewer.pal(9, "Set1"))
+mypal <- getPalette(colourCount)
+mypal[10] <- "black"
+
+
+
+gpl <- ggplot(temp, aes(x=year, y=value ,
+                        colour=indicator
+                       )) +
+
+    
+my_ggplot_theme(c(0.13, 0.8))+
+theme(legend.position = 'right')+
+geom_point(size=2) + 
+geom_line()+
+
+
+scale_colour_manual("", breaks=lbls, values=mypal) +
+
+#scale_colour_brewer(mypal)+
+
+
+# scale_color_brewer(palette="Spectral")+    
+
+scale_y_continuous(breaks=pretty_breaks(n=5))+
+
+scale_x_continuous(breaks=integer_breaks(n=5))+
+
+labs(title=title_exp)+
+theme(plot.title = element_text(lineheight=.8, size=24, face="bold", vjust=1))+
+
+
+    xlab("Year")+
+ ylab("% GDP")
+
+
+
+fname <- paste(sel_country, "_berd_intensity.pdf", sep="")
+
+ggsave(fname, gpl, width=10,height=5)
+
+fname <- paste(sel_country, "_berd_intensity.png", sep="")
+ggsave(fname, gpl, width=10,height=5)
+
+#################################################################à
+
+temp <- berd_all
+
+sel <- which(temp$country==sel_country)
+
+temp <- temp[sel, ]
+
+sel <- which(temp$year>2004)
+temp <- temp[sel, ]
+
+temp <- temp[complete.cases(temp), ]
+
+
+sel <- which(temp$indicator=="TOTAL")
+temp <- temp[sel, ]
+
+lbls <- levels(temp$indicator)
+
+
+title_exp <- paste(sel_country, ": R&D Intensity per sector", sep="")
+
+
+
+
+gpl <- ggplot(temp, aes(x=year, y=value,
+                        colour=indicator)) +
+
+    
+my_ggplot_theme(c(0.13, 0.8))+
+theme(legend.position = 'right')+
+geom_point(size=2) + 
+geom_line()+
+
+
+scale_colour_manual("", breaks=lbls, values="black") +
+
+#scale_colour_brewer(mypal)+
+
+
+# scale_color_brewer(palette="Spectral")+    
+
+scale_y_continuous(breaks=pretty_breaks(n=5))+
+
+scale_x_continuous(breaks=integer_breaks(n=5))+
+
+labs(title=title_exp)+
+theme(plot.title = element_text(lineheight=.8, size=24, face="bold", vjust=1))+
+
+
+    xlab("Year")+
+ ylab("% GDP")
+
+
+
+fname <- paste(sel_country, "_berd_total_intensity.pdf", sep="")
+
+ggsave(fname, gpl, width=10,height=5)
+
+fname <- paste(sel_country, "_berd_total_intensity.png", sep="")
+ggsave(fname, gpl, width=10,height=5)
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+##################################################
+
+temp <- berd_sect
+
+sel <- which(temp$country==sel_country)
+
+temp <- temp[sel, ]
+
+sel <- which(temp$year>2004)
+temp <- temp[sel, ]
+
+
+temp <- temp[complete.cases(temp), ]
+
+
+lbls <- levels(temp$indicator)
+
+
+
+title_exp <- paste(sel_country, ": R&D Intensity per sector", sep="")
+
+# see http://bit.ly/1uhCvjk to understand how to create a large palette
+
+colourCount = length(lbls)
+getPalette = colorRampPalette(brewer.pal(9, "Set1"))
+mypal <- getPalette(colourCount)
+mypal[10] <- "black"
+
+
+
+gpl <- ggplot(temp, aes(x=year, y=value ,
+                        colour=indicator
+                       )) +
+
+    
+my_ggplot_theme(c(0.13, 0.8))+
+theme(legend.position = 'right')+
+geom_point(size=2) + 
+geom_line()+
+
+
+
+
+
+scale_colour_manual("", breaks=lbls, values=mypal) +
+
+#scale_colour_brewer(mypal)+
+
+
+# scale_color_brewer(palette="Spectral")+    
+
+scale_y_continuous(breaks=pretty_breaks(n=5))+
+
+scale_x_continuous(breaks=integer_breaks(n=5))+
+
+labs(title=title_exp)+
+theme(plot.title = element_text(lineheight=.8, size=24, face="bold", vjust=1))+
+
+
+    xlab("Year")+
+ ylab("Millions National Currency")
+
+
+
+fname <- paste(sel_country, "_berd_sector_intensity.pdf", sep="")
+
+ggsave(fname, gpl, width=10,height=5)
+
+fname <- paste(sel_country, "_berd_sector_intensity.png", sep="")
+ggsave(fname, gpl, width=10,height=5)
+
+
+
+
+
+
+
+print("So far so good")