Day 2: Bathroom Security



In [1]:

    
inputLines = lines <$> readFile "input/day2.txt"

In part 1, the keypad is rectangular and has only numeric keys

Therefore, an instruction is equivalent to adding or subtracting a number, provided we do not leave the keypad.



In [2]:

    
move :: Int -> Char -> Int
move n 'U' 
    | n > 3 = n - 3
move n 'D'
    | n < 7 = n + 3
move n 'L' 
    | n `mod` 3 /= 1 = n - 1
move n 'R'
    | n `mod` 3 /= 0 = n + 1
move n _ = n -- instead of moving out of the keypad, we just keep the same number



In [3]:

    
-- Part 1: execute the instructions and collect the resulting numbers (after dropping the initial '5' with tail)
concatMap show . tail . scanl (foldl move) 5 <$> inputLines

In part 2, the keypad is not rectangular any more and can contain letters

First, we will define the two keypads using lists of strings.



In [4]:

    
keypad1 = [ "123"  
          , "456"
          , "789" ]



In [5]:

    
keypad2 = [ "  1  "  
          , " 234 "
          , "56789"
          , " ABC "
          , "  D  " ]

Idea: create a map that maps (key, direction) tuples to the next key in the given direction

For example, for both keypads we would map ('2', 'R') to '3'.

To create the map, a function that creates tuples of neighbouring elements in a list will be useful. This is easy to do thanks to Control.Applicative (see http://stackoverflow.com/questions/2546524/how-do-you-write-the-function-pairs-in-haskell and http://stackoverflow.com/questions/11810889/functions-as-applicative-functors-haskell-lyah):



In [6]:

    
pairs = zip <*> tail
pairs "56789" -- check that it works for the middle row of keypad2









    





[('5','6'),('6','7'),('7','8'),('8','9')]

We want to get rid of spaces because they don't correspond to a valid key



In [7]:

    
pairs " ABC "









    





[(' ','A'),('A','B'),('B','C'),('C',' ')]



In [8]:

    
removeSpaces = filter (\ (a, b) -> a /= ' ' && b /= ' ')
removeSpaces $ pairs " ABC "









    





[('A','B'),('B','C')]

A function that takes a list of pairs and creates "forward" and "backward" moves



In [9]:

    
createForwardBackwardMoves :: Char -> Char -> [(Char, Char)] -> [((Char, Char), Char)]
createForwardBackwardMoves fw bw = concatMap (\(a, b) -> [((a, fw), b), ((b, bw), a)]) . removeSpaces

-- Create all right/left moves for a row
createRightLeftMoves :: String -> [((Char, Char), Char)]
createRightLeftMoves = createForwardBackwardMoves 'R' 'L' . pairs

-- Create all down/up moves for two neighbouring rows
createDownUpMoves :: (String, String) -> [((Char, Char), Char)]
createDownUpMoves = createForwardBackwardMoves 'D' 'U' . uncurry zip

createRightLeftMoves " 234 "         -- second row of second keypad
createDownUpMoves ("  1  ", " 234 ") -- first and second row of second keypad









    





[(('2','R'),'3'),(('3','L'),'2'),(('3','R'),'4'),(('4','L'),'3')]






    





[(('1','D'),'3'),(('3','U'),'1')]

Create a map that contains all valid up/down/left/right moves



In [10]:

    
import qualified Data.Map as Map



In [11]:

    
createMovesMap :: [String] -> Map.Map (Char, Char) Char
createMovesMap rows =
    Map.fromList $ 
    concatMap createRightLeftMoves rows ++ 
    concatMap createDownUpMoves (pairs rows)



In [12]:

    
-- Takes a map of all possible moves, the current key, and the direction, and finds the next key
move' :: Map.Map (Char, Char) Char -> Char -> Char -> Char
move' movesMap currentKey direction = Map.findWithDefault currentKey (currentKey, direction) movesMap



In [13]:

    
-- Takes a keypad and calculates the code (the initial key '5' is dropped with 'tail')
solution keypad = tail . scanl (foldl (move' movesMap)) '5' <$> inputLines
    where
        movesMap = createMovesMap keypad

Reproduce solution of part 1



In [14]:

    
solution keypad1

Solution of part 2



In [15]:

    
solution keypad2









    





"D87AD"