# fredplot.R
# Functions to download and plot datasets from the St. Lous Fed's Federal
# Reserve Economic Data (FRED) database.
# Based on code by Espen Henriksen
# Reorganized, extended, and documented by Paul Backus

# A Note on Indentation Style:
# Many of the function calls in this code are formatted like this:
#   some_function(
#   	foo,
#   	bar,
#   	baz
#   )
# rather than the usual
#   some_function(foo, bar, baz)
# in order to avoid excessively long lines and make nested function calls
# easier to follow.

library("XML")
library("xts")

# Create a URL query string from key=value parameters
queryString <- function(...) {
	params <- list(...)
	paste(
		lapply(
			names(params),
			function(pname) {
				paste(pname, "=", URLencode(params[[pname]]), sep="")
			}
		),
		collapse="&" # use collapse instead of sep to flatten list
	)
}

# Fetch raw XML data from the FRED web interface
# Full documentation at:  http://api.stlouisfed.org/docs/fred/
# ... allows additional parameters; eg, freq
callFredApi <- function(call_string, ...) {
	api_key <- "055ba538c874e5974ee22d786f27fdda" # courtesy of Kim Ruhl

	# Construct URL from call string and any parameters given in "..."
	# The finished URL should have the form:
	#   http://.../fred/some/resource?api_key=foo&param1=val1[&param2=val2...]
	# ie, the web address, followed by a ?, followed by a &-separated list
	#   of parameters
	# The api_key parameter is always required, and so is handled automatically.
	url <- paste(
		"http://api.stlouisfed.org/fred/", # base url
		call_string, # subdirectory--documented on fred website
		"?", # separator between web address and parameter list
		queryString(api_key=api_key, ...),
		sep=""
	)
	return(xmlTreeParse(url, useInternal=TRUE))
}

# Helper function to extract specific attributes from FRED's XML
collectAttrs <- function(xmldoc, tag, attr) {
	sapply(
		getNodeSet(xmldoc, paste("//", tag)),
		function(el) { xmlGetAttr(el, attr) }
	)
}

# Download the specified series and returns it as a vector, with the dates
# of each observation stored in the vector's names attribute
getFredData <- function(series_id, ...) {
	xmldoc <- callFredApi(
		call_string="series/observations",
		series_id=series_id,
		...
	)

	dataseries <- as.numeric(collectAttrs(xmldoc, "observation", "value"))
	names(dataseries) <- collectAttrs(xmldoc, "observation", "date")
	return(dataseries)
}

# Download the metadata of a FRED series and returns a particular attribute
# A list of available attributes can be found at
#   http://api.stlouisfed.org/docs/fred/series.html
getFredMetadata <- function(series_id, attribute, ...) {
	xmldoc <- callFredApi(
		call_string="series",
		series_id=series_id,
		...
	)
	attrs <- collectAttrs(xmldoc, "series", attribute)
	return(attrs)
}

# Return a multivariate time series of the variables specified in series_ids
getFredTable <- function(series_ids, ...) {
	data <- do.call(
		merge,
		lapply(
			series_ids, 
			function(series) { as.xts(getFredData(series, ...)) }
		)
	)
	colnames(data) <- series_ids
	return(data)
}

# Bare-bones code to make plots and save them to pdf files
# This is the fallback if no other plot routine is provided
defaultPlotRoutine = function(table, colname) { 
	plot(table[,colname], main="")
	title(main=colname)
	dev.print(device=pdf, paste(colname, "pdf", sep=".")) 
}

# Generic function to plot the columns of a table (matrix, data.frame, xts...)
# You can pass in your own function with custom plotting commands to add 
# text, labels, etc. to the plot (see above for example)
# Otherwise, the default plot routine defined above is used
# 
# This function is not specific to FRED; it will work with any matrix-like
# table structure in R (though it does assume the existence of colnames).
plotColumns <- function(table, plotRoutine=defaultPlotRoutine) {
	sapply(
		colnames(table),
		function(colname) { 
			plotRoutine(table, colname)
		}
	)
	invisible() # no return value
}

# A more sophisticated plotting routine with FRED-specific code for axis
# labels and source attribution text
# This function encapsulates all the fiddly formatting details
plotFredPDFs <- function(table, series_id) {
	plot(table[,series_id], main="")
	title(
		# use series title as the main title for the graph
		main=getFredMetadata(series_id, "title"),
		# put units on the y-axis
		ylab=getFredMetadata(series_id, "units")
	)
	# Source attribution in small type along the bottom
	mtext(
		paste(
			"Source: FRED, Federal Reserve Economic Data, from the Federal Reserve Bank of St. Louis; series", 
			series_id
		),
		side=1, # bottom
		adj=0,  # align left
		padj=1, # align bottom
		line=3, # don't overlap the x-axis
		cex=0.7 # font size
	)
	# Write to pdf
	dev.print(device=pdf, paste(series_id, "pdf", sep="."))
	# Write to eps
	dev.print(device=postscript, paste(series_id, "eps", sep="."))
}