advent02.hs

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