Adding comments to describe the hanoi algorithm (dunno if it's correct, but it works on paper)

lib/Homework/Ch01/Hanoi.hs

@@ -2,47 +2,93 @@ module Homework.Ch01.Hanoi where
 
 import Data.Maybe
 
-data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)
+-- | Move pegs from the first peg to the last peg.
+-- The moves that were made are returned, but an error is returned if a move
+-- can't be made.
+hanoi :: String -> String -> String -> Int -> Either String [Move]
+hanoi pegLabelA pegLabelB pegLabelC numDiscs =
+  let -- CONSTRUCT a set of pegs given the provided arguments
+      pegsStart = initPegs pegLabelA pegLabelB pegLabelC numDiscs
+      -- Make a move
+      (movesMade, _) = move pegsStart
+   in -- Cheat the return for now, assume that movesMade is present for TDD
+      Right [fromJust movesMade]
 
+-- | Make a move
+-- Given some pegs, make a move if a move is possible and return the pegs with
+-- the move that was made.
+--
+-- The return of this function is a 2-tuple of ($THE_MOVE, $PEGS_AFTER_MOVE).
+move :: Pegs -> (Maybe Move, Pegs)
+move pegs =
+  let -- pull apart the first peg
+      pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA pegs
+      -- pull apart the last peg
+      pegC@(Peg lastPegLabel lastPegDiscs) = pegsPegC pegs
+      -- get the smallest disc from the first peg
+      firstPegDisc = last firstPegDiscs
+      -- get the smallest disk from the last peg
+      lastPegDisc = last lastPegDiscs
+      -- the disc from the first peg can move to the  last peg if it is smaller
+      -- than the last peg's smallest disc
+      canMove = firstPegDisc < lastPegDisc
+   in -- return a tuple of (move made, pegs after move)
+      if canMove
+        then
+          ( -- return the move made
+            Just $
+              Move
+                { moveFrom = firstPegLabel,
+                  moveTo = lastPegLabel
+                },
+            -- modify the pegs to reflect the move
+            pegs
+              { -- Retain all discs but the last disc in peg A
+                pegsPegA = pegA {pegDiscs = init firstPegDiscs},
+                -- Append peg A's last disk to the end of peg C's discs
+                pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
+              }
+          )
+        else
+          ( -- no move can be made, so no move is returned
+            Nothing,
+            -- return the pegs as they are
+            pegs
+          )
+
+-- A set of pegs ordered from start to finish.
 data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} deriving (Eq, Show)
 
-data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)
+-- CONSTRUCT a set of pegs with their labels and number of discs to fill the first peg with
-
+initPegs :: String -> String -> String -> Int -> Pegs
-data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
+initPegs pegLabelA pegLabelB pegLabelC numDiscs =
-
-hanoi :: Int -> String -> String -> String -> Either String [Move]
-hanoi numDiscs pegLabelA pegLabelB pegLabelC =
-  let pegs =
   Pegs
     { pegsPegA = fillPeg pegLabelA numDiscs,
       pegsPegB = emptyPeg pegLabelB,
       pegsPegC = emptyPeg pegLabelC
     }
-   in Right . return . fromJust . fst $ move pegs
 
-move :: Pegs -> (Maybe Move, Pegs)
+-- A peg is labeled and contains a stack of discs
-move pegs =
+data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)
-  let pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA pegs
-      pegC@(Peg lastPegLabel lastPegDiscs) = pegsPegC pegs
-      firstPegDisc = last firstPegDiscs
-      lastPegDisc = last lastPegDiscs
-      canMove = firstPegDisc < lastPegDisc
-   in if canMove
-        then
-          ( Just $ Move firstPegLabel lastPegLabel,
-            pegs
-              { pegsPegA = pegA {pegDiscs = init firstPegDiscs},
-                pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
-              }
-          )
-        else (Nothing, pegs)
 
+-- CONSTRUCT a new peg with a label and number of disks to fill it with
 fillPeg :: String -> Int -> Peg
-fillPeg label numDisks =
+fillPeg label numDiscs =
   Peg
     { pegLabel = label,
-      pegDiscs = Disc <$> reverse [1 .. numDisks]
+      pegDiscs = stackDiscs numDiscs
     }
 
+-- CONSTRUCT an empty peg with a label
 emptyPeg :: String -> Peg
 emptyPeg label = Peg {pegLabel = label, pegDiscs = []}
+
+-- A Disc has a size.
+data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
+
+-- CONSTRUCT a stack of discs
+stackDiscs :: Int -> [Disc]
+stackDiscs numDiscs = Disc <$> reverse [1 .. numDiscs]
+
+-- A move has the peg that the disc was moved from and the peg it was moved to
+data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)

test/Homework/Ch01/HanoiSpec.hs

@@ -5,26 +5,89 @@ import Test.Hspec
 
 spec :: Spec
 spec = describe "Hanoi" $ do
+  -- Testing the solver function
   describe "hanoi" $ do
-    it "can solve for a stack of 1 and three pegs" $ do
+    -- helper to construct a hanoi function with preconfigured labels
-      hanoi 1 "a" "b" "c"
+    let hanoiOf = hanoi "a" "b" "c"
+
+    it "can solve for a stack of 1 disc" $ do
+      hanoiOf 1 --          a@[1] b@[] c@[]
         `shouldBe` Right
-          [Move "a" "c"]
+          [ Move "a" "c" -- a@[]  b@[] c@[1]
-    it "can solve for stack of 3 and three pegs" $ do
-      hanoi 3 "a" "b" "c"
-        `shouldBe` Right
-          [ Move "a" "c",
-            Move "a" "b",
-            Move "c" "b"
           ]
+
+    it "can solve for a stack of 2 discs" $ do
+      hanoiOf 2 --           a@[2, 1] b@[]  c@[]
+        `shouldBe` Right
+          [ Move "a" "c", -- a@[2]    b@[]  c@[1]
+            Move "a" "b", -- a@[]     b@[2] c@[1]
+            Move "c" "a", -- a@[1]    b@[2] c@[]
+            Move "a" "c", -- a@[1]    b@[]  c@[2]
+            Move "a" "c" --  a@[]     b@[]  c@[2, 1]
+          ]
+
+    it "can solve for a stack of 3 discs" $ do
+      hanoiOf 3 --           a@[3, 2, 1] b@[]     c@[]
+        `shouldBe` Right
+          [ Move "a" "c", -- a@[3, 2]    b@[]     c@[1]
+            Move "a" "b", -- a@[3]       b@[2]    c@[1]
+            Move "c" "b", -- a@[3]       b@[2, 1] c@[]
+            Move "a" "c", -- a@[]        b@[2, 1] c@[3]
+            Move "b" "a", -- a@[1]       b@[2]    c@[3]
+            Move "b" "c", -- a@[1]       b@[]     c@[3, 2]
+            Move "a" "c" --  a@[]        b@[]     c@[3, 2, 1]
+          ]
+
+  -- Testing individual moves
+  describe "move" $ do
+    it "moves the smallest peg from peg A to peg C if peg C's disc is bigger" $ do
+      let emptyPegs = initPegs "a" "b" "c" 0
+          pegs =
+            emptyPegs
+              { pegsPegA = (emptyPeg "a") {pegDiscs = [Disc 3, Disc 1]},
+                pegsPegC = (emptyPeg "c") {pegDiscs = [Disc 2]}
+              }
+          -- run the function
+          (moveMade, pegsAfterMove) = move pegs
+
+      -- a move should have been made
+      moveMade `shouldBe` Just (Move "a" "c")
+      -- the pegs should have changed
+      pegsAfterMove
+        `shouldBe` pegs
+          { pegsPegA = (pegsPegA pegs) {pegDiscs = [Disc 3]},
+            pegsPegC = (pegsPegC pegs) {pegDiscs = [Disc 2, Disc 1]}
+          }
+
+  -- Testing constructor for a set of pegs
+  describe "initPegs" $ do
+    it "creates pegs with labels and fills the first peg with discs" $ do
+      initPegs "a" "b" "c" 3
+        `shouldBe` Pegs
+          { pegsPegA = Peg {pegLabel = "a", pegDiscs = [Disc 3, Disc 2, Disc 1]},
+            pegsPegB = Peg {pegLabel = "b", pegDiscs = []},
+            pegsPegC = Peg {pegLabel = "c", pegDiscs = []}
+          }
+
+  -- Testing constructor for a peg with discs
   describe "fillPeg" $ do
     it "creates a list of disks from biggest to smallest" $ do
       fillPeg "a" 3
         `shouldBe` Peg
           { pegLabel = "a",
-            pegDiscs =
+            pegDiscs = [Disc 3, Disc 2, Disc 1]
-              [ Disc 3,
-                Disc 2,
-                Disc 1
-              ]
           }
+
+  -- Testing constructor for a peg without discs
+  describe "emptyPeg" $ do
+    it "creates an empty peg" $ do
+      emptyPeg "a"
+        `shouldBe` Peg
+          { pegLabel = "a",
+            pegDiscs = []
+          }
+
+  -- Testing constructor for a stack of discs
+  describe "stackDiscs" $ do
+    it "should create a stack of discs from largest to smallest" $ do
+      stackDiscs 3 `shouldBe` [Disc 3, Disc 2, Disc 1]