ggplot(adjusted.salaries.frame, aes(x=yearID, y=payroll)) +
  geom_point() +
  geom_point(aes(x=adjusted.yankees.frame$yearID, y=adjusted.yankees.frame$payroll, 
      color="Yankees", colour=adjusted.yankees.frame$Result, 
      shape=adjusted.yankees.frame$Result), size=5) +
  geom_line(aes(x=adjusted.yankees.frame$yearID, y=adjusted.yankees.frame$payroll, 
      color="Yankees"), size=1.1) +
  
  ylab("Team Payroll (in U.S. Dollars)") +
  xlab("Year") +
  
  opts(title="MLB Payrolls: The New York Yankees vs All Other Teams (adjusted for inflation)",
    legend.title = theme_blank(),
    panel.background = theme_blank()) +
  scale_y_continuous(formatter = mysep)

This is a very quick post just to share a quick tip on how to add non overlapping labels to a scatterplot in ggplot using a great package called directlabels. The trick is to make each point a single member group using an aesthetic like colour and then apply the direct.label function with the first.qp method. Some example code and output is below

library(ggplot2)
library(directlabels)
x<-runif(10)
y<-rnorm(10)
z<-as.character(midwest$county[1:10])
q<-qplot(x,y)+geom_point(aes(colour=z))
direct.label(q, first.qp)

If there are better ways then I’d love to know but it works well for me and has the added advantage that the labels are matched to the points by colour.

My R package designed to import all of the Berkeley Earth Surface temperature data is officially on CRAN, as BerkeleyEarth.  The version there is 1.3 and I’ve completed some testing with the help of David Vavra. The result of that is version 1.5 which is available here at the drop box. I’ll be posting that to CRAN in a bit.  For anyone who has worked with temperature data from the various sources  Berkeley Earth is a godsend. For the first time we have a dataset that brings together all the open available temperature datasets into one consistent format. The following sources are merged and reconciled.

1. Global Historical Climatology Network – Monthly
2. Global Historical Climatology Network – Daily
3. US Historical Climatology Network – Monthly
4.  World Monthly Surface Station Climatology
5.  Hadley Centre / Climate Research Unit Data Collection
6.  US Cooperative Summary of the Month
7.  US Cooperative Summary of the Day
8.  US First Order Summary of the Day
9.  Scientific Committee on Antarctic Research
10.  GSN Monthly Summaries from NOAA
11.  Monthly Climatic Data of the World
12.  GCOS Monthly Summaries from DWD
13.  World Weather Records (only those published since 1961)
14.  Colonial Era Weather Archives.

The data files are availabe here: http://berkeleyearth.org/data/

Let’s start with a top level description of the dataflow through the system. All the source data is collected and turned into a common format: http://berkeleyearth.org/source-files/.   Those files are then merged into a single file called the “multi value” file. In this file every series for every station is present. The data format for all the temperature data files is common: there are 7 columns: Station Id, Series Number, Date, Temperature, Uncertainty, Observations, and Time of Observation. So, in the “multi-value” file a single station will have multiple series numbers.  In the next step of the process “single value” files are created. There are four versions of these files depending upon the Quality control applied and whether or not seasonality is removed.  Thus there are 5 versions of the  data: Multi value, single value with no QC and no removal of seasonality, single value with QC and no removal… you get the idea. In addition, the final files are delivered as TMAX, TMIN and TAVG. In other words there are 15 datasets.

The 15 datasets can all be downloaded with version 1.5 of the package using the function downloadBerkeley(). The function is passed a data.frame of Urls to the files and those selected are downloaded and unzipped. In this process the package will create Three top level directories: TAVG, TMIN, and TMAX.  Files are then downloaded to sub directories under the correct directory. It’s vitally important to keep all directories and file names intact for this package to function. The file named “data.txt”, has the same name across all 15 versions, so keeping things organized via directory structure will prevent obvious mistakes. There is a safeguard of sorts in the files themselves. Every file starts with comments that indicate the type of file that it is ( Tmax, multi value ). I’ve included a function getFileInformation()  that will iterate through a directory and write this information to a local file. That function also  reads all the files and extracts the “readme” headers, writing them to a separate “readme” subdirectory.

The download takes a while and I suggest you fire it up and leave your system alone while it downloads and unpacks the data. Should you get any warnings  or errors you can always patch things up by hand ( download manually) or call downloadBerkeley() again subsetting the  url data.frame to target those files that get corrupted. That is, on occasion you MAY get a warning that the file size downloaded doesnt match the file description. I suggest patching these up by hand downloading. I could, of course add some code to check and verify the whole downloading process, so ask if you would like that.

Once you have all the files downloaded you are ready to use the rest of the package. Every folder has the same set of files: data related to the stations and the core file “data.txt” The station metadata comes in several versions from the bare minimum ( station, lat,lon, altitude) to the complete station descrition. Functions are provided to read every file: They are all named to let you know exactly what file they read   readSiteComplete()  readSiteDetail().  The filenames are all defaulted to the Berkeley defined name. You merely set the Directory name and call the function. All functions return a data.frame with standard R NA’s used in place of the Berkeley values for NA.  In addition, I’ve rearranged some of the data columns so that the station inventories can be used with the package RghcnV3.

The big task in all of this is reading the file “data.txt”. On the surface it’s easy. Its a 7 column file that can be read as a matrix, using read.delim(). There are two challenges. The first challenge is the “sparse” time format. There are over 44K stations. Some of those stations have a couple months of data, others have data from 1701 on. Some stations have complete records with reports for every month; other stations have gaps in there reporting. Berkeley common format only reports the  months that have data. Like So:

Station    Series     date  Temperature

1               1           1806.042    23

1               1           1925.125     16

If all the dates between 1806 and 1925 have no records ( either absent or dropped because of QC)  then the months are simply missing. There are no NA. This gives us a very compact data storage solution, however, if you want to do any real work you have to put that data into a structure like a time series or a matrix where all times of all stations are aligned. In short, you need to fill in NAs. And you have to do this every time you  read the data in. At some point I expect that people will get that storage is cheap and they will just store NAs where they are needed. Reading in sparse data and filling in NAs is simple, time consuming, and prone to bone headed mistakes. Our second challenge is memory. Once we’ve expanded the data to include NA we run the risk of blowing thru RAM. Then if we want to calculate on the data we might make intermediate versions. More memory. There isn’t a simple solution to this, but here is what version 1.5 has. It has three different routines for reading in the data:

readBerkeleyData():  This routine  reads all 7 data columns and does no infilling. Its primary purpose is to create a memory backed file of the data. However, if you want to analyze things like time of observation or number of observations you have to use this function. Also, if you have your own method of “infilling NA”   you can use this to grab all the data in its time sparse format. On FIRST read the function will take about 10 minutes to create a file backed version of the matrix using the package bigmemory. Every subsequent use of the call gets you immediate access to the data.bin file it creates.

readBerkeleyTemp(): this routine also creates a file backed matrix. On the very first call it sees if the temperature.bin file exists. Since that file doesnt exists,  it is created. It is created from “data.txt” OR “data.bin”.  Data.bin is created by readBerkeleyData(). So basically, readBerkeleyTemp() on first pass calls readBerkeleyData(). If readBerkeleyData() hasn’t been called before, it is called and data.bin is created and returned to readBerkeleyTemp(). The function then proceeds to create a file called temperature.bin.  That file has a column for every station and a row for every time. NAs are put in place. The column names are also used to represent the station Id. Row names are used for time. The Berkeley “date” format is changed as well.  This process can take over 2 hours. A buffer variable is provided to control how much data is read in before it is flushed to disk. It is set to 500K.  At some stage This buffer will be optimized to the local RAM actually available. If you have more than 4GB you can play with this number to see if that speeds things up.

Lastly the function  readAsArray() is provided. This function does not create a file backed matrix. It reads in “data.txt” and creates a 3D array of temperature only. The first dimension is stations, the second is months and the third  is years. dimnames are provided. This data structure is used by the analytical functions in RghcnV3.

Do you have tens of histograms to show but no room to put them all on the page? As I was reading this paper in Nature Genetics, I came across a simple and clever way of packing all this information in a small space: arrange them all around a circle, and add some guides to help their cross-comparison.

It didn’t look too difficult to implement in ggplot2 thanks to polar coordinates and after a busy Saturday afternoon I ended up with the following image with my data (*) (and a poster-ready pdf, after 2 seconds of prettying up with Inkscape):

The graph shows the proportion of some SNP scores (‘first’, ‘second’ and ‘third’) for a number of phenotypes, which are grouped by themes. I’m quite happy with the result. It’s pretty and useful: it’s very easy to compare one histogram with any of the other 60.

The code is still a bit rough around the edges; a few things are not terribly elegant or are hard-coded. An improved version will be shipped with our graphical package next month. In the mean-time, here it is, if you want to try it with your own data.

It returns a ggplot object containing the graph. You can either display it, with print(), save it as a pdf with ggsave(“myPlot.pdf”) or modify it with the usual ggplot2 commands. I’ve called it polar histogram, which, I think, is self-explanatory. If you know how it’s actually called, please let me know. (No, I will not call it polR histogram.)

And here is some fake data to get you going:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34

# fake data for polarHistogram()
# Christophe Ladroue
library(plyr)
library(ggplot2)
source("polarHistogram.R")
 
# a little helper that generates random names for families and items.
randomName<-function(n=1,syllables=3){
  vowels<-c("a","e","i","o","u","y")
  consonants<-setdiff(letters,vowels)
  replicate(n,
            paste(
              rbind(sample(consonants,syllables,replace=TRUE),
                    sample(vowels,syllables,replace=TRUE)),
              sep='',collapse='')
            )
}
 
  set.seed(42)
 
  nFamily<-20
  nItemPerFamily<-sample(1:6,nFamily,replace=TRUE)
  nValues<-3
 
  df<-data.frame(
    family=rep(randomName(nFamily),nItemPerFamily),
    item=randomName(sum(nItemPerFamily),2))
 
df<-cbind(df,as.data.frame(matrix(runif(nrow(df)*nValues),nrow=nrow(df),ncol=nValues)))
 
 
  df<-melt(df,c("family","item"),variable_name="score") # from wide to long
  p<-polarHistogram(df,familyLabel=FALSE)
  print(p)

Options:
Many defaults can be changed already, look at the code for the complete list. The two things you might want to change are familyLabels (logical) which displays (or not) the name of each group as well, and direction, which is either ‘inwards’ or ‘outwards’.

Coding notes:
It wasn’t terribly difficult but it did take me a bit longer than expected, for a few reasons:

1. coord_polar() doesn’t affect the orientation of geom_text() so it had to be calculated manually.


2. You’ll notice that the label orientations change between 6 and 9 o’clock, or they would end up upside down and be difficult to read.
3. There are some scoping issues with plyr and ggplot2 which can be a bit annoying once you encapsulate your code in a function. For example:
   Select All Code:

   1 2 3 4 5 6 7 8 9 10 11 12 13 14

   df<-data.frame( x=runif(10), y=runif(10))   z<-10 ggplot(df)+geom_point(aes(x=x+z,y=y)) # works   rm(z) fakeFunction<-function(df){ z<-10 ggplot(df)+geom_point(aes(x=x+z,y=y)) }   fakeFunction(df) # error

Happy plotting!

(*) The numbers are fudged, don’t spend time reverse-engineering them.

This is the fourth post in the series about Multiple Factor Models. I will build on the code presented in the prior post, Multiple Factor Model – Building CSFB Factors, and I will show how to build a multiple factor risk model. For an example of the multiple factor risk models, please read following references:

• MSCI Barra United States Equity Multi-Factor Model, page 101
• Northfield Fundamental Risk Model

The outline of this post:

• Run cross sectional regression to estimate factor returns
• Compute factor covariance using shrinkage estimator
• Forecast stocks specific variances using GARCH(1,1)
• Compute portfolio risk using multiple factor model and compare it to the historical standard deviation of portfolio returns.

Let’s start by loading the CSFB factors that we saved at the end of the prior post. [If you are missing data.factors.Rdata file, please execute fm.all.factor.test() function first to create and save CSFB factors.] Next, I will run cross sectional regression to estimate factor returns.

###############################################################################
# Load Systematic Investor Toolbox (SIT)
# http://systematicinvestor.wordpress.com/systematic-investor-toolbox/
###############################################################################
con = gzcon(url('http://www.systematicportfolio.com/sit.gz', 'rb'))
    source(con)
close(con)
	#*****************************************************************
	# Load factor data that we saved at the end of the fm.all.factor.test functions
	#****************************************************************** 
	load.packages('quantmod,abind')	
		
	load(file='data.factors.Rdata')
		# remove Composite Average factor
		factors.avg = factors.avg[which(names(factors.avg) != 'AVG')]	
		
	#*****************************************************************
	# Run cross sectional regression to estimate factor returns
	#****************************************************************** 
	nperiods = nrow(next.month.ret)
	n = ncol(next.month.ret)
		
	# create sector dummy variables: binary 0/1 values for each sector
	nsectors = len(levels(sectors))	
	sectors.matrix = array(double(), c(nperiods, n, nsectors))
		dimnames(sectors.matrix)[[3]] = levels(sectors)		
	for(j in levels(sectors)) {
		sectors.matrix[,,j] = matrix(sectors == j,  nr=nperiods, nc=n, byrow=T)
	}
	
	# create matrix for each factor
	factors.matrix = abind(factors.avg, along = 3)		
	
	# combine sector dummies and all factors
	all.data = abind(sectors.matrix, factors.matrix)		
	
	# create betas and specific.return
	beta = all.data[,1,] * NA
	specific.return = next.month.ret * NA
		nfactors = ncol(beta)
		
	# append next.month.ret to all.data			
	all.data = abind(next.month.ret, all.data, along = 3)
		dimnames(all.data)[[3]][1] = 'Ret'
			
	# estimate betas (factor returns)
	for(t in 12:(nperiods-1)) {		
		temp = all.data[t:t,,]
		x = temp[,-c(1:2)]
		y = temp[,1]
		b = lm(y~x)$coefficients
		
		b[2:nsectors] = b[1] + b[2:nsectors]
		beta[(t+1),] = b		
		
		specific.return[(t+1),] = y - rowSums(temp[,-1] * matrix(b, n, nfactors, byrow=T), na.rm=T)	
	}

To estimate factor returns (betas), we solve for coefficients of the following multiple factor model:

Ret = b1 * F1 + b2 * F2 + ... + bn * Fn + e
where
b1...bn are estimated factor returns
F1...Fn are factor exposures. I.e. sector dummies and CSFB factor exposures
e is stock specific return, not captured by factors F1...Fn

Note that we cannot include the first sector dummy variable in the regression, otherwise we will get a linearly dependent relationship of the first sector dummy variable with all other sector dummy variables. The sector effect of the first sector dummy variable is absorbed into the intercept in the regression.

There are a few alternative ways of estimating this regression. For example, the robust linear model can be estimated with following code:

	load.packages('MASS')
	temp = rlm(y~x)$coefficients

The quantile regression can can be estimated with following code:

	load.packages('quantreg')
	temp = rq(y ~ x, tau = 0.5)$coefficients

Next let’s look at the cumulative factor returns.

	#*****************************************************************
	# helper function
	#****************************************************************** 	
	fm.hist.plot <- function(temp, smain=NULL) {			
		ntemp = ncol(temp)		
		cols = plota.colors(ntemp)	
		plota(temp, ylim = range(temp), log='y', main=smain)
		for(i in 1:ntemp) plota.lines(temp[,i], col=cols[i])
		plota.legend(colnames(temp), cols, as.list(temp))
	}

	#*****************************************************************
	# Examine historical cumulative factor returns
	#****************************************************************** 	
	temp = make.xts(beta, index(next.month.ret))
		temp = temp['2000::',]
		temp[] = apply(coredata(temp), 2, function(x) cumprod(1 + ifna(x,0)))
	
	fm.hist.plot(temp[,-c(1:nsectors)], 'Factor Returns')

The Price Reversals(PR) and Small Size(SS) factors have done well.

Next let’s estimate the factor covariance matrix over the rolling 24 month window.

	load.packages('BurStFin')	
	factor.covariance = array(double(), c(nperiods, nfactors, nfactors))
		dimnames(factor.covariance)[[2]] = colnames(beta)
		dimnames(factor.covariance)[[3]] = colnames(beta)

	# estimate factor covariance
	for(t in 36:(nperiods-1)) {
		factor.covariance[t,,] = var.shrink.eqcor(beta[(t-23):t,])
	}

Next let’s forecast stocks specific variances using GARCH(1,1). I will use the GARCH estimation routine described in the Trading using Garch Volatility Forecast post.

	#*****************************************************************
	# Compute stocks specific variance foreasts using GARCH(1,1)
	#****************************************************************** 	
	load.packages('tseries,fGarch')	

	specific.variance = next.month.ret * NA

	for(i in 1:n) {
		specific.variance[,i] = bt.forecast.garch.volatility(specific.return[,i], 24) 
	}

Now we have all the ingredients to compute a portfolio risk:

Portfolio Risk = (common factor variance + specific variance)^0.5
	common factor variance = (portfolio factor exposure) * factor covariance matrix * (portfolio factor exposure)'
	specific variance = (specific.variance)^2 * (portfolio weights)^2

	#*****************************************************************
	# Compute portfolio risk
	#****************************************************************** 
	portfolio = rep(1/n, n)
		portfolio = matrix(portfolio, n, nfactors)
	
	portfolio.risk = next.month.ret[,1] * NA
	for(t in 36:(nperiods-1)) {	
		portfolio.exposure = colSums(portfolio * all.data[t,,-1], na.rm=T)
		
		portfolio.risk[t] = sqrt(
			portfolio.exposure %*% factor.covariance[t,,] %*% (portfolio.exposure) + 
			sum(specific.variance[t,]^2 * portfolio[,1]^2, na.rm=T)
			)
	}

Next let’s compare portfolio risk estimated using multiple factor risk model with portfolio historical risk.

	#*****************************************************************
	# Compute historical portfolio risk
	#****************************************************************** 
	portfolio = rep(1/n, n)
		portfolio = t(matrix(portfolio, n, nperiods))
	
	portfolio.returns = next.month.ret[,1] * NA
		portfolio.returns[] = rowSums(mlag(next.month.ret) * portfolio, na.rm=T)
	
	hist.portfolio.risk = runSD(portfolio.returns, 24)
	
	#*****************************************************************
	# Plot risks
	#****************************************************************** 			
	plota(portfolio.risk['2000::',], type='l')
		plota.lines(hist.portfolio.risk, col='blue')
		plota.legend('Risk,Historical Risk', 'black,blue')

The multiple factor risk model does a decent job of estimating portfolio risk most of the time.

To view the complete source code for this example, please have a look at the fm.risk.model.test() function in factor.model.test.r at github.

Lately I have been rather productive in my programming and frustrated at the same time. Trying to solve the problems of creating a demographics summary table proved to be a lesson in frustration with R. Since I love R, this was disheartening. I did eventually find the reporttools package which does make a great latex table, but onlyin latex. Also the tables package looks great, but also not entirely what I was looking for, so I do the first logical thing for an R User when faced with this sort of thing. I created a package to fill in the missing functionality.

The dostats package/function

The new package is dostats. There are two functions of the package.

1. Create summaries of vectors through the dostats function.
2. Manipulate functions.

The package started out with the dostats function for creating more informative summary tables. It works very similar with tabular from tables package, but it is designed to work with plyr functions. The idea is to pass in a vector as the first argument and then the remaining arguments are functions that compute statistics on the vector. For example:

library(dostats)
set.seed(20120220)
dostats(rnorm(100), mean, sd, N = length)

##     mean     sd   N
## 1 0.0775 0.8975 100

There is also the renaming construct built in to create the desired variables. This construct is nice because it facilitates easily passing as an argument into ldply such as

library(plyr)
ldply(mtcars, dostats, mean, sd, IQR)

##     .id     mean       sd     IQR
## 1   mpg  20.0906   6.0269   7.375
## 2   cyl   6.1875   1.7859   4.000
## 3  disp 230.7219 123.9387 205.175
## 4    hp 146.6875  68.5629  83.500
## 5  drat   3.5966   0.5347   0.840
## 6    wt   3.2172   0.9785   1.029
## 7  qsec  17.8487   1.7869   2.008
## 8    vs   0.4375   0.5040   1.000
## 9    am   0.4062   0.4990   1.000
## 10 gear   3.6875   0.7378   1.000
## 11 carb   2.8125   1.6152   2.000

This makes for a more logical summary data.frame object that has usable columns, each with the same data type. Unfortunatly this does not always work for all data set. The above example only has numerical data. Any data frame with categorigal data would have that data treated as categorical. Another limitation is that the results of each function must be the same dimention for each variable. For this reason I introduced functions that filter by the variable class.

• class.stats creates a dostats function for a given class, tested by inherits.
• integer.stats predefined class stats for integer variables. This defined as class.stats('integer')
• numeric.stats for numeric variables, which would also include integer variables.
• factor.stats for factors.

When a class.stats function is passed to ldply, variable not matching that class are silently removed.

ldply(iris, numeric.stats, mean, sd)

##            .id  mean     sd
## 1 Sepal.Length 5.843 0.8281
## 2  Sepal.Width 3.057 0.4359
## 3 Petal.Length 3.758 1.7653
## 4  Petal.Width 1.199 0.7622

ldply(iris, factor.stats, N = length)

##       .id   N
## 1 Species 150

You can also chain together arguments to compute on subsets using ddply and ldply.

ddply(iris, .(Species), ldply, numeric.stats,
    mean, median, sd)

##       Species          .id  mean median     sd
## 1      setosa Sepal.Length 5.006   5.00 0.3525
## 2      setosa  Sepal.Width 3.428   3.40 0.3791
## 3      setosa Petal.Length 1.462   1.50 0.1737
## 4      setosa  Petal.Width 0.246   0.20 0.1054
## 5  versicolor Sepal.Length 5.936   5.90 0.5162
## 6  versicolor  Sepal.Width 2.770   2.80 0.3138
## 7  versicolor Petal.Length 4.260   4.35 0.4699
## 8  versicolor  Petal.Width 1.326   1.30 0.1978
## 9   virginica Sepal.Length 6.588   6.50 0.6359
## 10  virginica  Sepal.Width 2.974   3.00 0.3225
## 11  virginica Petal.Length 5.552   5.55 0.5519
## 12  virginica  Petal.Width 2.026   2.00 0.2747

Function manipulations

Passing all these functions around also requires some extra function manipulation functions. Now that is a mouthful, but something we do with R.

Composition

R lacks a function composition function. So I created one. function(x)any(is.na(x)) is just to long to type, and I find myself doing things like this far too often. The word “function” is just too long to type and takes up lots of space. It is much easier to do any%.%is.na or compose(any, is.na) either of which results in a function that creates a new function testing if there are any missing values. The two forms are

1. compose(...)
2. fun1%.%fun2

compose takes any number of arguments and nests them with the right most being the inner most and the left being the outermost. The easy to remember is that they read the same as when they were input.

Argument Manipulations

Composition and dostats, only operate on the first argument which necessitates functions for manipulating arguments.

1. wargs: creates a new function with changed defaults. An example would be wargs(mean, rm.na=T) creates a new function that automatically removes missing values.
2. onarg: Specifies the first argument for the function. Such as onarg(rep,'times') makes the number of times to repeate the first argument.

One example of this that is included in dostats is the contains and %contains% which is the reverse order of %in%.

Conclussion

There will likely be more functions as I come across the necessity. If you have an idea that should be included submit to the issues tracker.

When I ran

> test=NULL
> for (i in 1:10){
+   if (i%%2!=0){
+     test=c(test,i)
+     i=i+2}}
> test
[1] 1 3 5 7 9

I was expecting the same output as

> test=NULL
> i=1
> while (i test
[1] 1 5 9

So this means that the dummy index in R “for” loops cannot be tweaked that easily. I seem to remember doing this kind of (dirty) tricks with earlier versions… Now, Alessandra and Robin think this is a good thing that the for loop is robust against this kind of non-sense, so I may be a minority in complaining about this lack of control [for me, if not for for].