Concretizing the pegs

This commit is contained in:
Logan McGrath 2021-10-06 13:39:05 -07:00
parent cd9b71c03e
commit e2b81e0411
2 changed files with 38 additions and 26 deletions

View File

@ -2,39 +2,47 @@ module Homework.Ch01.Hanoi where
import Data.Maybe import Data.Maybe
newtype Peg = Peg () 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 Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)
data Disc = Disc {discSize :: Int} deriving (Eq, Show, Ord) data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
type Pegs = [(String, [Disc])]
hanoi :: Int -> String -> String -> String -> Either String [Move] hanoi :: Int -> String -> String -> String -> Either String [Move]
hanoi numDisks pegLabelA pegLabelB pegLabelC = hanoi numDiscs pegLabelA pegLabelB pegLabelC =
let pegs = let pegs =
[ (pegLabelA, fillPegWithDiscs numDisks), Pegs
(pegLabelB, []), { pegsPegA = fillPeg pegLabelA numDiscs,
(pegLabelC, []) pegsPegB = emptyPeg pegLabelB,
] pegsPegC = emptyPeg pegLabelC
}
in Right . return . fromJust . fst $ move pegs in Right . return . fromJust . fst $ move pegs
move :: Pegs -> (Maybe Move, Pegs) move :: Pegs -> (Maybe Move, Pegs)
move pegs = move pegs =
let (firstPegLabel, firstPeg) = head pegs let pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA pegs
(lastPegLabel, lastPeg) = last pegs pegC@(Peg lastPegLabel lastPegDiscs) = pegsPegC pegs
firstPegDisc = last firstPeg firstPegDisc = last firstPegDiscs
lastPegDisc = last lastPeg lastPegDisc = last lastPegDiscs
canMove = firstPegDisc < lastPegDisc canMove = firstPegDisc < lastPegDisc
in if canMove in if canMove
then then
( Just $ Move firstPegLabel lastPegLabel, ( Just $ Move firstPegLabel lastPegLabel,
[ (firstPegLabel, init firstPeg), pegs
head $ tail pegs, { pegsPegA = pegA {pegDiscs = init firstPegDiscs},
(lastPegLabel, lastPeg <> [firstPegDisc]) pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
] }
) )
else (Nothing, []) else (Nothing, pegs)
fillPegWithDiscs :: Int -> [Disc] fillPeg :: String -> Int -> Peg
fillPegWithDiscs numDisks = Disc <$> reverse [1 .. numDisks] fillPeg label numDisks =
Peg
{ pegLabel = label,
pegDiscs = Disc <$> reverse [1 .. numDisks]
}
emptyPeg :: String -> Peg
emptyPeg label = Peg {pegLabel = label, pegDiscs = []}

View File

@ -17,10 +17,14 @@ spec = describe "Hanoi" $ do
Move "a" "b", Move "a" "b",
Move "c" "b" Move "c" "b"
] ]
describe "fillPegWithDiscs" $ do describe "fillPeg" $ do
it "creates a list of disks from biggest to smallest" $ do it "creates a list of disks from biggest to smallest" $ do
fillPegWithDiscs 3 fillPeg "a" 3
`shouldBe` [ Disc 3, `shouldBe` Peg
Disc 2, { pegLabel = "a",
Disc 1 pegDiscs =
] [ Disc 3,
Disc 2,
Disc 1
]
}