The Elegance of Rule-Based Programming in Mathematica

Not too long ago I had to take a programming test as part of the application process for a development position at a hedge fund. The test had two problems - one easy and one not so easy. The solutions to both problems had to be implemented in your choice of Java, C or C++. You had two hours to finish.


I have never been good at presure cooker coding tests like this. I personally don't think these kind of tests bring out the best in most developers but there are some good devlopers who work well under these conditions. I just am not one of them.


In any case I recently thought of the hard problem on this test and how trivial it would be to solve in Mathematica. Indeed I whipped up and tested this solution on my train ride home which is only about 45 mins!


The solution is very short and I am guessing is much shorter than the average solution you can find in Java or C in the equivalent amount of time. The brevity come form exploiting mathematica's powerful rule-based approach. Most of the code is comments!

Problem

A collection of particles is contained in a linear chamber. They all have the same speed, but some are headed toward the right and others are headed toward the left. These particles can pass through each other without disturbing the motion of the particles, so all the particles will leave the chamber relatively quickly.


You will be given the initial conditions by a string containing at each position an 'L' for a leftward moving particle, an 'R' for a rightward moving particle, or a '.' for an empty location. Initially, no location in the chamber contains two particles passing through each other.


Create an animation of the process. At each unit of time, you want a string showing occupied locations with an 'X' and unoccupied locations with a '.'. Create code that for a function animate that is given an integer speed and a string giving the initial conditions. The speed is the number of positions each particle moves in one time unit.


The function will return a list of strings in which each successive element shows the occupied locations at the next time unit. The first element of the return should show the occupied locations at the initial instant (at time = 0) in the 'X', '.' format. The last element in the return should show the empty chamber at the first time that it becomes empty.

Solution

ClearAll[simulation, step, L, R, r, l, rule1, rule2, rule3, animation];

(* 
This function does most of the work. It simulates a single step in the animation.
It uses 3 rules which are initialized in the calling function and are visble
here via the dynamic scoping of Block.

There are 3 transformations performed within a Do. The Do's role is to run the
transformations velocity times as a means for making the particles move
that many steps.

The first transform takes the input and adds an empty cell to the start and end of the chamber.
This is done to avoid having special rules to deal with the 
boundary conditions at the end of the chamber. 

The second transformation uses rules that are applied repeatedly using ReplaceAll (//.). 
I discuss the rules below. 

Delete is used to remove the dummy empty cells added in the first step and 
a third transformation maps lower case r and l back to upper case before the Do
repeats.

*)
step[chamber_List, velocity_Integer] := Module[{work = chamber},
  Do[
   work = 
    Delete[work  /. {P__} :> {{}, P, {}} //. {rule1, rule2, 
        rule3}, {{-1}, {1}}] /. {r -> R, l -> L}, {velocity}];
  work
  ]

(*
The simulation sets up 3 rules. It is not necessary to define the rules here in a
Block. The code is written this way largely because I incrementally developed the
rules in the global scope and grafted them into a program later on.

rule1 is responsible for moving a R partcle to the Right. NOTE: When a particle moves
I change its case from upper to lower to make it invisble to subsequent rules.

rule2 is responsible for handling an intermediate condition where a right moving
particle lands in a cell of another right moving particle that has not moved yet.

rule3 deals with left moving particles being careful to also handle the case where a
previously moved partcle Z may be in the same cell as the L. 

The hardest aspect of this solution was distilling the transformations down to these
three rules. It took some trial and error. It is possible I missed some corner case 
so let me know if you see a bug!!

The idea here is that FixedPointList drives the simulation until it reaches a steady
state and Most removes the repetitive last entry. 

A final transformation maps particles to "X" as dicated by the specifications.
*)

simulation[chamber_List, velocity_Integer] := 
 Block[
  {rule1 = {X___, {R}, {P___}, Y___} :> {X, {}, {P, r}, Y} ,
   rule2 = {X___,  {R | r, r}, {P___}, Y___} :> {X, {r}, {P, r}, Y},
   rule3 = {X___, {P___}, {L, Z___}, Y___} :> {X, {l, P}, {Z}, Y} },
  Most[FixedPointList[
     step[#, velocity] &, chamber]] //. {{(L | R) ..} -> "X", {} -> 
     "."}
  ]

(* 
The main function does little but convert from the string encoding specified by the problem to a more convenent symbolic form where each position in the chamber is one of {L}, {R} or {} for empty and the chamber itself is a list rather than a string.
*)

animation[chamber_String, velocity_Integer] := 
 simulation[
  (Characters[chamber] //. {"." -> {}, a_String :> {Symbol[a]}}), 
  velocity]

The Test Cases

1) The single particle starts at the 3rd position, moves to the 5th, then 7th, and then out of the chamber.

In[360]:= animation["..R....",2]//Grid
Out[360]=
..X....
....X..
......X
.......

2) At time 1, there are actually 4 particles in the chamber, but two are passing through each other at the 4th position.

In[361]:= animation["RR..LRL",3]//Grid
Out[361]= 
XX..XXX
.X.XX..
X.....X
.......

3) At time 0 there are 8 particles. At time 1, there are still 6 particles, but only 4 positions are occupied since particles are passing through each other.

In[362]:= animation["LRLR.LRLR",2]//Grid
Out[362]=
XXXX.XXXX
X..X.X..X
.X.X.X.X.
.X.....X.
.........

4) These particles are moving so fast that they all exit the chamber by time 1.

In[363]:= animation["RLRLRLRLRL",10]//Grid
Out[363]= 
XXXXXXXXXX
..........

5) The empty chamber test

In[364]:= animation["...",1]//Grid
Out[364]=
...

6) A complicated test

In[365]:= animation["LRRL.LR.LRR.R.LRRL.",1]//Grid
Out[365]= 
XXXX.XX.XXX.X.XXXX.
..XXX..X..XX.X..XX.
.X.XX.X.X..XX.XX.XX
X.X.XX...X.XXXXX..X
.X..XXX...X..XX.X..
X..X..XX.X.XX.XX.X.
..X....XX..XX..XX.X
.X.....XXXX..X..XX.
X.....X..XX...X..XX
.....X..X.XX...X..X
....X..X...XX...X..
...X..X.....XX...X.
..X..X.......XX...X
.X..X.........XX...
X..X...........XX..
..X.............XX.
.X...............XX
X.................X
...................

I'll post the Mathematica Notebook on MathematicaCookbook.com