oppi.li
advent of code solutions
aoc.oppi.li
haskell
aoc
2021: add all
Signed-off-by: oppiliappan <me@oppi.li>
+319
+18
src/2021/01.lhs
+18
src/2021/01.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import Data.List (tails)
4
+
import System.Environment (getArgs)
5
+
6
+
main = do
7
+
n <-
8
+
fmap (map read . lines) $
9
+
getArgs
10
+
>>= \case
11
+
["-"] -> getContents
12
+
[file] -> readFile file
13
+
print $ p1 n
14
+
print $ p2 n
15
+
16
+
p1 = length . filter (uncurry (<)) . (zip <*> tail)
17
+
18
+
p2 = p1 . map (sum . take 3) . tails
+27
src/2021/02.lhs
+27
src/2021/02.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import System.Environment (getArgs)
4
+
5
+
ans1 = foldl mv (0, 0)
6
+
where
7
+
mv (f, d) ["forward", i] = (f + read i, d)
8
+
mv (f, d) ["up", i] = (f, d - read i)
9
+
mv (f, d) ["down", i] = (f, d + read i)
10
+
mv x _ = x
11
+
12
+
ans2 = foldl mv (0, 0, 0)
13
+
where
14
+
mv (f, d, a) ["forward", i] = (f + read i, d + a * read i, a)
15
+
mv (f, d, a) ["up", i] = (f, d, a - read i)
16
+
mv (f, d, a) ["down", i] = (f, d, a + read i)
17
+
mv x _ = x
18
+
19
+
main = do
20
+
n <-
21
+
fmap (map words . lines) $
22
+
getArgs
23
+
>>= \case
24
+
["-"] -> getContents
25
+
[file] -> readFile file
26
+
print $ uncurry (*) $ ans1 n
27
+
print $ (\(f, d, _) -> f * d) $ ans2 n
+51
src/2021/03.lhs
+51
src/2021/03.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import Data.Char (digitToInt)
4
+
import Data.List (transpose)
5
+
import Data.Map (Map)
6
+
import qualified Data.Map as M
7
+
import System.Environment (getArgs)
8
+
9
+
bitsOfString = map (== '1')
10
+
11
+
intOfBits = foldl (\a x -> a * 2 + if x then 1 else 0) 0
12
+
13
+
binaryToInt = foldl (\a x -> a * 2 + digitToInt x) 0
14
+
15
+
freqs = M.fromListWith (+) . map (,1)
16
+
17
+
mostCommon l = ones m >= zeroes m
18
+
where
19
+
ones = (M.! True)
20
+
zeroes = (M.! False)
21
+
m = freqs l
22
+
23
+
leastCommon = not . mostCommon
24
+
25
+
type Stepper = [Bool] -> Bool
26
+
27
+
step :: Stepper -> [String] -> Int -> [String]
28
+
step stepper ls n = filter (\l -> bitsOfString l !! n == filterFn n) ls
29
+
where
30
+
filterFn n = stepper . bitsOfString $ map (!! n) ls
31
+
32
+
oxygen ls = head $ head $ dropWhile ((/= 1) . length) $ scanl (step mostCommon) ls [0 ..]
33
+
34
+
co2 ls = head $ head $ dropWhile ((/= 1) . length) $ scanl (step leastCommon) ls [0 ..]
35
+
36
+
ans1 = map (mostCommon . bitsOfString) . transpose
37
+
38
+
main = do
39
+
n <-
40
+
fmap lines $
41
+
getArgs
42
+
>>= \case
43
+
["-"] -> getContents
44
+
[file] -> readFile file
45
+
let one = ans1 n
46
+
γ = intOfBits one
47
+
ε = intOfBits $ map not one
48
+
o = binaryToInt $ oxygen n
49
+
co = binaryToInt $ co2 n
50
+
print $ γ * ε
51
+
print $ o * co
+76
src/2021/04.lhs
+76
src/2021/04.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import Control.Monad (join)
4
+
import Data.List (find, transpose)
5
+
import Data.List.Split (splitOn)
6
+
import Data.Maybe (isJust)
7
+
import System.Environment (getArgs)
8
+
import Text.Parsec.Char
9
+
import Text.ParserCombinators.Parsec
10
+
11
+
parseInt :: Parser Int
12
+
parseInt = read <$> (spaces *> many1 digit)
13
+
14
+
parseNums :: Parser [Int]
15
+
parseNums = parseInt `sepBy` char ','
16
+
17
+
parseBoardLine :: Parser [Int]
18
+
parseBoardLine = parseInt `sepBy` many1 (char ' ')
19
+
20
+
type Board = [[Int]]
21
+
22
+
parseBoard :: Parser Board
23
+
parseBoard = parseBoardLine `sepBy` newline
24
+
25
+
parseInput :: Parser ([Int], [Board])
26
+
parseInput = do
27
+
nums <- parseNums <* newline
28
+
boards <- parseBoard `sepBy` newline
29
+
return (nums, boards)
30
+
31
+
doParse :: Parser a -> String -> a
32
+
doParse parser input = v
33
+
where
34
+
Right v = parse parser "input" input
35
+
36
+
isVictor board = any row board || any row (transpose board)
37
+
where
38
+
row = all (== -1)
39
+
40
+
score :: Board -> Int
41
+
score = sum . concatMap (filter (> 0))
42
+
43
+
stepBoard call = map squish
44
+
where
45
+
squish = map (\x -> if x == call then -1 else x)
46
+
47
+
doRound boards call = map (stepBoard call) boards
48
+
49
+
doRound2 boards call = filter (not . isVictor) $ doRound boards call
50
+
51
+
victor :: Int -> [Board] -> Maybe Int
52
+
victor call boards = (* call) . score <$> find isVictor boards
53
+
54
+
ans1 boards calls =
55
+
join $
56
+
find isJust $
57
+
map (uncurry victor) $
58
+
zip (0 : calls) (scanl doRound boards calls)
59
+
60
+
ans2 boards calls =
61
+
head $
62
+
dropWhile (null . snd) $
63
+
reverse $
64
+
zip calls (scanl doRound2 boards calls)
65
+
66
+
main = do
67
+
n <-
68
+
fmap (splitOn "\n\n") $
69
+
getArgs
70
+
>>= \case
71
+
["-"] -> getContents
72
+
[file] -> readFile file
73
+
let calls = doParse parseNums $ head n
74
+
boards = map (filter (not . null) . doParse parseBoard) (tail n)
75
+
print $ ans1 boards calls
76
+
print $ (\(call, boards) -> (* call) $ score $ stepBoard call (head boards)) $ ans2 boards calls
+45
src/2021/05.lhs
+45
src/2021/05.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
module Main where
4
+
5
+
import Control.Monad (liftM2)
6
+
import Data.Functor ((<&>))
7
+
import Data.List.Split (splitOn)
8
+
import Data.Map (Map)
9
+
import qualified Data.Map as M
10
+
import System.Environment (getArgs)
11
+
12
+
parse n = ((a, b), (c, d))
13
+
where
14
+
[a, b, c, d] = map read $ concatMap (splitOn ",") $ splitOn " -> " n
15
+
16
+
doRange ((a, b), (c, d))
17
+
| a == c = map (a,) r2
18
+
| b == d = map (,b) r1
19
+
| otherwise = zip r1 r2
20
+
where
21
+
r1 = if a < c then [a .. c] else [a, a - 1 .. c]
22
+
r2 = if b < d then [b .. d] else [b, b - 1 .. d]
23
+
24
+
freqs = M.fromListWith (+) . map (,1)
25
+
26
+
solve = M.size . M.filter (> 1) . freqs . concatMap doRange
27
+
28
+
p1 = solve . filter (isHor |+ isVer)
29
+
where
30
+
isVer ((a, _), (c, _)) = a == c
31
+
isHor ((_, b), (_, d)) = b == d
32
+
33
+
p2 = solve
34
+
35
+
(|+) = liftM2 (||)
36
+
37
+
main = do
38
+
n <-
39
+
fmap (map parse . lines) $
40
+
getArgs
41
+
>>= \case
42
+
["-"] -> getContents
43
+
[file] -> readFile file
44
+
print $ p1 n
45
+
print $ p2 n
+21
src/2021/06.lhs
+21
src/2021/06.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import Data.List.Split (splitOn)
4
+
import qualified Data.Map as M
5
+
import Data.Maybe (fromMaybe)
6
+
import System.Environment (getArgs)
7
+
8
+
grow m = M.insertWith (+) 6 new . M.insertWith (+) 8 new . M.mapKeys pred . M.delete 0 $ m
9
+
where
10
+
new = fromMaybe 0 $ M.lookup 0 m
11
+
12
+
main = do
13
+
n <-
14
+
fmap (map read . splitOn ",") $
15
+
getArgs
16
+
>>= \case
17
+
["-"] -> getContents
18
+
[file] -> readFile file
19
+
let fish = M.fromListWith (+) $ map (,1) n
20
+
print $ sum $ iterate grow fish !! 80
21
+
print $ sum $ iterate grow fish !! 256
+22
src/2021/07.lhs
+22
src/2021/07.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import Data.List.Split (splitOn)
4
+
import qualified Data.Map as M
5
+
import Data.Maybe (fromMaybe)
6
+
import System.Environment (getArgs)
7
+
8
+
cost1 = abs
9
+
10
+
cost2 d = (d * d + abs d) `div` 2
11
+
12
+
solve cost n = minimum [sum (map (cost . subtract p) n) | p <- [minimum n .. maximum n]]
13
+
14
+
main = do
15
+
n <-
16
+
fmap (map read . splitOn ",") $
17
+
getArgs
18
+
>>= \case
19
+
["-"] -> getContents
20
+
[file] -> readFile file
21
+
print $ solve cost1 n
22
+
print $ solve cost2 n
+48
src/2021/09.lhs
+48
src/2021/09.lhs
···
1
+
{-# LANGUAGE LambdaCase #-}
2
+
3
+
import Data.Char (digitToInt)
4
+
import Data.List (sortBy)
5
+
import qualified Data.Map as M
6
+
import Data.Maybe (fromMaybe, mapMaybe)
7
+
import Data.Ord (Down (Down), comparing)
8
+
import qualified Data.Ord
9
+
import qualified Data.Set as S
10
+
import System.Environment (getArgs)
11
+
12
+
grid lines =
13
+
M.fromList
14
+
[ ((x, y), digitToInt d)
15
+
| (y, l) <- zip [0 ..] lines,
16
+
(x, d) <- zip [0 ..] l
17
+
]
18
+
19
+
around (x, y) = [(x + dx, y + dy) | (dx, dy) <- [(-1, 0), (1, 0), (0, -1), (0, 1)]]
20
+
21
+
minimas g = M.filterWithKey minima g
22
+
where
23
+
minima k a = a < minimum (mapMaybe (g M.!?) (around k))
24
+
25
+
-- generic bfs
26
+
bfs :: (Num n, Ord a) => (a -> [a]) -> [a] -> [(a, n)]
27
+
bfs next s = go S.empty (map (,0) s)
28
+
where
29
+
go _ [] = []
30
+
go seen ((x, dist) : xs)
31
+
| x `S.member` seen = go seen xs
32
+
| otherwise = (x, dist) : go (S.insert x seen) (xs ++ map (,dist + 1) (next x))
33
+
34
+
basin g m = bfs search [m]
35
+
where
36
+
search k = [a | a <- around k, Just v <- [M.lookup a g], v /= 9]
37
+
38
+
main = do
39
+
n <-
40
+
fmap lines $
41
+
getArgs
42
+
>>= \case
43
+
["-"] -> getContents
44
+
[file] -> readFile file
45
+
let g = grid n
46
+
let m = minimas g
47
+
print $ sum m + length m
48
+
print $ product $ take 3 $ sortBy (comparing Down) $ length . basin g <$> M.keys m