advent02.hs

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