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
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 Disc = Disc {discSize :: Int} deriving (Eq, Show, Ord)
type Pegs = [(String, [Disc])]
data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
hanoi :: Int -> String -> String -> String -> Either String [Move]
hanoi numDisks pegLabelA pegLabelB pegLabelC =
hanoi numDiscs pegLabelA pegLabelB pegLabelC =
let pegs =
[ (pegLabelA, fillPegWithDiscs numDisks),
(pegLabelB, []),
(pegLabelC, [])
]
Pegs
{ pegsPegA = fillPeg pegLabelA numDiscs,
pegsPegB = emptyPeg pegLabelB,
pegsPegC = emptyPeg pegLabelC
}
in Right . return . fromJust . fst $ move pegs
move :: Pegs -> (Maybe Move, Pegs)
move pegs =
let (firstPegLabel, firstPeg) = head pegs
(lastPegLabel, lastPeg) = last pegs
firstPegDisc = last firstPeg
lastPegDisc = last lastPeg
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,
[ (firstPegLabel, init firstPeg),
head $ tail pegs,
(lastPegLabel, lastPeg <> [firstPegDisc])
]
pegs
{ pegsPegA = pegA {pegDiscs = init firstPegDiscs},
pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
}
)
else (Nothing, [])
else (Nothing, pegs)
fillPegWithDiscs :: Int -> [Disc]
fillPegWithDiscs numDisks = Disc <$> reverse [1 .. numDisks]
fillPeg :: String -> Int -> Peg
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 "c" "b"
]
describe "fillPegWithDiscs" $ do
describe "fillPeg" $ do
it "creates a list of disks from biggest to smallest" $ do
fillPegWithDiscs 3
`shouldBe` [ Disc 3,
Disc 2,
Disc 1
]
fillPeg "a" 3
`shouldBe` Peg
{ pegLabel = "a",
pegDiscs =
[ Disc 3,
Disc 2,
Disc 1
]
}