my blog

The first post in this series introduced a categorical look at the Wolfram Language. The second post introduced monadic types and the do. Now it is time for an example application.

Here we take a look at the classic Hanoi Tower puzzle. The puzzle consists of three poles onto which stacks of disks with different sizes \(1 , 2 , 3 , \ldots\) can be placed. At the beginning of the puzzle all disks are stacked on the first pole with smaller disks being placed on top of larger ones. The aim of the puzzle is to transport all disks from the first pole to the third pole in discrete steps. In each step only one disk can be taken from the top of a stack and placed on a larger disk or on an empty pole.

The puzzle is solved in the hanoi_tower_example.nb notebook from here. The notebook starts with a definition of a pattern for the Hanoi Tower puzzle:

    towers = {_List , _List , _List};

The puzzle will be represented by a list containing three elements. Each element is a list and corresponds to a single pole of the puzzle. Elements of this list will be numbers corresponding to disc sizes. Another pattern is provided for expressions that will be used to record the moves that lead to the solution:

    move = {_ -> _ , {_List , _List , _List}};

Moves will be two element lists, the first element (e.g. 1->2) will record the number of the pole from which the disk was taken and the number of the pole onto which the disk was dropped (e.g. 1 , 2). The second element will contain the current configuration of the puzzle.

Next three definitions are provided for the hT monad that will be used in a recursive solution to the puzzle. The first definition is a pattern that will match any WL expression that is an hT monad for any type argument:

    pattern[hT] = hT[towers , {move ...}];

Next the return function is defined as (please note that an empty list also matches {move ...}):

    return[hT][x_] := hT[x , {}];

Finaly the bind operator for hT is given (please note that no additional pattern constraints are necessary for ma and aTomb):

    bind[hT][ma_ , aTomb_] := 
       With[
          {val = aTomb[grab[ma]]}, 
          hT[grab[val] , join[rest[ma], rest[val]]]
       ];

    grab[ma : pattern[hT]] := ma[[1]];
    rest[ma : pattern[hT]] := ma[[2]];

    join[a : {move ...} , b : {move ...}] := Join[a , b];

Providing lazy functions that evaluate only when they are called with appropriate arguments is important for recursion.

Only one action is provided for this monad with two definitions. The first one moves a single disk of puzzle tower from pole number from to pole number to:

    moveDiscs[from_ , to_ , 1][tower : towers] :=
       Module[{newtower},
          newtower = ReplacePart[
             ReplacePart[
                tower , 
                to -> Join[tower[[from]][[1 ;; 1]], tower[[to]]]
             ] , 
             from -> tower[[from , 2 ;;]]
          ];
          hT[newtower , {{from -> to , newtower}}]
       ];

The second one moves n disks from pole number from to pole number to. This time the definition uses the “do" notation and recursion:

    moveDiscs[from_ , to_ , n_][tower : towers] :=
       do[hT][
          toOther <- moveDiscs[
                      from , 
                      other[from , to] , 
                      n - 1][tower],
          toGoal <- moveDiscs[
                      from , 
                      to , 
                      1][toOther],
          finalMove <- moveDiscs[
                         other[from , to] , 
                         to , 
                         n - 1][toGoal],
          return[hT][finalMove]
       ];

where <- is the LeftArrow operator (<ESC><-<ESC> in the WL) and other[i , j] returns a pole number that is different then i and j. The procedure of solving the puzzle can be read off directly from the code above. First \(n-1\) disks are moved from pole number from to a pole that is different from from and to. Next, one disk is moved from pole number from to pole number to. Finaly the \(n-1\) disks are moved from the other pole to the to pole.

A solution to the puzzle with three disks on the first pole in the initial configuration can be obtained by evaluating:

    moveDiscs[1 , 3 , 3][makeTower[3]]

where makeTower[3] prepares the initial configuration of the puzzle. The result is:

    hT[
       {{},{},{1,2,3}},
       {
          {1->3,{{2,3},{},{1}}},
          {1->2,{{3},{2},{1}}},
          {3->2,{{3},{1,2},{}}},
          {1->3,{{},{1,2},{3}}},
          {2->1,{{1},{2},{3}}},
          {2->3,{{1},{},{2,3}}},
          {1->3,{{},{},{1,2,3}}}
       }
    ]

The first element of this expression is the final configuration of the solved puzzle. The second element is a list containing the moves used to obtain the solution.

The repository contains more examples including a list monad and a maybe monad. The reader is encouraged to download and explore these notebooks.

The Mathematica system has a very powerful set of built in functions. The flexibility of the Wolfram Language makes it possible to program in many different styles. Such freedom can, however, be overwhelming and it is a good idea to conform to styles of programming that are tailored to particular problems. Combining the monadic style of programming with the powerful standard library of the Wolfram Language can be very useful for problems that require a functional solution. There are many ways of implementing this style of programming in the Wolfram Language, I think that the method presented here is relatively simple and robust.

2021-02-09 EDIT: fixed some typos, edited last paragraph to sound more like a blog

monads and “do” notation in the Wolfram Language, part 3