BERT Example Functions

Here are some useful functions you can use in Excel with BERT. If you’re not familiar with BERT or landed here via search engine, have a look at the front page for quick install and usage instructions.

These functions aren’t guaranteed to be efficient, correct, comprehensive, or necessarily useful. You are encouraged to modify them for your needs. Unless otherwise noted, all code on this page is in the public domain.

If you have a suggestion, comment, or request for a particular function, please let us know.

Using These Functions

To use any of these functions, you just need to save the source file into your BERT startup folder. Right-click on one of the Save links below and select Save link as…

Save the file into Documents\BERT\functions. You’ll see a note in the BERT console when a new file is loaded.

You can also copy the code below and paste it into your own file. any file in the BERT startup folder will be automatically reloaded when you save changes.

Data Management

Sort

You can sort data with excel, but if that data changes it won’t re-sort. Also you lose the original order. Use this function to insert a sorted range that’s actively linked to the original range.

Show/Hide Code Download Example Spreadsheet


#
# sort a matrix.  if a column includes both string and numeric values,
# numbers will be treated as strings, which may have unexpected results.
#
Sort <- function( m, ascending=TRUE, sort.column.index = 1, empty.last=TRUE){
  sort.column.index = max( 1, min( ncol(m), sort.column.index ));
  m<-cbind(m,0); # hack for 1-column matrices
  m[order(unlist(m[,sort.column.index]), decreasing=!ascending, na.last=empty.last ),];
}

Shuffle

Shuffling data can be useful for bootstrap analysis or for randomizing fixed data sets (dice, cards).

Show/Hide Code Download Example Spreadsheet


#
# shuffle a matrix, optionally keeping rows intact.
#
Shuffle <- function( m, keep.rows=FALSE ){
  if( keep.rows ){
    m[sample(nrow(m)),];
  }
  else {
    matrix( m[sample(length(m))], nrow=nrow(m));
  }
}

Data Analysis

Dimensionality Reduction

Dimensionality reduction using Pricipcal Components Analysis (PCA)

Show/Hide Code Download Example Spreadsheet


#
# dimensionality reduction using PCA
#

pca <- function( mat, dimensions ){

	# ensure we have a numeric matrix
	
	mat <- matrix( as.numeric( mat ), nrow=nrow(mat));

	# if desired dimensions are not provided, use the 
	# number of columns in the output range

	if( missing( dimensions )){
		ref <- BERT$.Excel(89); # xlfCaller
		dimensions <- ncol(ref);
	}

	# covariance matrix

	Sigma <- (t(mat) %*% mat)/nrow(mat);
	
	# svd and then reduce
	
	pc <- svd(Sigma)$u;
	mat %*% pc[,1:dimensions]

}

#
# Add documentation to the excel "insert function" dialog
# for the function and the arguments, using R attributes
#

attr( pca, "description" ) <- list( 
	"Reduce dimensionality using principal components analysis (PCA)",
	mat = "matrix of data",
	dimensions = "(optional) number of dimensions in result"
);

Statistics

Matrix Correlation

Get a correlation matrix from multiple correlated data sets.

Show/Hide Code Download Example Spreadsheet


#
# return a 2-dimensional correlation matrix for the given data.
# unless full.matrix is set, the upper-triangular will be omitted
# (or the lower triangular, if data is in rows).
#
MatrixCorrelation <- function( m, data.in.columns=TRUE, full.matrix=FALSE ){
  
  if( !data.in.columns ){ 
    x <- cor(t(m)); 
    if( !full.matrix ) x[lower.tri(x)] <- NA;
  }
  else {
    x <- cor(m); 
    if( !full.matrix ) x[upper.tri(x)] <- NA;
  }
  return( x );
}

Test for Normality

Two tests for normality in a data set: the Shaprio-Wilk and Kolmogorov-Smirnov tests. In each case, the exported functions return the p-value from the test.

Show/Hide Code Download Example Spreadsheet


#
# normality tests; these functions return the p-values from each test
#

SWTest.p <- function(mat) {
  shapiro.test(mat)$p.value;
}

KSTest.p <- function(mat) {
  ks.test(mat, pnorm)$p.value;
}

Box-Cox Transform

Given a set of data, find lambda for the Box-Cox transform.

Show/Hide Code Download Example Spreadsheet


#
# find optmial lambda for the box-cox power transform.
# use the range.step parameter to control precision,
# and the range.min and range.max parameters to modify
# the search space.
#
boxcox <- function( m, range.min = -3, range.max = 3, range.step = .1 ){

	# local log-likelihood function
	F <- function( x, lambda ){
		if( lambda == 0 ){ xlambda <- log(x); }
		else{ xlambda <- (x^lambda-1)/lambda; }
		n <- length(x);
		xhl <- sum(xlambda)/n;
		-n/2 * log(sum(((xlambda-xhl )^2)/n)) + (lambda-1)*sum(log(x));
	}

	# test against range and return max
	index <- which.max(sapply(
    seq( range.min, range.max, by=range.step ), function(x){ F(m, x) } ))
	return((index-1)*range.step+range.min);

}

Matrix Functions

Eigensystem

Functions for getting eigenvalues and eigenvectors from a matrix.

Show/Hide Code Download Example Spreadsheet


#
# wrapper functions for eigenvalues and eigenvectors
#

EigenValues <- function(x) {
  eigen(x, only.values=T)$values
}

EigenVectors <- function(x) {
  eigen(x)$vectors
}

Finance

Trinomial Lattice Option Pricing

Generate call & put values using a trinomial lattice.

Show/Hide Code Download Example Spreadsheet


TrinomialLattice.Option <- function(
  time.in.years, 
  underlying.price, 
  strike.price, 
  risk.free.rate, 
  sigma, 
  number.of.steps, 
  call.option = TRUE, 
  early.exercise = FALSE ) {
    
    dT <- time.in.years / number.of.steps;
    up <- exp(sigma * sqrt(2*dT));
    down <- 1/up; # == exp(-sigma * sqrt(2*dT));
    m <- 1;
    
    discount.factor <- exp( -risk.free.rate * dT );
    
    up.probability <- (( exp(risk.free.rate*dT/2) - exp(-sigma*sqrt(dT/2))) 
      / ( exp( sigma*sqrt(dT/2)) - exp( -sigma*sqrt(dT/2))))^2;
    down.probability <- (( exp(sigma*sqrt(dT/2)) - exp(risk.free.rate*dT/2) ) 
      / ( exp( sigma*sqrt(dT/2)) - exp( -sigma*sqrt(dT/2))))^2;
    m.probability = 1 - (up.probability + down.probability);
    
    # cat( up.probability, m.probability, down.probability, "\n" );
    
    # this is how to create the price matrix (2n+1 x n+1):
    
    #mat <- matrix( up^(rep(number.of.steps:(-number.of.steps), number.of.steps+1)), 
    #  ncol=number.of.steps+1) * underlying.price;
    #mat[ abs(row(mat) - (number.of.steps+1)) >= col(mat)] <- 0;
    
    #print( "price matrix:");
    #print(mat);
    
    # but you only need the payoffs at expiry (look at the price matrix to see why)
    if( call.option )
    {
      p <- pmax( 0, (underlying.price * up^(number.of.steps:(-number.of.steps))) - strike.price);
    }
    else
    {
      p <- pmax( 0, strike.price - (underlying.price * up^(number.of.steps:(-number.of.steps))));
    }
    
    # generate a matrix to multiply.  this seems like the fastest way  
    n <- number.of.steps * 2 + 1
    mm<-matrix( c( up.probability, m.probability, down.probability, rep(0, n-2) ), 
      nrow=n, ncol=n-2); 
    
    # might as well get the test out of the loop
    if( early.exercise )
    {
      for( idx in 1:number.of.steps )
      {
        p <- pmax( p, c( 0, colSums( mm * p ), 0 ));
      }
    }
    else
    {
      for( idx in 1:number.of.steps )
      {
        p <- c( 0, colSums( mm * p ), 0 );
      }
    }
    return( p[number.of.steps+1] * discount.factor^number.of.steps);
    
  }

Binomial Lattice Option Pricing

Generate call & put values using a binomial lattice.

Show/Hide Code Download Example Spreadsheet


BinomialLattice.Option <- function( 
  time.in.years, 
  underlying.price, 
  strike.price, 
  risk.free.rate, 
  sigma, 
  number.of.steps, 
  call.option = TRUE, 
  early.exercise = FALSE ) {
    
  dT <- time.in.years / number.of.steps;
  up <- exp(sigma * sqrt(dT));
  discount.factor <- exp( -risk.free.rate * dT );
  up.probability <- ( exp( risk.free.rate * dT ) - (1/up) ) / ( up - (1/up) );
  down.probability <- 1 - up.probability;
    
  # price vector at n, limit at 0
  p <- sapply( 0:number.of.steps, function(i){ 
    underlying.price * up^(2*i - number.of.steps); });
  p[p < 0] <- 0;
    
  # get exercise value at expiry  
  if( call.option ){ v <- pmax(0, (p - strike.price)); }
  else { v <- pmax(0, (strike.price - p)); }
    
  # collapse tree
  ee.discount <- discount.factor;
  for( idx in number.of.steps:1 ){
    
    v <- rev(sapply( idx:1, function(x){ v[x+1] * up.probability * discount.factor + 
      v[x] * down.probability * discount.factor }));
    
    if( early.exercise )
    {
      # check early exercise value 
      if( call.option ){
        v <- pmax( v, sapply( 0:(idx-1), function(i) { 
          ( underlying.price * up^(2*i - (idx-1) ) - strike.price) * ee.discount; }));
      }
      else {
        v <- pmax( v, sapply( 0:(idx-1), function(i){ 
          ( strike.price - underlying.price * up^(2*i - (idx-1) )) * ee.discount; }));
      }
            
      # discounting appears to be backwards here, but it's done that way to
      # match the running option price vector 
            
      ee.discount <- ee.discount * discount.factor;
    }		
  }
  return(v[1]);
        
}

Binomial Lattice Tree

Generate the binomial lattice price matrix in a spreadsheet.

Show/Hide Code Download Example Spreadsheet


#
# generate a binomial lattice price matrix
#
BinomialLattice.PriceMatrix <- function( 
  underlying.price, time.in.years, risk.free.rate, sigma, number.of.steps ) {
  
  dT <- time.in.years / number.of.steps;
  up <- exp(sigma * sqrt(dT));
  mat <- diag( number.of.steps+1 );
  mat[,] <- up^((1-row(mat))*2+col(mat)-1) * underlying.price; 
  mat[lower.tri(mat)] <- NA; 
  mat;
  
}

#
# format the price matrix for presentation; requires 2n+1 rows and n+1 columns
#
BinomialLattice.DisplayPriceMatrix <- function( 
  underlying.price, time.in.years, risk.free.rate, sigma, number.of.steps ) {
  
  x <- BinomialLattice.PriceMatrix( 
    underlying.price, time.in.years, risk.free.rate, sigma, number.of.steps );
  sapply( 1:ncol(x), function(a){ 
    unlist(c(rep(NA,(nrow(x)-a)),Map(c,x[1:a,a],NA),rep(NA,max(0,(nrow(x)-a)))))})
  
}

Graphics

Histogram

This function is an example of using R graphics in Excel with the BERT graphics device. It generates a basic histogram of the input data.

Show/Hide Code Download Example Spreadsheet


#
# draw a histogram of the source data using the BERT graphics device. 
#
graph.histogram <- function(data, main="Histogram", xlabel="Data"){
  
  # passing cell=T means "use the cell address as a unique
  # identifier". otherwise, use the name parameter to identify 
  # the target shape.
  
  BERT.graphics.device(cell=T);

  # scrub the data (slightly) then generate a histogram
  
  x <- unlist( as.numeric( data ));
  hist( x, xlab=xlabel, main=main, col="pink", breaks=13, font.main=1);
  
  # we're done with the graphics device; we can shut it off.
  # this isn't strictly necessary, but there's a limit of 63
  # active devices so it's a good idea.
  
  dev.off();
  
  # returning TRUE indicates everything succeeded.  
  
  T
}

Drawing Maps

Using the maps package, it’s easy to create graphical maps from a list of countries (you could do the same thing for other geographic entities, like US states or French départments).

Before using this function, make sure to install the maps package; use Packages > Install Packages from the BERT console menu.

Show/Hide Code Download Example Spreadsheet


#
# draw a map from a list of countries and a list 
# of values, using a heat scale.  optionally add
# a title to the map.
#
# requires the `maps` package.
# 
draw.map <- function( countries, values, title ){

  library(maps);
  BERT.graphics.device(cell=T);

  # allow nulls in countries; map to values and ensure zeros.

  c2 <- unlist(countries[!is.na(countries)]);
  values <- as.numeric(values);
  values[is.na(values)] <- 0;
  v2 <- unlist(values[!is.na(countries)]);

  # for colors, reduce to a color space of 32 (?) levels. scale values.

  n <- 32;
  scaled.values <- round((1-((v2-min(v2))/(max(v2) - min(v2))))*(n-1))+1;
  heatcolors <- heat.colors(n);

  margins = c(0, 0, 0, 0);
  if( !missing(title)){ margins[3] <- .6; }

  # fill doesn't work properly (or at least as one would expect) 
  # when a country has multiple polygons, so do this in separate passes...

  # 1: space out the map
  par(mai=margins);
  map("world", c2, fill=F, lty=0);

  # 2: fill in countries
  sapply( c2, function(country){ 
    map( "world", country, fill=T, lty=0, add=T, 
      col=heatcolors[scaled.values[[which(c2==country)]]] );
  });

  # 3: draw lines on top
  map("world", c2, fill=F, col="#cccccc", add=T );

  # add title

  if(!missing(title)){ title( main=title, font.main=1 ); }
  
  dev.off();
  T;
}

Utilities

Getting the Caller Reference

Not a function in and of itself, but an example of how to use the Excel API to get a reference to the calling cell (the cell containing the function).

Show/Hide Code Download Example Spreadsheet


#
# how big is the calling reference? that might be useful to know
# if you are scaling data up or down, or initializing a data set.
#
How.Big <- function(){

  # use the Excel API function to get a reference to the
  # caller.  for a range, that will include the top-left
  # and bottom-right cells

  ref <- BERT$.Excel(89); # xlfCaller

  # use our functions to get the size of the range, and then
  # paste together a string

  n.rows <- nrow(ref);
  n.cols <- ncol(ref);

  return(paste(n.rows, "x", n.cols));

}