Adding comments to describe the hanoi algorithm (dunno if it's correct, but it works on paper)
This commit is contained in:
parent
e2b81e0411
commit
543ab9e7c3
@ -2,47 +2,93 @@ module Homework.Ch01.Hanoi where
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)
|
||||
|
||||
data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} deriving (Eq, Show)
|
||||
|
||||
data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)
|
||||
|
||||
data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
|
||||
|
||||
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 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 pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA 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 if canMove
|
||||
in -- return a tuple of (move made, pegs after move)
|
||||
if canMove
|
||||
then
|
||||
( Just $ Move firstPegLabel lastPegLabel,
|
||||
( -- return the move made
|
||||
Just $
|
||||
Move
|
||||
{ moveFrom = firstPegLabel,
|
||||
moveTo = lastPegLabel
|
||||
},
|
||||
-- modify the pegs to reflect the move
|
||||
pegs
|
||||
{ pegsPegA = pegA {pegDiscs = init firstPegDiscs},
|
||||
{ -- 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 (Nothing, pegs)
|
||||
else
|
||||
( -- no move can be made, so no move is returned
|
||||
Nothing,
|
||||
-- return the pegs as they are
|
||||
pegs
|
||||
)
|
||||
|
||||
fillPeg :: String -> Int -> Peg
|
||||
fillPeg label numDisks =
|
||||
Peg
|
||||
{ pegLabel = label,
|
||||
pegDiscs = Disc <$> reverse [1 .. numDisks]
|
||||
-- A set of pegs ordered from start to finish.
|
||||
data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} 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
|
||||
initPegs pegLabelA pegLabelB pegLabelC numDiscs =
|
||||
Pegs
|
||||
{ pegsPegA = fillPeg pegLabelA numDiscs,
|
||||
pegsPegB = emptyPeg pegLabelB,
|
||||
pegsPegC = emptyPeg pegLabelC
|
||||
}
|
||||
|
||||
-- A peg is labeled and contains a stack of discs
|
||||
data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)
|
||||
|
||||
-- CONSTRUCT a new peg with a label and number of disks to fill it with
|
||||
fillPeg :: String -> Int -> Peg
|
||||
fillPeg label numDiscs =
|
||||
Peg
|
||||
{ pegLabel = label,
|
||||
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)
|
||||
|
||||
@ -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
|
||||
hanoi 1 "a" "b" "c"
|
||||
-- helper to construct a hanoi function with preconfigured labels
|
||||
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"]
|
||||
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"
|
||||
[ Move "a" "c" -- a@[] b@[] c@[1]
|
||||
]
|
||||
|
||||
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 =
|
||||
[ Disc 3,
|
||||
Disc 2,
|
||||
Disc 1
|
||||
]
|
||||
pegDiscs = [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]
|
||||
|
||||
Loading…
Reference in New Issue
Block a user