95 lines
3.4 KiB
Haskell
95 lines
3.4 KiB
Haskell
module Homework.Ch01.Hanoi where
|
|
|
|
import Data.Maybe
|
|
|
|
-- | Move pegs from the first peg to the last peg.
|
|
-- The moves that were made are returned, but an error is returned if a move
|
|
-- can't be made.
|
|
hanoi :: String -> String -> String -> Int -> Either String [Move]
|
|
hanoi pegLabelA pegLabelB pegLabelC numDiscs =
|
|
let -- CONSTRUCT a set of pegs given the provided arguments
|
|
pegsStart = initPegs pegLabelA pegLabelB pegLabelC numDiscs
|
|
-- Make a move
|
|
(movesMade, _) = move pegsStart
|
|
in -- Cheat the return for now, assume that movesMade is present for TDD
|
|
Right [fromJust movesMade]
|
|
|
|
-- | Make a move
|
|
-- Given some pegs, make a move if a move is possible and return the pegs with
|
|
-- the move that was made.
|
|
--
|
|
-- The return of this function is a 2-tuple of ($THE_MOVE, $PEGS_AFTER_MOVE).
|
|
move :: Pegs -> (Maybe Move, Pegs)
|
|
move pegs =
|
|
let -- pull apart the first peg
|
|
pegA@(Peg firstPegLabel firstPegDiscs) = pegsPegA pegs
|
|
-- pull apart the last peg
|
|
pegC@(Peg lastPegLabel lastPegDiscs) = pegsPegC pegs
|
|
-- get the smallest disc from the first peg
|
|
firstPegDisc = last firstPegDiscs
|
|
-- get the smallest disk from the last peg
|
|
lastPegDisc = last lastPegDiscs
|
|
-- the disc from the first peg can move to the last peg if it is smaller
|
|
-- than the last peg's smallest disc
|
|
canMove = firstPegDisc < lastPegDisc
|
|
in -- return a tuple of (move made, pegs after move)
|
|
if canMove
|
|
then
|
|
( -- return the move made
|
|
Just $
|
|
Move
|
|
{ moveFrom = firstPegLabel,
|
|
moveTo = lastPegLabel
|
|
},
|
|
-- modify the pegs to reflect the move
|
|
pegs
|
|
{ -- Retain all discs but the last disc in peg A
|
|
pegsPegA = pegA {pegDiscs = init firstPegDiscs},
|
|
-- Append peg A's last disk to the end of peg C's discs
|
|
pegsPegC = pegC {pegDiscs = lastPegDiscs <> [firstPegDisc]}
|
|
}
|
|
)
|
|
else
|
|
( -- no move can be made, so no move is returned
|
|
Nothing,
|
|
-- return the pegs as they are
|
|
pegs
|
|
)
|
|
|
|
-- A set of pegs ordered from start to finish.
|
|
data Pegs = Pegs {pegsPegA :: Peg, pegsPegB :: Peg, pegsPegC :: Peg} deriving (Eq, Show)
|
|
|
|
-- CONSTRUCT a set of pegs with their labels and number of discs to fill the first peg with
|
|
initPegs :: String -> String -> String -> Int -> Pegs
|
|
initPegs pegLabelA pegLabelB pegLabelC numDiscs =
|
|
Pegs
|
|
{ pegsPegA = fillPeg pegLabelA numDiscs,
|
|
pegsPegB = emptyPeg pegLabelB,
|
|
pegsPegC = emptyPeg pegLabelC
|
|
}
|
|
|
|
-- A peg is labeled and contains a stack of discs
|
|
data Peg = Peg {pegLabel :: String, pegDiscs :: [Disc]} deriving (Eq, Show)
|
|
|
|
-- CONSTRUCT a new peg with a label and number of disks to fill it with
|
|
fillPeg :: String -> Int -> Peg
|
|
fillPeg label numDiscs =
|
|
Peg
|
|
{ pegLabel = label,
|
|
pegDiscs = stackDiscs numDiscs
|
|
}
|
|
|
|
-- CONSTRUCT an empty peg with a label
|
|
emptyPeg :: String -> Peg
|
|
emptyPeg label = Peg {pegLabel = label, pegDiscs = []}
|
|
|
|
-- A Disc has a size.
|
|
data Disc = Disc {discSize :: Int} deriving (Eq, Ord, Show)
|
|
|
|
-- CONSTRUCT a stack of discs
|
|
stackDiscs :: Int -> [Disc]
|
|
stackDiscs numDiscs = Disc <$> reverse [1 .. numDiscs]
|
|
|
|
-- A move has the peg that the disc was moved from and the peg it was moved to
|
|
data Move = Move {moveFrom :: String, moveTo :: String} deriving (Eq, Show)
|