advent of code solutions
op.tngl.io
haskell
aoc
2016: add all
Signed-off-by: oppiliappan <me@oppi.li>
+302
+7
readme.txt
+7
readme.txt
+117
src/2016/01.lhs
+117
src/2016/01.lhs
···
1
+
= 2016
2
+
3
+
== Day 1
4
+
5
+
=== Part 1
6
+
7
+
We start with some imports obviously:
8
+
9
+
\begin{code}
10
+
{-# LANGUAGE LambdaCase #-}
11
+
import qualified Data.Set as S
12
+
\end{code}
13
+
14
+
Once we have those in place, begin by parsing the input; the input is of the form:
15
+
16
+
```
17
+
R24, L45, CNN ...
18
+
```
19
+
20
+
Where `C` is a letter, `NN` form a natural number. First we normalize the input by appending a "," to the end. We then use `words` to split on spaces, now each element is of the form `CNN,`. Using `init` we can drop the trailing comma, and finally, call `extract` to parse `C` and `NN` separately.
21
+
22
+
\begin{code}
23
+
parse :: String -> [(Char, Int)]
24
+
parse input = map (extract . init) $ words normalized
25
+
where normalized = input ++ ","
26
+
extract (d:rest) = (d, read rest)
27
+
\end{code}
28
+
29
+
Next, we define a list of axes, the +x axis is defined as (1, 0) and so on:
30
+
31
+
\begin{code}
32
+
axis :: [(Int, Int)]
33
+
axis = [(0, 1), (1, 0), (0, -1), (-1, 0)]
34
+
\end{code}
35
+
36
+
And finally, the first bit of interesting computation; given a direction, we apply a move to the right or left. Each face is represented by an integer (0 being North, 1 being East etc.),
37
+
Turning right adds one; and turing left subtracts one, the modulo makes the computation cyclic:
38
+
39
+
\begin{code}
40
+
dir :: Int -> Char -> Int
41
+
dir face = \case
42
+
'R' -> (face + 1) `mod` 4
43
+
'L' -> (face - 1) `mod` 4
44
+
\end{code}
45
+
46
+
Now, given a position, and a movement; we can compute the new position like so; first compute the new face to look at by turning,
47
+
next, determine the axis that we would move along. If we are moving along the +x axis, (dx, dy) is set to (1, 0). Thus the new position is given by movind `l * dx` along the x-axis, and `l * dy` along the y-axis (which would be zero if `dy` is zero).
48
+
49
+
\begin{code}
50
+
move (face, x, y) (d, l) = (nf, x + l * dx, y + l * dy)
51
+
where nf = dir face d
52
+
(dx, dy) = axis !! nf
53
+
\end{code}
54
+
55
+
The problem requires us to compute the Manhattan distance of the destination location; which is given by:
56
+
57
+
\begin{code}
58
+
mag (_, x, y) = abs x + abs y
59
+
\end{code}
60
+
61
+
Thus, the solution to part 1 is given by `p1`; apply the `move` function starting at (0, 0, 0); and applying all the moves in the input. Finally compute the Manhattan distance of the destination from the origin.
62
+
63
+
\begin{code}
64
+
p1 :: [(Char, Int)] -> Int
65
+
p1 n = mag $ foldl' move (0, 0, 0) n
66
+
\end{code}
67
+
68
+
=== Part 2
69
+
70
+
In the second part, we are tasked with finding the first point that we cross over. This requires us to first enumerate all the points we have visited by making each move.
71
+
72
+
This `range` function is a helper to enumerate all points between two integers:
73
+
74
+
\begin{code}
75
+
range :: Int -> Int -> [Int]
76
+
range a b
77
+
| a <= b = [a .. b]
78
+
| otherwise = [a, a - 1 .. b]
79
+
\end{code}
80
+
81
+
The first point we cross over will then be the first duplicate element in the list of points we visit, `firstDup` uses `Data.Set` to determine the first duplicate point from a sequence:
82
+
83
+
\begin{code}
84
+
firstDup :: Ord a => [a] -> a
85
+
firstDup xs = go S.empty xs
86
+
where
87
+
go seen (x : xs)
88
+
| x `S.member` seen = x
89
+
| otherwise = go (S.insert x seen) xs
90
+
\end{code}
91
+
92
+
Thus, the solution to the second part is given by `p2`. First, `pts` is calculated as all the final locations after each move. We then run through these pairwise and calculate all the points in between. Finally, we determine the magnitude of the first point we visit twice.
93
+
94
+
\begin{code}
95
+
p2 :: [(Char, Int)] -> Int
96
+
p2 n = mag $ firstDup coords
97
+
where
98
+
pts = scanl move (0, 0, 0) n
99
+
pairs = zip pts (tail pts)
100
+
coords =
101
+
[ (0, x, y)
102
+
| ((_, x1, y1), (_, x2, y2)) <- pairs,
103
+
x <- range x1 x2,
104
+
y <- range y1 y2,
105
+
(x, y) /= (x1, y1)
106
+
]
107
+
\end{code}
108
+
109
+
Finally the `main` function is defined like so:
110
+
111
+
\begin{code}
112
+
input = "R8, R4, R4, R8"
113
+
main = do
114
+
let f = parse input
115
+
print $ p1 f
116
+
print $ p2 f
117
+
\end{code}
+46
src/2016/02.lhs
+46
src/2016/02.lhs
···
1
+
== Day 2
2
+
3
+
=== Part 1
4
+
5
+
\begin{code}
6
+
{-# LANGUAGE LambdaCase #-}
7
+
8
+
import qualified Data.Map as M
9
+
import System.Environment (getArgs)
10
+
11
+
grid = M.fromList $ zip [(x, y) | y <- [1, 0, -1], x <- [-1, 0, 1]] [1 .. 9]
12
+
13
+
grid2 =
14
+
M.fromList $
15
+
concat
16
+
[ [((0, 2), '1')],
17
+
[((-1, 1), '2'), ((0, 1), '3'), ((1, 1), '4')],
18
+
[((-2, 0), '5'), ((-1, 0), '6'), ((0, 0), '7'), ((1, 0), '8'), ((2, 0), '9')],
19
+
[((-1, -1), 'A'), ((0, -1), 'B'), ((1, -1), 'C')],
20
+
[((0, -2), 'D')]
21
+
]
22
+
23
+
move = \case
24
+
'L' -> (-1, 0)
25
+
'R' -> (1, 0)
26
+
'U' -> (0, 1)
27
+
'D' -> (0, -1)
28
+
29
+
mmove g pos d = if M.member npos g then npos else pos
30
+
where
31
+
delta = move d
32
+
npos = (fst pos + fst delta, snd pos + snd delta)
33
+
34
+
p1 ns = tail $ map (grid M.!) $ scanl (foldl' (mmove grid)) (0, 0) ns
35
+
36
+
p2 ns = tail $ map (grid2 M.!) $ scanl (foldl' (mmove grid2)) (-2, 0) ns
37
+
38
+
main = do
39
+
args <- getArgs
40
+
n <- case args of
41
+
["-"] -> getContents
42
+
[file] -> readFile file
43
+
let f = lines n
44
+
print $ p1 f
45
+
print $ p2 f
46
+
\end{code}
+24
src/2016/03.lhs
+24
src/2016/03.lhs
···
1
+
import qualified Data.List as L
2
+
import Data.List.Split (chunksOf, splitOn)
3
+
import qualified Data.Text as T
4
+
import System.Environment (getArgs)
5
+
6
+
strip = T.unpack . T.strip . T.pack
7
+
8
+
parse i = map read $ filter (not . null) $ map strip $ splitOn " " i
9
+
10
+
possible l = all test $ L.permutations l
11
+
where
12
+
test [a, b, c] = a + b > c
13
+
14
+
p1 = length . filter possible
15
+
16
+
main = do
17
+
args <- getArgs
18
+
n <- case args of
19
+
["-"] -> getContents
20
+
[file] -> readFile file
21
+
let f = map parse $ lines n
22
+
let f2 = chunksOf 3 $ concat $ L.transpose f
23
+
print $ p1 f
24
+
print $ p1 f2
+43
src/2016/04.lhs
+43
src/2016/04.lhs
···
1
+
import Data.Char
2
+
import qualified Data.List as L
3
+
import Data.List.Split (splitOn)
4
+
import qualified Data.Map as M
5
+
import qualified Data.Text as T
6
+
import System.Environment (getArgs)
7
+
8
+
parse i = (ls, read r, init c)
9
+
where
10
+
parts = splitOn "-" i
11
+
ls = concat $ init parts
12
+
[r, c] = splitOn "[" (L.last parts)
13
+
14
+
freqs = M.fromListWith (+) . map (,1)
15
+
16
+
cksum m = take 5 $ map fst $ L.sortBy f $ M.toList m
17
+
where
18
+
f (a, f1) (b, f2) = compare f2 f1 <> compare a b
19
+
20
+
p1 it =
21
+
sum $
22
+
map (\(_, b, _) -> b) $
23
+
filter solve it
24
+
where
25
+
solve (ls, room, c) = cksum (freqs ls) == c
26
+
27
+
decrypt n = map (chr . (+ 97) . (`mod` 26) . (+ n) . flip (-) 97 . ord)
28
+
29
+
p2 it =
30
+
L.find ((== "northpoleobjectstorage") . fst) $
31
+
map (\(a, b, _) -> (decrypt b a, b)) $
32
+
filter solve it
33
+
where
34
+
solve (ls, room, c) = cksum (freqs ls) == c
35
+
36
+
main = do
37
+
args <- getArgs
38
+
n <- case args of
39
+
["-"] -> getContents
40
+
[file] -> readFile file
41
+
let f = map parse $ lines n
42
+
print $ p1 f
43
+
print $ p2 f
+41
src/2016/05.lhs
+41
src/2016/05.lhs
···
1
+
import qualified Crypto.Hash.MD5 as MD5
2
+
import qualified Data.ByteString.Base16 as B16
3
+
import Data.ByteString.Char8 (pack)
4
+
import qualified Data.ByteString.Char8 as BS
5
+
import qualified Data.List as L
6
+
import qualified Data.Map as M
7
+
import System.Environment (getArgs)
8
+
9
+
validHashes inp =
10
+
[ h
11
+
| f <- [0 ..],
12
+
let h = BS.unpack $ B16.encode $ MD5.hash $ BS.pack $ inp ++ show f,
13
+
"00000" `L.isPrefixOf` h
14
+
]
15
+
16
+
p1 = take 8 . map (!! 5) . validHashes
17
+
18
+
p2 inp =
19
+
M.elems $
20
+
go
21
+
M.empty
22
+
[ (pos, val)
23
+
| h <- validHashes inp,
24
+
let pos = h !! 5,
25
+
let val = h !! 6,
26
+
pos `elem` "01234567"
27
+
]
28
+
where
29
+
go seen ((p, v) : rest)
30
+
| length seen == 8 = seen
31
+
| M.member p seen = go seen rest
32
+
| otherwise = go (M.insert p v seen) rest
33
+
34
+
main = do
35
+
args <- getArgs
36
+
n <- case args of
37
+
["-"] -> getContents
38
+
[file] -> readFile file
39
+
let f = init n
40
+
print $ p1 f
41
+
print $ p2 f
+24
src/2016/06.lhs
+24
src/2016/06.lhs
···
1
+
import qualified Data.List as L
2
+
import qualified Data.Map as M
3
+
import Data.Ord (comparing)
4
+
import System.Environment (getArgs)
5
+
6
+
freqs = M.fromListWith (+) . map (,1)
7
+
8
+
highest = L.maximumBy (comparing snd) . M.toList
9
+
10
+
lowest = L.minimumBy (comparing snd) . M.toList
11
+
12
+
p1 = map (fst . highest . freqs)
13
+
14
+
p2 = map (fst . lowest . freqs)
15
+
16
+
main = do
17
+
args <- getArgs
18
+
n <- case args of
19
+
["-"] -> getContents
20
+
[file] -> readFile file
21
+
let f = L.transpose $ lines n
22
+
putStrLn $ p1 f
23
+
putStrLn $ p2 f
24
+