Initiates into the mysteries of the goddess Logical Rigor use a strange speech among themselves, and find it all but impossible to communicate their visions to the mass of ordinary, unilluminated mankind. This accounts in part for the fact that, of the three disciplines most devoted to that goddess, analytical philosophy and neo-classical economics have done next to nothing to shape thought and the culture at large, or even within the academy, while mathematics gave up all such pretensions long ago.¹

I am not sure when it happened, but, at some point over the past ten years, I started to avoid arguing certain issues with people not familiar with rigorous mathematics, because I found it too upsetting to be reminded that many settled questions were still considered open to serious disagreement of opinion. Hopefully at some point I’ll find a better way to resolve these issues, because there is so much known only by the devotees of the goddess Logical Rigor that could benefit people, if only it were explained in a way they could understand. Sadly, I find it largely impossible to give someone more than a superficial intuition of how economic theory works without resorting to mathematics.

1. From Cosma Shalizi’s Review of Roemer’s “A Future for Socialism”

I’ve only been using these diagnostics for a week now for an academic project of my own, so I’ll summarize my understanding of their use as it stands today. Please correct me if I’m spreading misinformation.

As I see it, all diagnostics used to analyze the output of an MCMC sampler try to answer a simple question: has the sampler been given a sufficient adaptation (“burn-in”) period to justify your claim that the samples you draw from the chains approximate the posterior distribution of interest to you? This question in turn leads one to analyzing the samples drawn after the burn-in period for obvious warning signs. To test for these potential warning signs, it’s easiest to use the diagnostic functions that are included in coda.

To make the use of coda clear, I’m going to follow up on the linear regression example that I used in my last post. First, we generate some data from a linear model:

1
2
3
4
5
6

library('rjags')
 
N <- 1000
x <- 1:N
epsilon <- rnorm(N, 0, 1)
y <- x + epsilon

Then we set up our BUGS/JAGS model in example.bug:

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

model
{
	for (i in 1:N)
	{
		y[i] ~ dnorm(y.hat[i], tau)
		y.hat[i] <- a + b * x[i]
	}
	a ~ dnorm(0, .0001)
	b ~ dnorm(0, .0001)
	tau <- pow(sigma, -2)
	sigma ~ dunif(0, 100)
}

All of this is copied exactly from my earlier post. Now we change things by replacing our call to jags.samples() with a call to coda.samples(). This will provide output from JAGS in the format necessary for using the two diagnostic functions I understand best: plot() and gelman.plot().

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

jags <- jags.model('example.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 10)
samples <- coda.samples(jags,
                        c('a', 'b'),
                        1000)
png('plot_1.png')
plot(samples)
dev.off()

Because we have used such a small number of adaptive samples (only 10), our call to jags.model will produce this warning message:

1
2
3

#Warning message:
#In adapt(model, n.adapt) :
#  Adaptation incomplete. Recreate the model with a longer adaptive phase.

Thankfully, this message is not the only evidence that we’ve used too few adaptive samples: you can also tell from the output of our call to plot():

The density plots for a and b in the right column are very suspicious: they are extremely pointed and seem to include a large number of outlier values that don’t belong if the values for a and b are normally distributed. You can also see these extreme values in the trace plots in the left column as well: they are the extreme values at the start of the trace for each chain.

Simply using 1,000 adaptive samples instead of 10 makes a world of difference:

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

jags <- jags.model('example.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 1000)
samples <- coda.samples(jags,
                        c('a', 'b'),
                        1000)
png('plot_2.png')
plot(samples)
dev.off()

In this image, you can see that the trajectory of the chain is consistent over time and that its distribution looks appropriately normal. So the first takeaway message is simple: check the traces and distributions of your variables using plot() to make sure that they are reasonable and don’t indicate clear deficiencies in the length of your adaptation period. When you know the distributional form of your posteriors, this is particularly effective, as in our example here, where we know to expect normal distributions.

Another diagnostic tool is the Gelman plot, which has a simple logic to it: you test how similar the various chains you’re using are as a way to detect whether they’ve hit the target distribution. This similarity is what’s called mixing. To start, it’s easier to simply repeat our examples above using the Gelman plot:

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

jags <- jags.model('example.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 10)
samples <- coda.samples(jags,
                        c('a', 'b'),
                        1000)                        
png('plot_3.png')
gelman.plot(samples)
dev.off()

And then you can try to see how the plot looks different when you switch to a longer adaptive period:

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

jags <- jags.model('example.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 1000)
samples <- coda.samples(jags,
                        c('a', 'b'),
                        1000)                        
png('plot_4.png')
gelman.plot(samples)
dev.off()

Unfortunately, given our current call to jags.model(), it’s quite hard visually to identify convergence using Gelman plots, since the scales of these plots are not identical across our two examples, and the most prominent visual patterns are likely to be the results of random noise. There is a reason for this difficulty: we’re not properly initializing our sampler’s starting values separately for each chain. Both chains start from identical positions, which means that we don’t have enough power to really see the size of the space a theoretical chain might pass through before settling down. To fix that, we change our call to jags.model() to include an inits value, for which we provide an anonymous function that provides random values consistent with the prior we specified in example.bug. First, let’s repeat our previous approach again:

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

jags <- jags.model('example.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 10)
samples <- coda.samples(jags,
                        c('a', 'b'),
                        1000)
png('plot_5.png')
gelman.plot(samples)
dev.off()

Now let’s add proper random initialization for the starting position of each chain:

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

jags <- jags.model('example.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   inits = function ()
                   {
                     list('a' = rnorm(1, 0, 100),
                          'b' = rnorm(1, 0, 100))
                   },
                   n.chains = 4,
                   n.adapt = 10)
samples <- coda.samples(jags,
                        c('a', 'b'),
                        1000)
png('plot_6.png')
gelman.plot(samples)
dev.off()

Now you should be able to easily see that the chains are converging near the end of the sampling period, and that we would do well to give ourselves a greater adaptation period before using any of the samples we’ve generated, since the early samples in the chain are far too dispersed.

With these two techniques you should be able to diagnose obvious deficiencies in the length of your adaptive period.

1
2
3
4

package.info <- installed.packages()[,c(1,3)]
write.csv(package.info,
          file = 'my_installed_packages.csv',
          row.names = FALSE)

and sending me the output file my_installed_packages.csv by e-mail to jmw@johnmyleswhite.com.

It’s extraordinary how just the world can be at times.

As many people already know, I’ve recently uploaded a new R package called ProjectTemplate to GitHub and CRAN. The ProjectTemplate package provides a function, create.project(), that automatically builds a directory for a new R project with a clean sub-directory structure and automatic data and library loading tools. My hope is that standardized data loading, automatic importing of best practice packages, integrated unit testing and useful nudges towards keeping a cleanly organized codebase will improve the quality of R coding.

My inspiration for this approach comes from the rails command from Ruby on Rails, which initializes a new Rails project with the proper skeletal structure automatically. Also taken from Rails is ProjectTemplate’s approach of preferring convention over configuration: the automatic data and library loading as well as the automatic testing work out of the box because assumptions are made about the directory structure and naming conventions that will be used in your code. You can customize your codebase however you’d like, but you will have to edit the automation scripts to use your conventions instead of the defaults before you’ll get their benefits again.

In what follows, I try to highlight the state of the package as of today.

Installing

ProjectTemplate is available on CRAN and can be installed using a simple call to install.packages():

1

install.packages('ProjectTemplate')

If you would like access to changes that are not available in the current version on CRAN, please download the contents of the GitHub repository and then run,

1
2

R CMD BUILD .
R CMD INSTALL ProjectTemplate_*.tar.gz

Example Code

To create a new project called my-project, open R and type:

1
2

library('ProjectTemplate')
create.project('my-project')

To enter that project’s home directory and start working, type:

1
2

setwd('my-project')
load.project()

Once you have code worth testing, you can also type,

1

run.tests()

to automatically run all of the unit tests in your tests directory.

If you’re interested in these last two functions, you should know that load.project() is essentially a mnemonic for calling source('lib/boot.R'), which automatically loads all of your libraries and data sets. Similarly, run.tests() is essentially a mnemonic for calling source('lib/run_test.R'), which automatically runs all of the ‘testthat’ style unit tests contained in your tests directory.

Overview

As far as ProjectTemplate is concerned, a good project should look like the following:

• project/
• data/
• diagnostics/
• doc/
• graphs/
• lib/
• boot.R
• load_data.R
• load_libraries.R
• preprocess_data.R
• run_tests.R
• utilities.R
• profiling/
• reports/
• tests/
• README
• TODO

To do work on such a project, enter the main directory, open R and type source('lib/boot.R'). This will then automatically perform the following actions:

• source('lib/load_libraries.R'), which automatically loads the CRAN packages currently deemed best practices. At present, this list includes:
  • reshape
  • plyr
  • stringr
  • ggplot2
  • testthat
• source('lib/load_data.R'), which automatically imports any CSV or TSV data files inside of the data/ directory.
• source('lib/preprocess_data.R'), which allows you to make any run-time modifications to your data sets automatically. This is blank by default.

Default Project Layout

Within your project directory, ProjectTemplate creates the following directories and files whose purpose is explained below:

• data: Store your raw data files here. If they are CSV or TSV files, they will automatically be loaded when you call load.project() or source('lib/boot.R'), for which load.project() is essentially a mnemonic.
• diagnostics/: Store any scripts you use to diagnose your data sets for corruption or problematic data points. You should also put code that globally censors any data points here.
• doc/: Store documentation for your analysis here.
• graphs/: Store any graphs that you produce here.
• lib/: Store any files that provide useful functionality for your work, but do not constitute a statistical analysis per se here.
• lib/boot.R: This script handles automatically loading the other files in lib/ automatically. Calling load.project() automatically loads this file.
• lib/load_data.R: This script handles the automatic loading of any CSV and TSV files contained in data/.
• lib/load_libraries.R: This script handles the automatic loading of the best practice packages, which are reshape, plyr, stringr, ggplot2 and testthat.
• lib/preprocess_data.R: This script handles the preprocessing of your data, if you need to add columns at run-time or merge normalized data sets.
• lib/run_tests.R: This script automatically runs any test files contained in the tests/ directory using the 'testthat' package. Calling run.tests() automatically runs this script.
• lib/utilities.R: This script should contain quick general purpose code that belongs in a package, but hasn't been packaged up yet.
• profiling/: Store any scripts you use to benchmark and time your code here.
• reports/: Store any output reports, such as HTML or LaTeX versions of tables here. Sweave documents should also go here.
• tests/: Store any test cases in this directory. Your test files should use 'testthat' style tests.
• README: Write notes to help orient newcomers to your project.
• TODO: Write a list of future improvements and bug fixes you have planned.

Request for Comments

I would love to hear feedback about things that ProjectTemplate is missing or should do differently. Please leave any and all comments you have.

I’m going to assume that you have access to a machine that will run JAGS. If you don’t, then you should be able to use WinBUGS, which is very easy to get set up. Unfortunately, the details of what follows may not help you as much if you’re using WinBUGS.

To set up your system for using JAGS, there are two very easy steps:

1. Go download the current version of JAGS (2.1.0 as of 8/20/2010).
2. Install the current rjags package from CRAN (2.1.0-6 as of 8/20/2010).

Once you’ve done that, a simple call to library('rjags') will be enough to run JAGS from inside of R. You’ll want to do everything except model specification in R. You’ll specify the model in a separate file using BUGS/JAGS syntax.

Example 1: Inference on Normally Distributed Data

Let’s assume that you’ve got a bunch of data points from a normal distribution with unknown mean and variance. This is arguably the simplest data set you can analyze with JAGS. So, how do you perform the analysis?

First, let’s create some simulation data that we’ll use to test our JAGS model specification:

1
2
3
4
5
6
7

N <- 1000
x <- rnorm(N, 0, 5)
 
write.table(x,
            file = 'example1.data',
            row.names = FALSE,
            col.names = FALSE)

We don’t actually need to write out the data since ‘rjags’ automatically does this for us (and in another format at that), but it’s nice to be able to check that JAGS has done something reasonable by analyzing the raw inputs post hoc.

With your simulated data in hand, we’ll write up a model specification in JAGS syntax. Put the model specification in a file called example1.bug. The complete model looks like this:

1
2
3
4
5
6
7
8

model {
	for (i in 1:N) {
		x[i] ~ dnorm(mu, tau)
	}
	mu ~ dnorm(0, .0001)
	tau <- pow(sigma, -2)
	sigma ~ dunif(0, 100)
}

In every model specification file, you have to start out by telling JAGS that you’re specifying a model. Then you set up the model for every single data point using a for loop. Here, we say that x[i] is distributed normally (hence the dnorm() call) with mean mu and precision tau, where the precision is simply the reciprocal of the variance. Then we specify our priors for mu and tau, which are meant to be constant across the loop. We tell JAGS that mu is distributed normally with mean 0 and standard deviation 100. This is meant to serve as a non-informative prior, since our data set was designed to have all measurements substantially below 100. Then we specify tau in a slightly round-about way. We say that tau is a deterministic function (hence the deterministic <- instead of the distributional ~) of sigma, after raising sigma to the -2 power. Then we say that sigma has a uniform prior over the interval [0,100].

With this model specified in example1.bug, we can write more R code to invoke it and perform inference properly:

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

library('rjags')
 
jags <- jags.model('example1.bug',
                   data = list('x' = x,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 100)
 
update(jags, 1000)
 
jags.samples(jags,
             c('mu', 'tau'),
             1000)

Obviously, we have to import the 'rjags' package. Then we need to set up our model object in R, which we do using the jags.model() function. We specify the JAGS model specification file and the data set, which is a named list where the names must be those used in the JAGS model specification file. Finally, we tell the system how many parallel chains to run. (If you don't understand what the chains represent, I'd suggest just playing around and then reading up about the issue of mixing in MCMC.) Finally, we tell the system how many samples should be thrown away as part of the adaptive sampling period for each chain. For this example, I suspect that we could safely set this parameter to 0, but it costs so little that I've used 100 just as a placeholder. After calling jags.model(), we receive a JAGS model object, which we store in the jags variable.

After all of that set up, I've chosen to have the system run another 1000 iterations of the sampler just to show how to use the update() function, even though it's completely unnecessary in this simple problem. Finally, we use jags.sample() to draw 1000 samples from the sampler for the values of the named variables mu and tau.

When you call jags.sample(), you'll see the output provides proposed values for mu and tau. These should be close to 0 and 0.04 if JAGS is working properly, since those were the mean and precision values we used to create our simulation data. (At the risk of being pedantic: we used a standard deviation of 5, which gives a variance of 25 and a precision of 1 / 25 = 0.04.) Of course, they'll be even closer to the sample mean mean(x) and the sample precision 1 / var(x), so you should not forget to compare the inferred values to these values. The sample size, 1,000, isn't large enough to guarantee that the mean will be all that close to 0.

Example 2: Basic Linear Regression

Moving on to a slightly more interesting example, we can perform a simple linear regression in JAGS very easily. As before, we set up simulation data from a theoretical linear model:

1
2
3
4
5
6
7
8
9

N <- 1000
x <- 1:N
epsilon <- rnorm(N, 0, 1)
y <- x + epsilon
 
write.table(data.frame(X = x, Y = y, Epsilon = epsilon),
            file = 'example2.data',
            row.names = FALSE,
            col.names = TRUE)

We then set up the Bayesian model for our regression in example2.bug:

1
2
3
4
5
6
7
8
9
10

model {
	for (i in 1:N){
		y[i] ~ dnorm(y.hat[i], tau)
		y.hat[i] <- a + b * x[i]
	}
	a ~ dnorm(0, .0001)
	b ~ dnorm(0, .0001)
	tau <- pow(sigma, -2)
	sigma ~ dunif(0, 100)
}

Here, we've said that every data point is drawn from a normal distribution with mean a + b * x[i] and precision tau. We assign non-informative normal priors to a and b and a non-informative uniform prior to the standard deviation sigma, which is deterministically transformed into tau.

Then, we run this model using the same exact approach as we used earlier:

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

library('rjags')
 
jags <- jags.model('example2.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 100)
 
update(jags, 1000)
 
jags.samples(jags,
             c('a', 'b'),
             1000)

After running the chain for a good number of samples, we draw inferences for a and b, which should be close to the proper values of 0 and 1. I've ignored tau here, though there's no reason not to check that it was properly inferred.

Example 3: One Dimensional Logistic Regression

Finally, it's good to see a model that's harder to implement without a good deal of knowledge of optimization tools unless you use a sampling technique like the one JAGS automates. For that purpose, I'll show how to implement logistic regression. Here we set up a simple one-dimensional predictor for our binary outcome variable and assume the standard logistic model:

1
2
3
4
5
6
7
8
9

N <- 1000
x <- 1:N
z <- 0.01 * x - 5
y <- sapply(1 / (1 + exp(-z)), function(p) {rbinom(1, 1, p)})
 
write.table(data.frame(X = x, Z = z, Y = y),
            file = 'example3.data',
            row.names = FALSE,
            col.names = TRUE)

Then we set up our Bayesian model in example3.bug, where y[i] is Bernoulli distributed (or binomial distributed with 1 draw, if you prefer that sort of thing) and the linear model coefficients a and b are given non-informative normal priors:

1
2
3
4
5
6
7
8
9

model {
	for (i in 1:N){
		y[i] ~ dbern(p[i])
		p[i] <- 1 / (1 + exp(-z[i]))
		z[i] <- a + b * x[i]
	}
	a ~ dnorm(0, .0001)
	b ~ dnorm(0, .0001)
}

Finally, we perform our standard inference calls in R to run the model through JAGS and extract predicted values for a and b.

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

library('rjags')
 
jags <- jags.model('example3.bug',
                   data = list('x' = x,
                               'y' = y,
                               'N' = N),
                   n.chains = 4,
                   n.adapt = 100)
 
update(jags, 1000)
 
jags.samples(jags,
             c('a', 'b'),
             1000)

As always, you should check that the outputs you get make sense: here, you expect a to be approximately -5 and b to be around 0.01. This inference problem should take a good bit longer to solve: there are other tools for handling logistic regressions in JAGS that are faster, but I find this approach conceptually simplest and best for highlighting the similarity to a standard linear regression.

Some Errors I Made at the Start

Here are a few errors that stumped me for a bit as I got started using JAGS today:

1. Error 1, 'Invalid parent error': I got this error when I erroneously assigned a normal prior to one of my precision variables tau. This is nonsensical, since precisions are always positive. Hence, the parent node involving tau was deemed to be 'invalid', causing a fatal run-time error.
2. Error 2, 'Attempt to redefine node z[1]': This is an error that Gelman and Hill warn users about in their ARM book: you must be sure that you don't treat the values in loops as local variables, because they cannot be reset on each iteration -- they must have unique values across all iterations. Thus, you must build an array for all of the variables that you might think of as local within loops, such as intermediate latent variables. Not doing so will produce fatal run-time errors.
3. Error 3, 'Invalid vector argument to exp': This is related to the error above: when I corrected part of my attempt to reset z on each pass through the logistic loop in Example 3, I forgot to reset it in the definition of p[i]. This led to an invalid vector with no definition being passed to the exp() function, giving a fatal run-time error.

One Question I Have

My first attempt to run a linear regression didn't work. I still don't entirely understand why, but here is the alternative code that failed if you ever make the same type of mistake and find yourself puzzled:

1
2
3
4
5
6
7
8
9
10

model {
	for (i in 1:N){
		y[i] <- a + b * x[i] + epsilon[i]
                epsilon[i] ~ dnorm(0, tau)
	}
	a ~ dnorm(0, .0001)
	b ~ dnorm(0, .0001)
	tau <- pow(sigma, -2)
	sigma ~ dunif(0, 100)
}

My assumption is that it's more difficult to infer values for all the epsilon's at the same time as tau, which makes this harder than the earlier call without any explicit epsilon values. If that's wrong, please do correct me. Another hypothesis I entertained is that it's a problem to ever set y[i] to be a deterministic node, though this doesn't seem really plausible to me.

Thankfully, Neil handed me the raw data for his plot, so I was able to run a K-S test for normality, which rejected normality pretty easily, though I’m coming up with a tie that I’m surprised by:

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

scores <- read.csv('twifficiencyscores.txt', header = FALSE)
scores <- scores[,1]
 
m <- mean(scores)
s <- sd(scores)
 
ks.test(scores, 'pnorm', m, s)
#
#	One-sample Kolmogorov-Smirnov test
#
#data:  scores 
#D = 0.0616, p-value < 2.2e-16
#alternative hypothesis: two-sided 
#
#Warning message:
#In ks.test(scores, "pnorm", m, s) :
#  cannot compute correct p-values with ties

I suppose that I’m a bit worried that the p-value is simply a reflection of sample size here, since there are 7089 measurements. Would it be more compelling to bootstrap the D score from the K-S test on samples of 500 scores at a time to confirm that the non-normality is present even in small groups of scores?

Assuming that the data really has a skewed distribution, does anyone understand the scoring system well enough to say what produces the asymmetry?

This week I decided to start unit testing my R code, so I taught myself the bare minimum about the RUnit and testthat packages to be able to use them. Here’s what I found necessary to get started writing tests with both packages.

RUnit Basic Example

I’m going to assume that you’ve got a bunch of functions in sample.R that you want to test. For example, sample.R might contain a definition of the naïve factorial function:

1
2
3
4
5
6
7
8
9
10
11

factorial <- function(n)
{
  if (n == 0)
  {
    return(1)
  }
  else
  {
    return(n * factorial(n - 1))
  }
}

To test your functions, create a directory called tests that will store all of your test cases. In tests, create a file called 1.R that will contain your first set of tests. Each set of tests will go in a function inside of 1.R, named according to the convention test.*. For example, you might have this:

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

test.examples <- function()
{
  checkEquals(6, factorial(3))
  checkEqualsNumeric(6, factorial(3))
  checkIdentical(6, factorial(3))
  checkTrue(2 + 2 == 4, 'Arithmetic works')
  checkException(log('a'), 'Unable to take the log() of a string')
}
 
test.deactivation <- function()
{
  DEACTIVATED('Deactivating this test function')
}

To run this set of tests, we need to create a file called run_tests.R that will act as a test suite and invoke all of the tests in your tests directory:

1
2
3
4
5
6
7
8
9
10
11

library('RUnit')
 
source('sample.R')
 
test.suite <- defineTestSuite("example",
                              dirs = file.path("tests"),
                              testFileRegexp = '^\\d+\\.R')
 
test.result <- runTestSuite(test.suite)
 
printTextProtocol(test.result)

Here you inform the defineTestSuite() function that you’re creating a test suite called “example” and that the test files are located in a directory called “tests” where all of the files match the regular expression ‘^\\d+\\.R’. Then you run the suite explicitly and print out the results in a text format.

That’s it. With those ideas, you can write your own test suite for your R code.

Using the check*() Functions

In general, with RUnit, you use a function named something like check* to test the following conditions:

• checkEquals: Are two objects equal, including named attributes?
• checkEqualsNumeric: Are two numeric values equal?
• checkIdentical: Are two objects exactly the same?
• checkTrue: Does an expression evaluate to TRUE?
• checkException: Does an expression raise an error?

In addition to these functions, there’s also a DEACTIVATED() function that lets you turn off a test function during its execution if you need to do that.

testthat Basic Example

As above, I’m going to assume that you’ve got a bunch of functions in sample.R that you want to test. And, as before, to test your functions, you should create a directory called tests that will store all of your test cases. In tests, create a file called 1.R that will contain your first set of tests. We’ll use expect_that() for all of our tests, as in the example below:

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

expect_that(1 ^ 1, equals(1))
expect_that(2 ^ 2, equals(4))
 
expect_that(2 + 2 == 4, is_true())
expect_that(2 == 1, is_false())
 
expect_that(1, is_a('numeric'))
 
expect_that(print('Hello World!'), prints_text('Hello World!'))
 
expect_that(log('a'), throws_error())
 
expect_that(factorial(16), takes_less_than(1))

To run this set of tests, we need to create a file called run_tests.R that will act as a test suite and invoke all of the tests in your tests directory:

1
2
3
4
5

library('testthat')
 
source('sample.R')
 
test_dir('tests', reporter = 'Summary')

To get output, you have to inform test_dir() to use the SummaryReporter, which provides more than enough information for my purposes. See the testthat docs for other reporters you could use.

Using expect_that()

In general, you can ask expect_that() to test the following conditions:

• is_true: Does the expression evaluate to TRUE?
• is_false: Does the expression evaluate to FALSE?
• is_a: Did the object inherit from a specified class?
• equals: Is the expression equal within numerical tolerance to your expected value?
• is_equivalent_to: Is the object equal up to attributes to your expected value?
• is_identical_to: Is the object exactly equal to your expected value?
• matches: Does a string match the specified regular expression?
• prints_text: Does the text that’s printed match the specified regular expression?
• throws_error: Does the expression raise an error?
• takes_less_than: Does the expression take less than a specified number of seconds to run?

More testthat Tricks

There are some other tricks that testthat can do as well. It can automatically rerun tests on a directory of code whenever the code is edited using a function called auto_test() and it can set up contexts to separate tests using a function context(). I haven’t really explored either, so I can’t comment more on them.

Which to Use?

While I don’t think the arguments on behalf of either RUnit or testthat are unquestionable, I’m inclined to think that testthat has a brighter future, especially since it’s written by ggplot2′s author, Hadley Wickham.

I decided to get involved with this project because I feel that existing dating sites are not taking advantage of the tools that machine learning provides for building better recommendation systems, which a dating site effectively is at its core. The contrast between the quality of suggestions that you get from Netflix and the quality of matches you get on existing dating sites is so great that I felt compelled to get involved, if only to see if we could do something to improve the state of the art in the field.

While there are many reasons why matching people with other people that they’d be interested in dating is harder than matching people with movies they’d be interested in watching or webpages they’d be interested in reading, I’ve become increasingly convinced that the big players in the online dating market are either unaware of or simply indifferent to the tools that computer scientists can offer them. I’d really like to help remedy that. With the so-called Age of Big Data upon us, I think dating sites need to exploit the amount of information they collect by turning things over to statistical algorithms that can do a more effective job of inferring people’s preferences.

We’ve built Junebug to do just that. We’ve got a lot of great algorithms ready to churn through the user data we’re hoping to collect. We need your help, though, because we don’t have much real data yet. If you’re reading this and are single, please sign up, try out the site, and tell us what we can do to make it more enjoyable to use. And it would be even better if you told your friends to try out the site as well, since that would start to provide us with the amount of data we need to really show much more effective a systematic statistical approach can be for building a better dating site.

If you think that online dating can be improved by the introduction of more sophisticated mathematical analysis, please helps us prove that’s true by spreading the word and getting new people to participate on our site. We can promise to do everything we know how to do to turn the data we get into a valuable service for our users.

First, let’s start with a toy example for which there is a closed-form analytic solution. We’ll ignore that solution and use optimization functions to do the estimation. Starting with this toy example makes it easy to see how well an approximation system can be expected to perform under the best circumstances — and also where it goes wrong if you make poor programming decisions.

Suppose that you’ve got a sequence of values from an unknown Bernoulli variable like so:

1
2
3

p.parameter <- 0.8
sequence <- rbinom(10, 1, p.parameter)
# [1] 0 1 1 1 1 1 1 0 1 0

Given the sequence, we want to estimate the value of the parameter, p, which is not known to us. The maximum likelihood approach says that we should select the parameter that makes the data most probable. For a Bernoulli variable, this is simply a search through the space of values for p (i.e [0, 1]) that makes the data most probable to have observed.

It’s worth pointing out that the analytic solution to the maximum likelihood estimation problem is to use the sample mean. We’ll therefore use mean(sequence) as a measure of the accuracy of our approximation algorithm.

How do we find the parameter numerically? First, we want to define a function that specifies the probability of our entire data set. We assume that each observation in the data is independently and identically distributed, so that the probability of the sequence is the product of the probabilities of each value. For the Bernoulli variables, this becomes the following function:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

likelihood <- function(sequence, p.parameter)
{
  likelihood <- 1
 
  for (i in 1:length(sequence))
  {
    if (sequence[i] == 1)
    {
      likelihood <- likelihood * p.parameter
    }
    else
    {
      likelihood <- likelihood * (1 - p.parameter)
    }
  }
 
  return(likelihood)
}

To do maximum likelihood estimation, we therefore only need to use an optimization function to maximize this function. A quick examination of the likelihood function as a function of p makes it clear that any decent optimization algorithm should be able to find the maximum:

1
2
3
4
5
6
7
8
9
10

possible.p <- seq(0, 1, by = 0.001)
jpeg('Likelihood_Concavity.jpg')
library('ggplot2')
qplot(possible.p,
      sapply(possible.p, function (p) {likelihood(sequence, p)}),
      geom = 'line',
      main = 'Likelihood as a Function of P',
      xlab = 'P',
      ylab = 'Likelihood')
dev.off()

For single variable cases, I find that it’s easiest to use R’s base function optimize to solve the optimization problem:

1
2
3
4
5
6
7
8
9
10

mle.results <- optimize(function(p) {likelihood(sequence, p)},
                        interval = c(0, 1),
                        maximum = TRUE)
 
mle.results
# $maximum
# [1] 0.6999843
#
# $objective
# [1] 0.002223566

Here I’ve used an anonymous function that returns the likelihood of our current data given a value of p; I’ve also specified that the values of p must lie in the interval [0, 1] and asked optimize to maximize the result, rather than minimize, which is the default behavior. Examining the output of optimize, we can see that the likelihood of the data set was maximized very near 0.7, the sample mean. This suggests that the optimization approximation can work. It’s worth noting that the objective value is the likelihood of the data set for the specified value of p. The smallness of the objective for large problems can become a major problem. To understand why, it’s worth seeing what happens as the size of the sample grows from 10 to 2500 samples:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19

error.behavior <- data.frame()
 
for (n in 10:2500)
{
  sequence <- rbinom(n, 1, p.parameter)
 
  likelihood.results <- optimize(function(p) {likelihood(sequence, p)},
                                 interval = c(0, 1),
                                 maximum = TRUE)
 
  true.mle <- mean(sequence)
 
  likelihood.error <- true.mle - likelihood.results$maximum
 
  error.behavior <- rbind(error.behavior,
                          data.frame(N = n,
                                     Error = likelihood.error,
                                     Algorithm = 'Likelihood'))
}

As you can see, our approximation approach works great until our data set grows, and then it falls apart. This is exactly the opposite of what asymptotical statistical theory tells us should be happening, so it’s clear that something is going very wrong. A quick examination of the results from the last pass through our loop makes clear what’s wrong:

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

sequence <- rbinom(2500, 1, p.parameter)
 
likelihood.results <- optimize(function(p) {likelihood(sequence, p)},
                               interval = c(0, 1),
                               maximum = TRUE)
 
likelihood.results
# $maximum
# [1] 0.9999339
#
# $objective
# [1] 0

The likelihood of our data is numerically indistinguishable from 0 given the precision of my machine’s floating point values. Multiplying thousands of probabilities together is simply not a viable approach without infinite precision. Thankfully, there’s a very simple solution: replace all of the probabilities with their logarithms. Instead of maximizing the likelihood, we maximize the log likelihood, which involves summing rather than multiplying, and therefore stays numerically stable:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18

log.likelihood <- function(sequence, p)
{
  log.likelihood <- 0
 
  for (i in 1:length(sequence))
  {
    if (sequence[i] == 1)
    {
      log.likelihood <- log.likelihood + log(p)
    }
    else
    {
      log.likelihood <- log.likelihood + log(1 - p)
    }
  }
 
  return(log.likelihood)
}

You can check that this problem is as easily solved numerically as the original problem by graphing the log likelihood:

1
2
3
4
5
6
7
8
9
10

sequence <- c(0, 1, 1, 1, 1, 1, 1, 0, 1, 0)
possible.p <- seq(0, 1, by = 0.001)
jpeg('Log_Likelihood_Concavity.jpg')
qplot(possible.p,
      sapply(possible.p, function (p) {log.likelihood(sequence, p)}),
      geom = 'line',
      main = 'Log Likelihood as a Function of P',
      xlab = 'P',
      ylab = 'Log Likelihood')
dev.off()

And then you can rerun our error diagnostics using both approaches to confirm that the log likelihood approach does not suffer from the same numerical problems:

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

error.behavior <- data.frame()
 
for (n in 10:2500)
{
  sequence <- rbinom(n, 1, p.parameter)
 
  likelihood.results <- optimize(function(p) {likelihood(sequence, p)},
                                 interval = c(0, 1),
                                 maximum = TRUE)
 
  log.likelihood.results <- optimize(function(p) {log.likelihood(sequence, p)},
                                     interval = c(0, 1),
                                     maximum = TRUE)
 
  true.mle <- mean(sequence)
 
  likelihood.error <- true.mle - likelihood.results$maximum
  log.likelihood.error <- true.mle - log.likelihood.results$maximum
 
  error.behavior <- rbind(error.behavior,
                          data.frame(N = n,
                                     Error = likelihood.error,
                                     Algorithm = 'Likelihood'),
                          data.frame(N = n,
                                     Error = log.likelihood.error,
                                     Algorithm = 'Log Likelihood'))
}
 
jpeg('Long-Term_Error_Behavior.jpg')
ggplot(error.behavior, aes(x = N, y = Error)) + geom_line(aes(group = Algorithm, color = Algorithm)) + opts(title = 'Long-Term Error Behavior of Two Numerical Approaches', xlab = 'Sample Size', ylab = 'Deviation from True MLE')
dev.off()

More generally, given any data set and any model, you can — at least in principle — solve the maximum likelihood estimation problem using numerical optimization algorithms. The general algorithm requires that you specify a more general log likelihood function analogous to the R-like pseudocode below:

1
2
3
4
5
6
7
8
9
10
11

log.likelihood <- function(sequence.as.data.frame, likelihood.function, parameters)
{
  log.likelihood <- 0
 
  for (i in 1:nrow(sequence.as.data.frame))
  {
    log.likelihood <- log.likelihood + log(likelihood.function(sequence.as.data.frame[i,], parameters))
  }
 
  return(log.likelihood)
}

Then you need to apply multivariable, constrained optimization tools to find your maximum likelihood estimates. This actually turns out to be a hard problem in general, so I’m going to bail out on the topic here.

In a world in which the price of calculation continues to decrease rapidly, but the price of theorem proving continues to hold steady or increase, elementary economics indicates that we ought to spend a larger and larger fraction of our time on calculation.¹

Over the next ten years, I hope that more and more mathematically minded hackers, empowered by open source tools like the R programming language and emboldened by the popularization of statistical analyses by people like Steve Levitt, will follow Tukey’s suggestion.

1. J. W. Tukey : The American Statistician : Sunset Salvo

Hackers of the world, your priorities are not simply different from the average user’s: they often represent a direct attack on the average user’s preferences. You keep asserting that you have the normal person’s interests in mind, but I think you’re often simply concealing your own self-interest underneath politicized rhetoric about freedom and openness.