never executed always true always false
    1 {-|
    2 Module:      Y2016.D02
    3 Description: Advent of Code Day 02 Solutions.
    4 License:     MIT
    5 Maintainer:  @tylerjl
    6 
    7 Solutions to the day 02 set of problems for <adventofcode.com>.
    8 -}
    9 module Y2016.D02
   10   ( bathroomCode
   11   , grid1
   12   , grid2
   13   ) where
   14 
   15 import qualified Data.Matrix as Matrix
   16 
   17 -- | A position on the keypad grid
   18 type Position = (Int, Int)
   19 
   20 -- | Wrapper to construct a `Matrix`
   21 grid
   22   :: Int -- ^ Rows
   23   -> Int -- ^ Columns
   24   -> [a] -- ^ Elements
   25   -> Matrix.Matrix a -- ^ Resulting `Matrix`
   26 grid = Matrix.fromList
   27 
   28 -- | `Matrix` for part 1
   29 grid1 :: Matrix.Matrix String
   30 grid1 = grid 3 3 (map show ([1 ..] :: [Int]))
   31 
   32 -- | `Matrix` for part 2
   33 grid2 :: Matrix.Matrix String
   34 grid2 =
   35   grid 5 5 $
   36   [ "", "",  "1", "",  ""
   37   , "", "2", "3", "4", ""
   38   ] ++ map show ([5 .. 9] :: [Int]) ++
   39   [ "", "A", "B", "C", ""
   40   , "",  "", "D", "",  ""
   41   ]
   42 
   43 bathroomCode
   44   :: Matrix.Matrix String -- ^ Grid to solve for
   45   -> Position -- ^ Starting `Position` (y, x)
   46   -> String -- ^ Input `String` of movement instructions
   47   -> String -- ^ Bathroom code
   48 bathroomCode m origin = decode m "" origin . lines
   49 
   50 decode
   51   :: Matrix.Matrix String -- ^ Grid to solve for
   52   -> String -- ^ Solution key that's being built up
   53   -> Position -- ^ Current position
   54   -> [String] -- ^ List of movements for each code character
   55   -> String -- ^ Solution
   56 decode _ key _ [] = key
   57 decode m key position (moves:xs) =
   58   decode m (key ++ Matrix.getElem y x m) position' xs
   59   where
   60     position'@(x, y) = translate m position moves
   61 
   62 translate
   63   :: Matrix.Matrix [a] -- ^ `Matrix` to move within bounds of
   64   -> Position -- ^ Starting `Position`
   65   -> String -- ^ List of directions to move
   66   -> Position -- ^ Final position after performing movements
   67 translate _ position [] = position
   68 translate m position (x:xs)
   69   | withinBounds position' m = translate m position' xs
   70   | otherwise = translate m position xs
   71   where
   72     position' = move position x
   73 
   74 withinBounds
   75   :: Position -- ^ Coordinates of position to check
   76   -> Matrix.Matrix [a] -- ^ `Matrix` to test against
   77   -> Bool -- ^ Whether the given position lies within the matrix
   78 withinBounds (x, y) m =
   79   case Matrix.safeGet y x m of
   80     Nothing -> False
   81     Just v -> not $ null v
   82 
   83 move
   84   :: Position -- ^ Initial `Position`
   85   -> Char -- ^ Movement directive (any of "UDLR")
   86   -> Position -- ^ New `Position`
   87 move (x, y) c =
   88   case c of
   89     'U' -> (x, y - 1)
   90     'R' -> (x + 1, y)
   91     'D' -> (x, y + 1)
   92     'L' -> (x - 1, y)
   93     _ -> (x, y)