49 lines
1.5 KiB
Haskell
49 lines
1.5 KiB
Haskell
module Homework.Ch01.Hanoi where
|
|
|
|
import Data.Maybe
|
|
|
|
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, Ord, Show)
|
|
|
|
hanoi :: Int -> String -> String -> String -> Either String [Move]
|
|
hanoi numDiscs pegLabelA pegLabelB pegLabelC =
|
|
let pegs =
|
|
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 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,
|
|
pegs
|
|
{ pegsPegA = pegA {pegDiscs = init firstPegDiscs},
|
|
pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
|
|
}
|
|
)
|
|
else (Nothing, pegs)
|
|
|
|
fillPeg :: String -> Int -> Peg
|
|
fillPeg label numDisks =
|
|
Peg
|
|
{ pegLabel = label,
|
|
pegDiscs = Disc <$> reverse [1 .. numDisks]
|
|
}
|
|
|
|
emptyPeg :: String -> Peg
|
|
emptyPeg label = Peg {pegLabel = label, pegDiscs = []}
|