Towers of Hanoi in Haskell

Question 3.4 of Cracking the Coding Interview:

In the classic problem of the Towers of Hanoi, you have 3 towers and N disks of different sizes which can slide onto any tower. The puzzle starts with disks sorted in ascending order of size from top to bottom (i.e., each disk sits on top of an even larger one). You have the following constraints:

1. Only one disk can be moved at a time.
2. A disk is slid off the top of one tower onto the next tower.
3. A disk can only be placed on top of a larger disk.

Write a program to move the disks from the first tower to the last using stacks.

There’s a classic recursive solution: move the top (N-1) disks to the spare tower, then move the large bottom disk to the target tower, then finally move those (N-1) disk from the spare tower to the target tower.

Here’s a solution in Haskell:

module Hanoi where

type TowerIndex = Int
type Move = (TowerIndex,TowerIndex)
type DiskSize = Int
type Tower = [DiskSize]
type State = [Tower]

towerIndexes :: [TowerIndex]
towerIndexes = [0,1,2]

hanoi :: Int -> TowerIndex -> TowerIndex -> [Move]
hanoi 0 _ _ = []
hanoi n from to = hanoi (n-1) from spare ++ [(from, to)] ++ hanoi (n-1) spare to
  where spare = head $ filter (\t -> t /= from && t /= to) towerIndexes

---------------------------
---------- TESTS ----------

startState :: State
startState = [[1,2,3,4,5], [], []]

legalTower :: Tower -> Bool
legalTower [] = True
legalTower [d] = True
legalTower (d1:d2:ds) = d1 < d2 && legalTower (d2:ds)

legalState :: State -> Bool
legalState ts = all legalTower ts

move :: Move -> State -> State
move (i1,i2) s = map changeTower $ zip towerIndexes s where
  d = head $ s !! i1
  changeTower (i,t) 
    | i == i1   = tail t 
    | i == i2   = d:t 
    | otherwise = t

runMoves :: [Move] -> State -> [State]
runMoves moves s = foldl (\ss m -> move m (head ss) : ss) [s] moves

legalMoves :: [Move] -> State -> Bool
legalMoves moves s = all legalState $ runMoves moves s

moves :: [Move]
moves = hanoi 5 0 2

main = do
  print $ (head $ runMoves moves startState) == [[], [], [1,2,3,4,5]]
  print $ legalMoves moves startState

This page copyright James Fisher 2020. Content is not associated with my employer. Found an error? Edit this page.

Jim Fisher

CV

Speaking

Blogroll

RSS

TigYog

Kickabout