Concretizing the pegs
This commit is contained in:
parent
cd9b71c03e
commit
e2b81e0411
@ -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 = []}
|
||||
|
@ -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
|
||||
]
|
||||
}
|
||||
|
Loading…
Reference in New Issue
Block a user