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:
- Only one disk can be moved at a time.
- A disk is slid off the top of one tower onto the next tower.
- 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
More by Jim
- Smear phishing: a new Android vulnerability
- A probabilistic pub quiz for nerds
- Time is running out to catch COVID-19
- The inception bar: a new phishing method
- The hacker hype cycle
- Project C-43: the lost origins of asymmetric crypto
- How Hacker News stays interesting
- My parents are Flat-Earthers
- The dots do matter: how to scam a Gmail user
- The sorry state of OpenSSL usability
- I hate telephones
- The Three Ts of Time, Thought and Typing: measuring cost on the web
- Granddad died today
- Your syntax highlighter is wrong