39 lines
1.1 KiB
Haskell
39 lines
1.1 KiB
Haskell
module Homework.Ch01.Hanoi where
|
|
|
|
newtype Peg = Peg ()
|
|
|
|
data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)
|
|
|
|
data Disc = Disc {discSize :: Int} deriving (Eq, Show, Ord)
|
|
|
|
type Pegs = [(String, [Disc])]
|
|
|
|
hanoi :: Int -> String -> String -> String -> Either String [Move]
|
|
hanoi numDisks pegLabelA pegLabelB pegLabelC =
|
|
let pegs =
|
|
[ (pegLabelA, fillPegWithDiscs numDisks),
|
|
(pegLabelB, []),
|
|
(pegLabelC, [])
|
|
]
|
|
in Right $ snd $ move pegs
|
|
|
|
move :: Pegs -> (Pegs, [Move])
|
|
move pegs =
|
|
let (firstPegLabel, firstPeg) = head pegs
|
|
(lastPegLabel, lastPeg) = last pegs
|
|
firstPegDisc = last firstPeg
|
|
lastPegDisc = last lastPeg
|
|
canMove = firstPegDisc < lastPegDisc
|
|
in if canMove
|
|
then
|
|
( [ (firstPegLabel, init firstPeg),
|
|
head $ tail pegs,
|
|
(lastPegLabel, lastPeg <> [firstPegDisc])
|
|
],
|
|
[Move firstPegLabel lastPegLabel]
|
|
)
|
|
else (pegs, [])
|
|
|
|
fillPegWithDiscs :: Int -> [Disc]
|
|
fillPegWithDiscs numDisks = Disc <$> reverse [1 .. numDisks]
|