adventofcode16/app/advent02.hs

   1 module Main(main) where
   2
   3 import Data.Array.IArray
   4
   5 -- Row 1 is top, column 1 is left
   6 type Position = (Int, Int)
   7 type Keyboard = Array Position Char
   8
   9 kb1 = ["xxxxx",
  10        "x123x",
  11        "x456x",
  12        "x789x",
  13        "xxxxx"]
  14
  15 kb2 = ["xxxxxxx",
  16        "xxx1xxx",
  17        "xx234xx",
  18        "x56789x",
  19        "xxABCxx",
  20        "xxxDxxx",
  21        "xxxxxxx"]
  22
  23 enumerate = zip [0..]
  24
  25 mkKeyboard :: [String] -> Keyboard
  26 mkKeyboard kb = array ((0, 0), (length kb - 1, length (kb!!0) - 1))
  27     [((i, j), c) | (i, r) <- enumerate kb, (j, c) <- enumerate r]
  28
  29 keyboard1 = mkKeyboard kb1
  30 keyboard2 = mkKeyboard kb2
  31
  32 findKey :: Keyboard -> Char-> Position
  33 findKey kb c = fst $ head $ filter (\a -> (snd a) == c) $ assocs kb
  34
  35 -- data Coord = One | Two | Three
  36 --     deriving (Read, Show, Eq, Ord, Enum, Bounded)
  37 -- -- instance Bounded Coord where
  38 -- --     minBound = Coord 1
  39 -- --     maxBound = Coord 3
  40
  41 -- data Position = Position Coord Coord
  42 --     deriving (Show, Eq)
  43
  44 main :: IO ()
  45 main = do
  46         instrText <- readFile "data/advent02.txt"
  47         let instructions = lines instrText
  48         part1 instructions
  49         part2 instructions
  50
  51 part1 :: [String] -> IO ()
  52 part1 instructions = do
  53         putStrLn $ followInstructions keyboard1 instructions
  54
  55
  56 part2 :: [String] -> IO ()
  57 part2 instructions = do
  58         putStrLn $ followInstructions keyboard2 instructions
  59
  60
  61 followInstructions :: Keyboard -> [String] -> String
  62 followInstructions kb instr = moveSeries kb (startPosition kb) instr
  63
  64
  65 startPosition :: Keyboard -> Position
  66 startPosition kb = findKey kb '5'
  67
  68 moveSeries :: Keyboard -> Position -> [String] -> String
  69 moveSeries _ _ [] = []
  70 moveSeries kb p (i:is) = (n:ns)
  71     where p' = makeMoves kb p i
  72           n = kb ! p'
  73           ns = moveSeries kb p' is
  74
  75 makeMoves :: Keyboard -> Position -> [Char] -> Position
  76 makeMoves kb p ms = foldl (safeMove kb) p ms
  77
  78 safeMove :: Keyboard -> Position -> Char -> Position
  79 safeMove kb pos dir = maybeRevert kb pos (move pos dir)
  80
  81 move :: Position -> Char -> Position
  82 move (r, c) 'U' = (r-1, c)
  83 move (r, c) 'D' = (r+1, c)
  84 move (r, c) 'L' = (r, c-1)
  85 move (r, c) 'R' = (r, c+1)
  86
  87 maybeRevert :: Keyboard -> Position -> Position -> Position
  88 maybeRevert kb oldPos newPos
  89     | kb ! newPos == 'x' = oldPos
  90     | otherwise = newPos