advent of code solutions
op.tngl.io
haskell
aoc
2020: add all
Signed-off-by: oppiliappan <me@oppi.li>
+745
+14
src/2020/01.lhs
+14
src/2020/01.lhs
···
1
+
import System.Environment (getArgs)
2
+
3
+
p1 l = head [a * b | a <- l, b <- l, a + b == 2020]
4
+
5
+
p2 l = head [a * b * c | a <- l, b <- l, c <- l, a + b + c == 2020]
6
+
7
+
main = do
8
+
args <- getArgs
9
+
n <- case args of
10
+
["-"] -> getContents
11
+
[file] -> readFile file
12
+
let f = map read $ lines n
13
+
print $ p1 f
14
+
print $ p2 f
+27
src/2020/02.lhs
+27
src/2020/02.lhs
···
1
+
import Data.Bits (xor)
2
+
import Data.List.Split (splitOn)
3
+
import System.Environment (getArgs)
4
+
5
+
parse i = (read l, read h, c', p)
6
+
where
7
+
[r, c, p] = splitOn " " i
8
+
[l, h] = splitOn "-" r
9
+
c' = head c
10
+
11
+
p1 = length . filter id . map solve
12
+
where
13
+
solve (l, u, c, p) = all ($ length $ filter (== c) p) [(>= l), (<= u)]
14
+
15
+
p2 = length . filter id . map solve
16
+
where
17
+
solve (l, u, c, p) = foldl1 xor $ map ((== c) . (p !!) . subtract 1) [l, u]
18
+
19
+
main = do
20
+
args <- getArgs
21
+
n <- case args of
22
+
["-"] -> getContents
23
+
[file] -> readFile file
24
+
let f = map parse $ lines n
25
+
print $ p1 f
26
+
print $ p2 f
27
+
+27
src/2020/03.lhs
+27
src/2020/03.lhs
···
1
+
import System.Environment (getArgs)
2
+
3
+
countTrees right down ls = go (map cycle ls)
4
+
where
5
+
go [] = 0
6
+
go remaining@(r : rs) =
7
+
fromEnum (head r == '#') + go (map (drop right) (drop down remaining))
8
+
9
+
p1 = countTrees 3 1
10
+
11
+
p2 n =
12
+
product
13
+
[ countTrees 1 1 n,
14
+
countTrees 3 1 n,
15
+
countTrees 5 1 n,
16
+
countTrees 7 1 n,
17
+
countTrees 1 2 n
18
+
]
19
+
20
+
main = do
21
+
args <- getArgs
22
+
n <- case args of
23
+
["-"] -> getContents
24
+
[file] -> readFile file
25
+
let f = lines n
26
+
print $ p1 f
27
+
print $ p2 f
+84
src/2020/04.lhs
+84
src/2020/04.lhs
···
1
+
module Main where
2
+
3
+
import Data.Char (isDigit, isHexDigit)
4
+
import Data.Map.Strict (Map, (!))
5
+
import qualified Data.Map.Strict as Map
6
+
import System.Environment (getArgs)
7
+
import Text.ParserCombinators.Parsec
8
+
9
+
bet k (l, u) = k >= l && k <= u
10
+
11
+
right (Right b) = b
12
+
13
+
requiredFields = ["byr", "iyr", "eyr", "hgt", "hcl", "ecl", "pid"]
14
+
15
+
eyeColors = ["amb", "blu", "brn", "gry", "grn", "hzl", "oth"]
16
+
17
+
block = cell `sepBy` oneOf " \n"
18
+
19
+
cell = do
20
+
tag <- many lower
21
+
char ':'
22
+
rest <- many (alphaNum <|> char '#')
23
+
return (tag, rest)
24
+
25
+
parseInput :: String -> Either ParseError (Map String String)
26
+
parseInput s = Map.fromList <$> parse block "input" s
27
+
28
+
doCheck :: Map String String -> Bool
29
+
doCheck ls = all (`Map.member` ls) requiredFields
30
+
31
+
validByr s = bet (read s :: Int) (1920, 2002)
32
+
33
+
validIyr s = bet (read s :: Int) (2010, 2020)
34
+
35
+
validEyr s = bet (read s :: Int) (2020, 2030)
36
+
37
+
validEcl = flip elem eyeColors
38
+
39
+
validPid s = length s == 9 && all isDigit s
40
+
41
+
validHcl ('#' : rest) = length rest == 6 && all isHexDigit rest
42
+
validHcl _ = False
43
+
44
+
validHgt s =
45
+
let value = takeWhile isDigit s
46
+
unit = dropWhile isDigit s
47
+
height = (read value :: Int, unit)
48
+
in case height of
49
+
(v, "cm") -> bet v (150, 193)
50
+
(v, "in") -> bet v (59, 76)
51
+
_ -> False
52
+
53
+
doValidate :: Map String String -> Bool
54
+
doValidate map = all (\(s, v) -> v $ map ! s) ls
55
+
where
56
+
ls =
57
+
[ ("byr", validByr),
58
+
("iyr", validIyr),
59
+
("eyr", validEyr),
60
+
("hgt", validHgt),
61
+
("hcl", validHcl),
62
+
("ecl", validEcl),
63
+
("pid", validPid)
64
+
]
65
+
66
+
parseLines :: [String] -> [String]
67
+
parseLines allLines = unwords first : next
68
+
where
69
+
(first, rest) = break null allLines
70
+
next = if null rest then [] else parseLines (tail rest)
71
+
72
+
p1 = length . filter doCheck
73
+
74
+
p2 = length . filter doValidate . filter doCheck
75
+
76
+
main = do
77
+
args <- getArgs
78
+
n <- case args of
79
+
["-"] -> getContents
80
+
[file] -> readFile file
81
+
let f = parseLines $ lines n
82
+
let blocks = map (right . parseInput) f
83
+
print $ p1 blocks
84
+
print $ p2 blocks
+33
src/2020/05.lhs
+33
src/2020/05.lhs
···
1
+
module Main where
2
+
3
+
import Data.Char (digitToInt)
4
+
import Data.List (sort)
5
+
import System.Environment (getArgs)
6
+
7
+
binaryToInt = foldl (\a x -> a * 2 + digitToInt x) 0
8
+
9
+
doValidate = binaryToInt . map readBin
10
+
11
+
readBin s
12
+
| s `elem` "FL" = '0'
13
+
| otherwise = '1'
14
+
15
+
p1 = maximum . sort . map doValidate
16
+
17
+
p2 =
18
+
(+ 1)
19
+
. fst
20
+
. head
21
+
. dropWhile ((== 1) . uncurry subtract)
22
+
. (zip <*> tail)
23
+
. sort
24
+
. map doValidate
25
+
26
+
main = do
27
+
args <- getArgs
28
+
n <- case args of
29
+
["-"] -> getContents
30
+
[file] -> readFile file
31
+
let f = lines n
32
+
print $ p1 f
33
+
print $ p2 f
+17
src/2020/06.lhs
+17
src/2020/06.lhs
···
1
+
import Data.List.Split (splitOn)
2
+
import Data.Set (Set)
3
+
import qualified Data.Set as Set
4
+
import System.Environment (getArgs)
5
+
6
+
p1 = sum . map (Set.size . Set.fromList . filter (/= '\n'))
7
+
8
+
p2 = sum . map (Set.size . foldl1 Set.intersection . map Set.fromList . words)
9
+
10
+
main = do
11
+
args <- getArgs
12
+
n <- case args of
13
+
["-"] -> getContents
14
+
[file] -> readFile file
15
+
let f = splitOn "\n\n" n
16
+
print $ p1 f
17
+
print $ p2 f
+34
src/2020/07.lhs
+34
src/2020/07.lhs
···
1
+
import Data.Map (Map)
2
+
import qualified Data.Map as Map
3
+
import System.Environment (getArgs)
4
+
5
+
myBag = "shiny gold"
6
+
7
+
parseContained [] = []
8
+
parseContained ("no" : _) = []
9
+
parseContained (count : b : c : _ : rest) = (read count, unwords [b, c]) : parseContained rest
10
+
11
+
parseLine s = (leadingBag, parseContained trailingBags)
12
+
where
13
+
leadingBag = unwords (take 2 s)
14
+
trailingBags = drop 4 s
15
+
16
+
canContain m outer = myBag `elem` inners || any (canContain m) inners
17
+
where
18
+
inners = map snd $ m Map.! outer
19
+
20
+
countNested s m = foldl (\acc (c, b) -> acc + c * (1 + countNested b m)) 0 $ m Map.! s
21
+
22
+
p1 q = length $ filter (canContain q . fst) $ Map.toList q
23
+
24
+
p2 = countNested myBag
25
+
26
+
main = do
27
+
args <- getArgs
28
+
n <- case args of
29
+
["-"] -> getContents
30
+
[file] -> readFile file
31
+
let f = map (parseLine . words) $ lines n
32
+
let q = Map.fromList f
33
+
print $ p1 q
34
+
print $ p2 q
+53
src/2020/08.lhs
+53
src/2020/08.lhs
···
1
+
module Main where
2
+
3
+
import Data.Map (Map)
4
+
import qualified Data.Map as Map
5
+
import Data.Set (Set)
6
+
import qualified Data.Set as Set
7
+
import System.Environment (getArgs)
8
+
9
+
type Op = (String, Int)
10
+
11
+
parseLine :: [String] -> Op
12
+
parseLine [s, j] = (s, read (dropWhile (== '+') j))
13
+
14
+
run :: Int -> Int -> Set Int -> Map Int Op -> Int
15
+
run acc pc visited operations = if Set.member pc visited then acc else handleCase
16
+
where
17
+
visited' = Set.insert pc visited
18
+
handleCase =
19
+
case Map.lookup pc operations of
20
+
Just ("acc", v) -> run (acc + v) (pc + 1) visited' operations
21
+
Just ("nop", _) -> run acc (pc + 1) visited' operations
22
+
Just ("jmp", j) -> run acc (pc + j) visited' operations
23
+
_ -> acc
24
+
25
+
doesEnd :: Int -> Int -> Set Int -> Map Int Op -> Bool
26
+
doesEnd acc pc visited operations = not (Set.member pc visited) && handleCase
27
+
where
28
+
visited' = Set.insert pc visited
29
+
handleCase =
30
+
case Map.lookup pc operations of
31
+
Just ("acc", v) -> doesEnd (acc + v) (pc + 1) visited' operations
32
+
Just ("nop", _) -> doesEnd acc (pc + 1) visited' operations
33
+
Just ("jmp", j) -> doesEnd acc (pc + j) visited' operations
34
+
_ -> True -- pc has crossed the end!
35
+
36
+
genAll :: [Op] -> [[Op]]
37
+
genAll [] = []
38
+
genAll (n@("nop", v) : rest) = (("jmp", v) : rest) : map (n :) (genAll rest)
39
+
genAll (j@("jmp", v) : rest) = (("nop", v) : rest) : map (j :) (genAll rest)
40
+
genAll (acc : rest) = map (acc :) $ genAll rest
41
+
42
+
p1 = run 0 0 mempty . Map.fromList . zip [0 ..]
43
+
44
+
p2 = p1 . head . filter (doesEnd 0 0 mempty . Map.fromList . zip [0 ..]) . genAll
45
+
46
+
main = do
47
+
args <- getArgs
48
+
n <- case args of
49
+
["-"] -> getContents
50
+
[file] -> readFile file
51
+
let f = map (parseLine . words) $ lines n
52
+
print $ p1 f
53
+
print $ p2 f
+30
src/2020/09.lhs
+30
src/2020/09.lhs
···
1
+
import Data.Bifunctor
2
+
import Data.List (find, inits, sort, tails)
3
+
import System.Environment (getArgs)
4
+
5
+
sublists = concatMap inits . tails
6
+
7
+
windows m = foldr (zipWith (:)) (repeat []) . take m . tails
8
+
9
+
doCheck preamble target = target `elem` [x + y | x <- preamble, y <- preamble, x /= y]
10
+
11
+
checkAll = zipWith (\p t -> (t, doCheck p t))
12
+
13
+
findWeakness subs target = minimum t + maximum t
14
+
where
15
+
Just t = find ((== target) . sum) subs
16
+
17
+
p1 f = find (not . snd) $ checkAll (windows 25 f) (drop 25 f)
18
+
19
+
p2 f = findWeakness (sublists f) target
20
+
where
21
+
Just (target, _) = p1 f
22
+
23
+
main = do
24
+
args <- getArgs
25
+
n <-
26
+
map read . lines <$> case args of
27
+
["-"] -> getContents
28
+
[file] -> readFile file
29
+
print $ p1 n
30
+
print $ p2 n
+24
src/2020/10.lhs
+24
src/2020/10.lhs
···
1
+
import Control.Monad.Memo
2
+
import Data.List (sort)
3
+
import System.Environment (getArgs)
4
+
5
+
p1 s = product $ ($ q s) <$> [length . filter (== 1), length . filter (== 3)]
6
+
where
7
+
q = zipWith subtract <*> tail
8
+
9
+
p2 top s = startEvalMemo $ go 0
10
+
where
11
+
go c
12
+
| c == top = return 1
13
+
| otherwise = sum <$> mapM (memo go) (filter (`elem` s) $ map (+ c) [1, 2, 3])
14
+
15
+
main = do
16
+
args <- getArgs
17
+
n <-
18
+
map read . lines <$> case args of
19
+
["-"] -> getContents
20
+
[file] -> readFile file
21
+
let top = maximum n + 3
22
+
ls = sort (0 : top : n)
23
+
print $ p1 ls
24
+
print $ p2 top ls
+79
src/2020/11.lhs
+79
src/2020/11.lhs
···
1
+
import Data.List (sortOn)
2
+
import Data.Map (Map, (!))
3
+
import qualified Data.Map as Map
4
+
import Data.Maybe
5
+
import System.Environment (getArgs)
6
+
7
+
dirs =
8
+
[ (-1, -1),
9
+
(0, -1),
10
+
(1, -1),
11
+
(-1, 0),
12
+
(1, 0),
13
+
(-1, 1),
14
+
(0, 1),
15
+
(1, 1)
16
+
]
17
+
18
+
makeGrid s = (grid, width, height)
19
+
where
20
+
rows = lines s
21
+
grid = Map.fromList [((x, y), a) | (y, row) <- zip [0 ..] rows, (x, a) <- zip [0 ..] row]
22
+
width = length (head rows)
23
+
height = length rows
24
+
25
+
adjs1 m pt = length $ filter (== '#') $ mapMaybe ((`Map.lookup` m) . add pt) dirs
26
+
27
+
inGrid (x, y) w h = x < w && x >= 0 && y < h && y >= 0
28
+
29
+
add (x, y) (a, b) = (x + a, y + b)
30
+
31
+
-- [f, f.f, f.f.f, ...]
32
+
repeatF f = f : map (f .) (repeatF f)
33
+
34
+
bet k (l, u) = k >= l && k <= u
35
+
36
+
inside (p, q) (r, s) (a, b) = bet a (p, r) && bet b (q, s)
37
+
38
+
adjs2 grid pt w h =
39
+
length $
40
+
filter ((== '#') . head) $
41
+
filter (not . null) $
42
+
map
43
+
( dropWhile (== '.')
44
+
. map (grid !)
45
+
. takeWhile (inside (0, 0) (w - 1, h - 1))
46
+
. map ($ pt)
47
+
. repeatF
48
+
. add
49
+
)
50
+
dirs
51
+
52
+
rule1 w h m pt@(x, y) = if as == 0 then '#' else 'L'
53
+
where
54
+
as = adjs2 m pt w h
55
+
56
+
rule2 w h m pt@(x, y) = if as >= 5 then 'L' else '#'
57
+
where
58
+
as = adjs2 m pt w h
59
+
60
+
doStep w h m = Map.mapWithKey fn m
61
+
where
62
+
fn k 'L' = rule1 w h m k
63
+
fn k '#' = rule2 w h m k
64
+
fn k '.' = '.'
65
+
66
+
stepWhile prev w h
67
+
| prev == next = next
68
+
| otherwise = stepWhile next w h
69
+
where
70
+
next = doStep w h prev
71
+
72
+
main = do
73
+
args <- getArgs
74
+
n <- case args of
75
+
["-"] -> getContents
76
+
[file] -> readFile file
77
+
let (grid, width, height) = makeGrid n
78
+
let solve1 = stepWhile grid width height
79
+
print $ length $ filter ((== '#') . snd) $ Map.toList solve1
+46
src/2020/12.lhs
+46
src/2020/12.lhs
···
1
+
import System.Environment (getArgs)
2
+
3
+
parseLine s = (head s, read (tail s) :: Float)
4
+
5
+
rotate (x, y) t = (nx, ny)
6
+
where
7
+
nx = x * cos (pi * t / 180) - y * sin (pi * t / 180)
8
+
ny = x * sin (pi * t / 180) + y * cos (pi * t / 180)
9
+
10
+
p1 ls = sum $ map (round . abs) [fx, fy]
11
+
where
12
+
(fx, fy, _) = foldl fn (0.0, 0.0, 0.0) ls
13
+
fn (x, y, rot) ('N', v) = (x, y + v, rot)
14
+
fn (x, y, rot) ('E', v) = (x + v, y, rot)
15
+
fn (x, y, rot) ('W', v) = (x - v, y, rot)
16
+
fn (x, y, rot) ('S', v) = (x, y - v, rot)
17
+
fn (x, y, rot) ('R', v) = (x, y, rot - v)
18
+
fn (x, y, rot) ('L', v) = (x, y, rot + v)
19
+
fn (x, y, rot) ('F', v) = (nx, ny, rot)
20
+
where
21
+
nx = x + v * cos (pi * rot / 180)
22
+
ny = y + v * sin (pi * rot / 180)
23
+
24
+
p2 (sx, sy) ls = sum $ map (round . abs) [fx, fy]
25
+
where
26
+
(fx, fy, _, _) = foldl fn (0.0, 0.0, sx, sy) ls
27
+
fn (x, y, wx, wy) ('N', v) = (x, y, wx, wy + v)
28
+
fn (x, y, wx, wy) ('E', v) = (x, y, wx + v, wy)
29
+
fn (x, y, wx, wy) ('W', v) = (x, y, wx - v, wy)
30
+
fn (x, y, wx, wy) ('S', v) = (x, y, wx, wy - v)
31
+
fn (x, y, wx, wy) ('R', v) = (x, y, nwx, nwy)
32
+
where
33
+
(nwx, nwy) = rotate (wx, wy) (negate v)
34
+
fn (x, y, wx, wy) ('L', v) = (x, y, nwx, nwy)
35
+
where
36
+
(nwx, nwy) = rotate (wx, wy) v
37
+
fn (x, y, wx, wy) ('F', v) = (x + v * wx, y + v * wy, wx, wy)
38
+
39
+
main = do
40
+
args <- getArgs
41
+
n <-
42
+
map parseLine . lines <$> case args of
43
+
["-"] -> getContents
44
+
[file] -> readFile file
45
+
print $ p1 n
46
+
print $ p2 (10.0, 1.0) n
+50
src/2020/13.lhs
+50
src/2020/13.lhs
···
1
+
import Control.Monad (ap, zipWithM)
2
+
import Data.Bifunctor
3
+
import Data.List (sortOn)
4
+
import Data.List.Split
5
+
import Data.Tuple
6
+
import System.Environment (getArgs)
7
+
8
+
egcd _ 0 = (1, 0)
9
+
egcd a b = (t, s - q * t)
10
+
where
11
+
(s, t) = egcd b r
12
+
(q, r) = a `quotRem` b
13
+
14
+
modInv a b =
15
+
case egcd a b of
16
+
(x, y)
17
+
| a * x + b * y == 1 -> Just x
18
+
| otherwise -> Nothing
19
+
20
+
-- from rosetta code
21
+
chineseRemainder ls =
22
+
zipWithM modInv crtModulii modulii
23
+
>>= (Just . (`mod` modPI) . sum . zipWith (*) crtModulii . zipWith (*) residues)
24
+
where
25
+
residues = map fst ls
26
+
modulii = map snd ls
27
+
modPI = product modulii
28
+
crtModulii = (modPI `div`) <$> modulii
29
+
30
+
earliest start ls = t * b
31
+
where
32
+
(t, b) = minimum $ map swap $ zip `ap` map (mod start) $ ls
33
+
34
+
p1 n = earliest (negate start) departs
35
+
where
36
+
start = read (head n) :: Int
37
+
departs = map read $ filter (/= "x") $ splitOn "," (last n)
38
+
39
+
p2 n = chineseRemainder offs
40
+
where
41
+
offs = map (bimap negate read) $ filter ((/= "x") . snd) $ zip [0 ..] $ splitOn "," (last n)
42
+
43
+
main = do
44
+
args <- getArgs
45
+
n <-
46
+
lines <$> case args of
47
+
["-"] -> getContents
48
+
[file] -> readFile file
49
+
print $ p1 n
50
+
print $ p2 n
+78
src/2020/14.lhs
+78
src/2020/14.lhs
···
1
+
module Main where
2
+
3
+
import Data.Bifunctor (bimap)
4
+
import Data.Char
5
+
import Data.Either
6
+
import Data.Map (Map)
7
+
import qualified Data.Map as Map
8
+
import Data.Strings
9
+
import Numeric (readInt, showIntAtBase)
10
+
import System.Environment (getArgs)
11
+
import Text.Parsec.Char
12
+
import Text.ParserCombinators.Parsec
13
+
14
+
data Stmt = Mask String | Mem Int Int deriving (Show)
15
+
16
+
parseMask :: Parser Stmt
17
+
parseMask = string "mask = " >> Mask <$> many anyChar
18
+
19
+
parseNumber :: Parser Int
20
+
parseNumber = read <$> many1 digit
21
+
22
+
parseMem :: Parser Stmt
23
+
parseMem = Mem <$ string "mem[" <*> parseNumber <* string "] = " <*> parseNumber
24
+
25
+
parseLine :: Parser Stmt
26
+
parseLine = try parseMask <|> parseMem
27
+
28
+
applyMask :: Int -> String -> Int
29
+
applyMask v m = fst $ head $ readInt 2 (`elem` "01") digitToInt wm
30
+
where
31
+
bv = strPadLeft '0' 36 $ showIntAtBase 2 intToDigit v ""
32
+
wm = zipWith fn bv m
33
+
fn o 'X' = o
34
+
fn _ '1' = '1'
35
+
fn _ '0' = '0'
36
+
37
+
runProgram :: [Stmt] -> Int
38
+
runProgram ls = sum regs
39
+
where
40
+
(mask, regs) = foldl fn ("", Map.empty) ls
41
+
fn (_, regs) (Mask s) = (s, regs)
42
+
fn (m, regs) (Mem idx val) = (m, Map.insert idx nval regs)
43
+
where
44
+
nval = applyMask val m
45
+
46
+
floatings :: String -> [String]
47
+
floatings [] = [[]]
48
+
floatings ('X' : xs) = floatings xs >>= (\b -> ['0' : b, '1' : b])
49
+
floatings (x : xs) = map (x :) $ floatings xs
50
+
51
+
genIdxs :: Int -> String -> [Int]
52
+
genIdxs v m = map (fst . head . readInt 2 (`elem` "01") digitToInt) (floatings wm)
53
+
where
54
+
bv = strPadLeft '0' 36 $ showIntAtBase 2 intToDigit v ""
55
+
wm = zipWith fn bv m
56
+
fn o '0' = o
57
+
fn _ '1' = '1'
58
+
fn _ 'X' = 'X'
59
+
60
+
v2chip :: [Stmt] -> Int
61
+
v2chip ls = sum regs
62
+
where
63
+
(mask, regs) = foldl fn ("", Map.empty) ls
64
+
fn (_, regs) (Mask s) = (s, regs)
65
+
fn (m, regs) (Mem idx val) = (m, nmap)
66
+
where
67
+
idxs = genIdxs idx m
68
+
nmap = flip Map.union regs $ Map.fromList $ map (,val) idxs
69
+
70
+
main = do
71
+
args <- getArgs
72
+
n <-
73
+
rights . map (parse parseLine "main") . lines <$> case args of
74
+
["-"] -> getContents
75
+
[file] -> readFile file
76
+
print $ runProgram n
77
+
print $ v2chip n
78
+
+25
src/2020/15.lhs
+25
src/2020/15.lhs
···
1
+
module Main where
2
+
3
+
import Data.List.Split
4
+
import qualified Data.Map as M
5
+
import Data.Maybe
6
+
import System.Environment (getArgs)
7
+
8
+
run ls start input = fst $ foldl fn (start, startMap) ls
9
+
where
10
+
startMap = M.fromList $ zip input [1 ..]
11
+
fn (last, seen) i = (i - last', seen')
12
+
where
13
+
last' = fromMaybe i (M.lookup last seen)
14
+
seen' = M.insert last i seen
15
+
16
+
main = do
17
+
args <- getArgs
18
+
n <-
19
+
map read . splitOn "," <$> case args of
20
+
["-"] -> getContents
21
+
[file] -> readFile file
22
+
23
+
-- holy off-by-one errors
24
+
print $ run [8 .. 2020 - 1] 0 n
25
+
print $ run [8 .. 30000000 - 1] 0 n
+72
src/2020/16.lhs
+72
src/2020/16.lhs
···
1
+
module Main where
2
+
3
+
import Control.Monad (liftM2)
4
+
import Data.Function (on)
5
+
import Data.List (sortBy)
6
+
import Data.List.Split (splitOn)
7
+
import Data.Map (Map, (!))
8
+
import qualified Data.Map as Map
9
+
import Data.Set (Set, (\\))
10
+
import qualified Data.Set as Set
11
+
import System.Environment (getArgs)
12
+
import Text.Parsec.Char
13
+
import Text.ParserCombinators.Parsec
14
+
15
+
type Constraint = ((Int, Int), (Int, Int))
16
+
17
+
parseNumber = read <$> many1 digit
18
+
19
+
parseBound = (,) <$> parseNumber <* char '-' <*> parseNumber
20
+
21
+
parseConstraint = (,) <$> parseBound <* string " or " <*> parseBound
22
+
23
+
parseConstraints = (manyTill anyChar (string ": ") *> parseConstraint) `sepBy` newline
24
+
25
+
parseTicket = parseNumber `sepBy` char ','
26
+
27
+
parseNears = string "nearby tickets:" *> newline *> parseTicket `sepBy` newline
28
+
29
+
parseMine = string "your ticket:" *> newline *> parseTicket
30
+
31
+
parseInput s = do
32
+
let (p : q : r : _) = splitOn "\n\n" s
33
+
(,,)
34
+
<$> parse parseConstraints "cs" p
35
+
<*> parse parseMine "mine" q
36
+
<*> parse parseNears "nears" r
37
+
38
+
bet k (l, u) = k >= l && k <= u
39
+
40
+
(|+) = liftM2 (||)
41
+
42
+
within (a, b) = flip bet a |+ flip bet b
43
+
44
+
findInvalid cs = filter (\t -> not $ any (`within` t) cs)
45
+
46
+
isValid cs = all (\t -> any (`within` t) cs)
47
+
48
+
validFor :: [Constraint] -> [Int] -> Set Int
49
+
validFor cs items = foldl1 Set.intersection (map vcf items)
50
+
where
51
+
vcf i = Set.fromList [idx | (cons, idx) <- zip cs [0 ..], cons `within` i]
52
+
53
+
main = do
54
+
args <- getArgs
55
+
n <-
56
+
parseInput <$> case args of
57
+
["-"] -> getContents
58
+
[file] -> readFile file
59
+
let Right (cs, mine, nears) = n
60
+
validTickets = filter (isValid cs) nears
61
+
cols = map (\i -> map (!! i) validTickets) [0 .. length cs - 1]
62
+
possibleCons = sortBy (compare `on` (Set.size . snd)) $ zip [0 ..] $ map (validFor cs) cols
63
+
corresp =
64
+
Map.fromList $
65
+
map (\(i, v) -> (head $ Set.toList v, i)) $
66
+
(head possibleCons :) $
67
+
zipWith fn <*> tail $
68
+
possibleCons
69
+
where
70
+
fn (i, s) (i', s') = (i', s' \\ s)
71
+
print $ sum $ concatMap (findInvalid cs) nears
72
+
print $ product $ map ((mine !!) . (corresp !)) [0 .. 5]
+52
src/2020/17.lhs
+52
src/2020/17.lhs
···
1
+
module Main where
2
+
3
+
import Control.Monad
4
+
import Data.Map (Map)
5
+
import qualified Data.Map as M
6
+
import Data.Maybe
7
+
import System.Environment (getArgs)
8
+
9
+
toBool '#' = True
10
+
toBool '.' = False
11
+
12
+
gridMap s =
13
+
M.fromList
14
+
[ ((x, y, 0, 0), toBool a)
15
+
| (y, row) <- zip [0 ..] rows,
16
+
(x, a) <- zip [0 ..] row
17
+
]
18
+
where
19
+
rows = lines s
20
+
21
+
around (x, y, z, w) =
22
+
[ (x + x', y + y', z + z', w + w')
23
+
| x' <- [-1 .. 1],
24
+
y' <- [-1 .. 1],
25
+
z' <- [-1 .. 1],
26
+
w' <- [-1 .. 1],
27
+
(x', y', z', w') /= (0, 0, 0, 0)
28
+
]
29
+
30
+
convert True 2 = True
31
+
convert True 3 = True
32
+
convert False 3 = True
33
+
convert _ _ = False
34
+
35
+
doStep m = M.mapWithKey fn $ m <> M.fromList [(p, False) | p <- concatMap around (M.keys m)]
36
+
where
37
+
fn pos v = convert v n
38
+
where
39
+
n = length $ filter id $ map (fromMaybe False . flip M.lookup m) $ around pos
40
+
41
+
p1 grid = M.size $ M.filter id (iterate doStep grid !! 6)
42
+
43
+
p2 grid = M.size $ M.filter id (iterate doStep grid !! 6)
44
+
45
+
main = do
46
+
args <- getArgs
47
+
n <- case args of
48
+
["-"] -> getContents
49
+
[file] -> readFile file
50
+
let grid = gridMap n
51
+
print $ p1 grid
52
+
print $ p2 grid