haskell-homework/lib/Homework/Ch01/Hanoi.hs

49 lines
1.5 KiB
Haskell
Raw Normal View History

2021-10-01 00:04:16 +00:00
module Homework.Ch01.Hanoi where
import Data.Maybe
2021-10-06 20:39:05 +00:00
data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)
2021-10-01 00:04:16 +00:00
2021-10-06 20:39:05 +00:00
data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} deriving (Eq, Show)
2021-10-01 00:04:16 +00:00
2021-10-06 20:39:05 +00:00
data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)
2021-10-06 20:39:05 +00:00
data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
2021-10-01 00:04:16 +00:00
hanoi :: Int -> String -> String -> String -> Either String [Move]
2021-10-06 20:39:05 +00:00
hanoi numDiscs pegLabelA pegLabelB pegLabelC =
let pegs =
2021-10-06 20:39:05 +00:00
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 =
2021-10-06 20:39:05 +00:00
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,
2021-10-06 20:39:05 +00:00
pegs
{ pegsPegA = pegA {pegDiscs = init firstPegDiscs},
pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
}
)
2021-10-06 20:39:05 +00:00
else (Nothing, pegs)
fillPeg :: String -> Int -> Peg
fillPeg label numDisks =
Peg
{ pegLabel = label,
pegDiscs = Disc <$> reverse [1 .. numDisks]
}
2021-10-06 20:39:05 +00:00
emptyPeg :: String -> Peg
emptyPeg label = Peg {pegLabel = label, pegDiscs = []}