Tidying, especially the parser
[advent-of-code-16.git] / 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