├── inputs ├── 2015 │ ├── 04.txt │ ├── 10.txt │ ├── 11.txt │ ├── 20.txt │ ├── 22.txt │ ├── 21.txt │ ├── 25.txt │ ├── 17.txt │ ├── 24.txt │ ├── 15.txt │ ├── 23.txt │ ├── 14.txt │ ├── 09.txt │ └── 19.txt ├── 2016 │ ├── 13.txt │ ├── 05.txt │ ├── 14.txt │ ├── 17.txt │ ├── 19.txt │ ├── 16.txt │ ├── 18.txt │ ├── 12.txt │ ├── 23.txt │ ├── 15.txt │ ├── 25.txt │ ├── 11.txt │ └── 01.txt ├── 2017 │ ├── 17.txt │ ├── 03.txt │ ├── 14.txt │ ├── 06.txt │ ├── 10.txt │ ├── 15.txt │ ├── 23.txt │ ├── 13.txt │ ├── 18.txt │ ├── 24.txt │ ├── 22.txt │ ├── 02.txt │ └── 25.txt ├── 2018 │ ├── 11.txt │ ├── 14.txt │ ├── 22.txt │ ├── 09.txt │ ├── 21.txt │ ├── 19.txt │ ├── 12.txt │ ├── 06.txt │ └── 15.txt ├── 2019 │ ├── 04.txt │ ├── 24.txt │ ├── 12.txt │ ├── 02.txt │ ├── 10.txt │ ├── 16.txt │ ├── 07.txt │ ├── 01.txt │ └── 19.txt ├── 2020 │ ├── 23.txt │ ├── 15.txt │ ├── 25.txt │ ├── 17.txt │ ├── 13.txt │ ├── 22.txt │ └── 10.txt ├── 2021 │ ├── 17.txt │ ├── 21.txt │ ├── 23.txt │ ├── 11.txt │ ├── 12.txt │ ├── 06.txt │ ├── 16.txt │ └── 14.txt ├── 2022 │ ├── 11.txt │ └── 10.txt ├── 2023 │ ├── 06.txt │ └── 20.txt ├── 2024 │ ├── 11.txt │ ├── 21.txt │ └── 17.txt └── 2025 │ └── 02.txt ├── solutions ├── inputs ├── src │ ├── 2015 │ │ ├── 08.hs │ │ ├── 10.hs │ │ ├── 17.hs │ │ ├── 03.hs │ │ ├── 01.hs │ │ ├── 18.hs │ │ ├── 02.hs │ │ ├── 05.hs │ │ ├── 09.hs │ │ ├── 25.hs │ │ ├── 20.hs │ │ ├── 15.hs │ │ ├── 16.hs │ │ └── 24.hs │ ├── 2016 │ │ ├── 03.hs │ │ ├── 06.hs │ │ ├── 19.hs │ │ ├── 13.hs │ │ ├── 20.hs │ │ ├── 09.hs │ │ ├── 15.hs │ │ ├── 04.hs │ │ ├── 18.hs │ │ ├── 07.hs │ │ ├── 16.hs │ │ ├── 12.hs │ │ ├── 14.hs │ │ ├── 02.hs │ │ ├── 01.hs │ │ └── 17.hs │ ├── 2017 │ │ ├── 12.hs │ │ ├── 02.hs │ │ ├── 05.hs │ │ ├── 04.hs │ │ ├── 15.hs │ │ ├── 01.hs │ │ ├── 19.hs │ │ ├── 06.hs │ │ ├── 09.hs │ │ └── 24.hs │ ├── 2018 │ │ ├── 25.hs │ │ ├── 03.hs │ │ ├── 10.hs │ │ ├── 01.hs │ │ ├── 08.hs │ │ └── 05.hs │ ├── 2019 │ │ ├── 19.hs │ │ ├── 09.hs │ │ ├── 06.hs │ │ ├── 01.hs │ │ ├── 04.hs │ │ ├── 21.hs │ │ ├── 08.hs │ │ ├── 05.hs │ │ ├── 02.hs │ │ └── 16.hs │ ├── 2020 │ │ ├── 06.hs │ │ ├── 13.hs │ │ ├── 05.hs │ │ ├── 10.hs │ │ ├── 03.hs │ │ ├── 21.hs │ │ ├── 18.hs │ │ ├── 02.hs │ │ ├── 25.hs │ │ ├── 01.hs │ │ ├── 07.hs │ │ ├── 24.hs │ │ └── 04.hs │ ├── 2021 │ │ ├── 07.hs │ │ ├── 01.hs │ │ ├── 06.hs │ │ ├── 25.hs │ │ ├── 02.hs │ │ ├── 11.hs │ │ ├── 04.hs │ │ ├── 05.hs │ │ └── 13.hs │ ├── 2022 │ │ ├── 01.hs │ │ ├── 04.hs │ │ ├── 06.hs │ │ ├── 03.hs │ │ ├── 02.hs │ │ ├── 25.hs │ │ ├── 05.hs │ │ ├── 12.hs │ │ └── 18.hs │ ├── 2023 │ │ ├── 09.hs │ │ ├── 06.hs │ │ ├── 04.hs │ │ ├── 13.hs │ │ ├── 21.hs │ │ └── 15.hs │ ├── 2024 │ │ ├── 25.hs │ │ ├── 01.hs │ │ ├── 02.hs │ │ ├── 23.hs │ │ ├── 04.hs │ │ ├── 05.hs │ │ ├── 03.hs │ │ ├── 20.hs │ │ └── 22.hs │ ├── 2025 │ │ ├── 12.hs │ │ ├── 11.hs │ │ ├── 05.hs │ │ ├── 06.hs │ │ ├── 02.hs │ │ ├── 03.hs │ │ ├── 07.hs │ │ └── 01.hs │ └── Dummy.hs └── LICENSE ├── .ghcid ├── cabal.project ├── .gitignore ├── common ├── src │ ├── Advent │ │ ├── Orphans.hs │ │ ├── Nat.hs │ │ ├── Format │ │ │ ├── Types.hs │ │ │ └── Lexer.x │ │ ├── Group.hs │ │ ├── Memo.hs │ │ ├── Fix.hs │ │ ├── KnotHash.hs │ │ └── Visualize.hs │ └── Advent.hs └── LICENSE └── README.md /inputs/2016/13.txt: -------------------------------------------------------------------------------- 1 | 1350 2 | -------------------------------------------------------------------------------- /inputs/2017/17.txt: -------------------------------------------------------------------------------- 1 | 345 2 | -------------------------------------------------------------------------------- /inputs/2018/11.txt: -------------------------------------------------------------------------------- 1 | 8868 2 | -------------------------------------------------------------------------------- /solutions/inputs: -------------------------------------------------------------------------------- 1 | ../inputs -------------------------------------------------------------------------------- /inputs/2015/04.txt: -------------------------------------------------------------------------------- 1 | yzbqklnj 2 | -------------------------------------------------------------------------------- /inputs/2015/10.txt: -------------------------------------------------------------------------------- 1 | 1113222113 2 | -------------------------------------------------------------------------------- /inputs/2015/11.txt: -------------------------------------------------------------------------------- 1 | vzbxkghb 2 | -------------------------------------------------------------------------------- /inputs/2015/20.txt: -------------------------------------------------------------------------------- 1 | 36000000 2 | -------------------------------------------------------------------------------- /inputs/2016/05.txt: -------------------------------------------------------------------------------- 1 | ffykfhsq 2 | -------------------------------------------------------------------------------- /inputs/2016/14.txt: -------------------------------------------------------------------------------- 1 | qzyelonm 2 | -------------------------------------------------------------------------------- /inputs/2016/17.txt: -------------------------------------------------------------------------------- 1 | lpvhkcbi 2 | -------------------------------------------------------------------------------- /inputs/2016/19.txt: -------------------------------------------------------------------------------- 1 | 3012210 2 | -------------------------------------------------------------------------------- /inputs/2017/03.txt: -------------------------------------------------------------------------------- 1 | 265149 2 | -------------------------------------------------------------------------------- /inputs/2017/14.txt: -------------------------------------------------------------------------------- 1 | oundnydw 2 | -------------------------------------------------------------------------------- /inputs/2018/14.txt: -------------------------------------------------------------------------------- 1 | 320851 2 | -------------------------------------------------------------------------------- /inputs/2020/23.txt: -------------------------------------------------------------------------------- 1 | 364297581 2 | -------------------------------------------------------------------------------- /inputs/2019/04.txt: -------------------------------------------------------------------------------- 1 | 134564-585159 2 | -------------------------------------------------------------------------------- /inputs/2020/15.txt: -------------------------------------------------------------------------------- 1 | 10,16,6,0,1,17 2 | -------------------------------------------------------------------------------- /inputs/2016/16.txt: -------------------------------------------------------------------------------- 1 | 01111001100111011 2 | -------------------------------------------------------------------------------- /inputs/2020/25.txt: -------------------------------------------------------------------------------- 1 | 8252394 2 | 6269621 3 | -------------------------------------------------------------------------------- /inputs/2015/22.txt: -------------------------------------------------------------------------------- 1 | Hit Points: 51 2 | Damage: 9 3 | -------------------------------------------------------------------------------- /inputs/2018/22.txt: -------------------------------------------------------------------------------- 1 | depth: 5355 2 | target: 14,796 3 | -------------------------------------------------------------------------------- /inputs/2017/06.txt: -------------------------------------------------------------------------------- 1 | 14 0 15 12 11 11 3 5 1 6 8 4 9 1 8 4 2 | -------------------------------------------------------------------------------- /inputs/2021/17.txt: -------------------------------------------------------------------------------- 1 | target area: x=102..157, y=-146..-90 2 | -------------------------------------------------------------------------------- /inputs/2024/11.txt: -------------------------------------------------------------------------------- 1 | 2 72 8949 0 981038 86311 246 7636740 2 | -------------------------------------------------------------------------------- /inputs/2024/21.txt: -------------------------------------------------------------------------------- 1 | 413A 2 | 480A 3 | 682A 4 | 879A 5 | 083A 6 | -------------------------------------------------------------------------------- /inputs/2015/21.txt: -------------------------------------------------------------------------------- 1 | Hit Points: 104 2 | Damage: 8 3 | Armor: 1 4 | -------------------------------------------------------------------------------- /inputs/2019/24.txt: -------------------------------------------------------------------------------- 1 | #..#. 2 | #.#.# 3 | ...#. 4 | ....# 5 | #.#.# 6 | -------------------------------------------------------------------------------- /inputs/2017/10.txt: -------------------------------------------------------------------------------- 1 | 225,171,131,2,35,5,0,13,1,246,54,97,255,98,254,110 2 | -------------------------------------------------------------------------------- /inputs/2018/09.txt: -------------------------------------------------------------------------------- 1 | 405 players; last marble is worth 70953 points 2 | -------------------------------------------------------------------------------- /inputs/2017/15.txt: -------------------------------------------------------------------------------- 1 | Generator A starts with 591 2 | Generator B starts with 393 3 | -------------------------------------------------------------------------------- /inputs/2021/21.txt: -------------------------------------------------------------------------------- 1 | Player 1 starting position: 1 2 | Player 2 starting position: 10 3 | -------------------------------------------------------------------------------- /inputs/2023/06.txt: -------------------------------------------------------------------------------- 1 | Time: 47 70 75 66 2 | Distance: 282 1079 1147 1062 3 | -------------------------------------------------------------------------------- /inputs/2019/12.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | -------------------------------------------------------------------------------- /inputs/2015/25.txt: -------------------------------------------------------------------------------- 1 | To continue, please consult the code grid in the manual. Enter the code at row 3010, column 3019. 2 | -------------------------------------------------------------------------------- /inputs/2016/18.txt: -------------------------------------------------------------------------------- 1 | .^^..^...^..^^.^^^.^^^.^^^^^^.^.^^^^.^^.^^^^^^.^...^......^...^^^..^^^.....^^^^^^^^^....^^...^^^^..^ 2 | -------------------------------------------------------------------------------- /inputs/2020/17.txt: -------------------------------------------------------------------------------- 1 | .##.##.. 2 | ..###.## 3 | .##....# 4 | ###..##. 5 | #.###.## 6 | .#.#..#. 7 | .......# 8 | .#..#..# 9 | -------------------------------------------------------------------------------- /inputs/2024/17.txt: -------------------------------------------------------------------------------- 1 | Register A: 35200350 2 | Register B: 0 3 | Register C: 0 4 | 5 | Program: 2,4,1,2,7,5,4,7,1,3,5,5,0,3,3,0 6 | -------------------------------------------------------------------------------- /inputs/2021/23.txt: -------------------------------------------------------------------------------- 1 | ############# 2 | #...........# 3 | ###B#B#D#D### 4 | #D#C#B#A# 5 | #D#B#A#C# 6 | #C#A#A#C# 7 | ######### 8 | -------------------------------------------------------------------------------- /solutions/src/Dummy.hs: -------------------------------------------------------------------------------- 1 | {- | 2 | Module : Dummy 3 | Description : Work around Cabal bug for haddock generation 4 | -} 5 | module Dummy where 6 | -------------------------------------------------------------------------------- /inputs/2015/17.txt: -------------------------------------------------------------------------------- 1 | 33 2 | 14 3 | 18 4 | 20 5 | 45 6 | 35 7 | 16 8 | 35 9 | 1 10 | 13 11 | 18 12 | 13 13 | 50 14 | 44 15 | 48 16 | 6 17 | 24 18 | 41 19 | 30 20 | 42 21 | -------------------------------------------------------------------------------- /inputs/2021/11.txt: -------------------------------------------------------------------------------- 1 | 6636827465 2 | 6774248431 3 | 4227386366 4 | 7447452613 5 | 6223122545 6 | 2814388766 7 | 6615551144 8 | 4836235836 9 | 5334783256 10 | 4128344843 11 | -------------------------------------------------------------------------------- /inputs/2020/13.txt: -------------------------------------------------------------------------------- 1 | 1015292 2 | 19,x,x,x,x,x,x,x,x,41,x,x,x,x,x,x,x,x,x,743,x,x,x,x,x,x,x,x,x,x,x,x,13,17,x,x,x,x,x,x,x,x,x,x,x,x,x,x,29,x,643,x,x,x,x,x,37,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,x,23 3 | -------------------------------------------------------------------------------- /.ghcid: -------------------------------------------------------------------------------- 1 | --command="cabal repl --repl-options=-fno-break-on-exception --repl-options=-fno-break-on-error --repl-options=-v1 --repl-options=-ferror-spans --repl-options=-j --repl-options=-Wall --repl-options=-Wno-x-partial" 2 | -------------------------------------------------------------------------------- /inputs/2015/24.txt: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 3 4 | 7 5 | 11 6 | 13 7 | 17 8 | 19 9 | 23 10 | 31 11 | 37 12 | 41 13 | 43 14 | 47 15 | 53 16 | 59 17 | 61 18 | 67 19 | 71 20 | 73 21 | 79 22 | 83 23 | 89 24 | 97 25 | 101 26 | 103 27 | 107 28 | 109 29 | 113 30 | -------------------------------------------------------------------------------- /inputs/2021/12.txt: -------------------------------------------------------------------------------- 1 | zi-end 2 | XR-start 3 | zk-zi 4 | TS-zk 5 | zw-vl 6 | zk-zw 7 | end-po 8 | ws-zw 9 | TS-ws 10 | po-TS 11 | po-YH 12 | po-xk 13 | zi-ws 14 | zk-end 15 | zi-XR 16 | XR-zk 17 | vl-TS 18 | start-zw 19 | vl-start 20 | XR-zw 21 | XR-vl 22 | XR-ws 23 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | package * 2 | ghc-options: -haddock 3 | 4 | packages: 5 | common/advent.cabal 6 | solutions/solutions.cabal 7 | 8 | source-repository-package 9 | type: git 10 | location: https://github.com/glguy/intcode 11 | tag: ff45a572f9a097d2572a5363869ab528eabffd30 12 | -------------------------------------------------------------------------------- /inputs/2015/15.txt: -------------------------------------------------------------------------------- 1 | Sugar: capacity 3, durability 0, flavor 0, texture -3, calories 2 2 | Sprinkles: capacity -3, durability 3, flavor 0, texture 0, calories 9 3 | Candy: capacity -1, durability 0, flavor 4, texture 0, calories 1 4 | Chocolate: capacity 0, durability 0, flavor -2, texture 2, calories 8 5 | -------------------------------------------------------------------------------- /inputs/2016/12.txt: -------------------------------------------------------------------------------- 1 | cpy 1 a 2 | cpy 1 b 3 | cpy 26 d 4 | jnz c 2 5 | jnz 1 5 6 | cpy 7 c 7 | inc d 8 | dec c 9 | jnz c -2 10 | cpy a c 11 | inc a 12 | dec b 13 | jnz b -2 14 | cpy c b 15 | dec d 16 | jnz d -6 17 | cpy 19 c 18 | cpy 14 d 19 | inc a 20 | dec d 21 | jnz d -2 22 | dec c 23 | jnz c -5 24 | -------------------------------------------------------------------------------- /inputs/2016/23.txt: -------------------------------------------------------------------------------- 1 | cpy a b 2 | dec b 3 | cpy a d 4 | cpy 0 a 5 | cpy b c 6 | inc a 7 | dec c 8 | jnz c -2 9 | dec d 10 | jnz d -5 11 | dec b 12 | cpy b c 13 | cpy c d 14 | dec d 15 | inc c 16 | jnz d -2 17 | tgl c 18 | cpy -16 c 19 | jnz 1 c 20 | cpy 89 c 21 | jnz 90 d 22 | inc a 23 | inc d 24 | jnz d -2 25 | inc c 26 | jnz c -5 27 | -------------------------------------------------------------------------------- /inputs/2016/15.txt: -------------------------------------------------------------------------------- 1 | Disc #1 has 13 positions; at time=0, it is at position 1. 2 | Disc #2 has 19 positions; at time=0, it is at position 10. 3 | Disc #3 has 3 positions; at time=0, it is at position 2. 4 | Disc #4 has 7 positions; at time=0, it is at position 1. 5 | Disc #5 has 5 positions; at time=0, it is at position 3. 6 | Disc #6 has 17 positions; at time=0, it is at position 5. 7 | -------------------------------------------------------------------------------- /inputs/2016/25.txt: -------------------------------------------------------------------------------- 1 | cpy a d 2 | cpy 9 c 3 | cpy 282 b 4 | inc d 5 | dec b 6 | jnz b -2 7 | dec c 8 | jnz c -5 9 | cpy d a 10 | jnz 0 0 11 | cpy a b 12 | cpy 0 a 13 | cpy 2 c 14 | jnz b 2 15 | jnz 1 6 16 | dec b 17 | dec c 18 | jnz c -4 19 | inc a 20 | jnz 1 -7 21 | cpy 2 b 22 | jnz c 2 23 | jnz 1 4 24 | dec b 25 | dec c 26 | jnz 1 -4 27 | jnz 0 0 28 | out b 29 | jnz a -19 30 | jnz 1 -21 31 | -------------------------------------------------------------------------------- /inputs/2019/02.txt: -------------------------------------------------------------------------------- 1 | 1,0,0,3,1,1,2,3,1,3,4,3,1,5,0,3,2,13,1,19,1,19,10,23,1,23,13,27,1,6,27,31,1,9,31,35,2,10,35,39,1,39,6,43,1,6,43,47,2,13,47,51,1,51,6,55,2,6,55,59,2,59,6,63,2,63,13,67,1,5,67,71,2,9,71,75,1,5,75,79,1,5,79,83,1,83,6,87,1,87,6,91,1,91,5,95,2,10,95,99,1,5,99,103,1,10,103,107,1,107,9,111,2,111,10,115,1,115,9,119,1,13,119,123,1,123,9,127,1,5,127,131,2,13,131,135,1,9,135,139,1,2,139,143,1,13,143,0,99,2,0,14,0 2 | -------------------------------------------------------------------------------- /inputs/2016/11.txt: -------------------------------------------------------------------------------- 1 | The first floor contains a promethium generator and a promethium-compatible microchip. 2 | The second floor contains a cobalt generator, a curium generator, a ruthenium generator, and a plutonium generator. 3 | The third floor contains a cobalt-compatible microchip, a curium-compatible microchip, a ruthenium-compatible microchip, and a plutonium-compatible microchip. 4 | The fourth floor contains nothing relevant. 5 | -------------------------------------------------------------------------------- /inputs/2020/22.txt: -------------------------------------------------------------------------------- 1 | Player 1: 2 | 30 3 | 42 4 | 25 5 | 7 6 | 29 7 | 1 8 | 16 9 | 50 10 | 11 11 | 40 12 | 4 13 | 41 14 | 3 15 | 12 16 | 8 17 | 20 18 | 32 19 | 38 20 | 31 21 | 2 22 | 44 23 | 28 24 | 33 25 | 18 26 | 10 27 | 28 | Player 2: 29 | 36 30 | 13 31 | 46 32 | 15 33 | 27 34 | 45 35 | 5 36 | 19 37 | 39 38 | 24 39 | 14 40 | 9 41 | 17 42 | 22 43 | 37 44 | 47 45 | 43 46 | 21 47 | 6 48 | 35 49 | 23 50 | 48 51 | 34 52 | 26 53 | 49 54 | -------------------------------------------------------------------------------- /inputs/2017/23.txt: -------------------------------------------------------------------------------- 1 | set b 81 2 | set c b 3 | jnz a 2 4 | jnz 1 5 5 | mul b 100 6 | sub b -100000 7 | set c b 8 | sub c -17000 9 | set f 1 10 | set d 2 11 | set e 2 12 | set g d 13 | mul g e 14 | sub g b 15 | jnz g 2 16 | set f 0 17 | sub e -1 18 | set g e 19 | sub g b 20 | jnz g -8 21 | sub d -1 22 | set g d 23 | sub g b 24 | jnz g -13 25 | jnz f 2 26 | sub h -1 27 | set g b 28 | sub g c 29 | jnz g 2 30 | jnz 1 3 31 | sub b -17 32 | jnz 1 -23 33 | -------------------------------------------------------------------------------- /inputs/2017/13.txt: -------------------------------------------------------------------------------- 1 | 0: 3 2 | 1: 2 3 | 2: 4 4 | 4: 4 5 | 6: 5 6 | 8: 6 7 | 10: 6 8 | 12: 8 9 | 14: 6 10 | 16: 6 11 | 18: 9 12 | 20: 8 13 | 22: 8 14 | 24: 8 15 | 26: 12 16 | 28: 8 17 | 30: 12 18 | 32: 12 19 | 34: 12 20 | 36: 10 21 | 38: 14 22 | 40: 12 23 | 42: 10 24 | 44: 8 25 | 46: 12 26 | 48: 14 27 | 50: 12 28 | 52: 14 29 | 54: 14 30 | 56: 14 31 | 58: 12 32 | 62: 14 33 | 64: 12 34 | 66: 12 35 | 68: 14 36 | 70: 14 37 | 72: 14 38 | 74: 17 39 | 76: 14 40 | 78: 18 41 | 84: 14 42 | 90: 20 43 | 92: 14 44 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | dist-*/ 3 | .HTF/ 4 | log/ 5 | .cabal-sandbox/ 6 | .stack-work/ 7 | cabal-dev 8 | *# 9 | *.aux 10 | *.bundle 11 | *.chi 12 | *.chs.h 13 | *.dSYM 14 | *.dylib 15 | *.dyn_hi 16 | *.dyn_o 17 | *.eventlog 18 | *.hi 19 | *.hp 20 | *.o 21 | *.a 22 | *.prof 23 | *.so 24 | *~ 25 | .*.swo 26 | .*.swp 27 | .DS_Store 28 | .hpc 29 | .hsenv 30 | TAGS 31 | cabal.project.local 32 | cabal.sandbox.config 33 | codex.tags 34 | docs 35 | stack.yaml 36 | tags 37 | wiki 38 | wip 39 | .ghc.environment.* 40 | -------------------------------------------------------------------------------- /inputs/2025/02.txt: -------------------------------------------------------------------------------- 1 | 96952600-96977512,6599102-6745632,32748217-32835067,561562-594935,3434310838-3434398545,150-257,864469-909426,677627997-677711085,85-120,2-19,3081-5416,34-77,35837999-36004545,598895-706186,491462157-491543875,5568703-5723454,6262530705-6262670240,8849400-8930122,385535-477512,730193-852501,577-1317,69628781-69809331,2271285646-2271342060,282-487,1716-2824,967913879-967997665,22-33,5722-11418,162057-325173,6666660033-6666677850,67640049-67720478,355185-381658,101543-146174,24562-55394,59942-93946,967864-1031782 2 | -------------------------------------------------------------------------------- /inputs/2015/23.txt: -------------------------------------------------------------------------------- 1 | jio a, +22 2 | inc a 3 | tpl a 4 | tpl a 5 | tpl a 6 | inc a 7 | tpl a 8 | inc a 9 | tpl a 10 | inc a 11 | inc a 12 | tpl a 13 | inc a 14 | inc a 15 | tpl a 16 | inc a 17 | inc a 18 | tpl a 19 | inc a 20 | inc a 21 | tpl a 22 | jmp +19 23 | tpl a 24 | tpl a 25 | tpl a 26 | tpl a 27 | inc a 28 | inc a 29 | tpl a 30 | inc a 31 | tpl a 32 | inc a 33 | inc a 34 | tpl a 35 | inc a 36 | inc a 37 | tpl a 38 | inc a 39 | tpl a 40 | tpl a 41 | jio a, +8 42 | inc b 43 | jie a, +4 44 | tpl a 45 | inc a 46 | jmp +2 47 | hlf a 48 | jmp -7 49 | -------------------------------------------------------------------------------- /common/src/Advent/Orphans.hs: -------------------------------------------------------------------------------- 1 | {-# Language TypeOperators #-} 2 | {-# OPTIONS_GHC -Wno-orphans #-} 3 | {-| 4 | Module : Advent.Orphans 5 | Description : Orphan instances 6 | Copyright : 2022 Eric Mertens 7 | License : ISC 8 | Maintainer : emertens@gmail.com 9 | 10 | Orphan instances missing from other packages. 11 | 12 | -} 13 | module Advent.Orphans where 14 | 15 | import Data.String ( IsString(..) ) 16 | import Text.ParserCombinators.ReadP ( ReadP, string ) 17 | 18 | instance a ~ String => IsString (ReadP a) where 19 | fromString = string -------------------------------------------------------------------------------- /inputs/2018/21.txt: -------------------------------------------------------------------------------- 1 | #ip 2 2 | seti 123 0 5 3 | bani 5 456 5 4 | eqri 5 72 5 5 | addr 5 2 2 6 | seti 0 0 2 7 | seti 0 4 5 8 | bori 5 65536 4 9 | seti 15466939 9 5 10 | bani 4 255 3 11 | addr 5 3 5 12 | bani 5 16777215 5 13 | muli 5 65899 5 14 | bani 5 16777215 5 15 | gtir 256 4 3 16 | addr 3 2 2 17 | addi 2 1 2 18 | seti 27 8 2 19 | seti 0 7 3 20 | addi 3 1 1 21 | muli 1 256 1 22 | gtrr 1 4 1 23 | addr 1 2 2 24 | addi 2 1 2 25 | seti 25 2 2 26 | addi 3 1 3 27 | seti 17 7 2 28 | setr 3 7 4 29 | seti 7 3 2 30 | eqrr 5 0 3 31 | addr 3 2 2 32 | seti 5 9 2 33 | -------------------------------------------------------------------------------- /inputs/2017/18.txt: -------------------------------------------------------------------------------- 1 | set i 31 2 | set a 1 3 | mul p 17 4 | jgz p p 5 | mul a 2 6 | add i -1 7 | jgz i -2 8 | add a -1 9 | set i 127 10 | set p 316 11 | mul p 8505 12 | mod p a 13 | mul p 129749 14 | add p 12345 15 | mod p a 16 | set b p 17 | mod b 10000 18 | snd b 19 | add i -1 20 | jgz i -9 21 | jgz a 3 22 | rcv b 23 | jgz b -1 24 | set f 0 25 | set i 126 26 | rcv a 27 | rcv b 28 | set p a 29 | mul p -1 30 | add p b 31 | jgz p 4 32 | snd a 33 | set a b 34 | jgz 1 3 35 | snd b 36 | set f 1 37 | add i -1 38 | jgz i -11 39 | snd a 40 | jgz f -16 41 | jgz a -19 42 | -------------------------------------------------------------------------------- /inputs/2019/10.txt: -------------------------------------------------------------------------------- 1 | ...###.#########.#### 2 | .######.###.###.##... 3 | ####.########.#####.# 4 | ########.####.##.###. 5 | ####..#.####.#.#.##.. 6 | #.################.## 7 | ..######.##.##.#####. 8 | #.####.#####.###.#.## 9 | #####.#########.##### 10 | #####.##..##..#.##### 11 | ##.######....######## 12 | .#######.#.#########. 13 | .#.##.#.#.#.##.###.## 14 | ######...####.#.#.### 15 | ###############.#.### 16 | #.#####.##..###.##.#. 17 | ##..##..###.#.####### 18 | #..#..########.#.##.. 19 | #.#.######.##.##...## 20 | .#.##.#####.#..#####. 21 | #.#.##########..#.##. 22 | -------------------------------------------------------------------------------- /inputs/2017/24.txt: -------------------------------------------------------------------------------- 1 | 31/13 2 | 34/4 3 | 49/49 4 | 23/37 5 | 47/45 6 | 32/4 7 | 12/35 8 | 37/30 9 | 41/48 10 | 0/47 11 | 32/30 12 | 12/5 13 | 37/31 14 | 7/41 15 | 10/28 16 | 35/4 17 | 28/35 18 | 20/29 19 | 32/20 20 | 31/43 21 | 48/14 22 | 10/11 23 | 27/6 24 | 9/24 25 | 8/28 26 | 45/48 27 | 8/1 28 | 16/19 29 | 45/45 30 | 0/4 31 | 29/33 32 | 2/5 33 | 33/9 34 | 11/7 35 | 32/10 36 | 44/1 37 | 40/32 38 | 2/45 39 | 16/16 40 | 1/18 41 | 38/36 42 | 34/24 43 | 39/44 44 | 32/37 45 | 26/46 46 | 25/33 47 | 9/10 48 | 0/29 49 | 38/8 50 | 33/33 51 | 49/19 52 | 18/20 53 | 49/39 54 | 18/39 55 | 26/13 56 | 19/32 57 | -------------------------------------------------------------------------------- /inputs/2018/19.txt: -------------------------------------------------------------------------------- 1 | #ip 2 2 | addi 2 16 2 3 | seti 1 0 1 4 | seti 1 4 3 5 | mulr 1 3 4 6 | eqrr 4 5 4 7 | addr 4 2 2 8 | addi 2 1 2 9 | addr 1 0 0 10 | addi 3 1 3 11 | gtrr 3 5 4 12 | addr 2 4 2 13 | seti 2 5 2 14 | addi 1 1 1 15 | gtrr 1 5 4 16 | addr 4 2 2 17 | seti 1 1 2 18 | mulr 2 2 2 19 | addi 5 2 5 20 | mulr 5 5 5 21 | mulr 2 5 5 22 | muli 5 11 5 23 | addi 4 5 4 24 | mulr 4 2 4 25 | addi 4 9 4 26 | addr 5 4 5 27 | addr 2 0 2 28 | seti 0 0 2 29 | setr 2 3 4 30 | mulr 4 2 4 31 | addr 2 4 4 32 | mulr 2 4 4 33 | muli 4 14 4 34 | mulr 4 2 4 35 | addr 5 4 5 36 | seti 0 6 0 37 | seti 0 3 2 38 | -------------------------------------------------------------------------------- /inputs/2021/06.txt: -------------------------------------------------------------------------------- 1 | 4,1,1,4,1,2,1,4,1,3,4,4,1,5,5,1,3,1,1,1,4,4,3,1,5,3,1,2,5,1,1,5,1,1,4,1,1,1,1,2,1,5,3,4,4,1,1,1,1,1,1,1,1,1,2,1,1,1,1,1,5,1,1,1,4,1,2,3,5,1,2,2,4,1,4,4,4,1,2,5,1,2,1,1,1,1,1,1,4,1,1,4,3,4,2,1,3,1,1,1,3,5,5,4,3,4,1,5,1,1,1,2,2,1,3,1,2,4,1,1,3,3,1,3,3,1,1,3,1,5,1,1,3,1,1,1,5,4,1,1,1,1,4,1,1,3,5,4,3,1,1,5,4,1,1,2,5,4,2,1,4,1,1,1,1,3,1,1,1,1,4,1,1,1,1,2,4,1,1,1,1,3,1,1,5,1,1,1,1,1,1,4,2,1,3,1,1,1,2,4,2,3,1,4,1,2,1,4,2,1,4,4,1,5,1,1,4,4,1,2,2,1,1,1,1,1,1,1,1,1,1,1,4,5,4,1,3,1,3,1,1,1,5,3,5,5,2,2,1,4,1,4,2,1,4,1,2,1,1,2,1,1,5,4,2,1,1,1,2,4,1,1,1,1,2,1,1,5,1,1,2,2,5,1,1,1,1,1,2,4,2,3,1,2,1,5,4,5,1,4 2 | -------------------------------------------------------------------------------- /solutions/src/2020/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Format (format) 15 | import Data.List (intersect, union) 16 | 17 | -- | 18 | -- >>> :main 19 | -- 6273 20 | -- 3254 21 | main :: IO () 22 | main = 23 | do inp <- [format|2020 6 (%s%n)*&%n|] 24 | print (length (foldr union [] =<< inp)) 25 | print (length (foldl1 intersect =<< inp)) 26 | -------------------------------------------------------------------------------- /inputs/2016/01.txt: -------------------------------------------------------------------------------- 1 | R1, R1, R3, R1, R1, L2, R5, L2, R5, R1, R4, L2, R3, L3, R4, L5, R4, R4, R1, L5, L4, R5, R3, L1, R4, R3, L2, L1, R3, L4, R3, L2, R5, R190, R3, R5, L5, L1, R54, L3, L4, L1, R4, R1, R3, L1, L1, R2, L2, R2, R5, L3, R4, R76, L3, R4, R191, R5, R5, L5, L4, L5, L3, R1, R3, R2, L2, L2, L4, L5, L4, R5, R4, R4, R2, R3, R4, L3, L2, R5, R3, L2, L1, R2, L3, R2, L1, L1, R1, L3, R5, L5, L1, L2, R5, R3, L3, R3, R5, R2, R5, R5, L5, L5, R2, L3, L5, L2, L1, R2, R2, L2, R2, L3, L2, R3, L5, R4, L4, L5, R3, L4, R1, R3, R2, R4, L2, L3, R2, L5, R5, R4, L2, R4, L1, L3, L1, L3, R1, R2, R1, L5, R5, R3, L3, L3, L2, R4, R2, L5, L1, L1, L5, L4, L1, L1, R1 2 | -------------------------------------------------------------------------------- /inputs/2018/12.txt: -------------------------------------------------------------------------------- 1 | initial state: .##..##..####..#.#.#.###....#...#..#.#.#..#...#....##.#.#.#.#.#..######.##....##.###....##..#.####.# 2 | 3 | .#... => # 4 | #.... => . 5 | #.### => . 6 | #.##. => . 7 | #...# => . 8 | ...#. => . 9 | .#..# => # 10 | .#### => # 11 | .###. => . 12 | ###.. => # 13 | ##### => . 14 | ....# => . 15 | .#.## => # 16 | ####. => . 17 | ##.#. => # 18 | #.#.# => # 19 | ..#.# => . 20 | .#.#. => # 21 | ###.# => # 22 | ##.## => . 23 | ..#.. => . 24 | ..... => . 25 | ..### => # 26 | #..## => # 27 | ##... => # 28 | ...## => # 29 | ##..# => . 30 | .##.. => # 31 | #..#. => . 32 | #.#.. => # 33 | .##.# => . 34 | ..##. => . 35 | -------------------------------------------------------------------------------- /inputs/2019/16.txt: -------------------------------------------------------------------------------- 1 | 59782619540402316074783022180346847593683757122943307667976220344797950034514416918778776585040527955353805734321825495534399127207245390950629733658814914072657145711801385002282630494752854444244301169223921275844497892361271504096167480707096198155369207586705067956112600088460634830206233130995298022405587358756907593027694240400890003211841796487770173357003673931768403098808243977129249867076581200289745279553289300165042557391962340424462139799923966162395369050372874851854914571896058891964384077773019120993386024960845623120768409036628948085303152029722788889436708810209513982988162590896085150414396795104755977641352501522955134675 2 | -------------------------------------------------------------------------------- /inputs/2018/06.txt: -------------------------------------------------------------------------------- 1 | 341, 330 2 | 85, 214 3 | 162, 234 4 | 218, 246 5 | 130, 67 6 | 340, 41 7 | 206, 342 8 | 232, 295 9 | 45, 118 10 | 93, 132 11 | 258, 355 12 | 187, 302 13 | 181, 261 14 | 324, 246 15 | 150, 203 16 | 121, 351 17 | 336, 195 18 | 44, 265 19 | 51, 160 20 | 63, 133 21 | 58, 117 22 | 109, 276 23 | 292, 241 24 | 81, 56 25 | 281, 284 26 | 226, 104 27 | 98, 121 28 | 178, 234 29 | 319, 332 30 | 279, 234 31 | 143, 163 32 | 109, 333 33 | 80, 188 34 | 106, 242 35 | 65, 59 36 | 253, 137 37 | 287, 317 38 | 185, 50 39 | 193, 132 40 | 96, 319 41 | 193, 169 42 | 100, 155 43 | 113, 161 44 | 182, 82 45 | 157, 148 46 | 132, 67 47 | 339, 296 48 | 243, 208 49 | 196, 234 50 | 87, 335 51 | -------------------------------------------------------------------------------- /solutions/src/2024/25.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 25 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format) 15 | import Data.List (tails) 16 | 17 | -- | >>> :main 18 | -- 2618 19 | main :: IO () 20 | main = 21 | do input <- [format|2024 25 (%s%n)*&%n|] 22 | print (length [() | x : ys <- tails (map concat input), y <- ys, and (zipWith ok x y)]) 23 | 24 | ok :: Char -> Char -> Bool 25 | ok '#' '#' = False 26 | ok _ _ = True -------------------------------------------------------------------------------- /inputs/2015/14.txt: -------------------------------------------------------------------------------- 1 | Vixen can fly 19 km/s for 7 seconds, but then must rest for 124 seconds. 2 | Rudolph can fly 3 km/s for 15 seconds, but then must rest for 28 seconds. 3 | Donner can fly 19 km/s for 9 seconds, but then must rest for 164 seconds. 4 | Blitzen can fly 19 km/s for 9 seconds, but then must rest for 158 seconds. 5 | Comet can fly 13 km/s for 7 seconds, but then must rest for 82 seconds. 6 | Cupid can fly 25 km/s for 6 seconds, but then must rest for 145 seconds. 7 | Dasher can fly 14 km/s for 3 seconds, but then must rest for 38 seconds. 8 | Dancer can fly 3 km/s for 16 seconds, but then must rest for 37 seconds. 9 | Prancer can fly 25 km/s for 6 seconds, but then must rest for 143 seconds. 10 | -------------------------------------------------------------------------------- /common/src/Advent.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Advent 3 | Description : Solution helper library 4 | Copyright : (c) Eric Mertens, 2018-2021 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | This module re-exports the most commonly used modules. 9 | 10 | * "Advent.Prelude" is full of useful helper functions 11 | * "Advent.Input" provides quick access to inputs in a few formats 12 | * "Advent.Format" provides a quasi-quoter for making input parsers 13 | 14 | -} 15 | module Advent ( 16 | module Advent.Prelude, 17 | module Advent.Input, 18 | module Advent.Format, 19 | ) where 20 | 21 | import Advent.Format 22 | import Advent.Input 23 | import Advent.Orphans () 24 | import Advent.Prelude 25 | -------------------------------------------------------------------------------- /solutions/src/2022/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :main + "1000\n2000\n3000\n\n4000\n\n5000\n6000\n\n7000\n8000\n9000\n\n10000\n" 12 | 24000 13 | 45000 14 | 15 | -} 16 | module Main where 17 | 18 | import Data.List (sortBy) 19 | 20 | import Advent (format) 21 | 22 | -- | 23 | -- >>> :main 24 | -- 67658 25 | -- 200158 26 | main :: IO () 27 | main = 28 | do input <- [format|2022 1 (%u%n)+&%n|] 29 | let elves = sortBy (flip compare) (map sum input) 30 | let top n = sum (take n elves) 31 | print (top 1) 32 | print (top 3) 33 | -------------------------------------------------------------------------------- /inputs/2017/22.txt: -------------------------------------------------------------------------------- 1 | #.#...###.#.##.#....##.## 2 | ..####.#.######....#....# 3 | ###..###.#.###.##.##..#.# 4 | ...##.....##.###.##.###.. 5 | ....#...##.##..#....###.. 6 | ##.#..###.#.###......#### 7 | #.#.###...###..#.#.#.#.#. 8 | ###...##..##..#..##...... 9 | ##.#.####.#..###....#.### 10 | .....#..###....######..## 11 | .##.#.###....#..#####..#. 12 | ########...##.##....##..# 13 | .#.###.##.#..#..#.#..##.. 14 | .#.##.##....##....##.#.#. 15 | ..#.#.##.#..##..##.#..#.# 16 | .####..#..#.###..#..#..#. 17 | #.#.##......##..#.....### 18 | ...####...#.#.##.....#### 19 | #..##..##..#.####.#.#..#. 20 | #...###.##..###..#..#.... 21 | #..#....##.##.....###..## 22 | #..##...#...##...####..#. 23 | #.###..#.#####.#..#..###. 24 | ###.#...#.##..#..#...##.# 25 | .#...#..#.#.#.##.####.... 26 | -------------------------------------------------------------------------------- /common/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021 Eric Mertens 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /solutions/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2021 Eric Mertens 2 | 3 | Permission to use, copy, modify, and/or distribute this software for any purpose 4 | with or without fee is hereby granted, provided that the above copyright notice 5 | and this permission notice appear in all copies. 6 | 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH 8 | REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND 9 | FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, 10 | INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS 11 | OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER 12 | TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF 13 | THIS SOFTWARE. 14 | -------------------------------------------------------------------------------- /inputs/2015/09.txt: -------------------------------------------------------------------------------- 1 | Tristram to AlphaCentauri = 34 2 | Tristram to Snowdin = 100 3 | Tristram to Tambi = 63 4 | Tristram to Faerun = 108 5 | Tristram to Norrath = 111 6 | Tristram to Straylight = 89 7 | Tristram to Arbre = 132 8 | AlphaCentauri to Snowdin = 4 9 | AlphaCentauri to Tambi = 79 10 | AlphaCentauri to Faerun = 44 11 | AlphaCentauri to Norrath = 147 12 | AlphaCentauri to Straylight = 133 13 | AlphaCentauri to Arbre = 74 14 | Snowdin to Tambi = 105 15 | Snowdin to Faerun = 95 16 | Snowdin to Norrath = 48 17 | Snowdin to Straylight = 88 18 | Snowdin to Arbre = 7 19 | Tambi to Faerun = 68 20 | Tambi to Norrath = 134 21 | Tambi to Straylight = 107 22 | Tambi to Arbre = 40 23 | Faerun to Norrath = 11 24 | Faerun to Straylight = 66 25 | Faerun to Arbre = 144 26 | Norrath to Straylight = 115 27 | Norrath to Arbre = 135 28 | Straylight to Arbre = 127 29 | -------------------------------------------------------------------------------- /solutions/src/2016/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Determine triples that are valid triangle side lengths. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (format, chunks, countBy) 17 | import Data.List (sort, transpose) 18 | 19 | -- | >>> :main 20 | -- 1050 21 | -- 1921 22 | main :: IO () 23 | main = 24 | do input <- [format|2016 3 (( *%d)*%n)*|] 25 | print (countBy goodTriangle input) 26 | print (countBy goodTriangle (rearrange input)) 27 | 28 | rearrange :: [[a]] -> [[a]] 29 | rearrange = chunks 3 . concat . transpose 30 | 31 | goodTriangle :: [Int] -> Bool 32 | goodTriangle xs = x + y > z 33 | where 34 | [x,y,z] = sort xs 35 | -------------------------------------------------------------------------------- /solutions/src/2022/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "2-4,6-8\n\ 14 | \2-3,4-5\n\ 15 | \5-7,7-9\n\ 16 | \2-8,3-7\n\ 17 | \6-6,4-6\n\ 18 | \2-6,4-8\n" 19 | :} 20 | 2 21 | 4 22 | 23 | -} 24 | module Main where 25 | 26 | import Data.Ix (inRange) 27 | 28 | import Advent (format, countBy) 29 | 30 | -- | 31 | -- >>> :main 32 | -- 584 33 | -- 933 34 | main :: IO () 35 | main = 36 | do input <- [format|2022 4 (%u-%u,%u-%u%n)*|] 37 | print $ countBy (\(a,b,c,d) -> a <= c && d <= b || c <= a && b <= d) input 38 | print $ countBy (\(a,b,c,d) -> inRange (a,b) c || inRange (a,b) d || inRange (c,d) a || inRange (c,d) b) input 39 | -------------------------------------------------------------------------------- /solutions/src/2025/12.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ParallelListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 12 solution 5 | Copyright : (c) Eric Mertens, 2025 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Yes, I'm aware that this doesn't actually solve the problem, 12 | but it does get the right answer for my input. 13 | 14 | I'll redo this at some point to do it correctly. 15 | 16 | -} 17 | module Main where 18 | 19 | import Advent (format, count, countBy) 20 | 21 | main :: IO () 22 | main = 23 | do (shapes, regions) <- [format|2025 12 (%d:%n(%s%n)*%n)*(%dx%d:( %d)*%n)*|] 24 | print (countBy (fits shapes) regions) 25 | 26 | fits :: [(Int, [String])] -> (Int, Int, [Int]) -> Bool 27 | fits shapes (x, y, regions) = 28 | x*y >= sum [ n * count '#' (concat s) | (_, s) <- shapes | n <- regions] 29 | -------------------------------------------------------------------------------- /solutions/src/2019/19.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 19 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Format (format) 15 | import Data.List (find) 16 | import Intcode (intcodeToList) 17 | 18 | -- | >>> :main 19 | -- 211 20 | -- 8071006 21 | main :: IO () 22 | main = 23 | do inp <- [format|2019 19 %d&,%n|] 24 | let f x y = 1 == head (intcodeToList inp [x,y]) 25 | print $ length [ () | x <- [0..49], y <- [0..49], f x y] 26 | print $ part2 f 0 100 27 | 28 | part2 :: (Int -> Int -> Bool) -> Int -> Int -> Int 29 | part2 f x0 y 30 | | f (x+99) (y-99) = x * 10000 + y - 99 31 | | otherwise = part2 f x (y+1) 32 | where 33 | Just x = find (`f` y) [x0..] 34 | -------------------------------------------------------------------------------- /solutions/src/2019/09.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 9 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> intcodeToList [109,1,204,-1,1001,100,1,100,1008,100,16,101,1006,101,0,99] [] 12 | [109,1,204,-1,1001,100,1,100,1008,100,16,101,1006,101,0,99] 13 | 14 | >>> intcodeToList [1102,34915192,34915192,7,4,7,99,0] [] 15 | [1219070632396864] 16 | 17 | >>> intcodeToList [104,1125899906842624,99] [] 18 | [1125899906842624] 19 | 20 | -} 21 | module Main (main) where 22 | 23 | import Advent (format) 24 | import Intcode (intcodeToList) 25 | 26 | -- | >>> :main 27 | -- 2941952859 28 | -- 66113 29 | main :: IO () 30 | main = 31 | do inp <- [format|2019 9 %d&,%n|] 32 | let go i = print (head (intcodeToList inp [i])) 33 | go 1 34 | go 2 35 | -------------------------------------------------------------------------------- /solutions/src/2017/12.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 12 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Day 12 asks us questions about connected components of a graph. 12 | For fun we'll just use the @fgl@ package to do this. 13 | -} 14 | module Main where 15 | 16 | import Advent (format) 17 | import Data.Graph.Inductive (UGr, reachable, noComponents, mkUGraph) 18 | 19 | main :: IO () 20 | main = 21 | do input <- [format|2017 12 (%u <-> %u&(, )%n)*|] 22 | let g = toGraph input 23 | print (length (reachable 0 g)) 24 | print (noComponents g) 25 | 26 | -- | Convert a list of nodes and the node's neighbors into an 27 | -- unlabeled graph. 28 | toGraph :: [(Int,[Int])] -> UGr 29 | toGraph xs = mkUGraph (fst <$> xs) (sequenceA =<< xs) 30 | -------------------------------------------------------------------------------- /inputs/2020/10.txt: -------------------------------------------------------------------------------- 1 | 46 2 | 63 3 | 21 4 | 115 5 | 125 6 | 35 7 | 89 8 | 17 9 | 116 10 | 90 11 | 51 12 | 66 13 | 111 14 | 142 15 | 148 16 | 60 17 | 2 18 | 50 19 | 82 20 | 20 21 | 47 22 | 24 23 | 80 24 | 101 25 | 103 26 | 16 27 | 34 28 | 72 29 | 145 30 | 141 31 | 124 32 | 14 33 | 123 34 | 27 35 | 62 36 | 61 37 | 95 38 | 138 39 | 29 40 | 7 41 | 149 42 | 147 43 | 104 44 | 152 45 | 22 46 | 81 47 | 11 48 | 96 49 | 97 50 | 30 51 | 41 52 | 98 53 | 59 54 | 45 55 | 88 56 | 37 57 | 10 58 | 114 59 | 110 60 | 4 61 | 56 62 | 122 63 | 139 64 | 117 65 | 108 66 | 91 67 | 36 68 | 146 69 | 131 70 | 109 71 | 31 72 | 75 73 | 70 74 | 140 75 | 38 76 | 121 77 | 3 78 | 28 79 | 118 80 | 54 81 | 107 82 | 84 83 | 15 84 | 76 85 | 71 86 | 102 87 | 130 88 | 132 89 | 87 90 | 55 91 | 129 92 | 83 93 | 23 94 | 42 95 | 69 96 | 1 97 | 77 98 | 135 99 | 128 100 | 94 101 | -------------------------------------------------------------------------------- /solutions/src/2021/07.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 7 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Find the minimum fuel cost to move the submarines to a common point. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (format) 17 | import Data.List (sort) 18 | 19 | -- | >>> :main 20 | -- 336721 21 | -- 91638945 22 | main :: IO () 23 | main = 24 | do inp <- [format|2021 7 %u&,%n|] 25 | 26 | let median = sort inp !! (length inp `div` 2) 27 | print (sum [abs (x - median) | x <- inp]) 28 | 29 | let mean = sum inp `div` length inp 30 | print (minimum [sum [triangle (abs (x-a)) | x <- inp] | a <- [mean, mean+1]]) 31 | 32 | -- | Sum of numbers from 1 to @n@ 33 | triangle :: Int -> Int 34 | triangle n = n * (n+1) `div` 2 35 | -------------------------------------------------------------------------------- /solutions/src/2015/08.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 8 solution 4 | Copyright : (c) Eric Mertens, 2015 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | -} 11 | module Main where 12 | 13 | import Advent.Input (getInputLines) 14 | 15 | -- | 16 | -- >>> :main 17 | -- 1350 18 | -- 2085 19 | main :: IO () 20 | main = 21 | do ws <- getInputLines 2015 8 22 | print (sum (part1 <$> ws)) 23 | print (sum (part2 <$> ws)) 24 | 25 | part1 :: String -> Int 26 | part1 str = 2 + sum (aux (init (tail str))) 27 | where 28 | aux ('\\':'"' :xs) = 1 : aux xs 29 | aux ('\\':'\\' :xs) = 1 : aux xs 30 | aux ('\\':'x':_:_:xs) = 3 : aux xs 31 | aux (_ :xs) = aux xs 32 | aux [] = [] 33 | 34 | part2 :: String -> Int 35 | part2 str = 2 + length (filter isExpand str) 36 | where 37 | isExpand x = x `elem` "\\\"" 38 | -------------------------------------------------------------------------------- /solutions/src/2016/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (counts, getInputLines) 15 | import Data.List (transpose, maximumBy) 16 | import Data.Map qualified as Map 17 | import Data.Ord (Down(Down), comparing) 18 | 19 | -- | >>> :main 20 | -- xdkzukcf 21 | -- cevsgyvd 22 | main :: IO () 23 | main = 24 | do input <- getInputLines 2016 6 25 | putStrLn (decode id input) 26 | putStrLn (decode Down input) 27 | 28 | decode :: Ord a => (Int -> a) -> [String] -> String 29 | decode f xs = mostCommon f <$> transpose xs 30 | 31 | mostCommon :: (Ord a, Ord b) => (Int -> b) -> [a] -> a 32 | mostCommon f = fst . maximumBy (comparing (f . snd)) . Map.assocs . counts 33 | -------------------------------------------------------------------------------- /solutions/src/2021/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ParallelListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Count the number of increasing pairs of measurements. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (countBy, format) 17 | 18 | -- | >>> :main 19 | -- 1681 20 | -- 1704 21 | main :: IO () 22 | main = 23 | do input <- [format|2021 1 (%u%n)*|] 24 | print (solve 1 input) 25 | print (solve 3 input) 26 | 27 | -- | >>> solve 1 [199, 200, 208, 210, 200, 207, 240, 269, 260, 263] 28 | -- 7 29 | -- 30 | -- >>> solve 3 [199, 200, 208, 210, 200, 207, 240, 269, 260, 263] 31 | -- 5 32 | solve :: 33 | Int {- ^ window size -} -> 34 | [Int] {- ^ measurements -} -> 35 | Int {- ^ count of ascending pairs -} 36 | solve n input = countBy id [x < y | x <- input | y <- drop n input] 37 | -------------------------------------------------------------------------------- /common/src/Advent/Nat.hs: -------------------------------------------------------------------------------- 1 | {-# Language TypeFamilies, RankNTypes, UndecidableInstances, TypeOperators, ImportQualifiedPost, DataKinds #-} 2 | {-| 3 | Module : Advent.Nat 4 | Description : Type level nats as successor and zero 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | -} 10 | module Advent.Nat where 11 | 12 | import GHC.TypeNats qualified as T 13 | 14 | -- | Natural numbers (used for type index) 15 | data Nat 16 | = Z -- ^ zero 17 | | S Nat -- ^ successor 18 | 19 | -- | Covert from GHC type literal syntax to an inductively defined natural 20 | type family FromNatural (n :: T.Natural) :: Nat where 21 | FromNatural 0 = 'Z 22 | FromNatural n = 'S (FromNatural (n T.- 1)) 23 | 24 | class UnfoldNat n where 25 | unfoldNat :: f 'Z -> (forall m. f m -> f ('S m)) -> f n 26 | 27 | instance UnfoldNat 'Z where 28 | unfoldNat z _ = z 29 | 30 | instance UnfoldNat n => UnfoldNat ('S n) where 31 | unfoldNat z s = s (unfoldNat z s) 32 | -------------------------------------------------------------------------------- /solutions/src/2020/13.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 13 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Chinese (toMod, chinese) 15 | import Advent.Format (format) 16 | import Data.Foldable (traverse_) 17 | import Data.List (foldl1') 18 | 19 | -- | 20 | -- >>> :main 21 | -- 3215 22 | -- 1001569619313439 23 | main :: IO () 24 | main = 25 | do (t,rawBusses) <- [format|2020 13 %lu%n(x|%lu)&,%n|] 26 | let busses = [(i,b) | (i, Just b) <- zip [0..] rawBusses] 27 | print (part1 t (map snd busses)) 28 | traverse_ print (part2 busses) 29 | 30 | part1 :: Integer -> [Integer] -> Integer 31 | part1 t busses = uncurry (*) (minimum [((-t)`mod`b, b) | b <- busses]) 32 | 33 | part2 :: [(Integer, Integer)] -> Maybe Integer 34 | part2 busses = chinese [toMod (-x) y | (x,y) <- busses] 35 | -------------------------------------------------------------------------------- /solutions/src/2018/25.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 25 solution 5 | Copyright : (c) Eric Mertens, 2018 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Format ( format ) 15 | import Data.Graph.Inductive.Graph (mkUGraph) 16 | import Data.Graph.Inductive.PatriciaTree (UGr) 17 | import Data.Graph.Inductive.Query (noComponents) 18 | 19 | -- | Print the answers to day 25 20 | main :: IO () 21 | main = 22 | do input <- [format|2018 25 (%d&,%n)*|] 23 | print (noComponents (starGraph input)) 24 | 25 | starGraph :: [[Int]] -> UGr 26 | starGraph stars = 27 | mkUGraph [ 1 .. length stars ] 28 | [ (i,j) | (i,x) <- zip [1..] stars 29 | , (j,y) <- zip [1..] stars 30 | , manhattan x y <= 3 ] 31 | 32 | manhattan :: [Int] -> [Int] -> Int 33 | manhattan x y = sum (zipWith (\a b -> abs (a-b)) x y) 34 | -------------------------------------------------------------------------------- /solutions/src/2016/19.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 19 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Elves sitting in a circle stealing presents. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (format) 17 | import Data.Sequence (Seq) 18 | import Data.Sequence qualified as Seq 19 | 20 | -- | >>> :main 21 | -- 1830117 22 | -- 1417887 23 | main :: IO () 24 | main = 25 | do elves <- [format|2016 19 %u%n|] 26 | let ring = Seq.fromList [1..elves] 27 | print (part1 ring) 28 | print (part2 ring) 29 | 30 | part1 :: Seq a -> a 31 | part1 (x Seq.:<| Seq.Empty) = x 32 | part1 (x Seq.:<| _ Seq.:<| xs) = part1 (xs Seq.|> x) 33 | 34 | part2 :: Seq a -> a 35 | part2 (x Seq.:<| Seq.Empty) = x 36 | part2 (x Seq.:<| xs) = part2 (xs' Seq.|> x) 37 | where 38 | xs' = Seq.deleteAt (half (length xs)) xs 39 | half x = (x-1) `quot` 2 40 | -------------------------------------------------------------------------------- /solutions/src/2015/10.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 10 solution 4 | Copyright : (c) Eric Mertens, 2015 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | -} 11 | module Main where 12 | 13 | import Advent.Input (getInputLines) 14 | import Data.List (group) 15 | 16 | -- | 17 | -- >>> :main 18 | -- 252594 19 | -- 3579328 20 | main :: IO () 21 | main = 22 | do [start] <- getInputLines 2015 10 23 | let steps = iterate lookAndSay start 24 | print (length (steps !! 40)) 25 | print (length (steps !! 50)) 26 | 27 | -- | Look and say process. 28 | -- 29 | -- >>> lookAndSay "1" 30 | -- "11" 31 | -- 32 | -- >>> lookAndSay "11" 33 | -- "21" 34 | -- 35 | -- >>> lookAndSay "21" 36 | -- "1211" 37 | -- 38 | -- >>> lookAndSay "1211" 39 | -- "111221" 40 | -- 41 | -- >>> lookAndSay "111221" 42 | -- "312211" 43 | lookAndSay :: String -> String 44 | lookAndSay = foldr aux [] . group 45 | where 46 | aux xs = shows (length xs) 47 | . showChar (head xs) 48 | -------------------------------------------------------------------------------- /inputs/2023/20.txt: -------------------------------------------------------------------------------- 1 | %cf -> hl, qt 2 | &bn -> rx 3 | %nb -> vt 4 | %hm -> jp 5 | %vr -> qt, sl 6 | %gq -> hm, nl 7 | %sl -> jx, qt 8 | &pl -> bn 9 | %hf -> vt, ch 10 | %kx -> dq 11 | %fr -> qf 12 | %rh -> vr 13 | &vt -> lz, dh, kr, kq, lm, qk 14 | &dq -> mz, ml, xd, fb, xs, rc, rt 15 | %hn -> qk, vt 16 | %bv -> nl 17 | %jv -> rh, qt 18 | %kq -> lm 19 | %nd -> hp 20 | %gj -> bv, nl 21 | %lv -> xs, dq 22 | %ch -> vt, kd 23 | %sm -> qt, nd 24 | %nt -> jv 25 | %qk -> cb 26 | %jx -> cf 27 | %hl -> qt, ng 28 | &qt -> sm, rh, nd, jx, nt, pl 29 | %bh -> nl, fr 30 | %kd -> vt, nb 31 | %gx -> mh, dq 32 | %hp -> nt, qt 33 | %rc -> lv 34 | broadcaster -> kr, zb, sm, xd 35 | &mz -> bn 36 | %qf -> rd, nl 37 | %sk -> nl, bh 38 | %rb -> nl, sk 39 | %cb -> hf, vt 40 | %fb -> rt 41 | &lz -> bn 42 | %mh -> dq, kx 43 | %rt -> mt 44 | %xd -> dq, fb 45 | %lm -> hn 46 | %hh -> vt, dh 47 | %ml -> ts 48 | %mt -> rc, dq 49 | %ts -> gx, dq 50 | %rd -> nl, gq 51 | %zb -> nl, rb 52 | %kr -> hh, vt 53 | &nl -> fr, zb, hm, zm 54 | &zm -> bn 55 | %dh -> kq 56 | %ng -> qt 57 | %xs -> ml 58 | %jp -> nl, gj 59 | -------------------------------------------------------------------------------- /solutions/src/2025/11.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, BlockArguments, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 11 solution 5 | Copyright : (c) Eric Mertens, 2025 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Advent.Memo (memo2) 16 | import Data.List (permutations) 17 | import Data.Map qualified as Map 18 | 19 | -- | >>> :main 20 | -- 585 21 | -- 349322478796032 22 | main :: IO () 23 | main = 24 | do input <- [format|2025 11 (%s:( %s)*%n)*|] 25 | let tab = Map.fromList input 26 | 27 | let ways = memo2 \src dst -> 28 | if src == dst then (1 :: Int) 29 | else sum [ways nxt dst | nxt <- Map.findWithDefault [] src tab] 30 | 31 | let route x [] = ways x "out" 32 | route x (y:z) = ways x y * route y z 33 | 34 | let solve src mids = sum (map (route src) (permutations mids)) 35 | 36 | print (solve "you" []) 37 | print (solve "svr" ["fft", "dac"]) 38 | -------------------------------------------------------------------------------- /solutions/src/2020/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language TemplateHaskell, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format, stageTH) 15 | import Data.List (sort) 16 | 17 | data H = HL | HR | HF | HB 18 | 19 | stageTH 20 | 21 | -- | 22 | -- >>> :main 23 | -- 951 24 | -- 653 25 | main :: IO () 26 | main = 27 | do inp <- [format|2020 5 (@H*%n)*|] 28 | let seatIds = map seatId inp 29 | print (maximum seatIds) 30 | print (gap (sort seatIds)) 31 | 32 | gap :: [Int] -> Int 33 | gap (x:y:_) | x+2 == y = x+1 34 | gap (_:xs) = gap xs 35 | gap [] = error "couldn't find a gap" 36 | 37 | seatId :: [H] -> Int 38 | seatId xs = let (r,c) = seat xs in 8*r+c 39 | 40 | seat :: [H] -> (Int,Int) 41 | seat = foldl f (0,0) 42 | where 43 | f (r,c) HL = (r,2*c ) 44 | f (r,c) HR = (r,2*c+1) 45 | f (r,c) HF = (2*r ,c) 46 | f (r,c) HB = (2*r+1,c) 47 | -------------------------------------------------------------------------------- /solutions/src/2025/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, GADTs, DataKinds #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2025 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "3-5 14 | 10-14 15 | 16-20 16 | 12-18 17 | \& 18 | 1 19 | 5 20 | 8 21 | 11 22 | 17 23 | 32 24 | " 25 | :} 26 | 3 27 | 14 28 | 29 | -} 30 | module Main where 31 | 32 | import Advent (countBy, format) 33 | import Advent.Box (size, unionBoxes, Box', Box(Pt, Dim)) 34 | 35 | -- | >>> :main 36 | -- 664 37 | -- 350780324308385 38 | main :: IO () 39 | main = 40 | do (fresh, input) <- [format|2025 5 (%u-%u%n)*%n(%u%n)*|] 41 | 42 | -- NB. Dim uses an exclusive upper-bound (so we add 1) 43 | let fresh' = unionBoxes [Dim lo (hi + 1) Pt | (lo, hi) <- fresh] 44 | isFresh x = any (inRange x) fresh' 45 | 46 | print (countBy isFresh input) 47 | print (sum (map size fresh')) 48 | 49 | inRange :: Int -> Box' 1 -> Bool 50 | inRange x (Dim lo hi Pt) = lo <= x && x < hi 51 | -------------------------------------------------------------------------------- /solutions/src/2020/10.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 10 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (count) 15 | import Advent.Format (format) 16 | import Data.List (sort) 17 | 18 | -- | 19 | -- >>> :main 20 | -- 1998 21 | -- 347250213298688 22 | main :: IO () 23 | main = 24 | do adapters <- [format|2020 10 (%u%n)*|] 25 | let socket = 0 26 | let device = maximum adapters + 3 27 | 28 | let jolts = sort (socket : device : adapters) 29 | let diffs = zipWith (-) (tail jolts) jolts 30 | print (count 3 diffs * count 1 diffs) 31 | 32 | let part2 (1:ds) x y z = part2 ds y z (z+y+x) 33 | part2 (2:ds) _ y z = part2 ds z 0 (z+y) -- unused in normal input 34 | part2 (3:ds) _ _ z = part2 ds 0 0 z 35 | part2 [] _ _ z = z 36 | part2 _ _ _ _ = error "unexpected gap" 37 | print (part2 diffs 0 0 1 :: Integer) 38 | -------------------------------------------------------------------------------- /solutions/src/2023/09.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-# OPTIONS_GHC -Wno-x-partial #-} 3 | {-| 4 | Module : Main 5 | Description : Day 9 solution 6 | Copyright : (c) Eric Mertens, 2023 7 | License : ISC 8 | Maintainer : emertens@gmail.com 9 | 10 | 11 | 12 | Interpolate a polynomial sequence to find the next and previous 13 | elements of the sequence. 14 | 15 | >>> :{ 16 | :main + 17 | "0 3 6 9 12 15 18 | 1 3 6 10 15 21 19 | 10 13 16 21 30 45 20 | " 21 | :} 22 | 114 23 | 2 24 | 25 | -} 26 | module Main (main) where 27 | 28 | import Advent (format) 29 | 30 | -- | Parse the input and print out answers to both parts. 31 | -- 32 | -- >>> :main 33 | -- 1762065988 34 | -- 1066 35 | main :: IO () 36 | main = 37 | do input <- [format|2023 9 (%d& %n)*|] 38 | print (sum (map nextInSequence input)) 39 | print (sum (map (nextInSequence . reverse) input)) 40 | 41 | nextInSequence :: [Int] -> Int 42 | nextInSequence = sum . map last . takeWhile (any (0 /=)) . iterate differences 43 | 44 | differences :: [Int] -> [Int] 45 | differences xs = zipWith subtract xs (tail xs) 46 | -------------------------------------------------------------------------------- /solutions/src/2015/17.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 17 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (counts, format) 15 | 16 | main :: IO () 17 | main = 18 | do input <- [format|2015 17 (%u%n)*|] 19 | let combos = combinations 0 input 150 [] 20 | print (length combos) 21 | print (foldr const undefined (counts combos)) 22 | 23 | -- | Given a list of container sizes and an amount, 24 | -- return a list of the ways to chose a subset of those containers 25 | -- so that they sum to the desired amount. The resulting list 26 | -- is arranged by number of containers used. The nth element uses 27 | -- n-containers (zero-indexed). 28 | combinations :: Int -> [Int] -> Int -> [Int] -> [Int] 29 | combinations used _ 0 = (used:) 30 | combinations _ [] _ = id 31 | combinations used (x:xs) amt = 32 | (if x <= amt then combinations (used+1) xs (amt-x) else id) 33 | . combinations used xs amt 34 | 35 | -------------------------------------------------------------------------------- /solutions/src/2019/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent 15 | import Control.Applicative 16 | import Data.List 17 | import Data.Map (Map) 18 | import Data.Map qualified as Map 19 | 20 | -- | >>> :main 21 | -- 110190 22 | -- 343 23 | main :: IO () 24 | main = 25 | do inp <- [format|2019 6 (%s%)%s%n)*|] 26 | 27 | let orbits = Map.fromList [ (y,x) | (x,y) <- inp] 28 | 29 | print $ sum [ length (path orbits i) | (_,i) <- inp ] 30 | 31 | let you = orbits Map.! "YOU" 32 | san = orbits Map.! "SAN" 33 | t1 = path orbits you 34 | t2 = path orbits san 35 | common = intersect t1 t2 36 | 37 | print (length t1 + length t2 - 2 * length common) 38 | 39 | path :: Ord a => Map a a -> a -> [a] 40 | path m i = 41 | case Map.lookup i m of 42 | Nothing -> [] 43 | Just j -> i : path m j 44 | -------------------------------------------------------------------------------- /solutions/src/2020/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, ParallelListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Sledding down a slope counting trees. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (countBy, getInputArray) 17 | import Advent.Coord (Coord(C)) 18 | import Data.Array.Unboxed qualified as A 19 | 20 | -- | 21 | -- >>> :main 22 | -- 240 23 | -- 2832009600 24 | main :: IO () 25 | main = 26 | do inp <- getInputArray 2020 3 27 | print $ solve 3 1 inp 28 | print $ solve 1 1 inp 29 | * solve 3 1 inp 30 | * solve 5 1 inp 31 | * solve 7 1 inp 32 | * solve 1 2 inp 33 | 34 | solve :: Int -> Int -> A.UArray Coord Char -> Int 35 | solve dx dy grid 36 | = countBy (\c -> '#' == grid A.! c) 37 | [ C y (xlo + xoff `rem` width) 38 | | xoff <- [0, dx ..] 39 | | y <- [ylo, ylo+dy .. yhi]] 40 | where 41 | width = xhi - xlo + 1 42 | (C ylo xlo, C yhi xhi) = A.bounds grid 43 | -------------------------------------------------------------------------------- /solutions/src/2025/06.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 6 solution 4 | Copyright : (c) Eric Mertens, 2025 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | >>> :{ 11 | :main + 12 | "123 328 51 64 13 | 45 64 387 23 14 | 6 98 215 314 15 | * + * + 16 | " 17 | :} 18 | 4277556 19 | 3263827 20 | 21 | -} 22 | module Main where 23 | 24 | import Advent (getInputLines) 25 | import Data.List (transpose) 26 | import Data.List.Split (splitWhen) 27 | 28 | -- | >>> :main 29 | -- 7229350537438 30 | -- 11479269003550 31 | main :: IO () 32 | main = 33 | do input <- getInputLines 2025 6 34 | let problems = splitWhen (all (' ' ==)) (transpose input) 35 | print (sum (map solve1 problems)) 36 | print (sum (map solve2 problems)) 37 | 38 | solve1 :: [String] -> Int 39 | solve1 xs = finish (head (last xs')) (init xs') 40 | where 41 | xs' = transpose xs 42 | 43 | solve2 :: [String] -> Int 44 | solve2 (x:xs) = finish (last x) (init x : xs) 45 | 46 | finish :: Char -> [String] -> Int 47 | finish '+' xs = sum (map read xs) 48 | finish '*' xs = product (map read xs) 49 | -------------------------------------------------------------------------------- /solutions/src/2017/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Data.List (delete) 16 | 17 | main :: IO () 18 | main = 19 | do xs <- [format|2017 2 (%u&%t%n)*|] 20 | print (sum (map checksum1 xs)) 21 | print (sum (map checksum2 xs)) 22 | 23 | -- | First checksum is the difference of the largest and smallest elements 24 | -- 25 | -- >>> checksum1 [5,1,9,5] 26 | -- 8 27 | -- >>> checksum1 [7,5,3] 28 | -- 4 29 | -- >>> checksum1 [2,4,6,8] 30 | -- 6 31 | checksum1 :: [Int] -> Int 32 | checksum1 xs = maximum xs - minimum xs 33 | 34 | -- | Second checksum is the quotient of the only two elements that evenly 35 | -- divide each other. 36 | -- 37 | -- >>> checksum2 [5,9,2,8] 38 | -- 4 39 | -- >>> checksum2 [9,4,7,3] 40 | -- 3 41 | -- >>> checksum2 [3,8,6,5] 42 | -- 2 43 | checksum2 :: [Int] -> Int 44 | checksum2 xs = 45 | head [ q | x <- xs, y <- delete x xs, (q,0) <- [x `divMod` y] ] 46 | -------------------------------------------------------------------------------- /inputs/2015/19.txt: -------------------------------------------------------------------------------- 1 | Al => ThF 2 | Al => ThRnFAr 3 | B => BCa 4 | B => TiB 5 | B => TiRnFAr 6 | Ca => CaCa 7 | Ca => PB 8 | Ca => PRnFAr 9 | Ca => SiRnFYFAr 10 | Ca => SiRnMgAr 11 | Ca => SiTh 12 | F => CaF 13 | F => PMg 14 | F => SiAl 15 | H => CRnAlAr 16 | H => CRnFYFYFAr 17 | H => CRnFYMgAr 18 | H => CRnMgYFAr 19 | H => HCa 20 | H => NRnFYFAr 21 | H => NRnMgAr 22 | H => NTh 23 | H => OB 24 | H => ORnFAr 25 | Mg => BF 26 | Mg => TiMg 27 | N => CRnFAr 28 | N => HSi 29 | O => CRnFYFAr 30 | O => CRnMgAr 31 | O => HP 32 | O => NRnFAr 33 | O => OTi 34 | P => CaP 35 | P => PTi 36 | P => SiRnFAr 37 | Si => CaSi 38 | Th => ThCa 39 | Ti => BP 40 | Ti => TiTi 41 | e => HF 42 | e => NAl 43 | e => OMg 44 | 45 | CRnSiRnCaPTiMgYCaPTiRnFArSiThFArCaSiThSiThPBCaCaSiRnSiRnTiTiMgArPBCaPMgYPTiRnFArFArCaSiRnBPMgArPRnCaPTiRnFArCaSiThCaCaFArPBCaCaPTiTiRnFArCaSiRnSiAlYSiThRnFArArCaSiRnBFArCaCaSiRnSiThCaCaCaFYCaPTiBCaSiThCaSiThPMgArSiRnCaPBFYCaCaFArCaCaCaCaSiThCaSiRnPRnFArPBSiThPRnFArSiRnMgArCaFYFArCaSiRnSiAlArTiTiTiTiTiTiTiRnPMgArPTiTiTiBSiRnSiAlArTiTiRnPMgArCaFYBPBPTiRnSiRnMgArSiThCaFArCaSiThFArPRnFArCaSiRnTiBSiThSiRnSiAlYCaFArPRnFArSiThCaFArCaCaSiThCaCaCaSiRnPRnCaFArFYPMgArCaPBCaPBSiRnFYPBCaFArCaSiAl 46 | -------------------------------------------------------------------------------- /inputs/2017/02.txt: -------------------------------------------------------------------------------- 1 | 1236 741 557 1029 144 101 1968 2159 1399 80 1139 1167 1695 82 90 2236 2 | 2134 106 107 1025 584 619 191 496 80 352 351 2267 1983 1973 97 1244 3 | 3227 179 691 3177 172 1636 3781 2020 3339 2337 189 3516 1500 176 159 3279 4 | 201 688 364 180 586 659 623 577 188 265 403 670 195 720 115 37 5 | 1892 1664 2737 2676 849 2514 923 171 311 218 255 2787 1271 188 1278 2834 6 | 150 3276 204 603 3130 587 3363 3306 2890 127 176 174 383 3309 213 1620 7 | 5903 3686 200 230 6040 4675 6266 179 5375 1069 283 82 6210 6626 6398 1954 8 | 942 2324 1901 213 125 2518 655 189 2499 160 2841 2646 198 173 1841 200 9 | 232 45 272 280 44 248 50 266 296 297 236 254 58 212 276 48 10 | 563 768 124 267 153 622 199 591 204 125 93 656 198 164 797 506 11 | 243 4746 1785 204 568 4228 2701 4303 188 4148 4831 1557 4692 166 4210 3656 12 | 72 514 1572 172 1197 750 1392 1647 1587 183 1484 213 1614 718 177 622 13 | 1117 97 2758 2484 941 1854 1074 264 2494 83 1434 96 2067 2825 2160 92 14 | 2610 1290 204 2265 1374 2581 185 852 207 175 3308 1500 2898 1120 1892 3074 15 | 2322 1434 301 2156 98 2194 587 1416 1521 94 1985 424 91 119 1869 1073 16 | 66 87 176 107 2791 109 21 92 3016 2239 1708 3175 3210 2842 446 484 17 | -------------------------------------------------------------------------------- /solutions/src/2024/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Find sum of pairwise distances between two sorted lists 12 | and find sum of elements in first list multiplied by 13 | frequences of that element in the second list. 14 | 15 | >>> :{ 16 | :main + 17 | "3 4 18 | 4 3 19 | 2 5 20 | 1 3 21 | 3 9 22 | 3 3 23 | " 24 | :} 25 | 11 26 | 31 27 | 28 | -} 29 | module Main (main) where 30 | 31 | import Advent (counts, format) 32 | import Data.List (sort) 33 | import Data.Map qualified as Map 34 | 35 | -- | >>> :main 36 | -- 1530215 37 | -- 26800609 38 | main :: IO () 39 | main = 40 | do (left, right) <- unzip <$> [format|2024 1 (%u %u%n)*|] 41 | print (sum (zipWith distance (sort left) (sort right))) 42 | print (sum [k * v | (k, v) <- Map.assocs (Map.intersectionWith (*) (counts left) (counts right))]) 43 | 44 | -- | Absolute distance between two numbers. 45 | distance :: Int -> Int -> Int 46 | distance x y = abs (x - y) 47 | -------------------------------------------------------------------------------- /solutions/src/2024/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Find the number of reports that are ascending or descending 12 | and have neighbor differences between 1 and 3. 13 | 14 | >>> :{ 15 | :main + 16 | "7 6 4 2 1 17 | 1 2 7 8 9 18 | 9 7 6 2 1 19 | 1 3 2 4 5 20 | 8 6 4 4 1 21 | 1 3 6 7 9 22 | " 23 | :} 24 | 2 25 | 4 26 | 27 | -} 28 | module Main (main) where 29 | 30 | import Advent (countBy, format) 31 | import Data.List (inits, tails) 32 | 33 | -- | >>> :main 34 | -- 631 35 | -- 665 36 | main :: IO () 37 | main = 38 | do input <- [format|2024 2 (%u& %n)*|] 39 | print (countBy isSafe input) 40 | print (countBy (\x -> any isSafe (x : removeOne x)) input) 41 | 42 | isSafe :: [Int] -> Bool 43 | isSafe xs = all p1 ds || all p2 ds 44 | where 45 | p1 x = -3 <= x && x <= -1 46 | p2 x = 1 <= x && x <= 3 47 | ds = zipWith (-) xs (drop 1 xs) 48 | 49 | removeOne :: [a] -> [[a]] 50 | removeOne xs = zipWith (++) (inits xs) (drop 1 (tails xs)) 51 | -------------------------------------------------------------------------------- /solutions/src/2019/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Compute fuel costs for a rocket. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent.Format (format) 17 | 18 | -- | >>> :main 19 | -- 3188480 20 | -- 4779847 21 | main :: IO () 22 | main = 23 | do inp <- [format|2019 1 (%lu%n)*|] 24 | print (sum (map fuelCost inp)) 25 | print (sum (map recursiveFuelCost inp)) 26 | 27 | -- | Compute fuel cost given a mass. 28 | -- 29 | -- >>> fuelCost 12 30 | -- 2 31 | -- >>> fuelCost 14 32 | -- 2 33 | -- >>> fuelCost 1969 34 | -- 654 35 | -- >>> fuelCost 100756 36 | -- 33583 37 | fuelCost :: Integer -> Integer 38 | fuelCost x = x `div` 3 - 2 39 | 40 | -- | Compute fuel cost given a mass. 41 | -- 42 | -- >>> recursiveFuelCost 14 43 | -- 2 44 | -- >>> recursiveFuelCost 1969 45 | -- 966 46 | -- >>> recursiveFuelCost 100756 47 | -- 50346 48 | recursiveFuelCost :: Integer -> Integer 49 | recursiveFuelCost = sum . takeWhile (> 0) . tail . iterate fuelCost 50 | -------------------------------------------------------------------------------- /solutions/src/2022/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :main + "mjqjpqmgbljsphdztnvjfqwrcgsmlb\n" 12 | 7 13 | 19 14 | >>> :main + "bvwbjplbgvbhsrlpgdmjqwftvncz\n" 15 | 5 16 | 23 17 | >>> :main + "nppdvjthqldpwncqszvftbrmjlhg\n" 18 | 6 19 | 23 20 | >>> :main + "nznrnfrfntjfmvfwmzdfjlvtqnbhcprsg\n" 21 | 10 22 | 29 23 | >>> :main + "zcfzfwzzqfrljwzlrfnpqdbhtmscgvjw\n" 24 | 11 25 | 26 26 | 27 | -} 28 | module Main where 29 | 30 | import Data.List (findIndex, tails) 31 | import Data.Set qualified as Set 32 | 33 | import Advent (format) 34 | 35 | -- | 36 | -- >>> :main 37 | -- 1909 38 | -- 3380 39 | main :: IO () 40 | main = 41 | do input <- [format|2022 6 %s%n|] 42 | print (solve 4 input) 43 | print (solve 14 input) 44 | 45 | solve :: Ord a => Int -> [a] -> Int 46 | solve n input = maybe undefined (n+) (findIndex (start n) (tails input)) 47 | 48 | start :: Ord a => Int -> [a] -> Bool 49 | start n xs = length (Set.fromList (take n xs)) == n 50 | -------------------------------------------------------------------------------- /solutions/src/2015/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Follow up, down, left, right instructions to build a path. 12 | 13 | >>> :main + ">\n" 14 | 2 15 | 2 16 | 17 | >>> :main + "^v\n" 18 | 2 19 | 3 20 | 21 | >>> :main + "^>v<\n" 22 | 4 23 | 3 24 | 25 | >>> :main + "^v^v^v^v^v\n" 26 | 2 27 | 11 28 | 29 | -} 30 | module Main where 31 | 32 | import Data.List (transpose) 33 | import Data.Maybe (mapMaybe) 34 | 35 | import Advent (chunks, counts, format, partialSums) 36 | import Advent.Coord (Coord, origin, north, east, south, west, charToVec) 37 | 38 | -- | >>> :main 39 | -- 2572 40 | -- 2631 41 | main :: IO () 42 | main = 43 | do input <- [format|2015 3 (^|v|<|>)*!%n|] 44 | let directions = mapMaybe charToVec input 45 | print (countHouses 1 directions) 46 | print (countHouses 2 directions) 47 | 48 | countHouses :: Int {- ^ workers -} -> [Coord] -> Int 49 | countHouses n = 50 | length . counts . concatMap partialSums . transpose . chunks n 51 | -------------------------------------------------------------------------------- /inputs/2018/15.txt: -------------------------------------------------------------------------------- 1 | ################################ 2 | #########...#################### 3 | #########...###########.######## 4 | #########G..##########....###### 5 | ##########..###########...###### 6 | #########G...##########...###### 7 | #########..G.###########..###### 8 | ########...#.##########..####### 9 | #######G#..###E######....####### 10 | #######G.....#.######....####### 11 | ######...G......##E......####### 12 | ####...##.#..G..G.........###### 13 | ###..........G#####.......####.# 14 | ####........G#######...........# 15 | ####..G.....#########......#...# 16 | ###.........#########........### 17 | ##.....G.G..#########......##### 18 | #...G.......#########.........## 19 | #.G.........#########.E.##...### 20 | ##.....G.....#######....G#.E...# 21 | ##............#####...E.......## 22 | #.G...........E.......#E...##.## 23 | #....G........###########.....## 24 | #......##...#.################## 25 | #.#.........E..##.############## 26 | #.#.......G.......############## 27 | #.###........E....############## 28 | #.####.....###....############## 29 | #.#####......E..################ 30 | #######..........############### 31 | #########..####.################ 32 | ################################ 33 | -------------------------------------------------------------------------------- /inputs/2019/07.txt: -------------------------------------------------------------------------------- 1 | 3,8,1001,8,10,8,105,1,0,0,21,34,55,68,93,106,187,268,349,430,99999,3,9,102,5,9,9,1001,9,2,9,4,9,99,3,9,1001,9,5,9,102,2,9,9,101,2,9,9,102,2,9,9,4,9,99,3,9,101,2,9,9,102,4,9,9,4,9,99,3,9,101,4,9,9,102,3,9,9,1001,9,2,9,102,4,9,9,1001,9,2,9,4,9,99,3,9,101,2,9,9,1002,9,5,9,4,9,99,3,9,101,1,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,99,3,9,101,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,101,1,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,101,2,9,9,4,9,99,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,101,1,9,9,4,9,3,9,101,1,9,9,4,9,3,9,101,2,9,9,4,9,3,9,1001,9,2,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,101,1,9,9,4,9,3,9,101,1,9,9,4,9,99,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,3,9,1002,9,2,9,4,9,99 2 | -------------------------------------------------------------------------------- /solutions/src/2020/21.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 21 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (countBy, uniqueAssignment) 15 | import Advent.Format (format) 16 | import Data.List (intercalate, sort) 17 | import Data.Map (Map) 18 | import Data.Map qualified as Map 19 | import Data.Set (Set) 20 | import Data.Set qualified as Set 21 | 22 | -- | 23 | -- >>> :main 24 | -- 2517 25 | -- rhvbn,mmcpg,kjf,fvk,lbmt,jgtb,hcbdb,zrb 26 | main :: IO () 27 | main = 28 | do inp <- [format|2020 21 (%s& %(contains %s&(, )%)%n)*|] 29 | let [soln] = uniqueAssignment (toConstraints inp) 30 | badFoods = Set.fromList (Map.elems soln) 31 | 32 | print (countBy (`Set.notMember` badFoods) (concatMap fst inp)) 33 | putStrLn (intercalate "," (Map.elems soln)) 34 | 35 | toConstraints :: (Ord a, Ord b) => [([a],[b])] -> Map b (Set a) 36 | toConstraints inp = 37 | Map.fromListWith Set.intersection 38 | [(y, Set.fromList xs) | (xs, ys) <- inp, y <- ys] 39 | -------------------------------------------------------------------------------- /inputs/2019/01.txt: -------------------------------------------------------------------------------- 1 | 88093 2 | 102524 3 | 75875 4 | 62024 5 | 86072 6 | 106670 7 | 105440 8 | 51371 9 | 148951 10 | 123704 11 | 92364 12 | 50848 13 | 117125 14 | 95022 15 | 131085 16 | 129886 17 | 145084 18 | 123077 19 | 69219 20 | 84366 21 | 51344 22 | 65604 23 | 140383 24 | 53606 25 | 132685 26 | 83550 27 | 76648 28 | 120937 29 | 137498 30 | 84167 31 | 94438 32 | 54178 33 | 106306 34 | 80802 35 | 98524 36 | 70214 37 | 114108 38 | 118782 39 | 75444 40 | 76449 41 | 144233 42 | 56747 43 | 93663 44 | 137969 45 | 99981 46 | 110442 47 | 106873 48 | 93708 49 | 114085 50 | 53655 51 | 78096 52 | 137640 53 | 50775 54 | 72563 55 | 135043 56 | 146136 57 | 147244 58 | 105601 59 | 106293 60 | 63048 61 | 104864 62 | 93044 63 | 118222 64 | 107110 65 | 92725 66 | 57424 67 | 94602 68 | 87898 69 | 51668 70 | 137651 71 | 55070 72 | 67255 73 | 103823 74 | 83059 75 | 61150 76 | 82029 77 | 56060 78 | 56702 79 | 85486 80 | 114522 81 | 94121 82 | 104870 83 | 53014 84 | 111776 85 | 63615 86 | 78378 87 | 113830 88 | 80059 89 | 123427 90 | 73545 91 | 93688 92 | 122410 93 | 93174 94 | 131464 95 | 137014 96 | 114304 97 | 138703 98 | 54128 99 | 111698 100 | 84299 101 | -------------------------------------------------------------------------------- /common/src/Advent/Format/Types.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Advent.Format.Types 3 | Description : Types for the parser AST 4 | Copyright : (c) Eric Mertens, 2018-2021 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | -} 9 | 10 | module Advent.Format.Types where 11 | 12 | data Token 13 | = TOpenGroup 14 | | TCloseGroup 15 | | TAnyChar 16 | | TAnyLetter 17 | | TAnyWord 18 | | TUnsignedInteger 19 | | TSignedInteger 20 | | THexInteger 21 | | TUnsignedInt 22 | | TSignedInt 23 | | THexInt 24 | | TMany 25 | | TSome 26 | | TSepBy 27 | | TAlt 28 | | TAt String 29 | | TBang 30 | | TLiteral Char 31 | deriving (Eq, Ord, Show, Read) 32 | 33 | data Format 34 | -- repetitions 35 | = Many Format 36 | | Some Format 37 | | SepBy Format Format 38 | -- combinations 39 | | Alt Format Format 40 | | Follow [Format] 41 | -- return matched string 42 | | Gather Format 43 | | Named String 44 | -- explicit grouping to allow subtuples 45 | | Group Format 46 | -- primitives 47 | | Literal String 48 | | UnsignedInteger 49 | | SignedInteger 50 | | HexInteger 51 | | UnsignedInt 52 | | SignedInt 53 | | HexInt 54 | | Word 55 | | Char 56 | | Letter 57 | deriving Show 58 | -------------------------------------------------------------------------------- /solutions/src/2019/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format, countBy) 15 | import Data.List (group) 16 | 17 | -- | >>> :main 18 | -- 1929 19 | -- 1306 20 | main :: IO () 21 | main = 22 | do [(lo,hi)] <- [format|2019 4 (%u-%u%n)*|] 23 | let nums = map runs $ filter nondecreasing $ map show [lo..hi] 24 | print (countBy (any (> 1)) nums) 25 | print (countBy (elem 2 ) nums) 26 | 27 | -- | Return a list of the lengths of consecutive elements in a list. 28 | -- 29 | -- >>> runs [1,2,3] 30 | -- [1,1,1] 31 | -- >>> runs [1,1,1] 32 | -- [3] 33 | -- >>> runs [1,1,2,2,2,1,1] 34 | -- [2,3,2] 35 | -- >>> runs [] 36 | -- [] 37 | runs :: Eq a => [a] -> [Int] 38 | runs = map length . group 39 | 40 | -- | Predicate for non-decreasing lists. 41 | -- 42 | -- >>> nondecreasing [] 43 | -- True 44 | -- >>> nondecreasing [1,1,2,3] 45 | -- True 46 | -- >>> nondecreasing [3,3,2] 47 | -- False 48 | nondecreasing :: Ord a => [a] -> Bool 49 | nondecreasing xs = and (zipWith (<=) xs (tail xs)) 50 | -------------------------------------------------------------------------------- /solutions/src/2016/13.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 13 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Advent.Coord (Coord(..), cardinal) 16 | import Advent.Search (bfsOn) 17 | import Data.Bits (Bits(popCount)) 18 | 19 | data Entry = Entry { entrySteps :: !Int, entryCoord :: Coord } 20 | deriving (Eq, Show) 21 | 22 | -- | >>> :main 23 | -- 92 24 | -- 124 25 | main :: IO () 26 | main = 27 | do input <- [format|2016 13 %u%n|] 28 | let entries = bfsOn entryCoord (nextEntries input) initialEntry 29 | print $ head [steps | Entry steps (C 39 31) <- entries] 30 | print $ length $ takeWhile (<= 50) $ map entrySteps entries 31 | 32 | initialEntry :: Entry 33 | initialEntry = Entry 0 (C 1 1) 34 | 35 | isValidCoord :: Int -> Coord -> Bool 36 | isValidCoord input (C y x) = 37 | x >= 0 && y >= 0 && 38 | even (popCount (x*x + 3*x + 2*x*y + y + y*y + input)) 39 | 40 | nextEntries :: Int -> Entry -> [Entry] 41 | nextEntries input (Entry steps coord) = 42 | [Entry (steps+1) c | c <- cardinal coord, isValidCoord input c] 43 | -------------------------------------------------------------------------------- /solutions/src/2016/20.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 20 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent.Format (format) 15 | import Data.List (sort) 16 | 17 | type Blacklist = [(Integer,Integer)] 18 | 19 | -- | >>> :main 20 | -- 23923783 21 | -- 125 22 | main :: IO () 23 | main = 24 | do blacklist <- removeOverlap <$> [format|2016 20 (%lu-%lu%n)*|] 25 | print (lowest blacklist) 26 | print (countValid blacklist) 27 | 28 | -- | Remove all redundancy from the blacklist and put it in sorted order. 29 | removeOverlap :: Blacklist -> Blacklist 30 | removeOverlap = go . sort 31 | where 32 | go ((lo1,hi1):(lo2,hi2):rest) 33 | | hi1 >= lo2-1 = go ((lo1, max hi1 hi2) : rest) 34 | go (x:xs) = x : go xs 35 | go [] = [] 36 | 37 | -- | Smallest address that isn't blacklisted 38 | lowest :: Blacklist -> Integer 39 | lowest ((0,hi):_) = hi+1 40 | lowest ((lo,_):_) = lo-1 41 | lowest _ = 0 42 | 43 | -- | Number of addresses not blacklisted 44 | countValid :: Blacklist -> Integer 45 | countValid xs = 2^(32::Int) - sum [1+b-a | (a,b) <- xs] 46 | -------------------------------------------------------------------------------- /solutions/src/2021/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Multiplying fish! To make this problem tractable 12 | track how many of each age of fish we have rather 13 | than tracking all the individual ages of the fish. 14 | 15 | -} 16 | module Main (main) where 17 | 18 | import Advent (counts, format, power) 19 | import Data.Map (Map) 20 | import Data.Map qualified as Map 21 | 22 | -- | >>> :main 23 | -- 376194 24 | -- 1693022481538 25 | main :: IO () 26 | main = 27 | do inp <- counts <$> [format|2021 6 %u&,%n|] 28 | let bigFish = maximum (Map.keys inp) 29 | let oneStep = rule bigFish 30 | let nSteps = power (fmap . applyRule) oneStep 31 | print (sum (nSteps 80 `applyRule` inp)) 32 | print (sum (nSteps 256 `applyRule` inp)) 33 | 34 | rule :: Int -> Map Int (Map Int Int) 35 | rule n = counts <$> Map.fromList ((0, [6,8]) : [(i, [i-1]) | i <- [1..max n 8]]) 36 | 37 | applyRule :: (Ord a, Ord b) => Map a (Map b Int) -> Map a Int -> Map b Int 38 | applyRule r m = Map.unionsWith (+) [(v *) <$> (r Map.! k) | (k,v) <- Map.toList m] 39 | -------------------------------------------------------------------------------- /solutions/src/2016/09.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 9 solution 4 | Copyright : (c) Eric Mertens, 2021 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | -} 11 | module Main where 12 | 13 | import Advent ( getInputLines ) 14 | import Control.Applicative ( Alternative(some) ) 15 | import Text.ParserCombinators.ReadP as ReadP 16 | import Data.Char (isDigit) 17 | 18 | main :: IO () 19 | main = 20 | do xs <- getInputLines 2016 9 21 | print (sum (map decode1 xs)) 22 | print (sum (map decode2 xs)) 23 | 24 | decode1 :: String -> Int 25 | decode1 = mkDecode (\n xs -> n * length xs) 26 | 27 | decode2 :: String -> Int 28 | decode2 = mkDecode (\n xs -> n * decode2 xs) 29 | 30 | mkDecode :: 31 | (Int -> String -> Int) {- ^ repeated segment logic -} -> 32 | String {- ^ input string -} -> 33 | Int {- ^ decoded length -} 34 | mkDecode f = fst . head . readP_to_S (sum <$> ReadP.many (repeated <++ plain) <* eof) 35 | where 36 | number = read <$> munch1 isDigit 37 | plain = length <$> munch1 (/='(') 38 | repeated = 39 | do len <- char '(' *> number <* char 'x' 40 | f <$> number <* char ')' <*> ReadP.count len get 41 | -------------------------------------------------------------------------------- /common/src/Advent/Group.hs: -------------------------------------------------------------------------------- 1 | {-# Language TypeOperators, MultiParamTypeClasses #-} 2 | {-| 3 | Module : Advent.Group 4 | Description : Support for abstract algebraic groups 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | -} 10 | module Advent.Group 11 | ( Group(inverse) 12 | , RightAction(rightAction) 13 | , type (><|)((:><|)) 14 | ) where 15 | 16 | import Data.Semigroup (Sum(Sum), Product(Product)) 17 | 18 | class Monoid a => Group a where 19 | inverse :: a -> a 20 | 21 | instance Num a => Group (Sum a) where 22 | inverse (Sum n) = Sum (negate n) 23 | 24 | instance Fractional a => Group (Product a) where 25 | inverse (Product n) = Product (recip n) 26 | 27 | -- | Outer semi-direct product 28 | data a ><| b = a :><| b deriving Show 29 | 30 | instance (Semigroup a, Semigroup b, Group b, RightAction a b) => Semigroup (a ><| b) 31 | where 32 | (n1 :><| h1) <> (n2 :><| h2) = (rightAction n1 h1 <> rightAction n2 (inverse h1)) 33 | :><| (h1 <> h2) 34 | 35 | instance (Semigroup a, Monoid a, Group b, RightAction a b) => Monoid (a ><| b) where 36 | mempty = mempty :><| mempty 37 | mappend = (<>) 38 | 39 | class Semigroup b => RightAction a b where 40 | rightAction :: a -> b -> a 41 | -------------------------------------------------------------------------------- /solutions/src/2020/18.hs: -------------------------------------------------------------------------------- 1 | {-# Language BlockArguments #-} 2 | {-| 3 | Module : Main 4 | Description : Day 18 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (getInputLines) 15 | import Control.Applicative ((<|>)) 16 | import Data.Char (isDigit, digitToInt) 17 | import Text.ParserCombinators.ReadP 18 | 19 | -- | 20 | -- >>> :main 21 | -- 14208061823964 22 | -- 320536571743074 23 | main :: IO () 24 | main = 25 | do inp <- getInputLines 2020 18 26 | print (sum (map (run expr1) inp)) 27 | print (sum (map (run expr2) inp)) 28 | 29 | run :: ReadP a -> String -> a 30 | run p = fst . head . readP_to_S (skipSpaces *> p <* eof) 31 | 32 | l :: Char -> ReadP () 33 | l c = char c *> skipSpaces 34 | 35 | add, mul :: ReadP (Int -> Int -> Int) 36 | add = (+) <$ l '+' 37 | mul = (*) <$ l '*' 38 | 39 | number :: ReadP Int 40 | number = digitToInt <$> satisfy isDigit <* skipSpaces 41 | 42 | aexpr :: ReadP Int -> ReadP Int 43 | aexpr top = number <|> between (l '(') (l ')') top 44 | 45 | expr1, expr2 :: ReadP Int 46 | expr1 = chainl1 (aexpr expr1) (add <|> mul) 47 | expr2 = chainl1 (chainl1 (aexpr expr2) add) mul 48 | -------------------------------------------------------------------------------- /solutions/src/2022/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "vJrwpWtwJgWrhcsFMMfFFhFp\n\ 14 | \jqHRNqRjqzjGDLGLrsFMfFZSrLrFZsSL\n\ 15 | \PmmdzqPrVvPwwTWBwg\n\ 16 | \wMqvLMZHhHMvwLHjbvcjnnSBnvTQFn\n\ 17 | \ttgJtRGJQctTZtZT\n\ 18 | \CrZsJsPPZsGzwwsLwLmpwMDw\n" 19 | :} 20 | 157 21 | 70 22 | 23 | -} 24 | module Main where 25 | 26 | import Data.Char (isLower, ord) 27 | import Data.List (foldl1') 28 | import Data.Set qualified as Set 29 | 30 | import Advent (format, chunks) 31 | 32 | -- | 33 | -- >>> :main 34 | -- 7917 35 | -- 2585 36 | main :: IO () 37 | main = 38 | do input <- [format|2022 3 (%s%n)*|] 39 | print (sum (map (score . halves) input)) 40 | print (sum (map score (chunks 3 input))) 41 | 42 | halves :: String -> [String] 43 | halves xs = chunks (length xs `div` 2) xs 44 | 45 | score :: [String] -> Int 46 | score = priority . minimum . foldl1' Set.intersection . map Set.fromList 47 | 48 | priority :: Char -> Int 49 | priority x 50 | | isLower x = ord x - ord 'a' + 1 51 | | otherwise = ord x - ord 'A' + 27 52 | -------------------------------------------------------------------------------- /solutions/src/2022/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, TemplateHaskell #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :main + "A Y\nB X\nC Z\n" 12 | 15 13 | 12 14 | 15 | -} 16 | module Main where 17 | 18 | import Advent (format, stageTH) 19 | 20 | data A = AA | AB | AC deriving Show 21 | data B = BX | BY | BZ deriving Show 22 | 23 | stageTH 24 | 25 | main :: IO () 26 | main = 27 | do input <- [format|2022 2 (@A @B%n)*|] 28 | print $ sum [outcome a b + shapeScore b | (a,b) <- input] 29 | print $ sum [outcome a b + shapeScore b | (a,b') <- input, let b = pick a b' ] 30 | 31 | shapeScore :: B -> Int 32 | shapeScore BX = 1 33 | shapeScore BY = 2 34 | shapeScore BZ = 3 35 | 36 | outcome :: A -> B -> Int 37 | outcome AA BX = 3 38 | outcome AA BY = 6 39 | outcome AA BZ = 0 40 | outcome AB BX = 0 41 | outcome AB BY = 3 42 | outcome AB BZ = 6 43 | outcome AC BX = 6 44 | outcome AC BY = 0 45 | outcome AC BZ = 3 46 | 47 | desiredOutcome :: B -> Int 48 | desiredOutcome BX = 0 49 | desiredOutcome BY = 3 50 | desiredOutcome BZ = 6 51 | 52 | pick :: A -> B -> B 53 | pick a b = head [ x | x <- [BX,BY,BZ], outcome a x == desiredOutcome b ] 54 | -------------------------------------------------------------------------------- /solutions/src/2015/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Count open and closing parentheses. 12 | 13 | >>> :main + "(())\n" 14 | 0 15 | 16 | >>> :main + "()()\n" 17 | 0 18 | 19 | >>> :main + "(((\n" 20 | 3 21 | 22 | >>> :main + "(()(()(\n" 23 | 3 24 | 25 | >>> :main + "))(((((\n" 26 | 3 27 | 1 28 | 29 | >>> :main + "())\n" 30 | -1 31 | 3 32 | 33 | >>> :main + "))(\n" 34 | -1 35 | 1 36 | 37 | >>> :main + ")))\n" 38 | -3 39 | 1 40 | 41 | >>> :main + ")())())\n" 42 | -3 43 | 1 44 | 45 | >>> :main + "()())\n" 46 | -1 47 | 5 48 | 49 | -} 50 | module Main where 51 | 52 | import Advent (format, partialSums) 53 | import Data.Foldable (traverse_) 54 | import Data.List (elemIndex) 55 | 56 | -- | >>> :main 57 | -- 138 58 | -- 1771 59 | main :: IO () 60 | main = 61 | do inp <- [format|2015 1 %s%n|] 62 | let xs = map interpret inp 63 | print (sum xs) 64 | traverse_ print (part2 xs) 65 | 66 | interpret :: Char -> Int 67 | interpret '(' = 1 68 | interpret ')' = -1 69 | interpret x = error ("No interpretation for: " ++ [x]) 70 | 71 | part2 :: [Int] -> Maybe Int 72 | part2 = elemIndex (-1) . partialSums 73 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Advent of Code solution archive 2 | 3 | This is my complete set of solutions for the [Advent of Code](https://adventofcode.com) 4 | annual programming game. 5 | 6 | Generated Haddocks are available at 7 | 8 | These libraries and solutions are provided under the ISC license. 9 | 10 | ## Build steps 11 | 12 | 1. Install [GHCUP](https://www.haskell.org/ghcup/) 13 | 2. Install current version of GHC `ghcup install ghc 9.10.1` 14 | 3. Configure to use correct GHC `cabal configure -w ghc-9.10.1` 15 | 4. Build everything `cabal build all` 16 | 17 | GHC 9.6.3 isn't specifically required, however it's what I 18 | test with and what I use in CI. 19 | 20 | ## Running solutions 21 | 22 | There are multiple methods for finding the input file for 23 | each solution. 24 | 25 | 1. Default (no command line argument) reads file `inputs/YEAR/DAY.txt` 26 | 2. Filename argument reads the given file. 27 | 3. Hyphen `-` argument reads from stdin. 28 | 4. Plus `+` argument reads input from second command line argument as a string literal. 29 | 30 | Examples: 31 | 32 | ``` 33 | $ sln_2022_01 # defaults to inputs/2022/01.txt 34 | $ sln_2022_01 example.txt # reads example.txt 35 | $ sln_2022_01 - # reads from stdin 36 | $ sln_2022_01 + '"1\n2\n\n3\n4\n"' # parses Haskell string literal 37 | ``` 38 | -------------------------------------------------------------------------------- /common/src/Advent/Format/Lexer.x: -------------------------------------------------------------------------------- 1 | { 2 | module Advent.Format.Lexer where 3 | 4 | import Advent.Format.Types 5 | } 6 | %wrapper "posn" 7 | 8 | tokens :- 9 | 10 | "(" { token_ TOpenGroup } 11 | ")" { token_ TCloseGroup } 12 | "%c" { token_ TAnyChar } 13 | "%a" { token_ TAnyLetter } 14 | "%s" { token_ TAnyWord } 15 | "%t" { token_ (TLiteral '\t') } 16 | "%u" { token_ TUnsignedInt } 17 | "%d" { token_ TSignedInt } 18 | "%x" { token_ THexInt } 19 | "%lu" { token_ TUnsignedInteger } 20 | "%ld" { token_ TSignedInteger } 21 | "%lx" { token_ THexInteger } 22 | "*" { token_ TMany } 23 | "+" { token_ TSome } 24 | "&" { token_ TSepBy } 25 | "|" { token_ TAlt } 26 | "!" { token_ TBang } 27 | "@" . { token (TAt . tail) } 28 | "%n" { token_ (TLiteral '\n') } 29 | "%" . { token (TLiteral . head . tail)} 30 | . { token (TLiteral . head) } 31 | 32 | { 33 | type Action = AlexPosn -> String -> (AlexPosn, Token) 34 | 35 | token_ :: Token -> Action 36 | token_ x p _ = (p, x) 37 | 38 | token :: (String -> Token) -> Action 39 | token f p str = (p, f str) 40 | } 41 | -------------------------------------------------------------------------------- /common/src/Advent/Memo.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Advent.Memo 3 | Description : Memoization functions 4 | Copyright : (c) Eric Mertens, 2021 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | Re-exported MemoTrie operations and extended 9 | arity memoization. 10 | 11 | -} 12 | module Advent.Memo ( 13 | HasTrie, 14 | memo, memo2, memo3, memo4, memo5, memo6, 15 | ) where 16 | 17 | import Data.MemoTrie (HasTrie, memo, memo2, memo3, mup) 18 | 19 | -- | Memoize a quaternary function on successive arguments. 20 | -- Take care to exploit any partial evaluation. 21 | memo4 :: 22 | (HasTrie a, HasTrie b, HasTrie c, HasTrie d) => 23 | (a -> b -> c -> d -> e) -> 24 | (a -> b -> c -> d -> e) 25 | memo4 = mup memo3 26 | 27 | -- | Memoize a quaternary function on successive arguments. 28 | -- Take care to exploit any partial evaluation. 29 | memo5 :: 30 | (HasTrie a, HasTrie b, HasTrie c, HasTrie d, HasTrie e) => 31 | (a -> b -> c -> d -> e -> f) -> 32 | (a -> b -> c -> d -> e -> f) 33 | memo5 = mup memo4 34 | 35 | -- | Memoize a quaternary function on successive arguments. 36 | -- Take care to exploit any partial evaluation. 37 | memo6 :: 38 | (HasTrie a, HasTrie b, HasTrie c, HasTrie d, HasTrie e, HasTrie f) => 39 | (a -> b -> c -> d -> e -> f -> g) -> 40 | (a -> b -> c -> d -> e -> f -> g) 41 | memo6 = mup memo5 42 | -------------------------------------------------------------------------------- /inputs/2021/16.txt: -------------------------------------------------------------------------------- 1 | 220D62004EF14266BBC5AB7A824C9C1802B360760094CE7601339D8347E20020264D0804CA95C33E006EA00085C678F31B80010B88319E1A1802D8010D4BC268927FF5EFE7B9C94D0C80281A00552549A7F12239C0892A04C99E1803D280F3819284A801B4CCDDAE6754FC6A7D2F89538510265A3097BDF0530057401394AEA2E33EC127EC3010060529A18B00467B7ABEE992B8DD2BA8D292537006276376799BCFBA4793CFF379D75CA1AA001B11DE6428402693BEBF3CC94A314A73B084A21739B98000010338D0A004CF4DCA4DEC80488F004C0010A83D1D2278803D1722F45F94F9F98029371ED7CFDE0084953B0AD7C633D2FF070C013B004663DA857C4523384F9F5F9495C280050B300660DC3B87040084C2088311C8010C84F1621F080513AC910676A651664698DF62EA401934B0E6003E3396B5BBCCC9921C18034200FC608E9094401C8891A234080330EE31C643004380296998F2DECA6CCC796F65224B5EBBD0003EF3D05A92CE6B1B2B18023E00BCABB4DA84BCC0480302D0056465612919584662F46F3004B401600042E1044D89C200CC4E8B916610B80252B6C2FCCE608860144E99CD244F3C44C983820040E59E654FA6A59A8498025234A471ED629B31D004A4792B54767EBDCD2272A014CC525D21835279FAD49934EDD45802F294ECDAE4BB586207D2C510C8802AC958DA84B400804E314E31080352AA938F13F24E9A8089804B24B53C872E0D24A92D7E0E2019C68061A901706A00720148C404CA08018A0051801000399B00D02A004000A8C402482801E200530058AC010BA8018C00694D4FA2640243CEA7D8028000844648D91A4001088950462BC2E600216607480522B00540010C84914E1E0002111F21143B9BFD6D9513005A4F9FC60AB40109CBB34E5D89C02C82F34413D59EA57279A42958B51006A13E8F60094EF81E66D0E737AE08 2 | -------------------------------------------------------------------------------- /solutions/src/2016/15.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 15 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Solved using 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (format) 17 | import Advent.Chinese (chinese, toMod) 18 | 19 | -- | >>> :main 20 | -- Just 376777 21 | -- Just 3903937 22 | main :: IO () 23 | main = 24 | do input1 <- [format|2016 15 (Disc #%lu has %lu positions; at time=%lu, it is at position %lu.%n)*|] 25 | let input2 = input1 ++ [(fromIntegral (length input1) + 1, 11, 0, 0)] 26 | print (solve input1) 27 | print (solve input2) 28 | 29 | -- | Given a list of discs, find the right time to push the button. 30 | -- 31 | -- Example: 32 | -- 33 | -- @ 34 | -- Disc #1 has 5 positions; at time=0, it is at position 4. 35 | -- Disc #2 has 2 positions; at time=0, it is at position 1. 36 | -- @ 37 | -- 38 | -- >>> solve [(1, 5, 0, 4), (2, 2, 0, 1)] 39 | -- Just 5 40 | solve :: 41 | [(Integer, Integer, Integer, Integer)] {- ^ disc location, disc size, initial time, initial rotations -} -> 42 | Maybe Integer {- ^ time to press button -} 43 | solve discs = chinese [toMod (t-p-i) n | (i, n, t, p) <- discs] 44 | -------------------------------------------------------------------------------- /solutions/src/2021/25.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Coord (Coord(..), below, right) 15 | import Advent.Input (getInputMap) 16 | import Data.Map (Map) 17 | import Data.Map qualified as Map 18 | 19 | -- | >>> :main 20 | -- 582 21 | main :: IO () 22 | main = 23 | do inp <- getInputMap 2021 25 24 | let C ny nx = 1 + maximum (Map.keys inp) 25 | let inp' = Map.filter (`elem` ">v") inp 26 | let steps = iterate (step ny nx) inp' 27 | print (length (evolution steps)) 28 | 29 | evolution :: Eq a => [a] -> [a] 30 | evolution (x:y:_) | x == y = [x] 31 | evolution (x:xs) = x : evolution xs 32 | evolution [] = [] 33 | 34 | step :: Int -> Int -> Map Coord Char -> Map Coord Char 35 | step ny nx = step1 ny nx 'v' below . step1 ny nx '>' right 36 | 37 | step1 :: Int -> Int -> Char -> (Coord -> Coord) -> Map Coord Char -> Map Coord Char 38 | step1 ny nx c f inp = 39 | Map.fromList [ 40 | (if v == c && Map.notMember k' inp then k' else k, v) 41 | | (k, v) <- Map.toList inp 42 | , let k' = fixup (f k) 43 | ] 44 | where 45 | fixup (C y x) = C (y `mod` ny) (x `mod` nx) 46 | -------------------------------------------------------------------------------- /solutions/src/2015/18.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 18 solution 4 | Copyright : (c) Eric Mertens, 2021 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | -} 11 | module Main where 12 | 13 | import Advent (countBy, arrIx, times, getInputArray) 14 | import Advent.Coord (Coord(C), neighbors) 15 | import Data.Array.Unboxed (Ix(range), IArray(bounds), UArray, (!), amap, array, elems) 16 | 17 | type Lights = UArray Coord Bool 18 | 19 | main :: IO () 20 | main = 21 | do input <- amap ('#'==) <$> getInputArray 2015 18 22 | print $ countLights $ times 100 (applyRule life) input 23 | print $ countLights $ times 100 (applyRule (addCorners life)) input 24 | 25 | countLights :: Lights -> Int 26 | countLights = countBy id . elems 27 | 28 | type Rule = Lights -> Coord -> Bool 29 | 30 | applyRule :: Rule -> Lights -> Lights 31 | applyRule f a = array (bounds a) [(i, f a i) | i <- range (bounds a)] 32 | 33 | life :: Rule 34 | life a c = n == 3 || 35 | n == 2 && a!c 36 | where 37 | n = countBy (\x -> arrIx a x == Just True) (neighbors c) 38 | 39 | addCorners :: Rule -> Rule 40 | addCorners f a i@(C y x) 41 | | x == xlo || x == xhi 42 | , y == ylo || y == yhi = True 43 | | otherwise = f a i 44 | where 45 | (C ylo xlo, C yhi xhi) = bounds a 46 | -------------------------------------------------------------------------------- /solutions/src/2024/23.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 23 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format) 15 | import Advent.MaxClique (maxCliques) 16 | import Data.Foldable (maximumBy) 17 | import Data.List (intercalate) 18 | import Data.Map qualified as Map 19 | import Data.Ord (comparing) 20 | import Data.Set qualified as Set 21 | 22 | -- | >>> :main 23 | -- 1227 24 | -- cl,df,ft,ir,iy,ny,qp,rb,sh,sl,sw,wm,wy 25 | main :: IO () 26 | main = 27 | do input <- [format|2024 23 (%s-%s%n)*|] 28 | let ns = Set.elems (Set.fromList [x | (a, b) <- input, x <- [a, b]]) 29 | g = Map.fromListWith (<>) [(min a b, Set.singleton (max a b)) | (a, b) <- input] 30 | hasEdge a b = maybe False (Set.member (max a b)) (Map.lookup (min a b) g) 31 | print $ length 32 | [ () 33 | | (a, aEdges) <- Map.assocs g 34 | , (b, bEdges) <- Map.assocs (Map.restrictKeys g aEdges) 35 | , c <- Set.elems (Set.intersection aEdges bEdges) 36 | , any (\n -> head n == 't') [a, b, c] 37 | ] 38 | putStrLn $ intercalate "," 39 | $ maximumBy (comparing length) 40 | $ maxCliques hasEdge ns 41 | -------------------------------------------------------------------------------- /solutions/src/2016/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format, counts) 15 | import Data.Char (ord, chr) 16 | import Data.List (sortBy) 17 | import qualified Data.Map as Map 18 | 19 | type Entry = ([String], Int, String) 20 | 21 | -- | >>> :main 22 | -- 158835 23 | -- [993] 24 | main :: IO () 25 | main = 26 | do input <- [format|2016 4 ((%a+-)*%d[%a*]%n)*|] 27 | let valid = [e | e <- input, isGoodEntry e] 28 | print (sum [sid | (_, sid, _) <- valid]) 29 | print [sid | e@(_, sid, _) <- valid, decryptEntry e == "northpole object storage"] 30 | 31 | decryptEntry :: Entry -> String 32 | decryptEntry (name, sid, _) = unwords (map (map (decrypt sid)) name) 33 | 34 | isGoodEntry :: Entry -> Bool 35 | isGoodEntry (name, _, hash) = hash == computeHash (concat name) 36 | 37 | computeHash :: String -> String 38 | computeHash x = take 5 (map fst (sortBy ordering (Map.toList (counts x)))) 39 | where 40 | ordering (xa,xn) (ya,yn) 41 | = compare yn xn -- descending 42 | <> compare xa ya -- ascending 43 | 44 | decrypt :: Int -> Char -> Char 45 | decrypt n c = chr ((ord c - ord 'a' + n) `mod` 26 + ord 'a') 46 | -------------------------------------------------------------------------------- /solutions/src/2016/18.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 18 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Run Rule 90, a cellular automaton, for a few generations and count how many 12 | cells are turned on. 13 | 14 | 15 | 16 | -} 17 | module Main (main) where 18 | 19 | import Advent (count, format) 20 | 21 | -- | >>> :main 22 | -- 2005 23 | -- 20008491 24 | main :: IO () 25 | main = 26 | do input <- [format|2016 18 %s%n|] 27 | print (solve input 40) 28 | print (solve input 400000) 29 | 30 | -- | Given a seed and number of generations, count the safe tiles in the map. 31 | solve :: 32 | String {- ^ seed -} -> 33 | Int {- ^ generations -} -> 34 | Int {- ^ total safe tiles -} 35 | solve input n = count '.' (concat (take n (iterate next input))) 36 | 37 | -- | Update logic for rule 90 based on previous cell values. 38 | rule90 :: Char {- ^ left -} -> Char {- ^ center -} -> Char {- ^ right -} -> Char 39 | rule90 x _ y 40 | | x /= y = '^' 41 | | otherwise = '.' 42 | 43 | -- | Compute the next generation. 44 | next :: String -> String 45 | next (x:xs) = go '.' x xs 46 | where 47 | go a b [] = [rule90 a b '.'] 48 | go a b (c:cs) = rule90 a b c : go b c cs 49 | -------------------------------------------------------------------------------- /solutions/src/2025/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : 02 02 solution 5 | Copyright : (c) Eric Mertens, 2025 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :main + "11-22,95-115,998-1012,1188511880-1188511890,222220-222224,1698522-1698528,446443-446449,38593856-38593862,565653-565659,824824821-824824827,2121212118-2121212124\n" 12 | 1227775554 13 | 4174379265 14 | 15 | -} 16 | module Main (main) where 17 | 18 | import Advent (format, same, chunks) 19 | 20 | -- | >>> :main 21 | -- 28146997880 22 | -- 40028128307 23 | main :: IO () 24 | main = 25 | do 26 | input <- [format|2025 02 (%u-%u)&,%n|] 27 | let numbers = do (lo, hi) <- input; [lo .. hi] 28 | print (sum (filter part1 numbers)) 29 | print (sum (filter part2 numbers)) 30 | 31 | -- | Predicate for numbers that are made of the same 32 | -- sequence of digits repeated twice. 33 | part1 :: Int -> Bool 34 | part1 x = even n && a == b 35 | where 36 | str = show x 37 | n = length str 38 | (a, b) = splitAt (n `quot` 2) str 39 | 40 | -- | Predicate for numbers that are made of the same 41 | -- sequence of digits repeated at least twice. 42 | part2 :: Int -> Bool 43 | part2 x = or [same (chunks i str) | i <- [1 .. n `quot` 2], n `mod` i == 0] 44 | where 45 | str = show x 46 | n = length str 47 | -------------------------------------------------------------------------------- /inputs/2021/14.txt: -------------------------------------------------------------------------------- 1 | KFFNFNNBCNOBCNPFVKCP 2 | 3 | PB -> F 4 | KC -> F 5 | OB -> H 6 | HV -> N 7 | FS -> S 8 | CK -> K 9 | CC -> V 10 | HF -> K 11 | VP -> C 12 | CP -> S 13 | HO -> N 14 | OS -> N 15 | HS -> O 16 | HB -> F 17 | OH -> V 18 | PP -> B 19 | BS -> N 20 | VS -> F 21 | CN -> B 22 | KB -> O 23 | KH -> B 24 | SS -> K 25 | NS -> B 26 | BP -> V 27 | FB -> S 28 | PV -> O 29 | NB -> S 30 | FC -> F 31 | VB -> P 32 | PC -> O 33 | VF -> K 34 | BV -> K 35 | OO -> B 36 | PN -> N 37 | NH -> H 38 | SP -> B 39 | KF -> O 40 | BN -> F 41 | OF -> C 42 | VV -> H 43 | BB -> P 44 | KN -> H 45 | PO -> C 46 | BH -> O 47 | HC -> B 48 | VO -> O 49 | FV -> B 50 | PK -> V 51 | KO -> H 52 | BK -> V 53 | SC -> S 54 | KV -> B 55 | OV -> S 56 | HK -> F 57 | NP -> V 58 | VH -> P 59 | OK -> S 60 | SO -> C 61 | PF -> C 62 | SH -> N 63 | FP -> V 64 | CS -> C 65 | HH -> O 66 | KK -> P 67 | BF -> S 68 | NN -> O 69 | OC -> C 70 | CB -> O 71 | BO -> V 72 | ON -> F 73 | BC -> P 74 | NO -> N 75 | KS -> H 76 | FF -> V 77 | FN -> V 78 | HP -> N 79 | VC -> F 80 | OP -> K 81 | VN -> S 82 | NV -> F 83 | SV -> F 84 | FO -> V 85 | PS -> H 86 | VK -> O 87 | PH -> P 88 | NF -> N 89 | KP -> S 90 | CF -> S 91 | FK -> P 92 | FH -> F 93 | CO -> H 94 | SN -> B 95 | NC -> H 96 | SK -> P 97 | CV -> P 98 | CH -> H 99 | HN -> N 100 | SB -> H 101 | NK -> B 102 | SF -> H 103 | -------------------------------------------------------------------------------- /solutions/src/2024/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language ParallelListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + "MMMSXXMASM 13 | MSAMXMSMSA 14 | AMXSXMAAMM 15 | MSAMASMSMX 16 | XMASAMXAMM 17 | XXAMMXXAMA 18 | SMSMSASXSS 19 | SAXAMASAAA 20 | MAMMMXMMMM 21 | MXMXAXMASX 22 | " 23 | :} 24 | 18 25 | 9 26 | 27 | -} 28 | module Main (main) where 29 | 30 | import Advent (getInputArray, arrIx) 31 | import Advent.Coord (Coord(C), neighbors, origin) 32 | import Data.Array.Unboxed (assocs) 33 | 34 | -- | >>> :main 35 | -- 2434 36 | -- 1835 37 | main :: IO () 38 | main = 39 | do input <- getInputArray 2024 4 40 | 41 | print (length [() | (k, 'X') <- assocs input 42 | , d <- neighbors origin 43 | , and [Just a == arrIx input b | a <- "MAS" | b <- iterate (d+) (d+k)] 44 | ]) 45 | 46 | print (length [() | (k, 'A') <- assocs input 47 | , let cs = map (\x -> arrIx input (k+x)) corners 48 | , target <- ["MMSS", "MSSM", "SSMM", "SMMS"] 49 | , map Just target == cs]) 50 | 51 | -- | Diagonal corners of the origin in clockwise order. 52 | corners :: [Coord] 53 | corners = [C (-1) (-1), C (-1) 1, C 1 1, C 1 (-1)] 54 | -------------------------------------------------------------------------------- /solutions/src/2016/07.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, BlockArguments #-} 2 | {-| 3 | Module : Main 4 | Description : Day 7 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Control.Monad (guard) 16 | import Data.List (isInfixOf, tails) 17 | 18 | -- | >>> :main 19 | -- 118 20 | -- 260 21 | main :: IO () 22 | main = 23 | do xs <- [format|2016 7 ((%a*)&(]|[)%n)*|] 24 | print (length (filter supportsTLS xs)) 25 | print (length (filter supportsSSL xs)) 26 | 27 | split :: [String] -> ([String], [String]) 28 | split [] = ([],[]) 29 | split [x] = ([x],[]) 30 | split (x:y:z) = 31 | case split z of 32 | (a,b) -> (x:a,y:b) 33 | 34 | supportsTLS :: [String] -> Bool 35 | supportsTLS xs = 36 | case split xs of 37 | (supers, hypers) -> any hasABBA supers && not (any hasABBA hypers) 38 | where 39 | hasABBA ys = any isABBA (tails ys) 40 | 41 | isABBA (w:x:y:z:_) = w == z && x == y && w /= x 42 | isABBA _ = False 43 | 44 | supportsSSL :: [String] -> Bool 45 | supportsSSL xs = 46 | case split xs of 47 | (supers, hypers) -> 48 | not $ null 49 | do s <- supers 50 | x:y:z:_ <- tails s 51 | guard (x == z && x /= y) 52 | h <- hypers 53 | guard ( [y,x,y] `isInfixOf` h ) 54 | -------------------------------------------------------------------------------- /solutions/src/2020/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Password validation rules. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (countBy, count) 17 | import Advent.Format (format) 18 | 19 | type Input = (Int, Int, Char, String) 20 | 21 | -- | Check both password validation rules against the list of passwords. 22 | -- 23 | -- >>> :main 24 | -- 600 25 | -- 245 26 | main :: IO () 27 | main = 28 | do inp <- [format|2020 2 (%u-%u %c: %s%n)*|] 29 | print (countBy p1 inp) 30 | print (countBy p2 inp) 31 | 32 | -- | Target character must occur between low and high inclusive bounds. 33 | -- 34 | -- >>> p1 (1,3,'a',"abcde") 35 | -- True 36 | -- 37 | -- >>> p1 (1,3,'b',"cdefg") 38 | -- False 39 | -- 40 | -- >>> p1 (2,9,'c',"ccccccccc") 41 | -- True 42 | p1 :: Input -> Bool 43 | p1 (lo,hi,c,str) = lo <= n && n <= hi 44 | where n = count c str 45 | 46 | -- | Target character must occur at two given, 1-based indexes. 47 | -- 48 | -- >>> p2 (1,3,'a',"abcde") 49 | -- True 50 | -- 51 | -- >>> p2 (1,3,'b',"cdefg") 52 | -- False 53 | -- 54 | -- >>> p2 (2,9,'c',"ccccccccc") 55 | -- False 56 | p2 :: Input -> Bool 57 | p2 (i1,i2,c,str) = check i1 /= check i2 58 | where check i = (str !! (i-1)) == c 59 | -------------------------------------------------------------------------------- /solutions/src/2017/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Control.Monad.ST (ST, runST) 16 | import Data.Vector.Unboxed qualified as V 17 | import Data.Vector.Unboxed.Mutable qualified as M 18 | 19 | main :: IO () 20 | main = 21 | do input <- [format|2017 5 (%d%n)*|] 22 | print (solve part1 input) 23 | print (solve part2 input) 24 | 25 | -- | Update rules 26 | part1, part2 :: Int -> Int 27 | part1 x = x+1 28 | part2 x | x >= 3 = x-1 29 | | otherwise = x+1 30 | 31 | -- | Compute the number of steps until the program terminates given 32 | -- an update rule. 33 | -- 34 | -- >>> solve part1 [0,3,0,1,-3] 35 | -- 5 36 | -- >>> solve part2 [0,3,0,1,-3] 37 | -- 10 38 | solve :: 39 | (Int -> Int) {- ^ update rule -} -> 40 | [Int] {- ^ initial program -} -> 41 | Int {- ^ steps required -} 42 | solve f xs = runST (loop 0 0 =<< V.thaw (V.fromList xs)) 43 | where 44 | loop steps i mem 45 | | i < 0 || i >= M.length mem = pure $! steps 46 | | otherwise = 47 | do d <- M.read mem i 48 | M.write mem i (f d) 49 | loop (steps+1) (i+d) mem 50 | -------------------------------------------------------------------------------- /common/src/Advent/Fix.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost #-} 2 | {-| 3 | Module : Advent.Fix 4 | Description : Newtype for building recursive datatypes 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | -} 10 | module Advent.Fix where 11 | 12 | import Data.Functor.Classes (showsPrec1, Show1) 13 | import Data.Map (Map) 14 | import Data.Map qualified as Map 15 | 16 | -- | Fixed-point of a type 17 | newtype Fix f = Fix { unFix :: f (Fix f) } 18 | 19 | instance Show1 f => Show (Fix f) where 20 | showsPrec p (Fix x) = showParen (p >= 11) 21 | $ showString "Fix " 22 | . showsPrec1 11 x 23 | 24 | -- | Generic fold 25 | cata :: Functor t => (t a -> a) -> Fix t -> a 26 | cata f (Fix x) = f (fmap (cata f) x) 27 | 28 | -- | Generic monadic fold 29 | cataM :: Monad m => Traversable t => (t a -> m a) -> Fix t -> m a 30 | cataM f (Fix x) = f =<< traverse (cataM f) x 31 | 32 | -- | Generic unfold 33 | ana :: Functor f => (a -> f a) -> (a -> Fix f) 34 | ana f = Fix . fmap (ana f) . f 35 | 36 | -- | Convert a map of values parameterized by names into a recursively 37 | -- defined datatype. 38 | anaFromMap :: 39 | (Ord k, Functor f) => 40 | Map k (f k) {- ^ entries by name -} -> 41 | k {- ^ root name -} -> 42 | Fix f {- ^ root node with keys recursively resolved -} 43 | anaFromMap m = ana (m Map.!) 44 | -------------------------------------------------------------------------------- /solutions/src/2022/25.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 25 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "1=-0-2\n\ 14 | \12111\n\ 15 | \2=0=\n\ 16 | \21\n\ 17 | \2=01\n\ 18 | \111\n\ 19 | \20012\n\ 20 | \112\n\ 21 | \1=-1=\n\ 22 | \1-12\n\ 23 | \12\n\ 24 | \1=\n\ 25 | \122\n" 26 | :} 27 | 2=-1=0 28 | 29 | -} 30 | module Main where 31 | 32 | import Advent (format) 33 | 34 | -- | 35 | -- >>> :main 36 | -- 20-==01-2-=1-2---1-0 37 | main :: IO () 38 | main = 39 | do input <- [format|2022 25 (%s%n)*|] 40 | putStrLn (toSnafu (sum (map fromSnafu input))) 41 | 42 | fromSnafu :: String -> Int 43 | fromSnafu = foldl f 0 44 | where 45 | f acc c = 5 * acc + fromS c 46 | 47 | toSnafu :: Int -> String 48 | toSnafu = go "" 49 | where 50 | go acc 0 = acc 51 | go acc n = go (toS (m-2) : acc) n' 52 | where 53 | (n',m) = (n+2) `divMod` 5 54 | 55 | toS :: Int -> Char 56 | toS (-2) = '=' 57 | toS (-1) = '-' 58 | toS 0 = '0' 59 | toS 1 = '1' 60 | toS 2 = '2' 61 | toS _ = error "toS: bad digit" 62 | 63 | fromS :: Char -> Int 64 | fromS '2' = 2 65 | fromS '1' = 1 66 | fromS '0' = 0 67 | fromS '-' = -1 68 | fromS '=' = -2 69 | fromS _ = error "fromS: bad digit" 70 | -------------------------------------------------------------------------------- /inputs/2019/19.txt: -------------------------------------------------------------------------------- 1 | 109,424,203,1,21101,0,11,0,1105,1,282,21101,18,0,0,1105,1,259,2101,0,1,221,203,1,21101,31,0,0,1105,1,282,21102,38,1,0,1106,0,259,20101,0,23,2,21201,1,0,3,21101,1,0,1,21101,0,57,0,1105,1,303,2101,0,1,222,21001,221,0,3,21001,221,0,2,21101,259,0,1,21101,0,80,0,1106,0,225,21102,117,1,2,21102,91,1,0,1105,1,303,2101,0,1,223,20102,1,222,4,21102,1,259,3,21101,0,225,2,21102,1,225,1,21101,0,118,0,1105,1,225,21001,222,0,3,21102,1,77,2,21102,133,1,0,1105,1,303,21202,1,-1,1,22001,223,1,1,21102,1,148,0,1105,1,259,2102,1,1,223,21002,221,1,4,20101,0,222,3,21102,20,1,2,1001,132,-2,224,1002,224,2,224,1001,224,3,224,1002,132,-1,132,1,224,132,224,21001,224,1,1,21102,195,1,0,106,0,109,20207,1,223,2,20102,1,23,1,21101,0,-1,3,21101,0,214,0,1106,0,303,22101,1,1,1,204,1,99,0,0,0,0,109,5,1202,-4,1,249,21201,-3,0,1,21201,-2,0,2,22101,0,-1,3,21102,250,1,0,1106,0,225,22101,0,1,-4,109,-5,2105,1,0,109,3,22107,0,-2,-1,21202,-1,2,-1,21201,-1,-1,-1,22202,-1,-2,-2,109,-3,2106,0,0,109,3,21207,-2,0,-1,1206,-1,294,104,0,99,21202,-2,1,-2,109,-3,2105,1,0,109,5,22207,-3,-4,-1,1206,-1,346,22201,-4,-3,-4,21202,-3,-1,-1,22201,-4,-1,2,21202,2,-1,-1,22201,-4,-1,1,21202,-2,1,3,21102,1,343,0,1105,1,303,1106,0,415,22207,-2,-3,-1,1206,-1,387,22201,-3,-2,-3,21202,-2,-1,-1,22201,-3,-1,3,21202,3,-1,-1,22201,-3,-1,2,21202,-4,1,1,21102,384,1,0,1106,0,303,1105,1,415,21202,-4,-1,-4,22201,-4,-3,-4,22202,-3,-2,-2,22202,-2,-4,-4,22202,-3,-2,-3,21202,-4,-1,-2,22201,-3,-2,1,22101,0,1,-4,109,-5,2105,1,0 2 | -------------------------------------------------------------------------------- /solutions/src/2015/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Computes volumes and surface areas of boxes. 12 | 13 | >>> :main + "2x3x4\n" 14 | 58 15 | 34 16 | 17 | >>> :main + "1x1x10\n" 18 | 43 19 | 14 20 | 21 | -} 22 | module Main where 23 | 24 | import Advent (format) 25 | import Data.List (sort) 26 | 27 | data Package = Package Int Int Int 28 | data Face = Face Int Int 29 | 30 | -- | 31 | -- >>> :main 32 | -- 1606483 33 | -- 3842356 34 | main :: IO () 35 | main = 36 | do input <- [format|2015 2 (%ux%ux%u%n)*|] 37 | let packages = [Package x y z | (x,y,z) <- input] 38 | print (sum (part1 <$> packages)) 39 | print (sum (part2 <$> packages)) 40 | 41 | part1 :: Package -> Int 42 | part1 p = surfaceArea p + area (smallestFace p) 43 | 44 | part2 :: Package -> Int 45 | part2 p = volume p + perimeter (smallestFace p) 46 | 47 | volume :: Package -> Int 48 | volume (Package x y z) = x*y*z 49 | 50 | surfaceArea :: Package -> Int 51 | surfaceArea (Package x y z) = 2 * (x*y + x*z + y*z) 52 | 53 | smallestFace :: Package -> Face 54 | smallestFace (Package x y z) = let a:b:_ = sort [x,y,z] in Face a b 55 | 56 | area :: Face -> Int 57 | area (Face x y) = x*y 58 | 59 | perimeter :: Face -> Int 60 | perimeter (Face x y) = 2*(x+y) 61 | -------------------------------------------------------------------------------- /solutions/src/2015/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language BlockArguments, LambdaCase #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Password validation problems. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (getInputLines, countBy) 17 | import Data.List (isInfixOf, tails) 18 | 19 | main :: IO () 20 | main = 21 | do strs <- getInputLines 2015 5 22 | print (countBy part1 strs) 23 | print (countBy part2 strs) 24 | 25 | part1 :: String -> Bool 26 | part1 str = threeVowels str && hasDouble str && noProhibited str 27 | 28 | part2 :: String -> Bool 29 | part2 str = pairTwice str && nearby str 30 | 31 | threeVowels :: String -> Bool 32 | threeVowels = not . null . drop 2 . filter (`elem` "aeiou") 33 | 34 | hasDouble :: String -> Bool 35 | hasDouble = 36 | search \case 37 | x:y:_ -> x == y 38 | _ -> False 39 | 40 | noProhibited :: String -> Bool 41 | noProhibited str = not (any (`isInfixOf` str) ["ab","cd","pq","xy"]) 42 | 43 | search :: (String -> Bool) -> String -> Bool 44 | search p = any p . tails 45 | 46 | pairTwice :: String -> Bool 47 | pairTwice = 48 | search \case 49 | x:y:z -> [x,y] `isInfixOf` z 50 | _ -> False 51 | 52 | nearby :: String -> Bool 53 | nearby = 54 | search \case 55 | w:_:y:_ -> w == y 56 | _ -> False 57 | -------------------------------------------------------------------------------- /solutions/src/2022/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | " [D] \n\ 14 | \[N] [C] \n\ 15 | \[Z] [M] [P]\n\ 16 | \ 1 2 3 \n\ 17 | \\n\ 18 | \move 1 from 2 to 1\n\ 19 | \move 3 from 1 to 3\n\ 20 | \move 2 from 2 to 1\n\ 21 | \move 1 from 1 to 2\n" 22 | :} 23 | CMZ 24 | MCD 25 | 26 | -} 27 | module Main where 28 | 29 | import Data.List (transpose) 30 | import Data.Maybe (catMaybes) 31 | import Data.Map (Map) 32 | import Data.Map qualified as Map 33 | 34 | import Advent (format) 35 | 36 | main :: IO () 37 | main = 38 | do (toppart, labels, commands) <- [format|2022 5 39 | (( |[%c])& %n)* 40 | ( %c )& %n 41 | %n 42 | (move %u from %c to %c%n)*|] 43 | let stacks = Map.fromList (zip labels (map catMaybes (transpose toppart))) 44 | let solve f = map head (Map.elems (foldl (apply f) stacks commands)) 45 | putStrLn (solve (flip (foldl (flip (:))))) 46 | putStrLn (solve (++)) 47 | 48 | apply :: Ord k => ([a] -> [a] -> [a]) -> Map k [a] -> (Int, k, k) -> Map k [a] 49 | apply f stacks (n, fr, to) = 50 | case Map.alterF (traverse (splitAt n)) fr stacks of 51 | (a, m) -> Map.adjust (f a) to m 52 | -------------------------------------------------------------------------------- /solutions/src/2020/25.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes, ViewPatterns #-} 2 | {-| 3 | Module : Main 4 | Description : Day 25 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Brute-forcing this took me about 6 seconds, but using math makes it instant. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent.Format (format) 17 | import Data.Foldable (traverse_) 18 | import GHC.TypeNats (KnownNat, SomeNat(SomeNat), someNatVal) 19 | import Math.NumberTheory.Moduli ((^%), Mod, cyclicGroup, discreteLogarithm, getVal, isMultElement, isPrimitiveRoot) 20 | import Numeric.Natural (Natural) 21 | 22 | data DHParams = DH Integer Natural -- ^ generator modulus 23 | 24 | params :: DHParams 25 | params = DH 7 20201227 26 | 27 | -- | 28 | -- >>> :main 29 | -- 181800 30 | main :: IO () 31 | main = 32 | do (pub1,pub2) <- [format|2020 25 %lu%n%lu%n|] 33 | traverse_ print (hack params pub1 pub2) 34 | 35 | hack :: DHParams -> Integer -> Integer -> Maybe Integer 36 | hack (DH g (someNatVal -> SomeNat n)) (toMod n -> public1) (toMod n -> public2) = 37 | do cg <- cyclicGroup 38 | subject <- isPrimitiveRoot cg (fromInteger g) 39 | public' <- isMultElement public1 40 | pure (getVal (public2 ^% discreteLogarithm cg subject public')) 41 | 42 | toMod :: KnownNat m => proxy m -> Integer -> Mod m 43 | toMod _ = fromInteger 44 | -------------------------------------------------------------------------------- /solutions/src/2023/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2023 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | This problem asks us to consider the time we should spend 12 | charging up a toy car to beat a target distance. The distance 13 | the car will travel is a quadratic equation. What we end up 14 | doing is finding the distance between the roots of the function. 15 | 16 | -- >>> :{ 17 | :main + 18 | "Time: 7 15 30 19 | Distance: 9 40 200 20 | " 21 | :} 22 | 288 23 | 71503 24 | 25 | -} 26 | module Main (main) where 27 | 28 | import Advent (format, binSearchLargest) 29 | 30 | -- | 31 | -- 32 | -- >>> :main 33 | -- 281600 34 | -- 33875953 35 | main :: IO () 36 | main = 37 | do (times, distances) <- [format|2023 6 Time:( +%d!)*%nDistance:( +%d!)*%n|] 38 | let input1 = zip (map snd times) (map snd distances) 39 | input2 = (read (concatMap fst times), read (concatMap fst distances)) 40 | print (product (map ways input1)) 41 | print (ways input2) 42 | 43 | ways :: (Int, Int) -> Int 44 | ways (t, d) 45 | | valid mid = hi - tooLo 46 | | otherwise = 0 47 | where 48 | valid hold = (t - hold) * hold > d 49 | mid = t `div` 2 -- the midpoint is the best we can get 50 | tooLo = binSearchLargest (not . valid) 0 mid 51 | hi = binSearchLargest valid mid t 52 | -------------------------------------------------------------------------------- /solutions/src/2019/21.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 21 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format) 15 | import Data.Char (chr, ord) 16 | import Intcode (intcodeToList) 17 | import Debug.Trace 18 | 19 | -- | >>> :main 20 | -- 19355364 21 | -- 1142530574 22 | main :: IO () 23 | main = 24 | do inp <- [format|2019 21 %d&,%n|] 25 | let letsGo = print . last . intcodeToList inp . map ord 26 | letsGo part1 27 | letsGo part2 28 | 29 | eval :: [Int] -> [String] -> Either String Int 30 | eval pgm input 31 | | counter:_ <- filter ('#' `elem`) outLines = Left counter 32 | | otherwise = Right (last outs) 33 | where 34 | outs = intcodeToList pgm (map ord (unlines input)) 35 | outLines = lines (traceId (map chr outs)) 36 | 37 | 38 | -- !(A ∧ C) ∧ D # test cases didn't need B to be checked 39 | part1 :: String 40 | part1 = 41 | unlines 42 | [ "OR A J", 43 | "AND C J", 44 | "NOT J J", 45 | "AND D J", 46 | "WALK" ] 47 | 48 | -- !(A ∧ B ∧ C) ∧ D ∧ (E ∨ H) 49 | part2 :: String 50 | part2 = 51 | unlines 52 | [ "OR A J", 53 | "AND B J", 54 | "AND C J", 55 | "NOT J J", 56 | "AND D J", 57 | "OR E T", 58 | "OR H T", 59 | "AND T J", 60 | "RUN" ] 61 | -------------------------------------------------------------------------------- /solutions/src/2025/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language ParallelListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2025 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "987654321111111 14 | 811111111111119 15 | 234234234234278 16 | 818181911112111 17 | " 18 | :} 19 | 357 20 | 3121910778619 21 | 22 | -} 23 | module Main (main) where 24 | 25 | import Advent ( getInputLines ) 26 | import Data.Char ( digitToInt ) 27 | 28 | -- | >>> :main 29 | -- 17445 30 | -- 173229689350551 31 | main :: IO () 32 | main = 33 | do input <- getInputLines 2025 3 34 | let parts = map (solveLine . map digitToInt) input 35 | print (sum [p !! 1 | p <- parts]) 36 | print (sum [p !! 11 | p <- parts]) 37 | 38 | -- | Find the largest value that can be created by selecting 39 | -- each number of digits from the list starting at 1. 40 | solveLine :: 41 | [Int] {- ^ row of digits -} -> 42 | [Int] {- ^ largest value that can be selected for each size -} 43 | solveLine = foldl addDigit (repeat 0) 44 | 45 | -- | Given a list of best values so far when taking 46 | -- 1, 2 ... digits produce a new best list 47 | -- considering this new digit. 48 | addDigit :: [Int] -> Int -> [Int] 49 | addDigit prev d = 50 | [ max a (b * 10 + d) 51 | | a <- prev -- keep the old best value, or 52 | | b <- 0 : prev] -- add this digit to the best value one smaller 53 | -------------------------------------------------------------------------------- /solutions/src/2024/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ViewPatterns #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + "47|53 13 | 97|13 14 | 97|61 15 | 97|47 16 | 75|29 17 | 61|13 18 | 75|53 19 | 29|13 20 | 97|29 21 | 53|29 22 | 61|53 23 | 97|53 24 | 61|29 25 | 47|13 26 | 75|47 27 | 97|75 28 | 47|61 29 | 75|61 30 | 47|29 31 | 75|13 32 | 53|13\n 33 | 75,47,61,53,29 34 | 97,61,53,29,13 35 | 75,29,13 36 | 75,97,47,61,53 37 | 61,13,29 38 | 97,13,75,29,47 39 | " 40 | :} 41 | 143 42 | 123 43 | 44 | -} 45 | module Main (main) where 46 | 47 | import Advent (format) 48 | import Algebra.Graph.AdjacencyIntMap (edges, induce) 49 | import Algebra.Graph.AdjacencyIntMap.Algorithm (isTopSortOf, topSort) 50 | import Data.List (partition) 51 | 52 | -- | >>> :main 53 | -- 4996 54 | -- 6311 55 | main :: IO () 56 | main = 57 | do (ords, pagess) <- [format|2024 5 (%u%|%u%n)*%n(%u&,%n)*|] 58 | let graph = edges ords 59 | inputs = [(pages, induce (`elem` pages) graph) | pages <- pagess] 60 | (good, bad) = partition (uncurry isTopSortOf) inputs 61 | print (sum (map (middle . fst) good)) 62 | print (sum (map (either undefined middle . topSort . snd) bad)) 63 | 64 | -- | Return the middle element of an odd-length list. 65 | middle :: [a] -> a 66 | middle xs = xs !! (length xs `div` 2) 67 | -------------------------------------------------------------------------------- /solutions/src/2018/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2018 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Given a bunch of 2D regions find regions that do and do not overlap. 12 | 13 | >>> :{ 14 | :main + 15 | "#1 @ 1,3: 4x4\n\ 16 | \#2 @ 3,1: 4x4\n\ 17 | \#3 @ 5,5: 2x2\n" 18 | :} 19 | 4 20 | 3 21 | 22 | -} 23 | module Main (main) where 24 | 25 | import Advent (format, pickOne) 26 | import Advent.Box (Box(Dim, Pt), size, unionBoxes, intersectBox) 27 | import Data.List (tails) 28 | import Data.Maybe (isNothing) 29 | 30 | -- | Print the answers to part 1 and 2 of day 3's task. 31 | -- 32 | -- >>> :main 33 | -- 115304 34 | -- 275 35 | main :: IO () 36 | main = 37 | do input <- [format|2018 3 (#%u %@ %u,%u: %ux%u%n)*|] 38 | let boxes = [(i, Dim x (x+sx) (Dim y (y+sy) Pt)) | (i,x,y,sx,sy) <- input] 39 | print (part1 (map snd boxes)) 40 | print (part2 boxes) 41 | 42 | -- | Determine the size of the region covered by more than one patch 43 | part1 :: [Box n] -> Int 44 | part1 boxes = 45 | sum (map size (unionBoxes 46 | [q | p:ps <- tails boxes, Just q <- map (intersectBox p) ps])) 47 | 48 | -- | Determine identifier of patch with no overlaps. 49 | part2 :: [(i, Box n)] -> i 50 | part2 boxes = 51 | head [i | ((i,p),ps) <- pickOne boxes, all (isNothing . intersectBox p . snd) ps] 52 | -------------------------------------------------------------------------------- /solutions/src/2015/09.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 9 solution 5 | Copyright : (c) Eric Mertens, 2015 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "London to Dublin = 464\n\ 14 | \London to Belfast = 518\n\ 15 | \Dublin to Belfast = 141\n" 16 | :} 17 | 605 18 | 982 19 | 20 | -} 21 | module Main where 22 | 23 | import Advent.Format (format) 24 | import Data.List (permutations) 25 | import Data.Map (Map) 26 | import Data.Map qualified as Map 27 | import Data.Set qualified as Set 28 | 29 | data Edge = Edge String String deriving (Eq, Ord, Show, Read) 30 | 31 | edge :: String -> String -> Edge 32 | edge x y 33 | | x < y = Edge x y 34 | | otherwise = Edge y x 35 | 36 | -- | 37 | -- >>> :main 38 | -- 251 39 | -- 898 40 | main :: IO () 41 | main = 42 | do input <- [format|2015 9 (%s to %s = %u%n)*|] 43 | let graph = Map.fromList [(edge x y, d) | (x,y,d) <- input] 44 | places = uniques [z | (x,y,_) <- input, z <- [x,y]] 45 | costs = tripLength graph <$> permutations places 46 | print (minimum costs) 47 | print (maximum costs) 48 | 49 | tripLength :: Map Edge Int -> [String] -> Int 50 | tripLength m xs = sum (zipWith edgeLength xs (tail xs)) 51 | where 52 | edgeLength x y = m Map.! edge x y 53 | 54 | uniques :: Ord a => [a] -> [a] 55 | uniques = Set.toList . Set.fromList 56 | -------------------------------------------------------------------------------- /solutions/src/2018/10.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 10 solution 5 | Copyright : (c) Eric Mertens, 2018 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | In my original attempt I considered messages with a window size of 20. 12 | Now that I know the message is only 10 high, I've narrowed my predicate. 13 | 14 | -} 15 | module Main (main) where 16 | 17 | import Advent.Format (format) 18 | import Advent.Coord (coordRow, drawCoords, Coord(..)) 19 | import Data.Foldable (asum) 20 | import Data.List (transpose) 21 | import Data.Maybe (fromJust, isJust, isNothing) 22 | 23 | -- | Print the answers to day 10 24 | main :: IO () 25 | main = 26 | do let toSim (px, py, dx, dy) = iterate (C dy dx +) (C py px) 27 | input <- map toSim <$> [format|2018 10 (position=< *%d, *%d> velocity=< *%d, *%d>%n)*|] 28 | putStr $ fromJust $ asum $ zipWith draw [0..] $ transpose input 29 | 30 | -- | Given a number of seconds and the current list of particles, 31 | -- render the particles to a string when they are close enough together 32 | -- to be considered interesting to look at. 33 | draw :: Int -> [Coord] -> Maybe String 34 | draw i ps 35 | | hirow - lorow <= 10 = Just (show i ++ "\n" ++ picture) 36 | | otherwise = Nothing 37 | where 38 | lorow = minimum (map coordRow ps) 39 | hirow = maximum (map coordRow ps) 40 | picture = drawCoords ps 41 | -------------------------------------------------------------------------------- /solutions/src/2016/16.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 16 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Data.Vector.Unboxed (Vector) 16 | import Data.Vector.Unboxed qualified as Vector 17 | 18 | toBool :: Char -> Bool 19 | toBool x = x == '1' 20 | 21 | fromBool :: Bool -> Char 22 | fromBool x = if x then '1' else '0' 23 | 24 | part1, part2 :: Int 25 | part1 = 272 26 | part2 = 35651584 27 | 28 | expand :: Int -> Vector Bool -> Vector Bool 29 | expand n seed 30 | | Vector.length seed >= n = Vector.take n seed 31 | | otherwise = expand n 32 | $ seed <> Vector.singleton False <> 33 | Vector.map not (Vector.reverse seed) 34 | 35 | checksum :: Vector Bool -> [Char] 36 | checksum v 37 | | odd n = fromBool <$> Vector.toList v 38 | | otherwise = checksum 39 | $ Vector.generate (n`quot`2) $ \i -> 40 | v Vector.! (2*i) == v Vector.! (2*i+1) 41 | where 42 | n = Vector.length v 43 | 44 | -- | >>> :main 45 | -- 11111000111110000 46 | -- 10111100110110100 47 | main :: IO () 48 | main = 49 | do input <- [format|2016 16 (0|1)*!%n|] 50 | let v = Vector.fromList (toBool <$> input) 51 | putStrLn (checksum (expand part1 v)) 52 | putStrLn (checksum (expand part2 v)) 53 | -------------------------------------------------------------------------------- /solutions/src/2020/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Find entries in an /expense report/ that sum up to 2020 and return their 12 | product. 13 | 14 | -} 15 | module Main where 16 | 17 | import Advent.Format (format) 18 | import Data.List (sort) 19 | 20 | -- | >>> :main 21 | -- 494475 22 | -- 267520550 23 | main :: IO () 24 | main = 25 | do input <- [format|2020 1 (%u%n)*|] 26 | print (solve input 2) 27 | print (solve input 3) 28 | 29 | -- | Given a list of integer inputs, find the product of @count@ 30 | -- entries that sum up to @2020@. 31 | -- 32 | -- >>> solve [1721, 979, 366, 299, 675, 1456] 2 33 | -- 514579 34 | -- 35 | -- | >>> solve [1721, 979, 366, 299, 675, 1456] 3 36 | -- 241861950 37 | solve :: 38 | [Int] {- ^ inputs -} -> 39 | Int {- ^ count -} -> 40 | Int {- ^ product -} 41 | solve input n = solve' (sort input) n 2020 1 (error "no solution") 42 | 43 | solve' :: 44 | [Int] {- ^ sorted inputs -} -> 45 | Int {- ^ count -} -> 46 | Int {- ^ target sum -} -> 47 | Int {- ^ current product -} -> 48 | Int {- ^ next alternative -} -> 49 | Int {- ^ final product -} 50 | solve' _ 0 0 p _ = p 51 | solve' (x:xs) n s p e | 0 < n, x <= s = solve' xs (n-1) (s-x) (p*x) (solve' xs n s p e) 52 | solve' _ _ _ _ e = e 53 | -------------------------------------------------------------------------------- /inputs/2022/11.txt: -------------------------------------------------------------------------------- 1 | Monkey 0: 2 | Starting items: 50, 70, 89, 75, 66, 66 3 | Operation: new = old * 5 4 | Test: divisible by 2 5 | If true: throw to monkey 2 6 | If false: throw to monkey 1 7 | 8 | Monkey 1: 9 | Starting items: 85 10 | Operation: new = old * old 11 | Test: divisible by 7 12 | If true: throw to monkey 3 13 | If false: throw to monkey 6 14 | 15 | Monkey 2: 16 | Starting items: 66, 51, 71, 76, 58, 55, 58, 60 17 | Operation: new = old + 1 18 | Test: divisible by 13 19 | If true: throw to monkey 1 20 | If false: throw to monkey 3 21 | 22 | Monkey 3: 23 | Starting items: 79, 52, 55, 51 24 | Operation: new = old + 6 25 | Test: divisible by 3 26 | If true: throw to monkey 6 27 | If false: throw to monkey 4 28 | 29 | Monkey 4: 30 | Starting items: 69, 92 31 | Operation: new = old * 17 32 | Test: divisible by 19 33 | If true: throw to monkey 7 34 | If false: throw to monkey 5 35 | 36 | Monkey 5: 37 | Starting items: 71, 76, 73, 98, 67, 79, 99 38 | Operation: new = old + 8 39 | Test: divisible by 5 40 | If true: throw to monkey 0 41 | If false: throw to monkey 2 42 | 43 | Monkey 6: 44 | Starting items: 82, 76, 69, 69, 57 45 | Operation: new = old + 7 46 | Test: divisible by 11 47 | If true: throw to monkey 7 48 | If false: throw to monkey 4 49 | 50 | Monkey 7: 51 | Starting items: 65, 79, 86 52 | Operation: new = old + 5 53 | Test: divisible by 17 54 | If true: throw to monkey 5 55 | If false: throw to monkey 0 56 | -------------------------------------------------------------------------------- /solutions/src/2019/08.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, TemplateHaskell #-} 2 | {-| 3 | Module : Main 4 | Description : Day 8 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (count, chunks, format) 15 | import Control.Applicative ((<|>),many) 16 | import Data.List (minimumBy) 17 | import Data.Ord (comparing) 18 | 19 | type Layer = [[P]] 20 | 21 | data P = P0 | P1 | P2 22 | deriving (Eq, Ord, Show) 23 | 24 | mempty 25 | 26 | -- | >>> :main 27 | -- 2080 28 | -- ░██░░█░░█░███░░░██░░█░░░█ 29 | -- █░░█░█░░█░█░░█░█░░█░█░░░█ 30 | -- █░░█░█░░█░█░░█░█░░░░░█░█░ 31 | -- ████░█░░█░███░░█░░░░░░█░░ 32 | -- █░░█░█░░█░█░█░░█░░█░░░█░░ 33 | -- █░░█░░██░░█░░█░░██░░░░█░░ 34 | main :: IO () 35 | main = 36 | do inp <- [format|2019 8 @P*%n|] 37 | let layers = chunks 6 (chunks 25 inp) 38 | print (part1 layers) 39 | mapM_ (putStrLn . map render) (overlayLayers layers) 40 | 41 | render :: P -> Char 42 | render P0 = '\x2591' 43 | render P1 = '\x2588' 44 | render P2 = '\x2592' 45 | 46 | overlayLayers :: [Layer] -> Layer 47 | overlayLayers = foldr1 (zipWith (zipWith overlay)) 48 | 49 | overlay :: P -> P -> P 50 | overlay P2 x = x 51 | overlay x _ = x 52 | 53 | part1 :: [Layer] -> Int 54 | part1 layers = count P1 layer * count P2 layer 55 | where 56 | layer = minimumBy (comparing (count P0)) 57 | $ map concat layers 58 | -------------------------------------------------------------------------------- /solutions/src/2017/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (countBy, format) 15 | import Data.List (sort, nub) 16 | 17 | 18 | main :: IO () 19 | main = 20 | do input <- [format|2017 4 (%s& %n)*|] 21 | print (countBy allUnique input) 22 | print (countBy allUniqueModuloAnagrams input) 23 | 24 | 25 | -- | Predicate that returns true when all elements in the list are unique 26 | -- 27 | -- >>> allUnique (words "aa bb cc dd ee") 28 | -- True 29 | -- >>> allUnique (words "aa bb cc dd aa") 30 | -- False 31 | -- >>> allUnique (words "aa bb cc dd aaa") 32 | -- True 33 | allUnique :: Ord a => [a] -> Bool 34 | allUnique x = x == nub x 35 | 36 | 37 | -- | Predicate that returns true when all elements in the list are unique 38 | -- when considering anagrams equal to each other. 39 | -- 40 | -- >>> allUniqueModuloAnagrams (words "abcde fghij") 41 | -- True 42 | -- >>> allUniqueModuloAnagrams (words "abcde xyz ecdab") 43 | -- False 44 | -- >>> allUniqueModuloAnagrams (words "a ab abc abd abf abj") 45 | -- True 46 | -- >>> allUniqueModuloAnagrams (words "iiii oiii ooii oooi oooo") 47 | -- True 48 | -- >>> allUniqueModuloAnagrams (words "oiii ioii iioi iiio") 49 | -- False 50 | allUniqueModuloAnagrams :: Ord a => [[a]] -> Bool 51 | allUniqueModuloAnagrams = allUnique . map sort 52 | -------------------------------------------------------------------------------- /solutions/src/2019/05.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | This task expands the virtual machine defined in day 2 12 | adding jumps, conditionals, inputs, and outputs. 13 | 14 | This solution works with the following passes: 15 | 16 | 1. Parse input text file into a list of numbers 17 | 2. Execute op codes to extract the input/output "effects" 18 | 3. Evaluate the effect as a function from a list of inputs to list of outputs 19 | 4. Apply the function to a single input and find the last output. 20 | 21 | >>> intcodeToList [3,12,6,12,15,1,13,14,13,4,13,99,-1,0,1,9] <$> [[0],[10]] 22 | [[0],[1]] 23 | 24 | >>> intcodeToList [3,3,1105,-1,9,1101,0,0,12,4,12,99,1] <$> [[0],[10]] 25 | [[0],[1]] 26 | 27 | >>> :{ 28 | >>> intcodeToList 29 | >>> [3,21,1008,21,8,20,1005,20,22,107,8,21,20,1006,20,31, 30 | >>> 1106,0,36,98,0,0,1002,21,125,20,4,20,1105,1,46,104, 31 | >>> 999,1105,1,46,1101,1000,1,20,4,20,1105,1,46,98,99] 32 | >>> <$> [[7],[8],[9]] 33 | >>> :} 34 | [[999],[1000],[1001]] 35 | 36 | -} 37 | module Main (main) where 38 | 39 | import Advent (format) 40 | import Intcode (intcodeToList) 41 | 42 | -- | >>> :main 43 | -- 15508323 44 | -- 9006327 45 | main :: IO () 46 | main = 47 | do inp <- [format|2019 5 %d&,%n|] 48 | let go i = print (last (intcodeToList inp [i])) 49 | go 1 50 | go 5 51 | -------------------------------------------------------------------------------- /solutions/src/2020/07.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 7 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | The problem gives us a list of rules about the immediate contents 12 | of each color of bag. We use this to compute the transitive 13 | closure of bag contents in order to answer queries about a shiny 14 | gold bag. 15 | 16 | -} 17 | module Main (main) where 18 | 19 | import Advent (countBy) 20 | import Advent.Format (format) 21 | import Data.Map (Map) 22 | import Data.Map qualified as Map 23 | import Data.Maybe (fromMaybe) 24 | 25 | type Bag = (String, String) 26 | type Rule = (Bag, Maybe [(Integer, Bag)]) 27 | 28 | ------------------------------------------------------------------------ 29 | 30 | -- | 31 | -- >>> :main 32 | -- 268 33 | -- 7867 34 | main :: IO () 35 | main = 36 | do rules <- [format|2020 7 ((%s %s) bags contain (no other bags|(%lu (%s %s) bag(|s))&(, )).%n)*|] 37 | let tc = transClosBags rules 38 | k = ("shiny", "gold") 39 | print (countBy (Map.member k) tc) 40 | print (sum (tc Map.! k)) 41 | 42 | transClosBags :: [Rule] -> Map Bag (Map Bag Integer) 43 | transClosBags rules = tc 44 | where 45 | tc = expand <$> Map.fromList rules 46 | 47 | expand contents = 48 | Map.unionsWith (+) 49 | [ (n*) <$> Map.insertWith (+) bag 1 (tc Map.! bag) 50 | | (n, bag) <- fromMaybe [] contents] 51 | -------------------------------------------------------------------------------- /solutions/src/2021/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, TemplateHaskell #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Implement a simple submarine piloting/aiming command interpreter. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (format, stageTH) 17 | import Data.Foldable (foldMap') 18 | 19 | -- | Three possible commands a submarine can receive. 20 | data C = Cforward | Cdown | Cup 21 | 22 | stageTH 23 | 24 | -- | >>> :main 25 | -- 1636725 26 | -- 1872757425 27 | main :: IO () 28 | main = 29 | do inp <- [format|2021 2 (@C %u%n)*|] 30 | case foldMap' toS inp of 31 | S dx dy1 dy2 -> 32 | do print (dx*dy1) 33 | print (dx*dy2) 34 | 35 | -- | Computes the individual effect of a single instruction on a submarine. 36 | toS :: (C, Int) -> S 37 | toS (c,n) = 38 | case c of 39 | Cup -> S 0 (-n) 0 40 | Cdown -> S 0 n 0 41 | Cforward -> S n 0 0 42 | 43 | -- | Tracks the current state of the submarine's x displacement 44 | -- as well as the displacement for parts 1 and 2 45 | data S = S !Int !Int !Int -- dx dy1 dy2 46 | deriving Show 47 | 48 | -- | A submarine that hasn't moved and is at the origin. 49 | instance Monoid S where mempty = S 0 0 0 50 | 51 | -- | Composes two submarine movements from left to right. 52 | instance Semigroup S where S x1 y1 z1 <> S x2 y2 z2 = S (x1+x2) (y1+y2) (z1+z2+y1*x2) 53 | -------------------------------------------------------------------------------- /solutions/src/2018/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2018 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Day 1 gives us a list of differences to sum up. We compute the sum 12 | of these differences, and we search for duplicates in the partial 13 | sums of the differences list. 14 | 15 | -} 16 | module Main (main) where 17 | 18 | import Advent (format, partialSums) 19 | import Data.Maybe (fromJust) 20 | import Data.Set qualified as Set 21 | 22 | -- | Print the answers to the problem. 23 | -- 24 | -- >>> :main 25 | -- 474 26 | -- 137041 27 | main :: IO () 28 | main = 29 | do inp <- [format|2018 1 ((%+|)%ld%n)*|] 30 | print (sum inp) 31 | print (part2 inp) 32 | 33 | -- | Given the list of differences, find the first partial sum 34 | -- that repeats when we cycle the list of differences. 35 | -- 36 | -- >>> part2 [1,-1] 37 | -- 0 38 | -- >>> part2 [3,3,4,-2,-4] 39 | -- 10 40 | -- >>> part2 [-6,3,8,5,-6] 41 | -- 5 42 | -- >>> part2 [7,7,-2,-7,-4] 43 | -- 14 44 | part2 :: [Integer] -> Integer 45 | part2 = fromJust . firstDuplicate . partialSums . cycle 46 | 47 | -- | Find the first duplicate element in a list. 48 | firstDuplicate :: Ord a => [a] -> Maybe a 49 | firstDuplicate = go Set.empty 50 | where 51 | go _ [] = Nothing 52 | go seen (x:xs) 53 | | x `Set.member` seen = Just x 54 | | otherwise = go (Set.insert x seen) xs 55 | -------------------------------------------------------------------------------- /solutions/src/2021/11.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 11 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Simulating a sea of octopuses that flash when they get excited. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (count, getInputMap) 17 | import Advent.Coord (Coord(..), neighbors) 18 | import Data.Char (digitToInt) 19 | import Data.List (elemIndex, foldl') 20 | import Data.Map (Map) 21 | import Data.Map qualified as Map 22 | import Data.Maybe (fromJust) 23 | 24 | -- | >>> :main 25 | -- 1585 26 | -- 382 27 | main :: IO () 28 | main = 29 | do inp <- fmap digitToInt <$> getInputMap 2021 11 30 | let flashes = simulate inp 31 | print (sum (take 100 flashes)) 32 | print (1 + fromJust (elemIndex (Map.size inp) flashes)) 33 | 34 | -- | Initial grid state to flashes per step 35 | simulate :: Map Coord Int -> [Int] 36 | simulate = map (count 0) . tail . iterate step 37 | 38 | -- | Advance the state of the world one time step 39 | step :: Map Coord Int -> Map Coord Int 40 | step m = foldl' excite (fmap (1 +) m) [k | (k, 9) <- Map.toList m] 41 | 42 | -- | Excite an octopus at the given location 43 | excite :: Map Coord Int -> Coord -> Map Coord Int 44 | excite m x = 45 | case Map.lookup x m of 46 | Just e 47 | | e >= 9 -> foldl' excite (Map.insert x 0 m) (neighbors x) 48 | | e >= 1 -> Map.insert x (1 + e) m 49 | _ -> m 50 | -------------------------------------------------------------------------------- /solutions/src/2021/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Today we played Bingo and picked the first and last winning cards 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (format) 17 | import Data.List (partition, transpose) 18 | 19 | type Board = [[Int]] 20 | 21 | -- | >>> :main 22 | -- 49686 23 | -- 26878 24 | main :: IO () 25 | main = 26 | do (calls, boards) <- [format|2021 4 %u&,%n(%n(( *%u)+%n)+)*|] 27 | let outcomes = play calls boards 28 | print (head outcomes) 29 | print (last outcomes) 30 | 31 | -- | Given the called numbers and initial boards return a list of 32 | -- winning scores in order of winning. 33 | play :: [Int] -> [Board] -> [Int] 34 | play [] _ = [] 35 | play (c:calls) boards = 36 | case partition isWinner (map (mark c) boards) of 37 | (winners, losers) -> map (score c) winners ++ play calls losers 38 | 39 | -- | Mark off a called number on a board. 40 | mark :: Int -> Board -> Board 41 | mark c = map (map (\x -> if x == c then -1 else x)) 42 | 43 | -- | Compute the final score for a board given the last call and unmarked numbers. 44 | score :: Int -> Board -> Int 45 | score c b = c * sum (filter (-1 /=) (concat b)) 46 | 47 | -- | Predicate for boards with a completed row or column 48 | isWinner :: Board -> Bool 49 | isWinner b = f b || f (transpose b) 50 | where f = any (all (-1 ==)) 51 | -------------------------------------------------------------------------------- /solutions/src/2015/25.hs: -------------------------------------------------------------------------------- 1 | {-# Language MagicHash, UnboxedSums, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 25 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent.Format (format) 15 | import GHC.Natural (Natural) 16 | import GHC.Num.Integer (integerPowMod#) 17 | 18 | -- | >>> :main 19 | -- 8997277 20 | main :: IO () 21 | main = 22 | do (row,col) <- [format|2015 25 To continue, please consult the code grid in the manual. Enter the code at row %lu, column %lu.%n|] 23 | print (code row col) 24 | 25 | -- | Compute the value at a location on Santa's infinite sheet of paper. 26 | code :: 27 | Integer {- ^ row -} -> 28 | Integer {- ^ column -} -> 29 | Integer {- ^ cell value -} 30 | code row col 31 | = 20151125 32 | * powModInteger 252533 (cell (row-1) (col-1)) 33554393 33 | `mod` 33554393 34 | 35 | powModInteger :: Integer -> Integer -> Natural -> Integer 36 | powModInteger x y m = 37 | case integerPowMod# x y m of 38 | (# x | #) -> toInteger x 39 | (# | _ #) -> error "powModInteger: bad argument" 40 | 41 | -- | Compute zero-indexed cell of diagonally filled table using zero-indexed row, column. 42 | cell :: 43 | Integer {- ^ row -} -> 44 | Integer {- ^ column -} -> 45 | Integer 46 | cell r c = sum1N (r+c) + c 47 | 48 | -- | Compute sum of non-negative integers from 0 to the given upper bound. 49 | sum1N :: Integer {- ^ upper bound -} -> Integer 50 | sum1N n = n*(n+1)`quot`2 51 | -------------------------------------------------------------------------------- /solutions/src/2024/03.hs: -------------------------------------------------------------------------------- 1 | {-# Language LambdaCase #-} 2 | {-| 3 | Module : Main 4 | Description : Day 3 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :main + "xmul(2,4)&mul[3,7]!^don't()_mul(5,5)+mul(32,64](mul(11,8)undo()?mul(8,5))" 12 | 161 13 | 48 14 | 15 | -} 16 | module Main (main) where 17 | 18 | import Advent (getRawInput) 19 | import Advent.ReadS (P, runP, pread, string, (<++), pany, psatisfy) 20 | import Control.Applicative (asum, many, some, empty) 21 | import Data.Char (isDigit) 22 | 23 | -- | >>> :main 24 | -- 166357705 25 | -- 88811886 26 | main :: IO () 27 | main = 28 | do input <- runP (many pInstr) <$> getRawInput 2024 3 29 | print (part1 input) 30 | print (part2 input) 31 | 32 | part1 :: [Instr] -> Int 33 | part1 xs = sum [x * y | Mul x y <- xs] 34 | 35 | part2 :: [Instr] -> Int 36 | part2 = snd . foldl f (True, 0) 37 | where 38 | f (enabled, acc) = \case 39 | Do -> (True , acc) 40 | Don't -> (False , acc) 41 | Mul x y -> (enabled, if enabled then acc + x * y else acc) 42 | 43 | data Instr = Mul Int Int | Do | Don't 44 | deriving Show 45 | 46 | -- | Parse a number consisting of 1 to 3 digits. 47 | pInt :: P Int 48 | pInt = 49 | do str <- some (psatisfy isDigit) 50 | if length str <= 3 then pure (read str) else empty 51 | 52 | pInstr :: P Instr 53 | pInstr = asum 54 | [ Mul <$ string "mul(" <*> pInt <* string "," <*> pInt <* string ")" 55 | , Do <$ string "do()" 56 | , Don't <$ string "don't()" 57 | ] <++ pany *> pInstr 58 | -------------------------------------------------------------------------------- /solutions/src/2023/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2023 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | We get a list of the winning numbers and out numbers 12 | and have to figure out how many points we got and then 13 | using a recursive card winning system count up how many 14 | cards we played. 15 | 16 | >>> :{ 17 | :main + 18 | "Card 1: 41 48 83 86 17 | 83 86 6 31 17 9 48 53 19 | Card 2: 13 32 20 16 61 | 61 30 68 82 17 32 24 19 20 | Card 3: 1 21 53 59 44 | 69 82 63 72 16 21 14 1 21 | Card 4: 41 92 73 84 69 | 59 84 76 51 58 5 54 83 22 | Card 5: 87 83 26 28 32 | 88 30 70 12 93 22 82 36 23 | Card 6: 31 18 13 56 72 | 74 77 10 23 35 67 36 11 24 | " 25 | :} 26 | 13 27 | 30 28 | 29 | -} 30 | module Main (main) where 31 | 32 | import Advent (format) 33 | import Data.List (intersect) 34 | 35 | -- | Parse the input and print out the answers to both parts. 36 | -- 37 | -- >>> :main 38 | -- 21485 39 | -- 11024379 40 | main :: IO () 41 | main = 42 | do input <- [format|2023 4 (Card +%d:( +%d)* %|( +%d)*%n)*|] 43 | let wins = [length (a `intersect` b) | (_, a, b) <- input] 44 | print (sum (map points wins)) 45 | print (sum (asPart2 wins)) 46 | 47 | -- | Convert wins to points for part 1 48 | points :: Int -> Int 49 | points 0 = 0 50 | points n = 2 ^ (n - 1) 51 | 52 | -- | Convert a list of wins for each card into the number of cards 53 | -- each card turns into. 54 | asPart2 :: [Int] -> [Int] 55 | asPart2 = foldr (\wins xs -> 1 + sum (take wins xs) : xs) [] 56 | -------------------------------------------------------------------------------- /solutions/src/2024/20.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 20 solution 4 | Copyright : (c) Eric Mertens, 2024 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | -} 11 | module Main (main) where 12 | 13 | import Advent (getInputArray, arrIx, count) 14 | import Advent.Coord (Coord(C), cardinal, manhattan, coordRow, coordCol) 15 | import Advent.Search (dfs) 16 | import Data.Array.Unboxed (UArray, amap, assocs, accumArray, bounds) 17 | import Data.List (tails) 18 | 19 | -- >>> :main 20 | -- 1346 21 | -- 985482 22 | main :: IO () 23 | main = 24 | do input <- getInputArray 2024 20 25 | let open = amap ('#' /=) input 26 | start : _ = [p | (p, 'S') <- assocs input] 27 | step p = [p' | p' <- cardinal p, True <- arrIx open p'] 28 | path = dfs step start 29 | pathArray = accumArray (\_ e -> e) (-1) (bounds open) (zip path [0..]) :: UArray Coord Int 30 | (C loy lox, C hiy hix) = bounds input 31 | cheats = [ d 32 | | (p1, c1) <- zip path [0..] 33 | , y2 <- [max loy (coordRow p1 - 20) .. min hiy (coordRow p1 + 20)] 34 | , let dy = abs (coordRow p1 - y2) 35 | , x2 <- [max lox (coordCol p1 - 20 + dy) .. min hix (coordCol p1 + 20 - dy)] 36 | , let dx = abs (coordCol p1 - x2) 37 | , let d = dx + dy 38 | , c2 <- arrIx pathArray (C y2 x2) 39 | , c2 - c1 >= 100 + d 40 | ] 41 | print (count 2 cheats) 42 | print (length cheats) 43 | -------------------------------------------------------------------------------- /common/src/Advent/KnotHash.hs: -------------------------------------------------------------------------------- 1 | {-# Language DataKinds, BlockArguments, PatternSynonyms, ParallelListComp #-} 2 | module Advent.KnotHash (knotHash, tieKnots) where 3 | 4 | import Advent (chunks, fromDigits, partialSums) 5 | import Advent.Permutation (mkPermutation, runPermutation, Permutation, rotateLeft, rotateRight) 6 | import Data.Bits (Bits(xor)) 7 | import Data.Char (ord) 8 | import Data.Foldable (Foldable(foldl')) 9 | import Data.List (foldl1') 10 | import Data.Word (Word8) 11 | import GHC.TypeNats (SNat, pattern SNat, natSing, natVal, withSomeSNat) 12 | import Numeric.Natural (Natural) 13 | 14 | -- | Given a rope size and an input string, compute the resulting hash. 15 | knotHash :: 16 | String {- ^ input string -} -> 17 | Integer {- ^ knot value -} 18 | knotHash = 19 | fromDigits 256 . map (fromIntegral . foldl1' xor) . 20 | chunks 16 . tieKnots 256 . concat . replicate 64 . 21 | (++ [17, 31, 73, 47, 23]) . map ord 22 | 23 | -- | Create a rope, tie knots of the given lengths while skipping 24 | -- according to the increasing skip rule. 25 | tieKnots :: 26 | Natural {- ^ rope length -} -> 27 | [Int] {- ^ knot lengths -} -> 28 | [Int] {- ^ resulting rope -} 29 | tieKnots n lengths = 30 | withSomeSNat n \sn@SNat -> 31 | runPermutation id $ 32 | mconcat [ p sn offset len 33 | | offset <- partialSums (zipWith (+) [0..] lengths) 34 | | len <- lengths 35 | ] 36 | 37 | p :: SNat n -> Int -> Int -> Permutation n 38 | p n@SNat offset len = 39 | rotateLeft offset <> 40 | mkPermutation (\i -> if i < len then len - 1 - i else i) <> -- reverse first length elements 41 | rotateRight offset 42 | -------------------------------------------------------------------------------- /solutions/src/2019/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Format (format) 15 | import Intcode 16 | 17 | -- | >>> :main 18 | -- 7210630 19 | -- 3892 20 | main :: IO () 21 | main = 22 | do pgm <- new <$> [format|2019 2 %d&,%n|] 23 | print (startup 12 2 pgm) 24 | print (head [ 100 * noun + verb 25 | | noun <- [0..99] 26 | , verb <- [0..99] 27 | , startup noun verb pgm == 19690720 ]) 28 | 29 | -- | Run the given program after assigning the given noun and verb. 30 | startup :: Int {- ^ noun -} -> Int {- ^ verb -} -> Machine -> Int 31 | startup noun verb 32 | = (! 0) 33 | . runPgm 34 | . set 1 noun 35 | . set 2 verb 36 | 37 | -- | Run the given program starting at the given program counter 38 | -- returning the initial memory value once the program halts. 39 | -- 40 | -- >>> let check = memoryList . runPgm . new 41 | -- >>> check [1,0,0,0,99] 42 | -- [2,0,0,0,99] 43 | -- >>> check [2,3,0,3,99] 44 | -- [2,3,0,6,99] 45 | -- >>> check [2,4,4,5,99,0] 46 | -- [2,4,4,5,99,9801] 47 | -- >>> check [1,1,1,4,99,5,6,0,99] 48 | -- [30,1,1,4,2,5,6,0,99] 49 | -- >>> check [1,9,10,3,2,3,11,0,99,30,40,50] 50 | -- [3500,9,10,70,2,3,11,0,99,30,40,50] 51 | runPgm :: Machine -> Machine 52 | runPgm mach = 53 | case step mach of 54 | Step mach' -> runPgm mach' 55 | StepHalt -> mach 56 | _ -> error "Unexpected step on day 2" 57 | -------------------------------------------------------------------------------- /solutions/src/2022/12.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 12 solution 4 | Copyright : (c) Eric Mertens, 2022 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | >>> :{ 11 | :main + 12 | "Sabqponm\n\ 13 | \abcryxxl\n\ 14 | \accszExk\n\ 15 | \acctuvwj\n\ 16 | \abdefghi\n" 17 | :} 18 | 31 19 | 29 20 | 21 | -} 22 | module Main where 23 | 24 | import Data.Array.Unboxed (UArray, (!), assocs, amap) 25 | 26 | import Advent (getInputArray, arrIx) 27 | import Advent.Coord (Coord, cardinal) 28 | import Advent.Search (bfsOnN) 29 | 30 | -- | 31 | -- >>> :main 32 | -- 528 33 | -- 522 34 | main :: IO () 35 | main = 36 | do input <- getInputArray 2022 12 37 | print (solve input 'S') 38 | print (solve input 'a') 39 | 40 | -- | Given an input map and a starting letter, return the length of the shortest 41 | -- path to the ending letter (@E@). 42 | solve :: UArray Coord Char -> Char -> Int 43 | solve input startLetter = 44 | head [n | (e, n) <- bfsOnN fst step startStates, input ! e == 'E'] 45 | where 46 | startStates = [(k, 0) | (k, v) <- assocs input, v == startLetter] 47 | elevations = amap elevation input 48 | 49 | step (here, n) = 50 | [ (next, n+1) 51 | | next <- cardinal here 52 | , dest <- arrIx elevations next 53 | , succ (elevations ! here) >= dest 54 | ] 55 | 56 | -- | Compute the logical elevation by mapping start and end characters to 57 | -- their corresponding lowercase elevation values. 58 | elevation :: Char -> Char 59 | elevation 'S' = 'a' 60 | elevation 'E' = 'z' 61 | elevation x = x 62 | -------------------------------------------------------------------------------- /solutions/src/2017/15.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, NumDecimals #-} 2 | {-| 3 | Module : Main 4 | Description : Day 15 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Day 15 has us comparing two number sequence generators together to find 12 | pairs that match on the lowest 16 bits. 13 | 14 | -} 15 | module Main where 16 | 17 | import Advent (countBy, format) 18 | import Data.Bits ((.&.)) 19 | 20 | -- | Print the solution to Day 15. Input file can be overridden with 21 | -- command-line arguments. 22 | main :: IO () 23 | main = 24 | do (startA, startB) <- [format|2017 15 Generator A starts with %u%nGenerator B starts with %u%n|] 25 | 26 | print $ countBy (uncurry match) $ take 40e6 27 | $ zip (iterate nextA startA) 28 | (iterate nextB startB) 29 | 30 | print $ countBy (uncurry match) $ take 5e6 31 | $ zip (filter (isDivisibleBy 4) (iterate nextA startA)) 32 | (filter (isDivisibleBy 8) (iterate nextB startB)) 33 | 34 | -- | Check if the first 16-bits of a pairs of numbers match. 35 | match :: Int -> Int -> Bool 36 | match x y = x .&. 0xffff == y .&. 0xffff 37 | 38 | -- | Step functions for the generators. 39 | nextA, nextB :: Int -> Int 40 | nextA x = x * 16807 `rem` 0x7fffffff 41 | nextB x = x * 48271 `rem` 0x7fffffff 42 | 43 | -- | Returns true if the divisor evenly divides the dividend. 44 | -- 45 | -- >>> isDivisibleBy 2 10 46 | -- True 47 | -- >>> isDivisibleBy 3 10 48 | -- False 49 | isDivisibleBy :: 50 | Int {- ^ divisor -} -> 51 | Int {- ^ dividend -} -> 52 | Bool 53 | isDivisibleBy x y = y `rem` x == 0 54 | -------------------------------------------------------------------------------- /solutions/src/2025/07.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Main 3 | Description : Day 7 solution 4 | Copyright : (c) Eric Mertens, 2025 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | >>> :{ 11 | :main + 12 | ".......S....... 13 | ............... 14 | .......^....... 15 | ............... 16 | ......^.^...... 17 | ............... 18 | .....^.^.^..... 19 | ............... 20 | ....^.^...^.... 21 | ............... 22 | ...^.^...^.^... 23 | ............... 24 | ..^...^.....^.. 25 | ............... 26 | .^.^.^.^.^...^. 27 | ............... 28 | " 29 | :} 30 | 21 31 | 40 32 | 33 | -} 34 | module Main (main) where 35 | 36 | import Advent ( getInputArray, arrIx ) 37 | import Advent.Coord ( above, left, right, Coord(..) ) 38 | import Data.Array.Unboxed (range, (!), elems, indices, listArray, bounds, UArray, Array) 39 | 40 | -- | >>> :main 41 | -- 1541 42 | -- 80158285728929 43 | main :: IO () 44 | main = 45 | do input <- getInputArray 2025 7 46 | let beam = simulateBeam input 47 | 48 | print (length [() | ('^', n) <- elems input `zip` elems beam, n > 0]) 49 | 50 | let (C _ loc, C hir hic) = bounds input 51 | print (sum [beam ! i | i <- range (C hir loc, C hir hic) ]) 52 | 53 | simulateBeam :: UArray Coord Char -> Array Coord Int 54 | simulateBeam input = counts 55 | where 56 | check i xs = if arrIx input i `elem` map Just xs then counts ! i else 0 57 | counts = listArray (bounds input) 58 | [ if 'S' == input ! i then 1 else u + l + r 59 | | i <- indices input 60 | , let u = check (above i) "S." 61 | l = check (above (left i)) "^" 62 | r = check (above (right i)) "^" 63 | ] 64 | -------------------------------------------------------------------------------- /solutions/src/2017/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format) 15 | import Data.Char (digitToInt) 16 | 17 | 18 | -- | Print the solution to day 1. Input file can be overridden via the 19 | -- command-line. 20 | main :: IO () 21 | main = 22 | do xs <- map digitToInt <$> [format|2017 1 %s%n|] 23 | print (part1 xs) 24 | print (part2 xs) 25 | 26 | 27 | -- | Parse the first line of the input as a list of digits 28 | -- 29 | -- >>> parseInput "1234\n" 30 | -- [1,2,3,4] 31 | parseInput :: String -> [Int] 32 | parseInput = map digitToInt . head . lines 33 | 34 | 35 | -- | Compute checksum matching against next neighbor. 36 | -- 37 | -- >>> part1 [1,1,2,2] 38 | -- 3 39 | -- >>> part1 [1,1,1,1] 40 | -- 4 41 | -- >>> part1 [1,2,3,4] 42 | -- 0 43 | -- >>> part1 [9,1,2,1,2,1,2,9] 44 | -- 9 45 | part1 :: [Int] -> Int 46 | part1 = solve 1 47 | 48 | 49 | -- | Compute checksum matching against furthest neighbor. 50 | -- 51 | -- >>> part2 [1,2,1,2] 52 | -- 6 53 | -- >>> part2 [1,2,2,1] 54 | -- 0 55 | -- >>> part2 [1,2,3,4,2,5] 56 | -- 4 57 | -- >>> part2 [1,2,3,1,2,3] 58 | -- 12 59 | -- >>> part2 [1,2,1,3,1,4,1,5] 60 | -- 4 61 | part2 :: [Int] -> Int 62 | part2 xs = solve (length xs `div` 2) xs 63 | 64 | 65 | -- | Compute the sum of the elements of a list where the 66 | -- neighbor @n@ elements to the right (circularly) is a 67 | -- match. 68 | solve :: Int -> [Int] -> Int 69 | solve n xs = sum [ x | (x,y) <- xs `zip` drop n (cycle xs), x == y ] 70 | -------------------------------------------------------------------------------- /solutions/src/2023/13.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 13 solution 5 | Copyright : (c) Eric Mertens, 2023 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "#.##..##. 14 | ..#.##.#. 15 | ##......# 16 | ##......# 17 | ..#.##.#. 18 | ..##..##. 19 | #.#.##.#.\n 20 | #...##..# 21 | #....#..# 22 | ..##..### 23 | #####.##. 24 | #####.##. 25 | ..##..### 26 | #....#..# 27 | " 28 | :} 29 | 405 30 | 400 31 | 32 | -} 33 | module Main (main) where 34 | 35 | import Advent (format) 36 | import Data.List (tails, transpose) 37 | 38 | -- | 39 | -- 40 | -- >>> :main 41 | -- 28895 42 | -- 31603 43 | main :: IO () 44 | main = 45 | do input <- [format|2023 13 (%s%n)*&%n|] 46 | print (sum (map (solver 0) input)) 47 | print (sum (map (solver 1) input)) 48 | 49 | findReflection :: Int -> [String] -> [Int] 50 | findReflection differences xs = 51 | [ i 52 | | (i, l, r) <- zip3 [0..] (inits' xs) (tails xs) 53 | , not (null l), not (null r) 54 | , let diff x y = if x == y then 0 else 1 55 | , differences == sum2 (sum2 diff) l r 56 | ] 57 | 58 | solver :: Int -> [String] -> Int 59 | solver n xs = 60 | head (findReflection n (transpose xs) ++ map (100 *) (findReflection n xs)) 61 | 62 | -- | Like inits, but the prefixes are built up in reverse 63 | -- >>> inits' [1,2,3] 64 | -- [[],[1],[2,1],[3,2,1]] 65 | inits' :: [a] -> [[a]] 66 | inits' = scanl (flip (:)) [] 67 | 68 | -- | Kind of a generalized dot-product. Trims off longer list. 69 | -- >>> sum2 (*) [2,3] [10,100,1000] 70 | -- 320 71 | sum2 :: Num c => (a -> b -> c) -> [a] -> [b] -> c 72 | sum2 f xs ys = sum (zipWith f xs ys) 73 | -------------------------------------------------------------------------------- /solutions/src/2017/19.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Advent.Coord 3 | Description : Day 19 solution 4 | Copyright : (c) Eric Mertens, 2017 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | 9 | 10 | Day 19 has us follow an ASCII art trail and report on the letters 11 | we find along the way as well as the total trail path length. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent.Input (getInputArray) 17 | import Advent.Coord (Coord(..), north, east, south, west) 18 | import Data.Char (isAlpha) 19 | import Data.Array.Unboxed (UArray, (!), assocs) 20 | 21 | -- | Print the solutions to both parts of day 19. Input file can be 22 | -- overridden via the command-line arguments. 23 | main :: IO () 24 | main = 25 | do input <- getInputArray 2017 19 26 | 27 | let start:_ = [c | (c@(C 0 _), '|') <- assocs input] 28 | path = toPath input south start 29 | 30 | putStrLn (filter isAlpha path) 31 | print (length path) 32 | 33 | -- | Return the path given a map, current travel direction, 34 | -- and current location. 35 | toPath :: 36 | UArray Coord Char {- ^ map -} -> 37 | Coord {- ^ direction -} -> 38 | Coord {- ^ location -} -> 39 | String {- ^ path -} 40 | toPath grid d c = 41 | let isPath d' = grid ! (c + d') /= ' ' 42 | next d' = toPath grid d' (c + d') in 43 | case grid ! c of 44 | ' ' -> [] 45 | '+' | d /= south, isPath north -> '+' : next north 46 | | d /= north, isPath south -> '+' : next south 47 | | d /= west, isPath east -> '+' : next east 48 | | d /= east, isPath west -> '+' : next west 49 | a -> a : next d 50 | -------------------------------------------------------------------------------- /solutions/src/2017/06.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 6 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent 15 | import Data.Map qualified as Map 16 | import Data.Vector.Unboxed (Vector) 17 | import Data.Vector.Unboxed qualified as V 18 | 19 | main :: IO () 20 | main = 21 | do input <- [format|2017 6 %u&%t%n|] 22 | print (solve (V.fromList input)) 23 | 24 | -- | Compute both parts of Day 6 25 | -- 26 | -- >>> solve (V.fromList [0,2,7,0]) 27 | -- (5,4) 28 | solve :: Vector Int -> (Int,Int) 29 | solve = findLoop . iterate step 30 | 31 | -- | Computes the steps until a state repeats and also the length of the loop 32 | -- 33 | -- >>> findLoop [1,2,3,4,5,6,7,5] 34 | -- (7,3) 35 | -- >>> findLoop [1,1] 36 | -- (1,1) 37 | -- >>> findLoop [0,1,1] 38 | -- (2,1) 39 | findLoop :: Ord a => [a] -> (Int,Int) 40 | findLoop = go Map.empty 41 | where 42 | go seen (x:xs) = 43 | let n = Map.size seen in 44 | case Map.lookup x seen of 45 | Nothing -> go (Map.insert x n seen) xs 46 | Just i -> (n, n-i) 47 | 48 | -- | Given a vector representing the memory banks compute the new memory bank 49 | -- layout. 50 | -- 51 | -- >>> step (V.fromList [0,2,7,0]) 52 | -- [2,4,1,2] 53 | -- >>> step (V.fromList [2,4,1,2]) 54 | -- [3,1,2,3] 55 | -- >>> step (V.fromList [3,1,2,3]) 56 | -- [0,2,3,4] 57 | step :: Vector Int -> Vector Int 58 | step xs = V.accum (+) xs ((i, -mx) : [ (j`rem`n, 1) | j <- [i+1 .. i+mx]]) 59 | where 60 | mx = V.maximum xs 61 | Just i = V.elemIndex mx xs 62 | n = V.length xs 63 | -------------------------------------------------------------------------------- /solutions/src/2019/16.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 16 solution 5 | Copyright : (c) Eric Mertens, 2019 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent (format) 15 | import Data.Char (digitToInt) 16 | import Data.Vector.Unboxed qualified as V 17 | 18 | -- | >>> :main 19 | -- 27229269 20 | -- 26857164 21 | main :: IO () 22 | main = 23 | do inp <- [format|2019 16 %s%n|] 24 | let ns = digits inp 25 | 26 | putStrLn $ concatMap show $ V.toList $ V.take 8 $ iterate (fft 0) ns !! 100 27 | 28 | let offset = read (take 7 inp) 29 | 30 | let ns' = V.concat (replicate 10000 ns) 31 | putStrLn $ concatMap show $ V.toList $ V.take 8 $ V.drop offset $ iterate (fft offset) ns' !! 100 32 | 33 | digits :: String -> V.Vector Int 34 | digits = V.fromList . map digitToInt 35 | 36 | fft :: Int -> V.Vector Int -> V.Vector Int 37 | fft offset xs = V.generate (V.length xs) one 38 | where 39 | n = V.length xs 40 | ps = V.scanl (+) 0 xs 41 | factors i = takeWhile (\(Region _ a _) -> a < n) (regions i) 42 | 43 | one i 44 | | i < offset = 0 45 | | otherwise = abs $ sum [ m * (ps V.! min n end - ps V.! start) 46 | | Region m start end <- factors i] 47 | `rem` 10 48 | 49 | data Region = Region !Int !Int !Int 50 | deriving Show 51 | 52 | regions :: Int -> [Region] 53 | regions i = go 0 54 | where 55 | n = i + 1 56 | go offset = Region 1 (offset + i) (offset + i+n) 57 | : Region (-1) (offset + i + n*2) (offset + i+n*2+ n) 58 | : go (offset + 4 * n) 59 | -------------------------------------------------------------------------------- /solutions/src/2020/24.hs: -------------------------------------------------------------------------------- 1 | {-# Language TemplateHaskell, ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 24 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Cellular automaton on a hexagonal grid 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (counts, stageTH, times) 17 | import Advent.Coord (Coord, north, east, south, west) 18 | import Advent.Format (format) 19 | import Data.Foldable (foldl') 20 | import Data.Map (Map) 21 | import Data.Map.Strict qualified as Map 22 | import Data.Set (Set) 23 | import Data.Set qualified as Set 24 | 25 | data D = De | Dne | Dse | Dw | Dnw | Dsw 26 | 27 | stageTH 28 | 29 | -- | 30 | -- >>> :main 31 | -- 400 32 | -- 3768 33 | main :: IO () 34 | main = 35 | do inp <- [format|2020 24 (@D*%n)*|] 36 | let board = odds (map walk inp) 37 | print (Set.size board) 38 | print (Set.size (times 100 step board)) 39 | 40 | odds :: Ord a => [a] -> Set a 41 | odds = Map.keysSet . Map.filter odd . counts 42 | 43 | step :: Set Coord -> Set Coord 44 | step board 45 | = Map.keysSet 46 | $ Map.filterWithKey rule 47 | $ Map.unionsWith (+) 48 | [Map.mapKeysMonotonic (c +) neighborhood 49 | | c <- Set.toList board] 50 | where 51 | rule k v = v == 2 || v == 1 && Set.member k board 52 | 53 | neighborhood :: Map Coord Int 54 | neighborhood = counts (map translate [Dw,De,Dne,Dse,Dnw,Dsw]) 55 | 56 | walk :: [D] -> Coord 57 | walk = sum . map translate 58 | 59 | translate :: D -> Coord 60 | translate Dw = west 61 | translate De = east 62 | translate Dne = north + east 63 | translate Dse = south 64 | translate Dnw = north 65 | translate Dsw = south + west 66 | -------------------------------------------------------------------------------- /solutions/src/2023/21.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, TemplateHaskell, BangPatterns, BlockArguments, LambdaCase, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 21 solution 5 | Copyright : (c) Eric Mertens, 2023 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | The input cases are real super special for part 2, 12 | don't bother thinking about them too hard, just 13 | extrapolate and check. 14 | 15 | -} 16 | module Main (main) where 17 | 18 | import Advent (getInputArray, times, ordNub, arrIx) 19 | import Advent.Coord (Coord(..), cardinal) 20 | import Data.Array.Unboxed (UArray, bounds, assocs, amap) 21 | 22 | main :: IO () 23 | main = 24 | do input <- getInputArray 2023 21 25 | let start = head [ start | (start, 'S') <- assocs input] 26 | let input' = amap (\x -> x == 'S' || x == '.') input :: UArray Coord Bool 27 | 28 | print $ length $ times 64 (ordNub . concatMap (step input')) [start] 29 | 30 | let t0 = length $ times (65+131*0) (ordNub . concatMap (step input')) [start] 31 | let t1 = length $ times (65+131*1) (ordNub . concatMap (step input')) [start] 32 | let t2 = length $ times (65+131*2) (ordNub . concatMap (step input')) [start] 33 | 34 | let d01 = t1 - t0 35 | let d12 = t2 - t1 36 | let d01_12 = d12 - d01 37 | 38 | let f x = t0 + (t1-t0) * x + x * (x-1) `quot` 2 * d01_12 39 | print (f (26501365 `quot` 131)) 40 | 41 | step :: UArray Coord Bool -> Coord -> [Coord] 42 | step input here = 43 | [ here' 44 | | here' <- cardinal here 45 | , let (_, C ymax xmax) = bounds input 46 | , let modIt (C y x) = C (y `mod` (ymax+1)) (x `mod` (xmax+1)) 47 | , let hereLogical = modIt here' 48 | , True <- arrIx input hereLogical 49 | ] 50 | -------------------------------------------------------------------------------- /inputs/2022/10.txt: -------------------------------------------------------------------------------- 1 | noop 2 | noop 3 | addx 6 4 | addx -1 5 | noop 6 | addx 5 7 | addx 3 8 | noop 9 | addx 3 10 | addx -1 11 | addx -13 12 | addx 17 13 | addx 3 14 | addx 3 15 | noop 16 | noop 17 | noop 18 | addx 5 19 | addx 1 20 | noop 21 | addx 4 22 | addx 1 23 | noop 24 | addx -38 25 | addx 5 26 | noop 27 | addx 2 28 | addx 3 29 | noop 30 | addx 2 31 | addx 2 32 | addx 3 33 | addx -2 34 | addx 5 35 | addx 2 36 | addx -18 37 | addx 6 38 | addx 15 39 | addx 5 40 | addx 2 41 | addx -22 42 | noop 43 | noop 44 | addx 30 45 | noop 46 | noop 47 | addx -39 48 | addx 1 49 | addx 19 50 | addx -16 51 | addx 35 52 | addx -28 53 | addx -1 54 | addx 12 55 | addx -8 56 | noop 57 | addx 3 58 | addx 4 59 | noop 60 | addx -3 61 | addx 6 62 | addx 5 63 | addx 2 64 | noop 65 | noop 66 | noop 67 | noop 68 | noop 69 | addx 7 70 | addx -39 71 | noop 72 | noop 73 | addx 5 74 | addx 2 75 | addx 2 76 | addx -1 77 | addx 2 78 | addx 2 79 | addx 5 80 | addx 1 81 | noop 82 | addx 4 83 | addx -13 84 | addx 18 85 | noop 86 | noop 87 | noop 88 | addx 12 89 | addx -9 90 | addx 8 91 | noop 92 | noop 93 | addx -2 94 | addx -36 95 | noop 96 | noop 97 | addx 5 98 | addx 2 99 | addx 3 100 | addx -2 101 | addx 2 102 | addx 2 103 | noop 104 | addx 3 105 | addx 5 106 | addx 2 107 | addx 19 108 | addx -14 109 | noop 110 | addx 2 111 | addx 3 112 | noop 113 | addx -29 114 | addx 34 115 | noop 116 | addx -35 117 | noop 118 | addx -2 119 | addx 2 120 | noop 121 | addx 6 122 | noop 123 | noop 124 | noop 125 | noop 126 | addx 2 127 | noop 128 | addx 3 129 | addx 2 130 | addx 5 131 | addx 2 132 | addx 1 133 | noop 134 | addx 4 135 | addx -17 136 | addx 18 137 | addx 4 138 | noop 139 | addx 1 140 | addx 4 141 | noop 142 | addx 1 143 | noop 144 | noop 145 | -------------------------------------------------------------------------------- /solutions/src/2016/12.hs: -------------------------------------------------------------------------------- 1 | {-# Language RankNTypes, ImportQualifiedPost, LambdaCase #-} 2 | {-| 3 | Module : Main 4 | Description : Day 12 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (getInputLines) 15 | import Advent.ReadS 16 | import Advent.AsmProg 17 | import Control.Applicative (Alternative((<|>), empty)) 18 | import Control.Lens ((^.), (&~), (+=), (-=), (.=), (<~)) 19 | import Data.Foldable (for_) 20 | import Data.Vector (Vector) 21 | import Data.Vector qualified as Vector 22 | 23 | -- | >>> :main 24 | -- 318077 25 | -- 9227731 26 | main :: IO () 27 | main = 28 | do program <- Vector.fromList . map (runP pInst) <$> getInputLines 2016 12 29 | print (execute program 0) 30 | print (execute program 1) 31 | 32 | data Inst 33 | = Copy !Value !Register 34 | | Inc !Register 35 | | Dec !Register 36 | | Jnz !Value !Int 37 | deriving Show 38 | 39 | pInst :: P Inst 40 | pInst = P lex >>= \case 41 | "cpy" -> Copy <$> pValue <*> pReg 42 | "jnz" -> Jnz <$> pValue <*> P reads 43 | "inc" -> Inc <$> pReg 44 | "dec" -> Dec <$> pReg 45 | _ -> empty 46 | 47 | execute :: Vector Inst -> Int -> Int 48 | execute program c = (zeroRegisters &~ entry) ^. reg A 49 | where 50 | entry = 51 | do reg C .= c 52 | goto 0 53 | 54 | step = \case 55 | Copy i o -> 1 <$ (reg o <~ rval i) 56 | Inc r -> 1 <$ (reg r += 1) 57 | Dec r -> 1 <$ (reg r -= 1) 58 | Jnz i o -> do v <- rval i 59 | return $! if v == 0 then 1 else o 60 | 61 | goto pc = 62 | for_ (program Vector.!? pc) $ \o -> 63 | do offset <- step o 64 | goto (pc + offset) 65 | -------------------------------------------------------------------------------- /solutions/src/2016/14.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 14 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Crypto.Hash.MD5 (hash) 16 | import Data.ByteString qualified as B 17 | import Data.ByteString.Builder (byteStringHex) 18 | import Data.ByteString.Builder.Extra (toLazyByteStringWith, untrimmedStrategy) 19 | import Data.ByteString.Char8 qualified as B8 20 | import Data.ByteString.Lazy qualified as L 21 | import Data.List (isInfixOf, tails) 22 | 23 | -- | >>> :main 24 | -- 15168 25 | -- 20864 26 | main :: IO () 27 | main = 28 | do input <- [format|2016 14 %s%n|] 29 | print (solve input 1) 30 | print (solve input 2017) 31 | 32 | -- | Hash a bytestring to to ASCII encoded, lowercase hex 33 | hashmd5 :: B.ByteString -> B.ByteString 34 | hashmd5 35 | = L.toStrict 36 | . toLazyByteStringWith md5strategy L.empty 37 | . byteStringHex 38 | . hash 39 | where 40 | md5strategy = untrimmedStrategy 32 32 41 | 42 | iteratedHash :: Int -> B.ByteString -> B.ByteString 43 | iteratedHash n x 44 | | n <= 0 = x 45 | | otherwise = iteratedHash (n-1) (hashmd5 x) 46 | 47 | seed :: String -> Int -> B.ByteString 48 | seed input i = B8.pack (input ++ show i) 49 | 50 | solve :: String -> Int -> Int 51 | solve input iterations = 52 | search (map (B8.unpack . iteratedHash iterations . seed input) [0..]) !! 63 53 | 54 | search :: [String] -> [Int] 55 | search hashes = 56 | [ i | (i,h:hs) <- zip [0..] (tails hashes) 57 | , start <- take 1 [ x | x:y:z:_ <- tails h, x==y, y==z] 58 | , any (replicate 5 start `isInfixOf`) (take 1000 hs) 59 | ] 60 | -------------------------------------------------------------------------------- /inputs/2017/25.txt: -------------------------------------------------------------------------------- 1 | Begin in state A. 2 | Perform a diagnostic checksum after 12302209 steps. 3 | 4 | In state A: 5 | If the current value is 0: 6 | - Write the value 1. 7 | - Move one slot to the right. 8 | - Continue with state B. 9 | If the current value is 1: 10 | - Write the value 0. 11 | - Move one slot to the left. 12 | - Continue with state D. 13 | 14 | In state B: 15 | If the current value is 0: 16 | - Write the value 1. 17 | - Move one slot to the right. 18 | - Continue with state C. 19 | If the current value is 1: 20 | - Write the value 0. 21 | - Move one slot to the right. 22 | - Continue with state F. 23 | 24 | In state C: 25 | If the current value is 0: 26 | - Write the value 1. 27 | - Move one slot to the left. 28 | - Continue with state C. 29 | If the current value is 1: 30 | - Write the value 1. 31 | - Move one slot to the left. 32 | - Continue with state A. 33 | 34 | In state D: 35 | If the current value is 0: 36 | - Write the value 0. 37 | - Move one slot to the left. 38 | - Continue with state E. 39 | If the current value is 1: 40 | - Write the value 1. 41 | - Move one slot to the right. 42 | - Continue with state A. 43 | 44 | In state E: 45 | If the current value is 0: 46 | - Write the value 1. 47 | - Move one slot to the left. 48 | - Continue with state A. 49 | If the current value is 1: 50 | - Write the value 0. 51 | - Move one slot to the right. 52 | - Continue with state B. 53 | 54 | In state F: 55 | If the current value is 0: 56 | - Write the value 0. 57 | - Move one slot to the right. 58 | - Continue with state C. 59 | If the current value is 1: 60 | - Write the value 0. 61 | - Move one slot to the right. 62 | - Continue with state E. 63 | -------------------------------------------------------------------------------- /solutions/src/2015/20.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, BlockArguments #-} 2 | {-| 3 | Module : Main 4 | Description : Day 20 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Run a simulation of elves delivering presents which each elf taking a larger 12 | step size than the previous. 13 | 14 | -} 15 | module Main where 16 | 17 | import Advent.Format (format) 18 | import Control.Monad.Loop (for, exec_) 19 | import Control.Monad.Trans.Class ( MonadTrans(lift) ) 20 | import Data.Array.ST (readArray, writeArray, MArray(newArray), runSTUArray) 21 | import Data.Array.Unboxed (UArray, assocs) 22 | 23 | -- | >>> :main 24 | -- 831600 25 | -- 884520 26 | main :: IO () 27 | main = 28 | do target <- [format|2015 20 %u%n|] 29 | print (findHouse target (solve1 target)) 30 | print (findHouse target (solve2 target)) 31 | 32 | -- | Return the house number with at least the given number of presents. 33 | findHouse :: Int -> UArray Int Int -> Int 34 | findHouse target a = head [h | (h,t) <- assocs a, t >= target] 35 | 36 | solve1 :: Int -> UArray Int Int 37 | solve1 target = runSTUArray 38 | do let top = target `quot` 10 39 | a <- newArray (1,top) 0 40 | a <$ exec_ 41 | do elf <- for 1 (<= top) (1+) 42 | house <- for elf (<= top) (elf+) 43 | lift do old <- readArray a house 44 | writeArray a house (old + elf*10) 45 | 46 | solve2 :: Int -> UArray Int Int 47 | solve2 target = runSTUArray 48 | do let top = target `quot` 11 49 | a <- newArray (1,top) 0 50 | a <$ exec_ 51 | do elf <- for 1 (<=top) (1+) 52 | house <- for elf (<= min top (elf*50)) (+elf) 53 | lift do old <- readArray a house 54 | writeArray a house (old + elf*11) 55 | -------------------------------------------------------------------------------- /solutions/src/2015/15.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 15 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | We have a list of ingredients with different properties and a scoring 12 | function. We have to combine those ingredients to maximize the score. 13 | 14 | -} 15 | module Main where 16 | 17 | import Advent.Format (format) 18 | import Data.List (transpose) 19 | 20 | main :: IO () 21 | main = 22 | do input <- [format|2015 15 (%s: (%s %ld)&(, )%n)*|] 23 | let stats = map (map snd . snd) input 24 | n = fromIntegral (length input) 25 | possibilities = computeStats stats <$> divisions n 100 26 | 27 | print (maximum (map score possibilities)) 28 | print (maximum [score meal | meal <- possibilities, last meal == 500]) 29 | 30 | score :: 31 | [Integer] {- ^ properties list, calories are last -} -> 32 | Integer {- ^ score for recipe -} 33 | score = product . init 34 | 35 | computeStats :: 36 | [[Integer]] {- ^ properties for all ingredients -} -> 37 | [Integer] {- ^ divisions -} -> 38 | [Integer] {- ^ cumulative properties -} 39 | computeStats props divs 40 | = map (max 0 . sum) -- compute sum of each property 41 | $ transpose -- compute lists of each property 42 | $ zipWith (map . (*)) divs props -- scale up properties by ingredient 43 | 44 | divisions :: 45 | Integer {- ^ number of divisions -} -> 46 | Integer {- ^ amount to divide -} -> 47 | [[Integer]] {- ^ all possible divisions -} 48 | divisions 1 n = [[n]] 49 | divisions cnt n = 50 | do x <- [1..n-cnt+1] 51 | xs <- divisions (cnt - 1) (n-x) 52 | return (x:xs) 53 | -------------------------------------------------------------------------------- /solutions/src/2016/02.hs: -------------------------------------------------------------------------------- 1 | {-# Language TemplateHaskell, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 2 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (arrIx, format, stageTH) 15 | import Advent.Coord (Coord(..), east, north, origin, south, west) 16 | import Data.Foldable (foldl') 17 | import Data.Array (Array, (!), listArray) 18 | 19 | data D = DL | DR | DU | DD 20 | 21 | stageTH 22 | 23 | -- | >>> :main 24 | -- 97289 25 | -- 9A7DC 26 | main :: IO () 27 | main = 28 | do cmds <- [format|2016 2 (@D*%n)*|] 29 | putStrLn (computeCode keys1 cmds) 30 | putStrLn (computeCode keys2 cmds) 31 | 32 | keys1 :: Array Coord Char 33 | keys1 = listArray (C (-1) (-1), C 1 1) 34 | "123\ 35 | \456\ 36 | \789" 37 | 38 | keys2 :: Array Coord Char 39 | keys2 = listArray (C (-2) (-2), C 2 2) 40 | "..1..\ 41 | \.234.\ 42 | \56789\ 43 | \.ABC.\ 44 | \..D.." 45 | 46 | computeCode :: Array Coord Char -> [[D]] -> String 47 | computeCode ks cmds = map (ks!) (tail (scanl (process ks) origin cmds)) 48 | 49 | process :: 50 | Array Coord Char {- ^ key pad -} -> 51 | Coord {- ^ starting position -} -> 52 | [D] {- ^ command -} -> 53 | Coord {- ^ stopping position -} 54 | process ks = foldl' aux 55 | where 56 | aux pos mov 57 | | isValid ks pos' = pos' 58 | | otherwise = pos 59 | where 60 | pos' = pos + translate mov 61 | 62 | isValid :: Array Coord Char -> Coord -> Bool 63 | isValid ks i = maybe False (/= '.') (arrIx ks i) 64 | 65 | translate :: D -> Coord 66 | translate DL = west 67 | translate DR = east 68 | translate DU = north 69 | translate DD = south 70 | -------------------------------------------------------------------------------- /solutions/src/2021/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ParallelListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | The input is a bunch of segments; count intersections. 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (counts, countBy, format) 17 | 18 | -- | >>> :main 19 | -- 8060 20 | -- 21577 21 | main :: IO () 22 | main = 23 | do inp <- [format|2021 5 (%u,%u -> %u,%u%n)*|] 24 | print (solve (filter isStraight inp)) 25 | print (solve inp) 26 | 27 | -- | Compute the number of points covered by more than one segment 28 | solve :: [(Int, Int, Int, Int)] -> Int 29 | solve = countBy (> 1) . counts . concatMap points 30 | 31 | -- | Predicate for straight segments 32 | isStraight :: (Int, Int, Int, Int) -> Bool 33 | isStraight (x1, y1, x2, y2) = x1 == x2 || y1 == y2 34 | 35 | -- | Enumerate the points contained in a segment 36 | -- 37 | -- >>> points (1,1,1,3) 38 | -- [(1,1),(1,2),(1,3)] 39 | -- 40 | -- >>> points (9,7,7,7) 41 | -- [(9,7),(8,7),(7,7)] 42 | -- 43 | -- >>> points (1,1,3,3) 44 | -- [(1,1),(2,2),(3,3)] 45 | -- 46 | -- >>> points (9,7,7,9) 47 | -- [(9,7),(8,8),(7,9)] 48 | points :: (Int, Int, Int, Int) -> [(Int, Int)] 49 | points (x1, y1, x2, y2) 50 | | x1 == x2 = [(x1,y) | y <- range y1 y2] 51 | | y1 == y2 = [(x,y1) | x <- range x1 x2] 52 | | otherwise = [(x,y) | x <- range x1 x2 | y <- range y1 y2] 53 | 54 | -- | Inclusive enumeration of the integers between two bounds 55 | -- 56 | -- >>> range 3 5 57 | -- [3,4,5] 58 | -- 59 | -- >>> range 9 9 60 | -- [9] 61 | -- 62 | -- >>> range 7 1 63 | -- [7,6,5,4,3,2,1] 64 | range :: Int -> Int -> [Int] 65 | range x y 66 | | x <= y = [x .. y] 67 | | otherwise = [x, x-1 .. y] 68 | -------------------------------------------------------------------------------- /solutions/src/2024/22.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost, BangPatterns #-} 2 | {-| 3 | Module : Main 4 | Description : Day 22 solution 5 | Copyright : (c) Eric Mertens, 2024 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + "1 13 | 2 14 | 3 15 | 4 16 | 2024 17 | " 18 | :} 19 | 37990510 20 | 23 21 | 22 | -} 23 | module Main (main) where 24 | 25 | import Advent (format, times) 26 | import Data.Array.Unboxed (UArray, accumArray, assocs, elems) 27 | import Data.Bits (xor) 28 | 29 | -- | >>> :main 30 | -- 19241711734 31 | -- 2058 32 | main :: IO () 33 | main = 34 | do input <- [format|2024 22 (%u%n)*|] 35 | print (sum (map (times 2000 next) input)) 36 | let a = accumArray (+) 0 ((-9,-9,-9,-9),(9,9,9,9)) 37 | [(k,v) | i <- input, (k,v) <- assocs (char i), v > 0] 38 | :: UArray (Int,Int,Int,Int) Int 39 | print (maximum (elems a)) 40 | 41 | -- | Generate the next secret number 42 | -- 43 | -- >>> map next [1, 10, 100, 2024] 44 | -- [8685429, 4700978, 15273692, 8667524] 45 | next :: Int -> Int 46 | next x = c 47 | where 48 | prune y = y `mod` 16777216 49 | a = prune (x `xor` (x * 64)) 50 | b = prune (a `xor` (a `div` 32)) 51 | c = prune (b `xor` (b * 2048)) 52 | 53 | char :: Int -> UArray (Int,Int,Int,Int) Int 54 | char x = accumArray upd (-1) ((-9,-9,-9,-9),(9,9,9,9)) 55 | (gen 4 (delta x x1) (delta x1 x2) (delta x2 x3) (delta x3 x4) x4) 56 | where 57 | upd x y = if x == -1 then y else x 58 | 59 | x1 = next x 60 | x2 = next x1 61 | x3 = next x2 62 | x4 = next x3 63 | 64 | delta x y = y`mod`10 - x`mod`10 65 | 66 | gen !i !a !b !c !d !x 67 | | i <= 2000 = ((a,b,c,d), x`mod`10) : gen (i+1) b c d (delta x x') x' 68 | | otherwise = [] 69 | where x' = next x 70 | -------------------------------------------------------------------------------- /common/src/Advent/Visualize.hs: -------------------------------------------------------------------------------- 1 | {-| 2 | Module : Advent.Visualize 3 | Description : Module for visualizing components of the solutions 4 | Copyright : (c) Eric Mertens, 2018 5 | License : ISC 6 | Maintainer : emertens@gmail.com 7 | 8 | Thin wrapper around the JuicyPixels library to make it easy to generate 9 | small animations from solution files. 10 | 11 | -} 12 | module Advent.Visualize 13 | ( Image 14 | , PixelRGB8(..) 15 | 16 | , writePng 17 | , writeAnimation 18 | , generateImage 19 | 20 | , coordImage 21 | 22 | , colorWheel 23 | ) where 24 | 25 | import Advent.Coord 26 | import Codec.Picture 27 | import Data.Word (Word8) 28 | 29 | -- | Generate an image given coordinate bounds and a projection from coordinates to colors. 30 | coordImage :: 31 | Pixel p => 32 | (Coord, Coord) {- ^ inclusive coordinate range -} -> 33 | (Coord -> p) {- ^ pixel coloring function -} -> 34 | Image p 35 | coordImage (C loy lox, C hiy hix) f = generateImage toPixel width height 36 | where 37 | toPixel x y = f (C (loy+y) (lox+x)) 38 | width = hix - lox + 1 39 | height = hiy - loy + 1 40 | 41 | -- | Assign a gradient rainbow to the values of a 8-bit number. 42 | colorWheel :: Word8 -> PixelRGB8 43 | colorWheel i 44 | | i < 85 = PixelRGB8 (255 - i * 3) 0 (i * 3) 45 | | i < 170 = PixelRGB8 0 ((i-85) * 3) (255 - (i-85)*3) 46 | | otherwise = PixelRGB8 ((i-170) * 3) (255 - (i-170)*3) 0 47 | 48 | -- | Save a looping animated GIF to disk given the animation frames and a delay. 49 | writeAnimation :: 50 | FilePath {- ^ output filename -} -> 51 | Int {- ^ frame delay in centiseconds -} -> 52 | [Image PixelRGB8] {- ^ animation frames -} -> 53 | IO () 54 | writeAnimation path delay imgs = 55 | case writeGifAnimation path delay LoopingForever imgs of 56 | Left e -> fail e 57 | Right io -> io 58 | -------------------------------------------------------------------------------- /solutions/src/2021/13.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, BlockArguments, ImportQualifiedPost, TemplateHaskell, OverloadedLists #-} 2 | {-| 3 | Module : Main 4 | Description : Day 13 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Given a paper with some dots and a series of fold instructions 12 | we fold and fold and fold and find our secret code. 13 | 14 | -} 15 | module Main (main) where 16 | 17 | import Advent.Coord (Coord(C), drawCoords) 18 | import Advent (format, stageTH) 19 | import Data.Set (Set) 20 | import Data.Set qualified as Set 21 | 22 | data A = Ax | Ay deriving (Show) 23 | 24 | stageTH -- template haskell staging 25 | 26 | -- | >>> :main 27 | -- 716 28 | -- ███··███···██··█··█·████·███··█····███· 29 | -- █··█·█··█·█··█·█·█··█····█··█·█····█··█ 30 | -- █··█·█··█·█····██···███··███··█····█··█ 31 | -- ███··███··█····█·█··█····█··█·█····███· 32 | -- █·█··█····█··█·█·█··█····█··█·█····█·█· 33 | -- █··█·█·····██··█··█·█····███··████·█··█ 34 | main :: IO () 35 | main = 36 | do (points, folds) <- [format|2021 13 (%u,%u%n)*%n(fold along @A=%u%n)*|] 37 | let pointSet = Set.fromList [C y x | (x, y) <- points] 38 | states = scanl (flip foldPoints) pointSet folds 39 | p1 = states !! 1 -- points after first fold 40 | p2 = last states -- points after last fold 41 | print (length p1) 42 | putStr (drawCoords p2) 43 | 44 | -- | 2-dimensional fold the set of points over a line. 45 | foldPoints :: (A, Int) {- ^ fold line -} -> Set Coord -> Set Coord 46 | foldPoints (Ax, lx) = Set.map \(C y x) -> C y (fold1 lx x) 47 | foldPoints (Ay, ly) = Set.map \(C y x) -> C (fold1 ly y) x 48 | 49 | -- | 1-dimensional fold updating one point 50 | fold1 :: Int {- ^ fold -} -> Int {- ^ point -} -> Int 51 | fold1 a i = a - abs (a - i) 52 | -------------------------------------------------------------------------------- /solutions/src/2018/08.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 8 solution 5 | Copyright : (c) Eric Mertens, 2018 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Parse a tree out of a list of integers and then answer a pair of queries 12 | about the tree. 13 | 14 | -} 15 | {-# Language DeriveTraversable #-} 16 | module Main (main) where 17 | 18 | import Advent (format) 19 | import Control.Monad (replicateM) 20 | import Control.Monad.Trans.State.Strict (StateT(..)) 21 | import Data.List (uncons) 22 | 23 | -- | Print the answers to day 8 24 | -- 25 | -- >>> :main 26 | -- 42196 27 | -- 33649 28 | main :: IO () 29 | main = 30 | do input <- [format|2018 8 %u& %n|] 31 | let Just (tree, []) = runStateT parseTree input 32 | print (sum tree) 33 | print (part2 tree) 34 | 35 | -- | A tree can have children and metadata entries. 36 | data Tree a = Tree [Tree a] [a] -- ^ children and metadata 37 | deriving (Functor, Foldable, Traversable, Show) 38 | 39 | -- | Sum of metadata entries on leaf nodes and recursive call on 40 | -- child nodes identified by indexes stored in metadata. 41 | part2 :: Tree Int -> Int 42 | part2 (Tree xs ys) 43 | | null xs = sum ys 44 | | otherwise = sum [ sum (index (map part2 xs) (i-1)) | i <- ys, i > 0] 45 | 46 | -- | list index returning Nothing on failure. 47 | index :: [a] -> Int -> Maybe a 48 | index xs n 49 | | a:_ <- drop n xs = Just a 50 | | otherwise = Nothing 51 | 52 | -- | Get the next integer 53 | int :: StateT [Int] Maybe Int 54 | int = StateT uncons 55 | 56 | -- | Parse a tree from a list of integers 57 | parseTree :: StateT [Int] Maybe (Tree Int) 58 | parseTree = 59 | do n <- int 60 | m <- int 61 | a <- replicateM n parseTree 62 | b <- replicateM m int 63 | pure (Tree a b) 64 | -------------------------------------------------------------------------------- /solutions/src/2017/09.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, TemplateHaskell, OverloadedStrings #-} 2 | {-| 3 | Module : Main 4 | Description : Day 9 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Day 9 poses a problem of parsing a nested bracket structure. 12 | 13 | -} 14 | module Main where 15 | 16 | import Advent (format, stageTH) 17 | import Control.Applicative ((<|>)) 18 | import Data.Foldable (traverse_) 19 | import Linear (V2(V2)) 20 | import Text.ParserCombinators.ReadP (ReadP, get, between, sepBy) 21 | 22 | -- | Parse the group string format as defined in Day 9. Parse 23 | -- result is a vector containing the group score and garbage 24 | -- character count. 25 | parseGroup :: 26 | Int {- ^ group depth -} -> 27 | ReadP (V2 Int) {- ^ group score, garbage count -} 28 | parseGroup n = 29 | foldl (+) (V2 n 0) <$> 30 | between "{" "}" 31 | (sepBy (parseGroup (n+1) <|> V2 0 <$> parseGarbage) ",") 32 | 33 | -- | Parse a angle-bracket bracketed region of characters and return the 34 | -- number of non-ignored, contained characters. Characters including and 35 | -- following a @!@ are ignored inside garbgae. 36 | parseGarbage :: ReadP Int {- ^ garbage count -} 37 | parseGarbage = "<" *> elt 0 38 | 39 | elt :: Int -> ReadP Int 40 | elt n = 41 | do x <- get 42 | case x of 43 | '!' -> get *> elt n 44 | '>' -> pure n 45 | _ -> elt (n+1) 46 | 47 | -- | Starting parser named with a single letter to work with format. 48 | p :: ReadP (V2 Int) 49 | p = parseGroup 1 50 | 51 | stageTH 52 | 53 | -- | Print solution for Day 9. Puzzle input can be overriden by command-line 54 | -- argument. 55 | -- 56 | -- >>> :main 57 | -- 14212 58 | -- 6569 59 | main :: IO () 60 | main = 61 | do answers <- [format|2017 9 @p%n|] 62 | traverse_ print answers 63 | -------------------------------------------------------------------------------- /solutions/src/2018/05.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 5 solution 5 | Copyright : (c) Eric Mertens, 2018 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main (main) where 13 | 14 | import Advent.Format (format) 15 | import Data.Char (toLower, toUpper) 16 | import Data.List (nub) 17 | 18 | -- | Print the answers to day 5 19 | -- 20 | -- >>> :main 21 | -- 9370 22 | -- 6390 23 | main :: IO () 24 | main = 25 | do inp <- [format|2018 5 %s%n|] 26 | print (part1 inp) 27 | print (part2 inp) 28 | 29 | -- | Collapse the polymer using the lowercase/uppercase matching rule. 30 | -- 31 | -- >>> simplify "dabAcCaCBAcCcaDA" 32 | -- "dabCBAcaDA" 33 | simplify :: String -> String 34 | simplify = foldr step "" 35 | where 36 | -- Invariant: list argument to step is always completely reduced 37 | step x (y:ys) | match x y = ys 38 | step x ys = x : ys 39 | 40 | -- | Match characters where one is the lowercase version of the other. 41 | -- 42 | -- >>> match 'a' 'A' 43 | -- True 44 | -- >>> match 'A' 'a' 45 | -- True 46 | -- >>> match 'a' 'a' 47 | -- False 48 | match :: Char -> Char -> Bool 49 | match x y = x /= y && toUpper x == toUpper y 50 | 51 | -- | Compute the length of the collapsed polymer. 52 | -- 53 | -- >>> part1 "dabAcCaCBAcCcaDA" 54 | -- 10 55 | part1 :: String -> Int 56 | part1 = length . simplify 57 | 58 | 59 | -- | Find the minimum length a string can reduce to when we're allowed 60 | -- to remove any one pair of characters. 61 | -- 62 | -- >>> part2 "dabAcCaCBAcCcaDA" 63 | -- 4 64 | part2 :: String -> Int 65 | part2 str = minimum lengths 66 | where 67 | str' = simplify str 68 | candidates = nub (map toLower str') 69 | isOk bad x = bad /= toLower x 70 | lengths = [part1 (filter (isOk bad) str') | bad <- candidates] 71 | -------------------------------------------------------------------------------- /solutions/src/2022/18.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 18 solution 5 | Copyright : (c) Eric Mertens, 2022 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "2,2,2\n\ 14 | \1,2,2\n\ 15 | \3,2,2\n\ 16 | \2,1,2\n\ 17 | \2,3,2\n\ 18 | \2,2,1\n\ 19 | \2,2,3\n\ 20 | \2,2,4\n\ 21 | \2,2,6\n\ 22 | \1,2,5\n\ 23 | \3,2,5\n\ 24 | \2,1,5\n\ 25 | \2,3,5\n" 26 | :} 27 | 64 28 | 58 29 | 30 | -} 31 | module Main where 32 | 33 | import Data.Ix (inRange) 34 | import Data.Maybe (fromJust) 35 | import Data.Set (Set) 36 | import Data.Set qualified as Set 37 | 38 | import Advent (format) 39 | import Advent.Search (fill) 40 | import Advent.Coord3 (Coord3(..), boundingBox) 41 | 42 | -- | 43 | -- >>> :main 44 | -- 4332 45 | -- 2524 46 | main :: IO () 47 | main = 48 | do input <- [format|2022 18 (%u,%u,%u%n)*|] 49 | let cubes = Set.fromList (map toC3 input) 50 | let air = findAir cubes 51 | print (length [() | c <- Set.toList cubes, n <- neigh c, Set.notMember n cubes]) 52 | print (length [() | c <- Set.toList cubes, n <- neigh c, Set.member n air ]) 53 | 54 | -- | Given the the location of the lava cubes, find a bounding box of air surrounding them. 55 | findAir :: Set Coord3 -> Set Coord3 56 | findAir cubes = fill step (hi + 1) 57 | where 58 | (lo, hi) = fromJust (boundingBox cubes) 59 | box = (lo - 1, hi + 1) 60 | step c = [n | n <- neigh c, inRange box n, Set.notMember n cubes] 61 | 62 | -- | Neighbors of the cubes (excluding diagonals) 63 | neigh :: Coord3 -> [Coord3] 64 | neigh (C3 x y z) = [C3 (x+1) y z, C3 (x-1) y z, C3 x (y+1) z, C3 x (y-1) z, C3 x y (z+1), C3 x y (z-1)] 65 | 66 | -- | Convert tuple to Coord3 67 | toC3 :: (Int, Int, Int) -> Coord3 68 | toC3 (x,y,z) = C3 x y z 69 | -------------------------------------------------------------------------------- /solutions/src/2015/16.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, BlockArguments, LambdaCase #-} 2 | {-| 3 | Module : Main 4 | Description : Day 16 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | We're given facts about a bunch of different /Sues/ and asked to 12 | check which one matches what we know about the one true /Sue/. 13 | 14 | -} 15 | module Main where 16 | 17 | import Advent.Format (format) 18 | 19 | main :: IO () 20 | main = 21 | do input <- [format|2015 16 (Sue %d: (%s: %d)&(, )%n)*|] 22 | print [i | (i, props) <- input, matchesClues1 props] 23 | print [i | (i, props) <- input, matchesClues2 props] 24 | 25 | -- | Predicate for properties that match exactly. 26 | matchesClues1 :: [(String,Int)] -> Bool 27 | matchesClues1 = matcher (const (==)) 28 | 29 | -- | Predicate like 'matchesClues1' but with special cases for 30 | -- /cats/, /trees/, /pomeranians/, and /goldfish/. 31 | matchesClues2 :: [(String,Int)] -> Bool 32 | matchesClues2 = 33 | matcher \case 34 | "cats" -> (<) 35 | "trees" -> (<) 36 | "pomeranians" -> (>) 37 | "goldfish" -> (>) 38 | _ -> (==) 39 | 40 | -- | Match a list of properties against the known hints. 41 | matcher :: 42 | (String -> Int -> Int -> Bool) {- ^ comparison selector -} -> 43 | [(String,Int)] {- ^ list of properties -} -> 44 | Bool {- ^ properties match clues -} 45 | matcher match = all \(prop, memory) -> 46 | match prop (clues prop) memory 47 | 48 | -- | Returns the given hint value for each property. 49 | clues :: String -> Int 50 | clues "children" = 3 51 | clues "cats" = 7 52 | clues "samoyeds" = 2 53 | clues "pomeranians" = 3 54 | clues "akitas" = 0 55 | clues "vizslas" = 0 56 | clues "goldfish" = 5 57 | clues "trees" = 3 58 | clues "cars" = 2 59 | clues "perfumes" = 1 60 | -------------------------------------------------------------------------------- /solutions/src/2020/04.hs: -------------------------------------------------------------------------------- 1 | {-# Language BlockArguments, ScopedTypeVariables, QuasiQuotes, TemplateHaskell, ViewPatterns #-} 2 | {-| 3 | Module : Main 4 | Description : Day 4 solution 5 | Copyright : (c) Eric Mertens, 2020 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Passport validation 12 | 13 | -} 14 | module Main (main) where 15 | 16 | import Advent (countBy, stageTH) 17 | import Advent.Format (format) 18 | import Data.Char (isDigit, isHexDigit) 19 | import Data.List (delete, sort) 20 | 21 | type Passport = [(F, String)] 22 | data F = Fbyr | Fiyr | Feyr | Fhgt | Fhcl | Fecl | Fpid | Fcid deriving (Eq, Ord, Show) 23 | 24 | stageTH 25 | 26 | -- | 27 | -- >>> :main 28 | -- 245 29 | -- 133 30 | main :: IO () 31 | main = 32 | do inp <- [format|2020 4 (@F:%s( |%n))*&%n|] 33 | let xs = filter complete inp 34 | print (length xs) 35 | print (countBy (all (uncurry validate)) xs) 36 | 37 | reqFields :: [F] 38 | reqFields = sort [Fbyr, Fiyr, Feyr, Fhgt, Fhcl, Fecl, Fpid] 39 | 40 | complete :: Passport -> Bool 41 | complete x = reqFields == sort (delete Fcid (map fst x)) 42 | 43 | range :: Integer -> Integer -> Integer -> Bool 44 | range lo hi x = lo <= x && x <= hi 45 | 46 | validate :: F -> String -> Bool 47 | validate Fbyr (reads -> [(n,"" )]) = range 1920 2002 n 48 | validate Fiyr (reads -> [(n,"" )]) = range 2010 2020 n 49 | validate Feyr (reads -> [(n,"" )]) = range 2020 2030 n 50 | validate Fhgt (reads -> [(n,"cm")]) = range 150 193 n 51 | validate Fhgt (reads -> [(n,"in")]) = range 59 76 n 52 | validate Fhcl ('#':hcl) = length hcl == 6 && all isHexDigit hcl 53 | validate Fecl ecl = ecl `elem` words "amb blu brn gry grn hzl oth" 54 | validate Fpid pid = length pid == 9 && all isDigit pid 55 | validate Fcid _ = True 56 | validate _ _ = False 57 | -------------------------------------------------------------------------------- /solutions/src/2015/24.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, BlockArguments, LambdaCase, TransformListComp #-} 2 | {-| 3 | Module : Main 4 | Description : Day 24 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :{ 12 | :main + 13 | "1 14 | 2 15 | 3 16 | 4 17 | 5 18 | 7 19 | 8 20 | 9 21 | 10 22 | 11 23 | " 24 | :} 25 | 99 26 | 44 27 | 28 | -} 29 | module Main (main) where 30 | 31 | import Advent.Format (format) 32 | import Advent (pickOne) 33 | import Data.List (sortBy, sort, tails) 34 | import Data.Ord (comparing) 35 | import Advent.Queue (Queue) 36 | import qualified Advent.Queue as Queue 37 | 38 | -- order specifically chosen to get desired Ord instance 39 | data Packages = Packages { pkgProduct, pkgSum :: !Int } 40 | deriving (Eq, Ord, Show) 41 | 42 | noPackages :: Packages 43 | noPackages = Packages 44 | { pkgSum = 0 45 | , pkgProduct = 1 46 | } 47 | 48 | addPackage :: Int -> Packages -> Packages 49 | addPackage p pkgs = Packages 50 | { pkgSum = pkgSum pkgs + p 51 | , pkgProduct = pkgProduct pkgs * fromIntegral p 52 | } 53 | 54 | solve :: Int -> [Int] -> Int 55 | solve n input = go (Queue.singleton (noPackages, sort input)) 56 | where 57 | target = sum input `quot` n 58 | 59 | go = \case 60 | Queue.Empty -> error "no solution" 61 | (pkg, pkgs) Queue.:<| q 62 | | target == pkgSum pkg -> pkgProduct pkg 63 | | otherwise -> go (Queue.appendList q more) 64 | where 65 | more = [(pkg', xs) | x:xs <- tails pkgs, let pkg' = addPackage x pkg, then takeWhile by pkgSum pkg' <= target] 66 | 67 | -- | Parse the input and print the solutions to both parts. 68 | -- 69 | -- >>> :main 70 | -- 11846773891 71 | -- 80393059 72 | main :: IO () 73 | main = 74 | do input <- [format|2015 24 (%u%n)*|] 75 | print (solve 3 input) 76 | print (solve 4 input) 77 | -------------------------------------------------------------------------------- /solutions/src/2016/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost, TemplateHaskell #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format, partialSums, stageTH) 15 | import Advent.Coord (Coord, manhattan, north, origin, turnLeft, turnRight) 16 | import Data.List (mapAccumL) 17 | import Data.Set qualified as Set 18 | 19 | data D = DL | DR 20 | 21 | stageTH 22 | 23 | -- | >>> :main 24 | -- 241 25 | -- Just 116 26 | main :: IO () 27 | main = 28 | do cmds <- [format|2016 1 (@D%d)&(, )%n|] 29 | let path = computePath cmds 30 | print (part1 path) 31 | print (part2 path) 32 | 33 | -- | Given a list of steps determine the ultimate Manhattan-distance from 34 | -- the starting position. 35 | part1 :: [Coord] -> Int 36 | part1 = manhattan origin . last 37 | 38 | part2 :: [Coord] -> Maybe Int 39 | part2 = fmap (manhattan origin) . duplicate 40 | 41 | computePath :: [(D,Int)] -> [Coord] 42 | computePath = partialSums . toSteps north 43 | 44 | -- | Find the first duplicate element in a list 45 | duplicate :: Ord a => [a] -> Maybe a 46 | duplicate = aux Set.empty 47 | where 48 | aux _ [] = Nothing 49 | aux seen (x:xs) 50 | | Set.member x seen = Just x 51 | | otherwise = aux (Set.insert x seen) xs 52 | 53 | -- | Compute steps taken by following a list of commands 54 | toSteps :: 55 | Coord {- ^ initial direction -} -> 56 | [(D,Int)] {- ^ commands -} -> 57 | [Coord] {- ^ list of directions -} 58 | toSteps dir0 cmds = concat (snd (mapAccumL aux dir0 cmds)) 59 | where 60 | aux dir (lr, steps) = 61 | let dir' = turn lr dir 62 | in (dir', replicate steps dir') 63 | 64 | turn :: D -> Coord -> Coord 65 | turn DL = turnLeft 66 | turn DR = turnRight 67 | -------------------------------------------------------------------------------- /solutions/src/2017/24.hs: -------------------------------------------------------------------------------- 1 | {-# Language BangPatterns, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 24 solution 5 | Copyright : (c) Eric Mertens, 2017 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | Build long bridges out of pieces with a pin count on each 12 | end. Pieces can be flipped over and to be connected the pin 13 | counts of two pieces must match. 14 | 15 | -} 16 | module Main where 17 | 18 | import Advent (format) 19 | import Data.List (delete) 20 | 21 | -- | Print solutions to both parts of the task. 22 | main :: IO () 23 | main = 24 | do input <- [format|2017 24 (%d/%d%n)*|] 25 | 26 | let bridges = search 0 0 0 input 27 | 28 | print (maximum (map snd bridges)) -- part 1: weights 29 | print (snd (maximum bridges)) -- part 2: lengths *then* weights 30 | 31 | -- | Given a required number of ports and a piece, return the possible 32 | -- unique orientations of that piece. 33 | orient :: 34 | Int {- ^ target left pin count -} -> 35 | (Int,Int) {- ^ current piece -} -> 36 | [(Int,Int)] {- ^ possible orientations of this piece -} 37 | orient a (b,c) 38 | | a == b = [(b,c)] 39 | | a == c = [(c,b)] 40 | | otherwise = [] 41 | 42 | -- | Generate statistics for all of the possible bridges given some pieces. 43 | search :: 44 | Int {- ^ current bridge length -} -> 45 | Int {- ^ current bridge weight -} -> 46 | Int {- ^ required port pins -} -> 47 | [(Int,Int)] {- ^ available pieces -} -> 48 | [(Int,Int)] {- ^ length and weight of possible bridges -} 49 | search !len !weight !match pieces = 50 | (len,weight) : -- values if we stopped here 51 | do piece <- pieces 52 | (a,b) <- orient match piece 53 | search (len+1) (weight+a+b) b (delete piece pieces) 54 | -------------------------------------------------------------------------------- /solutions/src/2023/15.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, ImportQualifiedPost #-} 2 | {-| 3 | Module : Main 4 | Description : Day 15 solution 5 | Copyright : (c) Eric Mertens, 2023 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | This problem has us follow a lens update sequence. The solution 12 | below stores the lenses in an array and uses accumArray to 13 | efficiently apply updates to that array in-place. 14 | 15 | >>> :main + "rn=1,cm-,qp=3,cm=2,qp-,pc=4,ot=9,ab=5,pc-,pc=6,ot=7\n" 16 | 1320 17 | 145 18 | 19 | -} 20 | module Main (main) where 21 | 22 | import Advent (format) 23 | import Data.Array (accumArray, assocs) 24 | import Data.Char (ord) 25 | 26 | -- | Parse the input sequence and print the results of both parts. 27 | -- 28 | -- >>> :main 29 | -- 503487 30 | -- 261505 31 | main :: IO () 32 | main = 33 | do input <- [format|2023 15 (%a+(-|=%d))!&,%n|] 34 | print (sum [hash raw | (raw, _) <- input]) 35 | 36 | let boxes = accumArray updateBox [] (0, 255) 37 | [(hash lbl, (lbl, cmd)) | (_, (lbl, cmd)) <- input] 38 | 39 | print (sum [ (1 + box) * sum (zipWith (*) [1..] (map snd xs)) 40 | | (box, xs) <- assocs boxes]) 41 | 42 | -- | Run the HASH algorithm on an input string. 43 | hash :: String -> Int 44 | hash str = foldl (\acc x -> 17 * (ord x + acc)) 0 str `rem` 256 45 | 46 | -- | Either update the focal length or remove a lens by label of a lens box. 47 | updateBox :: 48 | [(String, Int)] {- ^ lens box -} -> 49 | (String, Maybe Int) {- ^ label, new focal length -} -> 50 | [(String, Int)] {- ^ updated lens box -} 51 | updateBox prev (lbl, Nothing) = filter ((lbl /=) . fst) prev 52 | updateBox prev (lbl, Just n ) = go prev 53 | where 54 | go ((k, _) : xs) | lbl == k = (lbl, n) : xs 55 | go (x : xs) = x : go xs 56 | go [] = [(lbl, n)] 57 | -------------------------------------------------------------------------------- /solutions/src/2025/01.hs: -------------------------------------------------------------------------------- 1 | {-# Language QuasiQuotes, TemplateHaskell, ViewPatterns #-} 2 | {-| 3 | Module : Main 4 | Description : Day 1 solution 5 | Copyright : (c) Eric Mertens, 2025 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | >>> :main + "L68\nL30\nR48\nL5\nR60\nL55\nL1\nL99\nR14\nL82\n" 12 | 3 13 | 6 14 | 15 | -} 16 | module Main (main) where 17 | 18 | import Advent (count, format, stageTH) 19 | import Data.List (mapAccumL) 20 | 21 | -- | Direction of the turn: left (negative) or right (positive) 22 | data D = DL | DR deriving Show 23 | 24 | stageTH -- makes D visible in the format parser as @D 25 | 26 | -- | Count of labels on the dial: 0 to 99 27 | locations :: Int 28 | locations = 100 29 | 30 | -- | The arrow starts pointing at location 50 31 | start :: Int 32 | start = 50 33 | 34 | -- | >>> :main 35 | -- 992 36 | -- 6133 37 | main :: IO () 38 | main = 39 | do input <- [format|2025 1 (@D%u%n)*|] 40 | let (stops, zeros) = unzip (sim start input) 41 | print (count 0 stops) 42 | print (sum zeros) 43 | 44 | -- | Simulate a list of dial turns given a starting location to produce 45 | -- the list of intermediate dial locations as well as the number of times 46 | -- zero was passed each turn. 47 | sim :: 48 | Int {- ^ current location -} -> 49 | [(D, Int)] {- ^ list of turns -} -> 50 | [(Int, Int)] {- ^ trace of stop locations and zero passes -} 51 | sim _ [] = [] 52 | sim loc ((DR, n) : xs) = (loc', zeros) : sim loc' xs where (zeros, loc') = ( loc + n) `divMod` locations 53 | sim loc ((DL, n) : xs) = (loc', zeros) : sim loc' xs where (zeros, neg -> loc') = (neg loc + n) `divMod` locations 54 | 55 | -- | Negated dial location used to be able to treat left turns a positive turns on a negated dial. 56 | -- 57 | -- >>> map neg [0,1,2,98,99] 58 | -- [0,99,98,2,1] 59 | neg :: Int -> Int 60 | neg x = (-x) `mod` locations 61 | -------------------------------------------------------------------------------- /solutions/src/2016/17.hs: -------------------------------------------------------------------------------- 1 | {-# Language ImportQualifiedPost, QuasiQuotes #-} 2 | {-| 3 | Module : Main 4 | Description : Day 17 solution 5 | Copyright : (c) Eric Mertens, 2021 6 | License : ISC 7 | Maintainer : emertens@gmail.com 8 | 9 | 10 | 11 | -} 12 | module Main where 13 | 14 | import Advent (format) 15 | import Advent.Coord (east, north, origin, south, west, Coord(..)) 16 | import Advent.Search (bfs) 17 | import Crypto.Hash.MD5 (hash) 18 | import Data.Bits ((.&.), shiftR) 19 | import Data.ByteString qualified as BS 20 | import Data.ByteString (ByteString) 21 | import Data.ByteString.Char8 qualified as B8 22 | 23 | -- | >>> :main 24 | -- DUDRLRRDDR 25 | -- 788 26 | main :: IO () 27 | main = 28 | do input <- B8.pack <$> [format|2016 17 %s%n|] 29 | let paths = [path | (C 3 3, path) <- bfs (nextStates input) initialState ] 30 | shortestPath = head paths 31 | longestPath = last paths 32 | putStrLn shortestPath 33 | print (length longestPath) 34 | 35 | initialState :: (Coord, String) 36 | initialState = (origin, "") 37 | 38 | isValidLocation :: Coord -> Bool 39 | isValidLocation (C y x) = 0 <= x && x < 4 && 0 <= y && y < 4 40 | 41 | nextStates :: ByteString -> (Coord, String) -> [(Coord, String)] 42 | nextStates _ (C 3 3,path) = [] 43 | nextStates input (c, path) = 44 | [ (c', path++[step]) 45 | | (step, delta) <- directions input path 46 | , let c' = c + delta 47 | , isValidLocation c' 48 | ] 49 | 50 | directions :: ByteString -> String -> [(Char, Coord)] 51 | directions input path = ways 52 | where 53 | h = hash (input <> B8.pack path) 54 | 55 | isOpen x = 0xb <= x && x <= 0xf 56 | 57 | ways = [ ('U', north) | isOpen (BS.index h 0 `shiftR` 4) ] ++ 58 | [ ('D', south) | isOpen (BS.index h 0 .&. 0xf) ] ++ 59 | [ ('L', west) | isOpen (BS.index h 1 `shiftR` 4) ] ++ 60 | [ ('R', east) | isOpen (BS.index h 1 .&. 0xf) ] 61 | --------------------------------------------------------------------------------