41 lines
1.1 KiB
Haskell
41 lines
1.1 KiB
Haskell
module Homework.Ch01.Hanoi where
|
|
|
|
import Data.Maybe
|
|
|
|
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 . 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
|
|
canMove = firstPegDisc < lastPegDisc
|
|
in if canMove
|
|
then
|
|
( Just $ Move firstPegLabel lastPegLabel,
|
|
[ (firstPegLabel, init firstPeg),
|
|
head $ tail pegs,
|
|
(lastPegLabel, lastPeg <> [firstPegDisc])
|
|
]
|
|
)
|
|
else (Nothing, [])
|
|
|
|
fillPegWithDiscs :: Int -> [Disc]
|
|
fillPegWithDiscs numDisks = Disc <$> reverse [1 .. numDisks]
|