keywordsalad/haskell-homework
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Logan McGrath 2021-10-06 14:49:48 -07:00
parent e2b81e0411
commit 543ab9e7c3
2 changed files with 150 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

100
lib/Homework/Ch01/Hanoi.hs
View File

@ -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)

91
test/Homework/Ch01/HanoiSpec.hs
View File

@ -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]