Created
July 24, 2012 10:10
-
-
Save felixjung/3169256 to your computer and use it in GitHub Desktop.
Some R Code
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| # Import necessary packages | |
| library(xts); | |
| library(timeDate); | |
| require(Hmisc); | |
| library(ggplot2); | |
| library(scales); | |
| library(reshape2); | |
| library(gridExtra); | |
| library(grid); | |
| # Set working directory | |
| setwd("/Users/Felix/Documents/University/Maastricht University/Master Thesis/") | |
| # Import code | |
| source("Code/R/Library/additionalFunctions.R") # We require the color generator | |
| # Receives an xts object with market and model spreads | |
| genericLinePlot <- function(ts, legend, colors, title, yLabel, ar = c(1,1), legendTitles) { | |
| # Set y-axis upper limit | |
| yLimit <- max(na.exclude(ts)) | |
| if(yLimit > 1) { | |
| yLimit <- round(yLimit + 0.05 * yLimit, -1) | |
| } else { | |
| yLimit <- round(yLimit + 0.05 * yLimit, 2) | |
| } | |
| yMin <- min(na.exclude(ts)) | |
| if(yMin > 0) { | |
| yMin <- 0 | |
| } else { | |
| if(yMin < -1) { | |
| yMin <- round(yMin - 0.05 * yLimit, -1) | |
| } else { | |
| yMin <- round(yMin - 0.05 * yLimit, 2) | |
| } | |
| } | |
| # Set dummy label | |
| if(missing(yLabel)) { | |
| yLabel <- "" | |
| } | |
| # Check if a title has been provided | |
| if(missing(title)) { | |
| title <- "" | |
| } | |
| # Convert xts object to data.frame | |
| data <- data.frame(index(ts), coredata(ts)) | |
| colnames(data)[1] <- c("Date") | |
| # Backup column names for legend | |
| columnNames <- colnames(ts) | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| colors <- colorPaletteGenerator(length(columnNames)) | |
| } | |
| # Clean up column names | |
| breakBackups <- columnNames | |
| columnNames <- sub("X", "", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub(".", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| data <- melt(data, id = "Date") | |
| # Data plotting parameters | |
| lineThickness <- 0.35 | |
| lineThickness <- rep(lineThickness, length(colors)) | |
| lineStyles <- c(1:length(colors)) | |
| # Grid parameters | |
| refLineType <- 2 | |
| refLineWidth <- 0.2 | |
| refLineColor <- "#c1c0bd" | |
| # Create basic plot | |
| p <- ggplot( | |
| data, | |
| aes( | |
| x = Date, | |
| y = value, | |
| linetype = variable, | |
| colour = variable, | |
| size = variable | |
| ) | |
| ) + | |
| geom_line() + | |
| labs(x = "", y = yLabel) + | |
| scale_linetype_manual( | |
| values = lineStyles, | |
| labels = columnNames | |
| ) + | |
| scale_colour_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_size_manual( | |
| values = lineThickness, | |
| labels = columnNames | |
| ) + | |
| scale_x_date( | |
| breaks = date_breaks("2 months"), | |
| labels = date_format("%b-%y"), | |
| expand = c(0.01,0.01) | |
| ) + | |
| # scale_y_continuous( | |
| # breaks = seq(0, 70, 10), | |
| # labels = c(seq(0, 60, 10), " 70") | |
| # ) + | |
| coord_cartesian(ylim=c(yMin, yLimit)) + | |
| opts( | |
| plot.title = theme_text(size = 7 * 1.2, face = "bold", vjust = 1), | |
| title = title, | |
| plot.background = theme_blank(), | |
| plot.margin = unit(c(0,0,0,0), "cm"), | |
| panel.background = theme_rect(fill = "white"), | |
| panel.margin = unit(c(0,0,0,0), "cm"), | |
| panel.grid.minor = theme_line(colour = refLineColor, size = refLineWidth/2, linetype = refLineType), | |
| panel.grid.major = theme_line(colour = refLineColor, size = refLineWidth, linetype = refLineType), | |
| panel.border = theme_rect(colour = "#333333", size = 0.8), | |
| axis.line = theme_segment(colour = "#333333", size = 0.3), | |
| axis.ticks = theme_segment(colour = "#333333", size = 0.4), | |
| axis.ticks.length = unit(0.05, "cm"), | |
| axis.text.x = theme_text(family = "Helvetica", size = 7, colour = "#333333"), | |
| axis.text.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", hjust = 1), | |
| axis.title.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", angle = 90), | |
| legend.position = "bottom", | |
| legend.height = unit(0.5, "cm"), | |
| legend.background = theme_rect(fill = "#EEEEEE", colour = "#999999"), | |
| legend.key = theme_rect(colour = NA), | |
| legend.key.height = unit(0.1, "cm"), | |
| legend.key.width = unit(0.7, "cm"), | |
| legend.text = theme_text(family = "Helvetica", size = 6, colour = "black", lineheight = 0.8), | |
| legend.title = theme_blank() | |
| ) | |
| # Correct the legend entries with clean column Names and return plot | |
| if(legend == FALSE) { | |
| p <- p + opts(legend.position = "none") | |
| } | |
| if(!missing(legendTitles)){ | |
| p <- p + scale_fill_hue('my legend', | |
| breaks=columnNames, | |
| labels=legendTitles | |
| ) | |
| } | |
| # Return plot | |
| return(p) | |
| } | |
| genericLinePlotWrapper <- function(ts, fileName, legend, colors, ar = c(2,1), title = "", yLabel = "") { | |
| # Filename | |
| fileName <- paste("Latex/Images/", fileName, ".pdf", sep = "") | |
| if(missing(colors)) { | |
| plotResult <- genericLinePlot(ts, legend = TRUE, yLabel = yLabel, title = title, ar = ar) | |
| } else { | |
| plotResult <- genericLinePlot(ts, legend = TRUE, yLabel = yLabel, colors = colors, title = title, ar = ar) | |
| } | |
| # Start PDF devide | |
| pdf( | |
| file = fileName, | |
| width = 6.2, | |
| height = 2 | |
| ) | |
| # Push new viewport containing a grid | |
| pushViewport( | |
| viewport( | |
| layout = grid.layout( | |
| nrow = 1, | |
| ncol = 1, | |
| widths = unit(15, "cm"), | |
| heights = unit(1, "npc") | |
| ) | |
| ) | |
| ) | |
| # Add the plots to the viewport's grid | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) | |
| print(plotResult, vp = current.viewport()) | |
| # Turn off graphics device | |
| dev.off() | |
| } | |
| multiLinePlotWrapper <- function(tsList, fileName, yLabel, grid, colors, titles, legendTitles) { | |
| # Graphics driver and plot size setup | |
| fileName <- paste("Latex/Images/", fileName, ".pdf", sep = "") | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| numberOfColors <- 0 | |
| for(i in 1:length(tsList)) { | |
| numberOfColors <- max(numberOfColors, ncol(tsList[[i]])) | |
| } | |
| colors <- colorPaletteGenerator(numberOfColors) | |
| } | |
| # Start PDF devide | |
| pdf( | |
| file = fileName, | |
| width = 6.2, | |
| height = 5.5 | |
| ) | |
| if(missing(yLabel)) { | |
| yLabel = "" | |
| } | |
| plots <- list() | |
| # Build plot with corresponding titles | |
| if(missing(titles)) { | |
| if(missing(legendTitles)){ | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericLinePlot(tsList[[i]], yLabel = yLabel, TRUE, colors) | |
| } | |
| } else { | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericLinePlot(tsList[[i]], yLabel = yLabel, TRUE, colors, legendTitles = legendTitles) | |
| } | |
| } | |
| } else { | |
| if(missing(legendTitles)){ | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericLinePlot(tsList[[i]], yLabel = yLabel, TRUE, colors, titles[i]) | |
| } | |
| } else { | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericLinePlot(tsList[[i]], yLabel = yLabel, TRUE, colors, titles[i], legendTitles = legendTitles) | |
| } | |
| } | |
| } | |
| # Extract legend from most recent plot | |
| tmp <- ggplot_gtable(ggplot_build(plots[[1]])) | |
| leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") | |
| legend <- tmp$grobs[[leg]] | |
| # Remove legends from plots | |
| for(i in 1:length(plots)) { | |
| plots[[i]] <- plots[[i]] + opts(legend.position = "none") | |
| } | |
| # Push new viewport containing a grid | |
| pushViewport( | |
| viewport( | |
| layout = grid.layout( | |
| nrow = (length(plots) + 1), | |
| ncol = 1, | |
| widths = unit(15, "cm"), | |
| heights = unit(c(rep(1/length(plots) * 0.95, length(plots)), 0.05), "npc") | |
| ) | |
| ) | |
| ) | |
| # Add the plots to the viewport's grid | |
| for(i in 1:length(plots)) { | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = i)) | |
| print(plots[[i]], vp = current.viewport()) | |
| upViewport() | |
| } | |
| # Paint the legend onto the final element of the grid | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = (length(plots) + 1))) | |
| gp <- gpar() | |
| gp$col <- rgb(0,0,0,0) | |
| gp$lex <- 0 | |
| grid.rect(gp = gp) | |
| grid.draw(legend) | |
| # Turn off graphics device | |
| dev.off() | |
| } | |
| # Receives an xts object with market and model spreads | |
| genericBarPlot <- function(ts, legend, colors, title, yLabel, ar = c(1,1), legendTitles) { | |
| # Set y-axis upper limit | |
| yLimit <- max(na.exclude(ts)) | |
| if(yLimit > 1) { | |
| yLimit <- round(yLimit + 0.1 * yLimit, -1) | |
| } else { | |
| yLimit <- round(yLimit + 0.1 * yLimit, 2) | |
| } | |
| yMin <- min(na.exclude(ts)) | |
| if(yMin > 0) { | |
| yMin <- 0 | |
| } else { | |
| if(yMin < -1) { | |
| yMin <- round(yMin - 0.1 * yLimit, -1) | |
| } else { | |
| yMin <- round(yMin - 0.1 * yLimit, 2) | |
| } | |
| } | |
| # Set dummy label | |
| if(missing(yLabel)) { | |
| yLabel <- "" | |
| } | |
| # Check if a title has been provided | |
| if(missing(title)) { | |
| title <- "" | |
| } | |
| # Convert xts object to data.frame | |
| data <- data.frame(index(ts), coredata(ts)) | |
| colnames(data)[1] <- c("Date") | |
| # Backup column names for legend | |
| columnNames <- colnames(ts) | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| print("Generating colors.") | |
| colors <- colorPaletteGenerator(length(columnNames)) | |
| } | |
| # Clean up column names | |
| breakBackups <- columnNames | |
| columnNames <- sub("X", "", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub(".", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| data <- melt(data, id = "Date") | |
| # Data plotting parameters | |
| lineThickness <- 0.35 | |
| lineThickness <- rep(lineThickness, length(colors)) | |
| lineStyles <- c(1:length(colors)) | |
| # Grid parameters | |
| refLineType <- 2 | |
| refLineWidth <- 0.2 | |
| refLineColor <- "#c1c0bd" | |
| # Create basic plot | |
| p <- ggplot( | |
| data, | |
| aes( | |
| x = Date, | |
| y = value, | |
| linetype = variable, | |
| fill = variable, | |
| size = variable | |
| ) | |
| ) + | |
| geom_bar(stat = "identity") + | |
| labs(x = "", y = yLabel) + | |
| scale_linetype_manual( | |
| values = lineStyles, | |
| labels = columnNames | |
| ) + | |
| scale_fill_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_size_manual( | |
| values = lineThickness, | |
| labels = columnNames | |
| ) + | |
| scale_x_date( | |
| breaks = date_breaks("4 months"), | |
| labels = date_format("%b-%y"), | |
| expand = c(0.01,0.01) | |
| ) + | |
| # scale_y_continuous( | |
| # breaks = seq(0, 70, 10), | |
| # labels = c(seq(0, 60, 10), " 70") | |
| # ) + | |
| coord_cartesian(ylim=c(yMin, yLimit)) + | |
| opts( | |
| plot.title = theme_text(size = 7 * 1.2, face = "bold", vjust = 1), | |
| title = title, | |
| plot.background = theme_blank(), | |
| plot.margin = unit(c(0,0.3,0,0), "cm"), | |
| panel.background = theme_rect(fill = "white"), | |
| panel.margin = unit(c(0,0,0,0), "cm"), | |
| panel.grid.minor = theme_line(colour = refLineColor, size = refLineWidth/2, linetype = refLineType), | |
| panel.grid.major = theme_line(colour = refLineColor, size = refLineWidth, linetype = refLineType), | |
| panel.border = theme_rect(colour = "#333333", size = 0.8), | |
| axis.line = theme_segment(colour = "#333333", size = 0.3), | |
| axis.ticks = theme_segment(colour = "#333333", size = 0.4), | |
| axis.ticks.length = unit(0.05, "cm"), | |
| axis.text.x = theme_text(family = "Helvetica", size = 7, colour = "#333333"), | |
| axis.text.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", hjust = 1), | |
| axis.title.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", angle = 90), | |
| legend.position = "bottom", | |
| legend.height = unit(0.5, "cm"), | |
| legend.background = theme_rect(fill = "#EEEEEE", colour = "#999999"), | |
| legend.key = theme_rect(colour = NA), | |
| legend.key.height = unit(0.1, "cm"), | |
| legend.key.width = unit(0.7, "cm"), | |
| legend.text = theme_text(family = "Helvetica", size = 6, colour = "black", lineheight = 0.8), | |
| legend.title = theme_blank() | |
| ) | |
| # Correct the legend entries with clean column Names and return plot | |
| if(legend == FALSE) { | |
| p <- p + opts(legend.position = "none") | |
| } | |
| if(!missing(legendTitles)){ | |
| p <- p + scale_fill_hue('my legend', | |
| breaks=columnNames, | |
| labels=legendTitles | |
| ) | |
| } | |
| # Return plot | |
| return(p) | |
| } | |
| # Receives an xts object with market and model spreads | |
| genericAreaPlot <- function(ts, legend, colors, title, yLabel, ar = c(1,1), legendTitles) { | |
| # Set y-axis upper limit | |
| yLimit <- max(na.exclude(ts)) | |
| if(yLimit > 1) { | |
| yLimit <- round(yLimit + 0.1 * yLimit, -1) | |
| } else { | |
| yLimit <- round(yLimit + 0.1 * yLimit, 2) | |
| } | |
| yMin <- min(na.exclude(ts)) | |
| if(yMin > 0) { | |
| yMin <- 0 | |
| } else { | |
| if(yMin < -1) { | |
| yMin <- round(yMin - 0.1 * yLimit, -1) | |
| } else { | |
| yMin <- round(yMin - 0.1 * yLimit, 2) | |
| } | |
| } | |
| # Set dummy label | |
| if(missing(yLabel)) { | |
| yLabel <- "" | |
| } | |
| # Check if a title has been provided | |
| if(missing(title)) { | |
| title <- "" | |
| } | |
| # Convert xts object to data.frame | |
| data <- data.frame(index(ts), coredata(ts)) | |
| colnames(data)[1] <- c("Date") | |
| # Backup column names for legend | |
| columnNames <- colnames(ts) | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| print("Generating colors.") | |
| colors <- colorPaletteGenerator(length(columnNames)) | |
| } | |
| # Clean up column names | |
| breakBackups <- columnNames | |
| columnNames <- sub("X", "", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub(".", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| data <- melt(data, id = "Date") | |
| # Data plotting parameters | |
| lineThickness <- 0.35 | |
| lineThickness <- rep(lineThickness, length(colors)) | |
| lineStyles <- c(1:length(colors)) | |
| # Grid parameters | |
| refLineType <- 2 | |
| refLineWidth <- 0.2 | |
| refLineColor <- "#c1c0bd" | |
| # Create basic plot | |
| p <- ggplot( | |
| data, | |
| aes( | |
| x = Date, | |
| y = value, | |
| linetype = variable, | |
| fill = variable, | |
| size = variable, | |
| color = variable | |
| ) | |
| ) + | |
| geom_area(alpha = 0.5) + | |
| scale_fill_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_color_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_size_manual( | |
| values = 0.1, | |
| labels = columnNames | |
| ) + | |
| labs(x = "", y = yLabel) + | |
| scale_x_date( | |
| breaks = date_breaks("4 months"), | |
| labels = date_format("%b-%y"), | |
| expand = c(0.01,0.01) | |
| ) + | |
| coord_cartesian(ylim=c(yMin, yLimit)) + | |
| opts( | |
| plot.title = theme_text(size = 7 * 1.2, face = "bold", vjust = 1), | |
| title = title, | |
| plot.background = theme_blank(), | |
| plot.margin = unit(c(0,0.3,0,0), "cm"), | |
| panel.background = theme_rect(fill = "white"), | |
| panel.margin = unit(c(0,0,0,0), "cm"), | |
| panel.grid.minor = theme_line(colour = refLineColor, size = refLineWidth/2, linetype = refLineType), | |
| panel.grid.major = theme_line(colour = refLineColor, size = refLineWidth, linetype = refLineType), | |
| panel.border = theme_rect(colour = "#333333", size = 0.8), | |
| axis.line = theme_segment(colour = "#333333", size = 0.3), | |
| axis.ticks = theme_segment(colour = "#333333", size = 0.4), | |
| axis.ticks.length = unit(0.05, "cm"), | |
| axis.text.x = theme_text(family = "Helvetica", size = 7, colour = "#333333"), | |
| axis.text.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", hjust = 1), | |
| axis.title.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", angle = 90), | |
| legend.position = "bottom", | |
| legend.height = unit(0.5, "cm"), | |
| legend.background = theme_rect(fill = "#EEEEEE", colour = "#999999"), | |
| legend.key = theme_rect(colour = NA), | |
| legend.key.height = unit(0.1, "cm"), | |
| legend.key.width = unit(0.7, "cm"), | |
| legend.text = theme_text(family = "Helvetica", size = 6, colour = "black", lineheight = 0.8), | |
| legend.title = theme_blank() | |
| ) | |
| # Correct the legend entries with clean column Names and return plot | |
| if(legend == FALSE) { | |
| p <- p + opts(legend.position = "none") | |
| } | |
| if(!missing(legendTitles)){ | |
| p <- p + scale_fill_hue('my legend', | |
| breaks=columnNames, | |
| labels=legendTitles | |
| ) | |
| } | |
| # Return plot | |
| return(p) | |
| } | |
| # Receives an xts object with market and model spreads | |
| genericScatterPlot <- function(ts, legend, colors, title, yLabel, ar = c(1,1), legendTitles) { | |
| # Set y-axis upper limit | |
| yLimit <- max(na.exclude(ts)) | |
| if(yLimit > 1) { | |
| yLimit <- round(yLimit + 0.1 * yLimit, -1) | |
| } else { | |
| yLimit <- round(yLimit + 0.1 * yLimit, 2) | |
| } | |
| yMin <- min(na.exclude(ts)) | |
| if(yMin > 0) { | |
| yMin <- 0 | |
| } else { | |
| if(yMin < -1) { | |
| yMin <- round(yMin - 0.1 * yLimit, -1) | |
| } else { | |
| yMin <- round(yMin - 0.1 * yLimit, 2) | |
| } | |
| } | |
| # Ensure the right y axis limits for invertibility plots | |
| if(max(coredata(ts) == 1 | min(coredata(ts)) == 0)) { | |
| yMin <- -0.1 | |
| yMax <- 1.1 | |
| } | |
| # Set dummy label | |
| if(missing(yLabel)) { | |
| yLabel <- NULL | |
| } | |
| # Check if a title has been provided | |
| if(missing(title)) { | |
| title <- "" | |
| } | |
| # Convert xts object to data.frame | |
| data <- data.frame(index(ts), coredata(ts)) | |
| colnames(data)[1] <- c("Date") | |
| # Backup column names for legend | |
| columnNames <- colnames(ts) | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| print("Generating colors.") | |
| colors <- colorPaletteGenerator(length(columnNames)) | |
| } | |
| # Clean up column names | |
| breakBackups <- columnNames | |
| columnNames <- sub("X", "", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub(".", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| data <- melt(data, id = "Date") | |
| # Data plotting parameters | |
| lineThickness <- 0.35 | |
| lineThickness <- rep(lineThickness, length(colors)) | |
| lineStyles <- c(1:length(colors)) | |
| # Grid parameters | |
| refLineType <- 2 | |
| refLineWidth <- 0.2 | |
| refLineColor <- "#c1c0bd" | |
| # Create basic plot | |
| p <- ggplot( | |
| data, | |
| aes( | |
| x = Date, | |
| y = value, | |
| linetype = variable, | |
| color = variable, | |
| size = variable | |
| ) | |
| ) + | |
| geom_point(size = 1) + | |
| labs(x = NULL, y = yLabel) + | |
| scale_linetype_manual( | |
| values = lineStyles, | |
| labels = columnNames | |
| ) + | |
| scale_colour_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_size_manual( | |
| values = lineThickness, | |
| labels = columnNames | |
| ) + | |
| scale_x_date( | |
| breaks = date_breaks("4 months"), | |
| labels = date_format("%b-%y"), | |
| expand = c(0.01,0.01) | |
| ) + | |
| scale_y_continuous( | |
| breaks = c(0, 1), | |
| labels = c(0, 1) | |
| ) + | |
| coord_cartesian(ylim=c(yMin, yLimit)) + | |
| opts( | |
| plot.title = theme_text(size = 7 * 1.2, face = "bold", vjust = 1), | |
| title = title, | |
| plot.background = theme_blank(), | |
| plot.margin = unit(c(0,0.03,0.07,0), "cm"), | |
| panel.background = theme_rect(fill = "white"), | |
| panel.margin = unit(c(0,0,0,0), "cm"), | |
| panel.grid.minor = theme_line(colour = refLineColor, size = refLineWidth/2, linetype = refLineType), | |
| panel.grid.major = theme_line(colour = refLineColor, size = refLineWidth, linetype = refLineType), | |
| panel.border = theme_rect(colour = "#333333", size = 0.8), | |
| axis.line = theme_segment(colour = "#333333", size = 0.3), | |
| axis.ticks = theme_segment(colour = "#333333", size = 0.4), | |
| axis.ticks.length = unit(0.05, "cm"), | |
| axis.text.x = theme_text(family = "Helvetica", size = 7, colour = "#333333"), | |
| axis.text.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", hjust = 1), | |
| axis.title.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", angle = 90), | |
| legend.position = "bottom", | |
| legend.height = unit(0.5, "cm"), | |
| legend.background = theme_rect(fill = "#EEEEEE", colour = "#999999"), | |
| legend.key = theme_rect(colour = NA), | |
| legend.key.height = unit(0.1, "cm"), | |
| legend.key.width = unit(0.7, "cm"), | |
| legend.text = theme_text(family = "Helvetica", size = 6, colour = "black", lineheight = 0.8), | |
| legend.title = theme_blank() | |
| ) | |
| # Correct the legend entries with clean column Names and return plot | |
| if(legend == FALSE) { | |
| p <- p + opts(legend.position = "none") | |
| } | |
| if(!missing(legendTitles)){ | |
| p <- p + scale_fill_hue('my legend', | |
| breaks=columnNames, | |
| labels=legendTitles | |
| ) | |
| } | |
| # Return plot | |
| return(p) | |
| } | |
| # Receives an xts object with market and model spreads | |
| statisticsRibbonPlot <- function(ts, legend, colors, title, yLabel, ar = c(1,1), legendTitles) { | |
| # Set y-axis upper limit | |
| yLimit <- max(na.exclude(ts)) | |
| if(yLimit > 1) { | |
| yLimit <- round(yLimit + 0.05 * yLimit, -1) | |
| } else { | |
| yLimit <- round(yLimit + 0.05 * yLimit, 2) | |
| } | |
| yMin <- min(na.exclude(ts)) | |
| if(yMin > 0) { | |
| yMin <- 0 | |
| } else { | |
| if(yMin < -1) { | |
| yMin <- round(yMin - 0.05 * yLimit, -1) | |
| } else { | |
| yMin <- round(yMin - 0.05 * yLimit, 2) | |
| } | |
| } | |
| # Set dummy label | |
| if(missing(yLabel)) { | |
| yLabel <- "" | |
| } | |
| # Check if a title has been provided | |
| if(missing(title)) { | |
| title <- "" | |
| } | |
| # Convert xts object to data.frame | |
| data <- data.frame(index(ts), coredata(ts)) | |
| colnames(data) <- c("Date", "Mean", "Q1", "Median", "Q3") | |
| # Backup column names for legend | |
| columnNames <- colnames(ts) | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| print("Generating colors.") | |
| colors <- colorPaletteGenerator(length(columnNames)) | |
| } | |
| # Clean up column names | |
| breakBackups <- columnNames | |
| columnNames <- sub("X", "", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub(".", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| # Data plotting parameters | |
| lineThickness <- 0.35 | |
| lineThickness <- rep(lineThickness, length(colors)) | |
| lineStyles <- c(1:length(colors)) | |
| # Grid parameters | |
| refLineType <- 2 | |
| refLineWidth <- 0.2 | |
| refLineColor <- "#c1c0bd" | |
| # Create basic plot | |
| p <- ggplot( | |
| data, | |
| aes(x = Date) | |
| ) + | |
| geom_ribbon(aes(ymin = Q1, ymax = Q3, fill = "Quartile Range", alpha = "Quartile Range")) + | |
| geom_line(aes(y = Mean, color = "Mean", linetype = "Mean", size = "Mean")) + | |
| geom_line(aes(y = Median, colour = "Median", linetype = "Median", size = "Median")) + | |
| scale_fill_manual( | |
| values = c("#B5BFBC"), | |
| labels = c("Quartile Range") | |
| ) + | |
| scale_alpha_manual( | |
| values = c(0.5), | |
| labels = c("Quartile Range") | |
| ) + | |
| scale_size_manual( | |
| values = c(0.25, 0.25), | |
| labels = c("Mean", "Median") | |
| ) + | |
| scale_linetype_manual( | |
| values = c(1, 2), | |
| labels = c("Mean", "Median") | |
| ) + | |
| scale_color_manual( | |
| values = c("#B24057", "black"), | |
| labels = c("Mean", "Median") | |
| ) + | |
| labs(x = NULL, y = yLabel) + | |
| scale_x_date( | |
| breaks = date_breaks("2 months"), | |
| labels = date_format("%b-%y"), | |
| expand = c(0.01,0.01) | |
| ) + | |
| coord_cartesian(ylim=c(yMin, yLimit)) + | |
| opts( | |
| plot.title = theme_text(size = 7 * 1.2, face = "bold", vjust = 1), | |
| title = title, | |
| plot.background = theme_blank(), | |
| plot.margin = unit(c(0,0,0,0), "cm"), | |
| panel.background = theme_rect(fill = "white"), | |
| panel.margin = unit(c(0,0,0,0), "cm"), | |
| panel.grid.minor = theme_line(colour = refLineColor, size = refLineWidth/2, linetype = refLineType), | |
| panel.grid.major = theme_line(colour = refLineColor, size = refLineWidth, linetype = refLineType), | |
| panel.border = theme_rect(colour = "#333333", size = 0.8), | |
| axis.line = theme_segment(colour = "#333333", size = 0.3), | |
| axis.ticks = theme_segment(colour = "#333333", size = 0.4), | |
| axis.ticks.length = unit(0.05, "cm"), | |
| axis.text.x = theme_text(family = "Helvetica", size = 7, colour = "#333333"), | |
| axis.text.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", hjust = 1), | |
| axis.title.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", angle = 90), | |
| legend.position = "bottom", | |
| legend.height = unit(0.5, "cm"), | |
| legend.background = theme_rect(fill = "#EEEEEE", colour = "#999999"), | |
| legend.key = theme_rect(colour = NA), | |
| legend.key.height = unit(0.1, "cm"), | |
| legend.key.width = unit(0.7, "cm"), | |
| legend.text = theme_text(family = "Helvetica", size = 6, colour = "black", lineheight = 0.8), | |
| legend.title = theme_blank(), | |
| legend.direction = "horizontal", | |
| legend.box = "horizontal" | |
| ) + | |
| coord_equal(ratio = 1/1.4) | |
| # Correct the legend entries with clean column Names and return plot | |
| if(legend == FALSE) { | |
| p <- p + opts(legend.position = "none") | |
| } | |
| if(!missing(legendTitles)){ | |
| p <- p + scale_fill_hue('my legend', | |
| breaks=columnNames, | |
| labels=legendTitles | |
| ) | |
| } | |
| # Return plot | |
| return(p) | |
| } | |
| statisticsRibbonPlotWrapper <- function(ts, fileName, legend, colors, ar = c(2,1), title = "", yLabel = "") { | |
| # Filename | |
| fileName <- paste("Latex/Images/", fileName, ".pdf", sep = "") | |
| if(missing(colors)) { | |
| plotResult <- statisticsRibbonPlot(ts, legend = TRUE, yLabel = yLabel, title = title, ar = ar) | |
| } else { | |
| plotResult <- statisticsRibbonPlot(ts, legend = TRUE, yLabel = yLabel, colors = colors, title = title, ar = ar) | |
| } | |
| # Start PDF devide | |
| pdf( | |
| file = fileName, | |
| width = 6.2, | |
| height = 2 | |
| ) | |
| # Push new viewport containing a grid | |
| pushViewport( | |
| viewport( | |
| layout = grid.layout( | |
| nrow = 1, | |
| ncol = 1, | |
| widths = unit(15, "cm"), | |
| heights = unit(1, "npc") | |
| ) | |
| ) | |
| ) | |
| # Add the plots to the viewport's grid | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1)) | |
| print(plotResult, vp = current.viewport()) | |
| # Turn off graphics device | |
| dev.off() | |
| } | |
| multiStatisticsPlotWrapper <- function(tsList, fileName, yLabel, grid, colors, titles, legendTitles) { | |
| # Graphics driver and plot size setup | |
| fileName <- paste("Latex/Images/", fileName, ".pdf", sep = "") | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| numberOfColors <- 0 | |
| for(i in 1:length(tsList)) { | |
| numberOfColors <- max(numberOfColors, ncol(tsList[[i]])) | |
| } | |
| colors <- colorPaletteGenerator(numberOfColors) | |
| } | |
| # Start PDF devide | |
| pdf( | |
| file = fileName, | |
| width = 6.2, | |
| height = 5.5 | |
| ) | |
| if(missing(yLabel)) { | |
| yLabel = "" | |
| } | |
| plots <- list() | |
| # Build plot with corresponding titles | |
| if(missing(titles)) { | |
| if(missing(legendTitles)){ | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- statisticsRibbonPlot(tsList[[i]], yLabel = yLabel, TRUE, colors) | |
| } | |
| } else { | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- statisticsRibbonPlot(tsList[[i]], yLabel = yLabel, TRUE, colors, legendTitles = legendTitles) | |
| } | |
| } | |
| } else { | |
| if(missing(legendTitles)){ | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- statisticsRibbonPlot(tsList[[i]], yLabel = yLabel, TRUE, colors, titles[i]) | |
| } | |
| } else { | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- statisticsRibbonPlot(tsList[[i]], yLabel = yLabel, TRUE, colors, titles[i], legendTitles = legendTitles) | |
| } | |
| } | |
| } | |
| # Extract legend from most recent plot | |
| tmp <- ggplot_gtable(ggplot_build(plots[[1]])) | |
| leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") | |
| legend <- tmp$grobs[[leg]] | |
| # Remove legends from plots | |
| for(i in 1:length(plots)) { | |
| plots[[i]] <- plots[[i]] + opts(legend.position = "none") | |
| } | |
| # Push new viewport containing a grid | |
| pushViewport( | |
| viewport( | |
| layout = grid.layout( | |
| nrow = (length(plots) + 1), | |
| ncol = 1, | |
| widths = unit(15, "cm"), | |
| heights = unit(c(rep(1/length(plots) * 0.95, length(plots)), 0.05), "npc") | |
| ) | |
| ) | |
| ) | |
| # Add the plots to the viewport's grid | |
| for(i in 1:length(plots)) { | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = i)) | |
| print(plots[[i]], vp = current.viewport()) | |
| upViewport() | |
| } | |
| # Paint the legend onto the final element of the grid | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = (length(plots) + 1))) | |
| gp <- gpar() | |
| gp$col <- rgb(0,0,0,0) | |
| gp$lex <- 0 | |
| grid.rect(gp = gp) | |
| grid.draw(legend) | |
| # Turn off graphics device | |
| dev.off() | |
| } | |
| # Receives an xts object with market and model spreads | |
| genericStackedAreaPlot <- function(ts, legend, colors, title, yLabel, ar = c(1,1), legendTitles) { | |
| # Set y-axis upper limit | |
| yLimit <- 1.03 | |
| yMin <- -0.03 | |
| # Set dummy label | |
| if(missing(yLabel)) { | |
| yLabel <- "" | |
| } | |
| # Check if a title has been provided | |
| if(missing(title)) { | |
| title <- "" | |
| } | |
| # Convert xts object to data.frame | |
| data <- data.frame(index(ts), coredata(ts)) | |
| colnames(data)[1] <- c("Date") | |
| # Backup column names for legend | |
| columnNames <- colnames(ts) | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| print("Generating colors.") | |
| colors <- colorPaletteGenerator(length(columnNames)) | |
| } | |
| # Clean up column names | |
| breakBackups <- columnNames | |
| columnNames <- sub("X", "", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub(".", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| columnNames <- sub("_", " ", columnNames, ignore.case = FALSE, fixed = TRUE) | |
| data <- melt(data, id = "Date") | |
| # Data plotting parameters | |
| lineThickness <- 0.35 | |
| lineThickness <- rep(lineThickness, length(colors)) | |
| lineStyles <- c(1:length(colors)) | |
| # Grid parameters | |
| refLineType <- 2 | |
| refLineWidth <- 0.2 | |
| refLineColor <- "#c1c0bd" | |
| # Create basic plot | |
| p <- ggplot( | |
| data, | |
| aes( | |
| x = Date, | |
| y = value, | |
| # linetype = variable, | |
| fill = variable, | |
| size = variable, | |
| color = variable, | |
| alpha = variable | |
| ) | |
| ) + | |
| geom_area(position = 'stack') + | |
| scale_fill_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_alpha_manual( | |
| values = rep(0.6, length(columnNames)), | |
| labels = columnNames | |
| ) + | |
| scale_color_manual( | |
| values = colors, | |
| labels = columnNames | |
| ) + | |
| scale_size_manual( | |
| values = rep(0.1, length(columnNames)), | |
| labels = columnNames | |
| ) + | |
| labs(x = "", y = yLabel) + | |
| scale_x_date( | |
| breaks = date_breaks("2 months"), | |
| labels = date_format("%b-%y"), | |
| expand = c(0.01,0.01) | |
| ) + | |
| coord_cartesian(ylim=c(yMin, yLimit)) + | |
| opts( | |
| plot.title = theme_text(size = 7 * 1.2, face = "bold", vjust = 1), | |
| title = title, | |
| plot.background = theme_blank(), | |
| plot.margin = unit(c(0,0.3,0,0), "cm"), | |
| panel.background = theme_rect(fill = "white"), | |
| panel.margin = unit(c(0,0,0,0), "cm"), | |
| panel.grid.minor = theme_line(colour = refLineColor, size = refLineWidth/2, linetype = refLineType), | |
| panel.grid.major = theme_line(colour = refLineColor, size = refLineWidth, linetype = refLineType), | |
| panel.border = theme_rect(colour = "#333333", size = 0.8), | |
| axis.line = theme_segment(colour = "#333333", size = 0.3), | |
| axis.ticks = theme_segment(colour = "#333333", size = 0.4), | |
| axis.ticks.length = unit(0.05, "cm"), | |
| axis.text.x = theme_text(family = "Helvetica", size = 7, colour = "#333333"), | |
| axis.text.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", hjust = 1), | |
| axis.title.y = theme_text(family = "Helvetica", size = 7, colour = "#333333", angle = 90), | |
| legend.position = "bottom", | |
| legend.height = unit(0.5, "cm"), | |
| legend.background = theme_rect(fill = "#EEEEEE", colour = "#999999"), | |
| legend.key = theme_rect(colour = NA), | |
| legend.key.height = unit(0.1, "cm"), | |
| legend.key.width = unit(0.7, "cm"), | |
| legend.text = theme_text(family = "Helvetica", size = 6, colour = "black", lineheight = 0.8), | |
| legend.title = theme_blank() | |
| ) | |
| # Correct the legend entries with clean column Names and return plot | |
| if(legend == FALSE) { | |
| p <- p + opts(legend.position = "none") | |
| } | |
| if(!missing(legendTitles)){ | |
| p <- p + scale_fill_hue('my legend', | |
| breaks=columnNames, | |
| labels=legendTitles | |
| ) | |
| } | |
| # Return plot | |
| return(p) | |
| } | |
| multiStackedAreaPlotWrapper <- function(tsList, fileName, yLabel, grid, colors, titles, legendTitles) { | |
| # Graphics driver and plot size setup | |
| fileName <- paste("Latex/Images/", fileName, ".pdf", sep = "") | |
| # Check if color palette has been passed and generate one if necessary | |
| if(missing(colors)) { | |
| numberOfColors <- 0 | |
| for(i in 1:length(tsList)) { | |
| numberOfColors <- max(numberOfColors, ncol(tsList[[i]])) | |
| } | |
| colors <- colorPaletteGenerator(numberOfColors) | |
| } | |
| # Start PDF devide | |
| pdf( | |
| file = fileName, | |
| width = 6.2, | |
| height = 5.5 | |
| ) | |
| if(missing(yLabel)) { | |
| yLabel = "" | |
| } | |
| plots <- list() | |
| # Build plot with corresponding titles | |
| if(missing(titles)) { | |
| if(missing(legendTitles)){ | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericStackedAreaPlot(tsList[[i]], yLabel = yLabel, TRUE, colors) | |
| } | |
| } else { | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericStackedAreaPlot(tsList[[i]], yLabel = yLabel, TRUE, colors, legendTitles = legendTitles) | |
| } | |
| } | |
| } else { | |
| if(missing(legendTitles)){ | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericStackedAreaPlot(tsList[[i]], yLabel = yLabel, TRUE, colors, titles[i]) | |
| } | |
| } else { | |
| for(i in 1:length(tsList)) { | |
| plots[[i]] <- genericStackedAreaPlot(tsList[[i]], yLabel = yLabel, TRUE, colors, titles[i], legendTitles = legendTitles) | |
| } | |
| } | |
| } | |
| # Extract legend from most recent plot | |
| tmp <- ggplot_gtable(ggplot_build(plots[[1]])) | |
| leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") | |
| legend <- tmp$grobs[[leg]] | |
| # Remove legends from plots | |
| for(i in 1:length(plots)) { | |
| plots[[i]] <- plots[[i]] + opts(legend.position = "none") | |
| } | |
| # Push new viewport containing a grid | |
| pushViewport( | |
| viewport( | |
| layout = grid.layout( | |
| nrow = (length(plots) + 1), | |
| ncol = 1, | |
| widths = unit(15, "cm"), | |
| heights = unit(c(rep(1/length(plots) * 0.95, length(plots)), 0.05), "npc") | |
| ) | |
| ) | |
| ) | |
| # Add the plots to the viewport's grid | |
| for(i in 1:length(plots)) { | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = i)) | |
| print(plots[[i]], vp = current.viewport()) | |
| upViewport() | |
| } | |
| # Paint the legend onto the final element of the grid | |
| pushViewport(viewport(layout.pos.col = 1, layout.pos.row = (length(plots) + 1))) | |
| gp <- gpar() | |
| gp$col <- rgb(0,0,0,0) | |
| gp$lex <- 0 | |
| grid.rect(gp = gp) | |
| grid.draw(legend) | |
| # Turn off graphics device | |
| dev.off() | |
| } |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment