“How can I integrate PHP and R?”

I know I’m not the only one who’s asked this question. After all, with great content management systems like Drupal, it would very cool to be able to drop an R module into some PHP code and instantly have a web app popping out some snazzy looking ggplot graphics. After spending some time Google searching for an easy implementation and finding very little in the PHP + R space, I was able to piece together a method for integrating the two. It uses no JavaScript… no AJAX… just plain old PHP.

The poor man’s R web app

Disclaimer: There are many reasons why you shouldn’t actually stick the following code on the web for all to see. It is a very stripped down example, which is great for experimenting on a localhost, but has some serious security flaws.

This implementation of PHP and R consists of only two files. One written in PHP, and the other an R script. The PHP returns a form which uses the GET method to send a variable N to the server. When the form is submitted, the PHP will then execute an R script from the shell using a combination of the PHP command exec() and the Rscript shell command. This command will pass the variable N to the R script. The R script will then execute and save a histogram plot of N normally distributed values to the filesystem. Finally, when the R script is complete, the PHP will return the HTML tag containing the saved images path. First, the PHP file…

<?php
// poorman.php
 
echo "<form action='poorman.php' method='get'>";
echo "Number values to generate: <input type='text' name='N' />";
echo "<input type='submit' />";
echo "</form>";
 
if(isset($_GET['N']))
{
  $N = $_GET['N'];
 
  // execute R script from shell
  // this will save a plot at temp.png to the filesystem
  exec("Rscript my_rscript.R $N");
 
  // return image tag
  $nocache = rand();
  echo("<img src='temp.png?$nocache' />");
}
?>

and the R script…

# my_rscript.R
 
args <- commandArgs(TRUE)
 
N <- args[1]
x <- rnorm(N,0,1)
 
png(filename="temp.png", width=500, height=500)
hist(x, col="lightblue")
dev.off()

Finally, to help you visualize the whole process a bit better, below is a screenshot of the results…

Some Issues

This is a very simple example that works fine on a localhost, but there are some BIG issues that need to be resolved before this code is opened up to the web.

1. The user input isn’t sanitized
2. Only one user can be using this web app at a time
3. More care needs to be taken with read/write access
4. More care needs to be taken with the relative file paths
5. Speed?
6. … and I’m sure I’m missing many more

The bottom line is that with less than 20 lines of code we are able to generate R graphics in a browser… everything else is just details.

After a month of on-again, off-again coding, I’ve finally completed a web site geared towards calculating the Value at Risk of the average investor’s portfolio. The site is visualvar.com. The big idea was to combine the statistical and visualization tools of R (especially ggplot2) with the web interface of Drupal. While I’m happy with the results, I think this may only be the tip of the iceberg in mashing up these technologies. As a side note, I took a bit of a shortcut and I don’t actually have R running directly on the web server, which means I had to settle for ‘overnight’ calculations rather than ‘On-Demand’. But I still think it is a good proof of concept for combing Drupal with R.

Some Examples

For all the data lovers out there, below are some of my favorite visualizations that visualVaR produces using the users inputted portfolio. This one showing the rank correlation between the daily returns of the stocks in a portfolio (obviously the higher the dependency between two stocks, the greater the VaR).

And this one showing the 4 years of daily returns (the amount of data used in the VaR model) for a single stock in a portfolio, BP in the case.

I was a little hesitant to turn the site loose on the web, but I figured it would be best to just ’see what happens’. Please feel free to try it out, just cross your fingers that the server holds!

## open connection
library(RODBC)
channel <- odbcConnect("")
 
## create a plot
x <- rnorm(100,0,1)
 
## save plot as temp file
png(filename="temp.png", width=500, height=500)
hist(x, col="light blue")
dev.off()
 
## read temp file as a binary string
plot_binary <- paste(readBin("temp.png", what="raw", n=1e6), collapse="")
 
## insert binary sting into a table
sqlQuery(channel, paste("INSERT INTO test VALUES (1, x'",plot_binary,"')", sep=""))
 
## close connection
odbcClose(channel)

I understand the ‘other way’ to do this (and most would argue better) would be to ftp the file to the server and save only the file path to the database. I guess I’m just being a bit lazy by letting the database do all the storage details, but so far so good.

We just need to type this into our browser: http://stotastic.com/php/scatterPlot.php?tick1=BP&tick2=SPY&mm=01&dd=01&yyyy=2008
Where tick1 and tick2 are the stock tickers; and mm, dd, yyyy represent the starting date from which data is grabbed. So lets dig in and find out how PHP is used to make all this web magic work.

PHP Code

First, we need a function that downloads the data from Yahoo Finance.

// read in Yahoo finance, parse, and return array
function yahoo_get_adjclose($ticker, $mm, $dd, $yyyy) {
  // subtract 1 from mm since January is 0
  $mm = $mm-1;
 
  $url = "http://ichart.finance.yahoo.com/table.csv?s=$ticker&a=$mm&b=$dd&c=$yyyy";
  $ticker_data = CSV_to_array(file_get_contents($url));
 
  // extract adjusted close and reverse data
  // last row excluded since blank after parse
  $rowcount = count($ticker_data);
  for($i=($rowcount-2); $i>1; $i--){
    $ticker_adjclose[] = (float)$ticker_data[$i][6];
  } 
 
  return($ticker_adjclose);
}

Notice that we called a utility function to convert the data from a CSV to an array. We need this function because the data is returned from Yahoo Finance in a CSV and needs to be parsed into an array to be useful to us.

// function to parse CSV and return array
function CSV_to_array($strData) {
 
  $arrRows = explode("\n", $strData);
  foreach($arrRows as $strRow){
    $arrReturn[] = explode(",", $strRow);
  }
 
  return $arrReturn;
}

Also, in order to convert an array of daily close prices to returns, we’ll use the following utility function.

// convert value to log return
function log_return($x){
  for($i=0; $i<(count($x)-1); $i++){
    $r[] = log($x[$i+1]/$x[$i]);
  }
  return $r;
}

Finally, we put the above code to work by taking in a GET request, using the above functions to download Yahoo Finance data and convert it to an array of returns, send the data to Google in a POST request, and pass on the resulting image back to the user. The reason we are sending a POST request to send the data to Google rather than a GET is because we will be exceeding the data size of a GET request. More info on how to send a POST request to Google can be found here.

header('content-type: image/png'); 
$url = 'http://chart.apis.google.com/chart'; 
 
// get variables
$ticker1 = $_GET["tick1"];
$ticker2 = $_GET["tick2"];
$mm = $_GET["mm"];
$dd = $_GET["dd"];
$yyyy = $_GET["yyyy"];
$title = "Daily Return (%)";
 
// limit date to keep data size transfer down
$year_limit = (int)date("Y")-2;
if($yyyy<$year_limit) {
  $mm = 01;
  $dd = 01;
  $yyyy = 2008;
}
 
// read in Yahoo Finance data
$ticker1_data = yahoo_get_adjclose($ticker1, $mm, $dd, $yyyy);
$ticker2_data = yahoo_get_adjclose($ticker2, $mm, $dd, $yyyy);
 
// calculate log returns
$x = log_return($ticker1_data);
$y = log_return($ticker2_data);
 
// scale data to 1 to 100 range
$xmax = ceil(max($x)*10)/10;
$xmin = floor(min($x)*10)/10;
$ymax = ceil(max($y)*10)/10;
$ymin = floor(min($y)*10)/10;
 
foreach($x as $val){
  $xscaled[] = round(($val-$xmin)/($xmax-$xmin)*1000)/10;
}
 
foreach($y as $val){
  $yscaled[] = round(($val-$ymin)/($ymax-$ymin)*1000)/10;
}
 
// calculate chart range params
$xrange_max = $xmax*100;
$xrange_min = $xmin*100;
$yrange_max = $xmax*100;
$yrange_min = $xmin*100;
 
$xdash = 100/(($xrange_max - $xrange_min)/5);
$ydash = 100/(($yrange_max - $yrange_min)/5);
 
// Add chart array with data and params 
$chart = array( 
  'cht' => 's', 
  'chs' => '400x400', 
  'chd' => "t:".implode(",",$xscaled)."|".implode(",",$yscaled),
  'chxt' => "x,x,y,y",
  'chxr' => "0,$xrange_min,$xrange_max,5|2,$yrange_min,$yrange_max,5",
  'chm' => "o,3399FF,0,-1,5", 
  'chg' => "$xdash,$ydash", 
  'chtt' => "$title", 
  'chxl' => "1:|$ticker1|3:|$ticker2|",
  'chxp' => "1,50|3,50");
 
// Send the request, and print out the returned bytes. 
$context = stream_context_create( 
  array('http' => array( 
    'method' => 'POST', 
    'content' => http_build_query($chart)))); 
fpassthru(fopen($url, 'r', false, $context));

And there you have it! Google performs very little data processing, probably in order to keep server capacity down; therefore, a big chunk of the code above is needed to scale and format the data before sending it to Google. Take my server for a spin by typing something like this into your browser: http://stotastic.com/php/scatterPlot.php?tick1=JPM&tick2=GS&mm=01&dd=01&yyyy=2009, but please be kind to my server! (there is a GET sanitizing step I’m not showing in the code above).

## Black-Scholes Function
BS <-
function(S, K, T, r, sig, type="C"){
  d1 <- (log(S/K) + (r + sig^2/2)*T) / (sig*sqrt(T))
  d2 <- d1 - sig*sqrt(T)
  if(type=="C"){
    value <- S*pnorm(d1) - K*exp(-r*T)*pnorm(d2)
  }
  if(type=="P"){
    value <- K*exp(-r*T)*pnorm(-d2) - S*pnorm(-d1)
  }
  return(value)
}
 
 
## Function to find BS Implied Vol using Bisection Method
implied.vol <-
function(S, K, T, r, market, type){
  sig <- 0.20
  sig.up <- 1
  sig.down <- 0.001
  count <- 0
  err <- BS(S, K, T, r, sig, type) - market 
 
  ## repeat until error is sufficiently small or counter hits 1000
  while(abs(err) > 0.00001 && count<1000){
    if(err < 0){
      sig.down <- sig
      sig <- (sig.up + sig)/2
    }else{
      sig.up <- sig
      sig <- (sig.down + sig)/2
    }
    err <- BS(S, K, T, r, sig, type) - market
    count <- count + 1
  }
 
  ## return NA if counter hit 1000
  if(count==1000){
    return(NA)
  }else{
    return(sig)
  }
}

To apply the calculations above, I downloaded option data on the S&P 500 (SPX) as of midday Friday, May 21st. Data is available for multiple expiration dates, but I narrowed my analysis to only the near dated contract, which was the June contract. As with all market data, I had to do a bit of cleaning first, but you can find my clean data here. Once cleaned, the data was read into R and cranked though the implied volatility function. Note that the S&P 500 was at 1082 at the time of these quotes.

## read in data
dat <- read.csv("SPX_data.csv")
 
## calculate implied vol for Call
S <- 1082.74
T <- 28/365
r <- 0.01
 
n <- dim(dat)[1]
c.vol.Ask <- rep(0,n)
c.vol.Bid <- rep(0,n)
p.vol.Ask <- rep(0,n)
p.vol.Bid <- rep(0,n)
 
for(i in 1:n){
  c.vol.Ask[i] <- implied.vol(S, dat$K[i], T, r, dat$C.Ask[i], "C")
  c.vol.Bid[i] <- implied.vol(S, dat$K[i], T, r, dat$C.Bid[i], "C")
  p.vol.Ask[i] <- implied.vol(S, dat$K[i], T, r, dat$P.Ask[i], "P")
  p.vol.Bid[i] <- implied.vol(S, dat$K[i], T, r, dat$P.Bid[i], "P")
}

Finally the fun part, I plotted the implied volatility vs the strikes for both the calls and puts. I also plotted the open interest (number of open contracts held in the market) vs strike. For reference, I put the current S&P 500 index value (at the time of these quotes) as a vertical dashed red line.

## plot Volatility Smile and Open Interest
par(mfrow=c(2,2))
plot(dat$K, c.vol.Bid, typ="l", col="green", xlim=c(800, 1350), ylim= c(.2, .60),
     main=c("S&P 500 June Call", "Volatility Smile"), xlab="Strike", ylab="Implied Vol")
lines(dat$K, c.vol.Ask, col="blue")
abline(v=S, col="red", lty=2)
legend("bottomleft", cex=0.9, c("Ask", "Bid"), lty=1, col=c("blue", "green"))
 
plot(dat$K, p.vol.Bid, typ="l", col="green", xlim=c(800, 1350), ylim= c(.2, .6),
     main=c("S&P 500 June Put", "Volatility Smile"), xlab="Strike", ylab="Implied Vol")
lines(dat$K, p.vol.Ask, col="blue")
abline(v=S, col="red", lty=2)
legend("bottomleft", cex=0.9, c("Ask", "Bid"), lty=1, col=c("blue", "green"))
 
 plot(dat$K, dat$C.Open, xlim=c(800, 1350), ylim=c(0, 260000), type="h",
     main="Open Interest", xlab="Strike", ylab="Open Interest")
abline(v=S, col="red", lty=2)
 
 plot(dat$K, dat$P.Open, xlim=c(800, 1350), ylim=c(0, 260000), type="h",
     main="Open Interest", xlab="Strike", ylab="Open Interest")
abline(v=S, col="red", lty=2)

The most obvious thing you should notice is the phenomenon known as the ‘volatility smile’. The assumptions of the Black-Scholes model tell us that volatility should be constant for all strikes. Clearly the market doesn’t believe this assumption and there are numerous theories on why this happens. Something you may have missed, but is rather shocking, most of the put contracts held are at a strike of 800. These are essential insurance contracts for people who are worried about the S&P 500 dropping over 25% within the next month. Scary!

The Basics

As in all models, the first thing we need to do is describe the assets we have available for us to trade. I like to think of this as setting up the ‘rules of the game’. These rules will tell us what assets we have available and how those assets interact with each other. The Black-Scholes model gives us two assets to play with, the money market account and the stock we will base our option payoff on. The Black-Scholes model describes these assets using Brownian Motion, with the following ‘real world’ dynamics.



Where is the price of the money market account ‘share’ at time t and is the price of the stock. The ‘Big Idea’ of the Black-Scholes model is that we can use these tradable assets to replicate the payoff of an option. By continuously trading in these two assets, we will create a portfolio which will exactly replicate the final payoff of the option in all final states. Since this portfolio will have the same cash flows as the option in all possible states, the value of this portfolio must be the same as the value of the option at all times. If this wasn’t the case, there would be an arbitrage opportunity, which shouldn’t exist in an efficient market. The following describes the replicating formula in math terms.



Where are the trading strategies defining the number of ‘shares’ of each asset to own at time t. Also, this replicating portfolio must satisfy the self financing condition, which means no money is added or removed from the portfolio. The self financing condition is stated as . If we select the money market asset as the numeraire (a.k.a. we are discounting), we can define the following variables as the discounted asset and portfolio prices.



And the dynamics of the discounted assets under the ‘real world’ measure are



Using the Numeraire Invariance Theorem, such that the replicating portfolio remains a self financing portfolio when the money market asset is the selected numeraire, the dynamics of the replicating portfolio can be written as



Using Garsinov’s Theorem, we can change the measure to the ‘risk neutral’ measure (which I’ll identify with a ).



Therefore, the risk neutral dynamics of the discounted stock price is now which is a Martingale under the risk neutral measure. Plugging this into the discounted portfolio process, we get which is also a Martingale under the risk neutral measure. This is a key property, because we can write the expectation under the risk neutral measure as the following.



Since we can solve the SDE for the money market account as , then we can plug this into the expectation and get our concluding result.

.

Many people jump to this conclusion when they state “The price of the option is the discounted expected payoff under the risk neutral measure”. As a side note, when the interest rate is random, we can’t pull the discounting term out of the expectation, but the logic we followed is the same. The Black Scholes model assumes a constant interest rate which allows us to find formula for this expectation, which I’ll show in a bit.

The Black-Scholes PDE

As I mentioned earlier, there are a lot of derivations of the Black-Scholes PDE posted on the internet. Some of which make bold assertions rather than using the mathematical properties developed from stochastic calculus. These derivations basically assume a portfolio is delta-hedged and should therefore grow at the risk free rate. While this seems intuitively correct, the underlying mathematical properties called upon are not very clear. This approach is sometimes called the ‘Classical’ derivation. Since we now have more developed theories today than in the 1970’s, doesn’t it make since to put them to use and simplify the derivation? Below I present a derivation that relies on more precise mathematical properties, which is sometimes called the ‘Martingale’ derivation. It makes use of the connection between SDEs and PDEs via the Feynman-Kac Theorem.

First, using the definitions from above, we need to define the following function .



The function is simply a function which gives use the value of the replicating portfolio by inputting the time until expiration and the current stock price. Since the stock price is modeled as Geometric Brownian Motion, it is a Markov process. There is no added information from knowing the stock price history; therefore, we only need the current stock price. The next step is to write out the dynamics of using Ito’s Lemma.



Since we showed earlier that is a Martingale under the risk neutral measure, the term must be equal to 0. Setting this term to 0, we get the following PDE.



And there you have it folks, the Black-Scholes PDE derived in a few simple steps using some basic properties of stochastic calculus.

The Black-Scholes Call Price Formula

We could solve this PDE to get a formula for the price of a call under this Black-Scholes model, but an easier way (in my opinion) is to calculate the expectation under the risk neutral measure. First, recall that



Also, the risk neutral dynamics of the stock price are . We can solve this SDE such that . If we define , then , and so we can write the price of the option as the following.



If we note that the payoff is only positive if



then by introducing an indicator variable and breaking the expectation into two terms



We can simplify the second term.



Where is the standard normal CDF. We can simplify the first term as well.



By setting and changing the upper limit of integration to .



Putting the first and second terms together



Boom goes the dynamite!

Concluding Remarks

I hope that by using consistent notation, showing intermediate steps, and by stating various mathematical theorems used; that the reader will find this article presents a clear derivation of the Black Scholes model as compared to most other articles on the internet. To fully appreciate some of the mathematics, a basic knowledge of stochastic calculus is required. I suggest Shreve as a good place to look for more rigorous details on some of the underlying math.

The Model

The first things we need to do is to define the dynamics for all the tradable assets. We have at our disposal a money market account, as well as the stocks of Google and Apple (it is not a coincidence that I picked companies that don’t pay dividends). Below describes how we will model the dynamics of these assets.



In this model, is the price of a share in the money market account, and and are the stock prices. Notice that we have correlated the Brownian Motions such that the stock prices will tend to move up and down together just like in the real world. To make this model easier to work with, we will first convert the correlated Brownian Motions into independent Brownian Motions by defining the following.



By doing this, we can rewrite the ‘real world’ dynamics as

Calibration

Writing down a bunch of stochastic differential equations was pretty mechanical, but now comes the artsy part of modeling. The first thing we need is some stock price data, which can easily be downloaded from Yahoo Finance. This data gives us the stock price over discreet time intervals (I picked daily close prices). To use this data, lets define the discreet return as the solution to the following , in which case we can write . By assuming the drift and volatility terms are constants, we can use our model of the stock price dynamics to write the discreet returns as the following.



Where is the discreet time interval. By doing this, we can show that the discreet returns are distributed iid normal.



We can use the iid normal distribution to calibrate all the parameters. are simply the sample standard deviations of the discreet returns divided by , is the sample correlation of the discreet returns, and are the sample means of the discreet returns divided by (although I should note that we don’t actually need to know to price this option).

The Data

Now that we have the math worked out for calibrating the model, let’s take a look at some real data and see if the data agrees with our assumptions. First we need to read the data into R. The data I used can be found here. (I used R’s scan function since I’m lazy).

## Scan in close prices
GOOG <- scan()
AAPL <- scan()

Let’s take a look at the time series of stock prices.

## regular stock price chart
par(mfrow=c(2,1))
plot(GOOG, type="l", main="GOOG closing Price")
plot(AAPL, type="l", main="AAPL closing Price")

Now calculate and plot the daily returns.

## convert to returns
n <- length(GOOG)
GOOG.r <- log(GOOG[2:n]/GOOG[1:(n-1)])
AAPL.r <- log(AAPL[2:n]/AAPL[1:(n-1)])
 
## plot returns
matplot(cbind(GOOG.r, AAPL.r), type="l", lty=1, main="Daily Returns", ylab="Daily Return")
abline(h=0, col="blue")
legend("bottomleft", c("GOOG", "AAPL"), lty=1, col=c(1,2))

To check the iid normal assumption, we should do an autocorrelation plot and a QQ normal plot.

## autocorrelation plot
par(mfrow=c(2,2))
acf(GOOG.r)
acf(AAPL.r)
 
## QQ normal plots
qqnorm(GOOG.r, main="GOOG")
qqline(GOOG.r, col="red")
qqnorm(AAPL.r, main="AAPL")
qqline(AAPL.r, col="red")

Lastly, lets also take a look at the joint distribution of the returns.

## pairs plot
plot(GOOG.r, AAPL.r, main="Daily Returns")

The ACF plot suggests that the daily returns are iid, but they certainly have heavier tails than what would be produced by a normal distribution. In order to keep the model simple, we’ll assume normality of the returns holds, and give ourselves a ‘buffer’ when we calculate the fair price. Finally, time for the calibration!


GOOG vol: 0.2262006
AAPL vol: 0.2756421
Rho: 0.5413732


## calculate annualized vol
GOOG.vol <- sd(GOOG.r)/sqrt(1/252)
AAPL.vol <- sd(AAPL.r)/sqrt(1/252)
 
## calculate rho
rho <- cor(GOOG.r, AAPL.r)
 
cat("GOOG vol:", GOOG.vol, "\n")
cat("AAPL vol:", AAPL.vol, "\n")
cat("Rho:", rho, "\n")

Price Using Simulation

We are now at the point where we can price this option. As usual, the price of the option is the expected discounted payoff under the risk neutral measure. This particular option can be priced as where the risk neutral dynamics of the stock prices are the following.



Where are independent Brownian Motions under the risk neutral measure. We will estimate the expectation through Monte Carlo simulation under a Euler discretization scheme. Rather than assume a constant interest rate, lets make things a tad more interesting by modeling the interest rate using the Vasicek Model (I’ll assume a calibration, but we could have calibrated it to zero coupon bond prices).



The following R code simulates the risk neutral dynamics of this model and estimates the expectation. By doing so, we find that the fair price of this option is $0.31 per $1 of notional. Thus, buying it from our neighbor for $25 seems like a deal if we think the $6 difference is a sufficient buffer to cover the simplifying assumptions we made.

trials <- 10000     # simulation trials
T <- 1              # time until expiration (years)
m <- 200            # subintervals
dt <- T/m           # time per subinterval (years)
 
## set interest rate model parameters
k <- 0.4
theta <- 0.05
beta <- 0.03
 
## set strikes
K1 <- 500
K2 <- 240
 
## create storage vectors
s1 <- rep(0,m+1)       # stock price path 1
s2 <- rep(0,m+1)       # stock price path 2
r <- rep(0,m+1)        # interest rate
c <- rep(0, trials)    # payoff
 
## set initial stock prices and interest rate
s1[1] <- 500
s2[1] <- 240
r[1]  <- 0.01
 
## begin simulation
for(j in 1:trials){
  for(i in 2:(m+1)){
    z1 <- rnorm(1,0,1)
    z2 <- rnorm(1,0,1)
    z3 <- rnorm(1,0,1)
 
    ds1 <- s1[i-1]*(r[i-1]*dt + GOOG.vol*sqrt(dt)*z1)
    ds2 <- s2[i-1]*(r[i-1]*dt + AAPL.vol*sqrt(dt)*(rho*z1 + sqrt(1-rho^2)*z2))  
    dr  <- k*(theta - r[i-1])*dt + beta*sqrt(dt)*z3
 
    s1[i] <- s1[i-1] +  ds1
    s2[i] <- s2[i-1] +  ds2
    r[i]  <- r[i-1]  +  dr
  }
  ss <- sum(r[2:(m+1)]*dt)
  c[j] <- ifelse(s1[m+1]>K1 && s2[m+1]>K2, exp(-ss), 0)
}
 
cat("Option Price Estimate:", round(mean(c),3), "\n")
cat("Standard Error:", round(sd(c)/sqrt(trials),3), "\n")

## read in data
dat <- read.csv("CSHomePrice_History.csv")

Now that the data is loaded, lets start by simply plotting the time series of the Indices.

## save dataset dimensions
n <- dim(dat)[1]
m <- dim(dat)[2]
 
## plot time series
col <- seq(1, m-1, 1)
matplot(dat[,2:m], type="l", xaxt="n", main="Case-Shiller Indices", ylab="Index Value", lty=1, col=col)
xticks <- seq(1, n, 12)
xlabels <- dat$YEAR[xticks]
axis(1, at = xticks, las = 2, cex.axis = 0.6, labels = xlabels)
legend("topleft", names(dat)[2:m], lty=1, cex=0.6, col=col)

There’s alot of ’stuff’ going on which makes it hard to distinguish one index from another. To simplify things, lets just plot a subset of the indices. For no particular reason, I’ll pick New York, Las Vegas, and San Francisco.

## plot NY, LV, SF
col <- seq(1, 3, 1)
matplot(cbind(dat$NYXR, dat$LVXR, dat$SFXR), type="l", xaxt="n", 
              main="Case-Shiller Indices", ylab="Index Value", lty=1, col=col)
xticks <- seq(1, n, 12)
xlabels <- dat$YEAR[xticks]
axis(1, at = xticks, las = 2, cex.axis = 0.6, labels = xlabels)
legend("topleft", c("New York", "Las Vegas", "San Francisco"), lty=1, cex=0.6, col=col)

Much better, but all this really shows us is that there was a pretty substantial run-up in home values starting in the late 90s, followed by a bust in 2006 (not exactly new news). What would be more interesting would be to analyze the monthly returns in the indices, which I suspect would be somewhat stationary. If we define as the monthly return in the form , we can calculate it as . At this point we haven’t made any assumption about the distribution of .

## calculate the monthly returns
r <- log(dat[2:n, 2:m] / dat[1:(n-1), 2:m])
 
## plot monthly returns time series
col <- seq(1, 3, 1)
matplot(cbind(r$NYXR, r$LVXR, r$SFXR), type="b", pch=21, 
              xaxt="n", main="Monthly Returns", ylab="Monthly Return", lty=1, col=col)
abline(h=0)
xticks <- seq(2, n, 12)
xlabels <- dat$YEAR[xticks]
axis(1, at = xticks, las = 2, cex.axis = 0.6, labels = xlabels)
legend("bottomleft", c("New York", "Las Vegas", "San Francisco"), lty=1, cex=0.6, col=col)

Now things are starting to get interesting. Clearly there is some seasonality going on and the returns appear to be correlated. To investigate the correlation a bit more, lets do a pairs plot.

## pairs plot of monthly returns
pairs(cbind(r$NYXR, r$LVXR, r$SFXR), main="Monthly Returns", 
          labels=c("New York", "Las Vegas", "San Francisco"))

This confirms our suspicions about correlation. The monthly return almost appear bivariate normal. Lets produce some boxplots to investigate the distribution of .

## boxplot
boxplot(r, xaxt="n", main="Monthly Returns", ylab="Monthly Return", col="light blue") 
abline(h=0)
xticks <- seq(1, m-1, 1)
xlabels <- names(r)
axis(1, at = xticks, las = 2, cex.axis = 0.6, labels = xlabels)

It appears that the returns are roughly normal, with the mean return just above 0, but some appear to have much fatter tails than others (compare New York to Las Vegas for instance). We should perform some QQ Normal plots to see how normal the monthly returns really are.

## qqnorm plots
par(mfrow=c(3,4))
for(i in 1:12){
  qqnorm(r[,i], main=names(r)[i])
  qqline(r[,i], col="red")
}
windows()
par(mfrow=c(3,4))
for(i in 13:(m-1)){
  qqnorm(r[,i], main=names(r)[i])
  qqline(r[,i], col="red")
}

This confirms our suspicions that the return are ‘normal like’, but have some pretty fat tails (as do most financial assets). Although, New York and Boston appear to be much more normal than the rest. This analysis really begs for an ARMA model that incorporates the correlation across housing markets.

Simulated Paths

To give you an idea of what this process looks like, I have generate some sample paths using the Euler discretization method.

One important things you will notice is that this process starts at 0.03, but is pulled towards 0.10, which is the value of . I’ve added dashed lines to highlight this, as well as lines for the expected value of the process and confidence bands representing two standard deviations. Also, you may notice the major problem with this process is that the interest rate can drop below 0%. In the real world, this shouldn’t happen. The Cox-Ross-Ingersoll model, or CIR model, actually corrects for this, but the process is no longer normally distributed. The following is the R code used to generate the chart above.

## Simulate Sample Paths ##
 
## define model parameters
r0 <- 0.03
theta <- 0.10
k <- 0.3
beta <- 0.03
 
## simulate short rate paths
n <- 10    # MC simulation trials
T <- 10    # total time
m <- 200   # subintervals
dt <- T/m  # difference in time each subinterval
 
r <- matrix(0,m+1,n)  # matrix to hold short rate paths
r[1,] <- r0
 
for(j in 1:n){
  for(i in 2:(m+1)){
    dr <- k*(theta-r[i-1,j])*dt + beta*sqrt(dt)*rnorm(1,0,1)
    r[i,j] <- r[i-1,j] + dr
  }
} 
 
## plot paths
t <- seq(0, T, dt)
rT.expected <- theta + (r0-theta)*exp(-k*t)
rT.stdev <- sqrt( beta^2/(2*k)*(1-exp(-2*k*t)))
matplot(t, r[,1:10], type="l", lty=1, main="Short Rate Paths", ylab="rt") 
abline(h=theta, col="red", lty=2)
lines(t, rT.expected, lty=2) 
lines(t, rT.expected + 2*rT.stdev, lty=2) 
lines(t, rT.expected - 2*rT.stdev, lty=2) 
points(0,r0)

Bond Pricing and Yield Curve

One can show that a zero coupon bond with a maturity at time T can be found by calculating the following expectation under the risk neutral measure where the short rate process can be pretty much any process. We could estimate this expectation using Monte Carlo simulation, but the Vasicek model allows us to calculate the value of the zero coupon bond by using the Markov property and PDE techniques. Using this method, we can price the bond by the following equations.



This closed form solution for a zero coupon bond makes our lives much easier since we don’t need to compute the expectation under the martingale measure to find the price of a bond. Additionally, it will allow us to easily calculate the yield curve implied by the model. If we note that where is the continuous time yield for a zero coupon bond with maturity T, then we can use our model estimate of the bond price to rearrange this formula and solve for the yield by . Finally, to demonstrate some of the possible curve shapes allowed by the Vasicek model, I produced the following chart. Notice that the yield curve can be both increasing or decreasing with maturity.

The following R code implements the closed form pricing function for a bond under the Vasicek model, and then uses the pricing function to generate the chart above.

## function to find ZCB price using Vasicek model
VasicekZCBprice <- 
function(r0, k, theta, beta, T){
  b.vas <- (1/k)*(1-exp(-T*k)) 
  a.vas <- (theta-beta^2/(2*k^2))*(T-b.vas)+(beta^2)/(4*k)*b.vas^2
  return(exp(-a.vas-b.vas*r0))
}
 
## define model parameters for plotting yield curves
theta <- 0.10
k <- 0.5
beta <- 0.03
 
r0 <- seq(0.00, 0.20, 0.05)
n <- length(r0)
yield <- matrix(0, 10, n)
for(i in 1:n){
  for(T in 1:10){
    yield[T,i] <- -log(VasicekZCBprice(r0[i], k, theta, beta, T))/T
  }
}
 
maturity <- seq(1, 10, 1)
matplot(maturity, yield, type="l", col="black", lty=1, main="Yield Curve Shapes")
abline(h=theta, col="red", lty=2)

Formula vs Monte Carlo

Just to make sure the bond pricing formula was implemented correctly, I compared the price using the formula versus the price using Monte Carlo simulation to estimate the expectation under the martingale measure. Below are the results and R code. Seems everything is in order, although the Euler discretization method seems to be causing some error in the Monte Carlo results.


Exact Vasicek Price: 0.9614
MC Price: 0.9623
MC Standard Error: 0.0005


## define model parameters
r0 <- 0.03
theta <- 0.10
k <- 0.3
beta <- 0.03
 
## simulate short rate paths
n <- 1000  # MC simulation trials
T <- 1     # total time
m <- 200   # subintervals
dt <- T/m  # difference in time each subinterval
 
r <- matrix(0,m+1,n)  # matrix to hold short rate paths
r[1,] <- r0
for(j in 1:n){
  for(i in 2:(m+1)){
    dr <- k*(theta-r[i-1,j])*dt + beta*sqrt(dt)*rnorm(1,0,1)
    r[i,j] <- r[i-1,j] + dr
  }
} 
 
## calculate Monte Carlo bond price and compare to Exact Vasicek solution
ss <- colSums(r[2:(m+1),]*dt)  # integral estimate
c <- exp(-ss)
estimate <- mean(c)
stdErr <- sd(c)/sqrt(n)
exact <- VasicekZCBprice(r0, k, theta, beta, T)
 
cat('Exact Vasicek Price:', round(exact,4), '\n')
cat('MC Price:', round(estimate,4), '\n')
cat('MC Standard Error:', round(stdErr,4), '\n')