├── .gitignore ├── Build.hs ├── CHANGELOG.md ├── LICENSE ├── README.md ├── Setup.hs ├── app ├── aoc.hs └── intcode.hs ├── bench └── Bench.hs ├── feed.xml ├── package.yaml ├── reflections.md ├── reflections ├── day01.md ├── day02.md ├── day03.md ├── day04.md ├── day06.md ├── day08.md ├── day10.md ├── day11.md ├── day17.md └── day22.md ├── script ├── generate_days.hs └── open_files.vim ├── src ├── AOC.hs └── AOC │ ├── Challenge.hs │ ├── Challenge │ ├── Day01.hs │ ├── Day02.hs │ ├── Day03.hs │ ├── Day04.hs │ ├── Day05.hs │ ├── Day06.hs │ ├── Day07.hs │ ├── Day08.hs │ ├── Day09.hs │ ├── Day10.hs │ ├── Day11.hs │ ├── Day12.hs │ ├── Day13.hs │ ├── Day14.hs │ ├── Day15.hs │ ├── Day16.hs │ ├── Day17.hs │ ├── Day18.hs │ ├── Day19.hs │ ├── Day20.hs │ ├── Day21.hs │ ├── Day22.hs │ ├── Day23.hs │ ├── Day24.hs │ └── Day25.hs │ ├── Common.hs │ ├── Common │ ├── FinitarySet.hs │ ├── Intcode.hs │ ├── Intcode │ │ └── Memory.hs │ ├── Numeric.hs │ ├── Search.hs │ └── Subset.hs │ ├── Discover.hs │ ├── Prelude.hs │ ├── Run.hs │ ├── Run │ ├── Config.hs │ ├── Interactive.hs │ └── Load.hs │ ├── Solver.hs │ ├── Util.hs │ └── Util │ └── DynoMap.hs ├── stack.yaml ├── stack.yaml.lock ├── template ├── DayXX.hs ├── README.md.template ├── feed-item.xml.template ├── feed.xml.template ├── reflection.md.template └── reflections.md.template ├── test-data ├── 2016 │ ├── 01a.txt │ ├── 01b.txt │ ├── 02a.txt │ ├── 02b.txt │ ├── 03a.txt │ ├── 04a.txt │ ├── 05a.txt │ ├── 05b.txt │ ├── 06a.txt │ └── 06b.txt ├── 2017 │ ├── 01a.txt │ ├── 01b.txt │ ├── 02a.txt │ ├── 02b.txt │ ├── 03a.txt │ ├── 03b.txt │ ├── 04a.txt │ ├── 04b.txt │ ├── 05a.txt │ ├── 05b.txt │ ├── 06a.txt │ ├── 06b.txt │ ├── 07a.txt │ ├── 07b.txt │ ├── 08a.txt │ ├── 08b.txt │ ├── 09a.txt │ ├── 09b.txt │ ├── 10b.txt │ ├── 11a.txt │ ├── 11b.txt │ ├── 13a.txt │ ├── 13b.txt │ ├── 14a.txt │ ├── 14b.txt │ ├── 17a.txt │ ├── 18b.txt │ ├── 19a.txt │ ├── 19b.txt │ ├── 20a.txt │ └── 20b.txt ├── 2018 │ ├── 01a.txt │ ├── 01b.txt │ ├── 02a.txt │ ├── 02b.txt │ ├── 03a.txt │ ├── 03b.txt │ ├── 04a.txt │ ├── 04b.txt │ ├── 05a.txt │ ├── 05b.txt │ ├── 06a.txt │ ├── 06b.txt │ ├── 07a.txt │ ├── 07b.txt │ ├── 08a.txt │ ├── 08b.txt │ ├── 09a.txt │ ├── 10b.txt │ ├── 11a.txt │ ├── 11b.txt │ ├── 14a.txt │ ├── 14b.txt │ ├── 15a.txt │ ├── 15b.txt │ ├── 17a.txt │ ├── 18a.txt │ ├── 20a.txt │ ├── 22a.txt │ ├── 22b.txt │ ├── 23a.txt │ ├── 23b.txt │ ├── 24a.txt │ └── 24b.txt └── 2019 │ ├── 01a.txt │ ├── 01b.txt │ ├── 02a.txt │ ├── 03a.txt │ ├── 03b.txt │ ├── 04a.txt │ ├── 04b.txt │ ├── 05a.txt │ ├── 06a.txt │ ├── 06b.txt │ ├── 07a.txt │ ├── 07b.txt │ ├── 08a.txt │ ├── 09a.txt │ ├── 10a.txt │ ├── 10b.txt │ ├── 12a.txt │ ├── 12b.txt │ ├── 14a.txt │ ├── 14b.txt │ ├── 16a.txt │ ├── 16b.txt │ ├── 18a.txt │ ├── 18b.txt │ ├── 20a.txt │ ├── 20b.txt │ └── 24b.txt └── test └── Spec.hs /.gitignore: -------------------------------------------------------------------------------- 1 | .stack-work/ 2 | dist-newstyle/ 3 | /*.cabal 4 | *~ 5 | /data 6 | /prompt 7 | /aoc-conf.yaml 8 | /logs 9 | /bench-out 10 | /tmp 11 | /scratch 12 | _* 13 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | Changelog 2 | ========= 3 | 4 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Justin Le (c) 2018 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Justin Le nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /app/intcode.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | import AOC.Common.Intcode 4 | import System.Environment 5 | 6 | main :: IO () 7 | main = do 8 | x:_ <- getArgs 9 | Just mem <- parseMem <$> readFile x 10 | interactVM mem 11 | -------------------------------------------------------------------------------- /bench/Bench.hs: -------------------------------------------------------------------------------- 1 | 2 | import AOC 3 | import Control.Monad.Except 4 | 5 | main :: IO () 6 | main = do 7 | cfg <- configFile defConfPath 8 | void . runExceptT . mainRun cfg $ (defaultMRO TSAll) 9 | { _mroBench = True 10 | } 11 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: aoc2019 2 | version: 0.1.0.0 3 | github: "mstksg/advent-of-code-2019" 4 | license: BSD3 5 | author: "Justin Le" 6 | maintainer: "justin@jle.im" 7 | copyright: "(c) Justin Le 2019" 8 | 9 | extra-source-files: 10 | - README.md 11 | - CHANGELOG.md 12 | 13 | synopsis: "Development environment for Advent of Code challenges" 14 | category: Web 15 | 16 | description: | 17 | Scaffolding for an integrated development environment for Advent of Code 18 | challenges. Includes auto-runner, prompt displays and countdowns, and 19 | integrated submissions. 20 | 21 | ghc-options: 22 | - -Wall 23 | - -Wcompat 24 | - -Wno-partial-type-signatures 25 | - -Wredundant-constraints 26 | 27 | default-extensions: 28 | - AllowAmbiguousTypes 29 | - ApplicativeDo 30 | - BangPatterns 31 | - BlockArguments 32 | - DataKinds 33 | - DeriveFoldable 34 | - DeriveFunctor 35 | - DeriveGeneric 36 | - DeriveTraversable 37 | - EmptyCase 38 | - FlexibleContexts 39 | - FlexibleInstances 40 | - FunctionalDependencies 41 | - GADTs 42 | - GeneralizedNewtypeDeriving 43 | - ImplicitParams 44 | - KindSignatures 45 | - LambdaCase 46 | - MonadComprehensions 47 | - MultiParamTypeClasses 48 | - MultiWayIf 49 | - NumDecimals 50 | - OverloadedLabels 51 | - PartialTypeSignatures 52 | - PatternGuards 53 | - PatternSynonyms 54 | - PolyKinds 55 | - RankNTypes 56 | - RecordWildCards 57 | - ScopedTypeVariables 58 | - StandaloneDeriving 59 | - TemplateHaskell 60 | - TupleSections 61 | - TypeApplications 62 | - TypeInType 63 | - TypeOperators 64 | - UndecidableInstances 65 | - ViewPatterns 66 | 67 | dependencies: 68 | - base >= 4.7 && < 5 69 | - mtl 70 | 71 | library: 72 | source-dirs: src 73 | dependencies: 74 | - adjunctions 75 | - advent-of-code-api >= 0.2.7 76 | - advent-of-code-ocr 77 | - vector-sized 78 | - aeson 79 | - ansi-terminal 80 | - array 81 | - astar 82 | - bitvec 83 | - bytestring 84 | - carray 85 | - comonad 86 | - conduino >= 0.2.1.0 87 | - conduit 88 | - containers 89 | - criterion 90 | - data-default-class 91 | - data-memocombinators 92 | - deepseq 93 | - directory 94 | - fft 95 | - fgl 96 | - filepath 97 | - finitary 98 | - finite-typelits 99 | - foldl 100 | - free 101 | - generic-lens 102 | - ghc-typelits-knownnat 103 | - ghc-typelits-natnormalise 104 | - graphviz 105 | - groups 106 | - hashable 107 | - haskeline 108 | - haskell-names 109 | - haskell-src-exts 110 | - heredoc 111 | - hmatrix 112 | - hpack 113 | - lens 114 | - lens-regex-pcre 115 | - linear 116 | - megaparsec >= 8.0 117 | - monad-loops 118 | - mtl 119 | - nonempty-containers >= 0.3.3.0 120 | - one-liner-instances 121 | - pandoc 122 | - parallel 123 | - parsec 124 | - parser-combinators >= 1.2.0 125 | - primitive 126 | - profunctors 127 | - psqueues 128 | - recursion-schemes 129 | - safe 130 | - semigroupoids 131 | - sparse-linear-algebra 132 | - split 133 | - template-haskell 134 | - text 135 | - th-abstraction 136 | - time 137 | - transformers 138 | - unordered-containers 139 | - vector 140 | - vector-sized 141 | - vty 142 | - witherable 143 | - yaml 144 | 145 | executables: 146 | aoc2019: 147 | main: aoc.hs 148 | source-dirs: app 149 | ghc-options: 150 | - -threaded 151 | - -rtsopts 152 | - -with-rtsopts=-N 153 | - -O2 154 | - -j4 155 | dependencies: 156 | - ansi-terminal 157 | - aoc2019 158 | - containers 159 | - deepseq 160 | - finite-typelits 161 | - lens 162 | - optparse-applicative 163 | intcode: 164 | main: intcode.hs 165 | source-dirs: app 166 | ghc-options: 167 | - -threaded 168 | - -rtsopts 169 | - -with-rtsopts=-N 170 | - -O2 171 | - -j4 172 | dependencies: 173 | # - ansi-terminal 174 | - aoc2019 175 | # - containers 176 | # - deepseq 177 | # - finite-typelits 178 | # - lens 179 | # - optparse-applicative 180 | 181 | tests: 182 | aoc2019-test: 183 | main: Spec.hs 184 | source-dirs: test 185 | ghc-options: 186 | - -threaded 187 | - -rtsopts 188 | - -with-rtsopts=-N 189 | dependencies: 190 | - aoc2019 191 | - ansi-terminal 192 | 193 | benchmarks: 194 | aoc2019-bench: 195 | main: Bench.hs 196 | source-dirs: bench 197 | ghc-options: 198 | - -threaded 199 | - -rtsopts 200 | - -with-rtsopts=-N 201 | - -O2 202 | dependencies: 203 | - aoc2019 204 | -------------------------------------------------------------------------------- /reflections/day01.md: -------------------------------------------------------------------------------- 1 | 2 | Haskell has a history of making Day 1's seem trivial :) In this case it's a 3 | straightforward map: 4 | 5 | ```haskell 6 | fuel :: Int -> Int 7 | fuel = subtract 2 . (`div` 3) 8 | 9 | part1 :: [Int] -> Int 10 | part1 = sum . map fuel 11 | 12 | part2 :: [Int] -> Int 13 | part2 = sum . map (sum . drop 1 . takeWhile (>= 0) . iterate fuel) 14 | ``` 15 | 16 | These can be parsed with `map read . lines`! 17 | 18 | I accidentally forgot the `drop 1` the first time I submitted, so I hit the 19 | cooldown. Teaches me to remember to test all my answers next time :) 20 | -------------------------------------------------------------------------------- /reflections/day02.md: -------------------------------------------------------------------------------- 1 | So the bytecode/VM problems start day 2 this year, eh? 2 | 3 | This one was also pretty straightforward. For these types of problems, I like 4 | to use `Data.IntMap` or `Data.Sequence` for the memory, since they both have 5 | *O(log n)* indexing. `Data.Sequence` is the better choice here because it's 6 | basically `IntMap` with the indices (0, 1, 2 ...) automatically given for us :) 7 | 8 | I usually use `Data.Sequence` instead of `Data.Vector` because it has a better 9 | story when you want to change the length (by adding or removing elements): 10 | `Data.Vector` is very bad, unless you have some sort of amortized abstraction. 11 | However, in this case we don't ever change the length, so `Data.Vector` is 12 | technically just as good here :) 13 | 14 | So parsing: 15 | 16 | ```haskell 17 | import Data.List.Split (splitOn) 18 | import Data.Sequence (Seq(..)) 19 | import qualified Data.Sequence as Seq 20 | 21 | type Memory = (Int, Seq Int) 22 | 23 | parse :: String -> Memory 24 | parse = (0,) . Seq.fromList . map read . splitOn "," 25 | ``` 26 | 27 | We write our stepping function: 28 | 29 | ```haskell 30 | step :: Memory -> Maybe Memory 31 | step (p, r) = do 32 | o <- Seq.lookup p r >>= \case 33 | 1 -> pure (+) 34 | 2 -> pure (*) 35 | _ -> empty 36 | [a, b, c] <- traverse (`Seq.lookup` r) [p+1 .. p+3] 37 | [y, z] <- traverse (`Seq.lookup` r) [a,b] 38 | pure (p + 4, Seq.update c (o y z) r) 39 | ``` 40 | 41 | And away we go! 42 | 43 | ```haskell 44 | runProg :: Memory -> Maybe Int 45 | runProg m@(_,r) = case step m of 46 | Nothing -> Seq.lookup 0 r 47 | Just m' -> runProg m' 48 | 49 | part1 :: String -> Maybe Int 50 | part1 str = runProg (p, r') 51 | where 52 | (p,r) = parse str 53 | r' = Seq.update 1 12 . Seq.update 2 2 $ r 54 | ``` 55 | 56 | For part 2 we can just do a brute force search 57 | 58 | ```haskell 59 | part2 :: String -> Maybe (Int, Int) 60 | part2 str = listToMaybe 61 | [ (noun, verb) 62 | | noun <- [0..99] 63 | , verb <- [0..99] 64 | , let r' = Seq.update 1 noun . Seq.update 2 verb $ r 65 | , runProg (p, r') == Just 19690720 66 | ] 67 | where 68 | (p, r) = parse str 69 | ``` 70 | 71 | This doesn't take too long on my machine! But for my [actual solution][d02g], 72 | I actually used a binary search (that I had coded up for last year). I 73 | noticed that `noun` increases the answer by a lot, and `verb` increases it by a 74 | little, so by doing an binary search on `noun`, then an binary search 75 | on `verb`, you can get a good answer pretty quickly. My part 2 time (470 μs) 76 | is only twice as long as my part 1 time (260 μs) with the binary search. Happy 77 | that some prep time paid off :) 78 | 79 | ```haskell 80 | part2' :: String -> Maybe (Int, Int) 81 | part2' str = do 82 | noun <- binaryMinSearch (\i -> 83 | runProg (p, Seq.update 1 (i + 1) r) > Just moon 84 | ) 0 99 85 | let r' = Seq.update 1 noun r 86 | verb <- binaryMinSearch (\i -> 87 | runProg (p, Seq.update 2 (i + 1) r) > Just moon 88 | ) 0 99 89 | pure (noun, verb) 90 | where 91 | moon = 19690720 92 | (p, r) = parse str 93 | ``` 94 | 95 | This gets us an O(log n) search instead of an O(n^2) search, cutting down times 96 | pretty nicely. 97 | 98 | Just for the same of completion, I'm including my implementation of 99 | `binaryMinSearch` here. It's tucked away in my utilities/common 100 | functionality file normally! 101 | 102 | ```haskell 103 | -- | Find the lowest value where the predicate is satisfied within the 104 | -- given bounds. 105 | binaryMinSearch 106 | :: (Int -> Bool) 107 | -> Int -- ^ min 108 | -> Int -- ^ max 109 | -> Maybe Int 110 | binaryMinSearch p = go 111 | where 112 | go !x !y 113 | | x == mid || y == mid = Just (x + 1) 114 | | p mid = go x mid 115 | | otherwise = go mid y 116 | where 117 | mid = ((y - x) `div` 2) + x 118 | ``` 119 | -------------------------------------------------------------------------------- /reflections/day03.md: -------------------------------------------------------------------------------- 1 | As another data processing one, I feel like this might be another win for 2 | Haskell as well :) My part 2 leaderboard position was much higher than my 3 | part1 position --- my suspicion is that the new twist made it difficult for 4 | imperative coders, but the twist was naturally handled in the Haskell case. 5 | 6 | First off, I'm going to parse the path not as a series of directions and 7 | numbers, but rather as a list of each individual step to take. This was 8 | similar to my approach for [2016 Day 1][y16d1]. I'm using my favorite type for 9 | describing points, [V2][], because it has a really useful `Num` instance to 10 | support addition of points. 11 | 12 | [y16d1]: https://adventofcode.com/2016/day/1 13 | [V2]: https://hackage.haskell.org/package/linear/docs/Linear-V2.html 14 | 15 | ```haskell 16 | import Data.List.Split 17 | import Linear.V2 18 | 19 | parsePath :: String -> [V2 Int] 20 | parsePath = concatMap parsePoint . splitOn "," 21 | where 22 | parsePoint (d:ns) = replicate (read ns) $ case d of 23 | 'U' -> V2 0 1 24 | 'R' -> V2 1 0 25 | 'D' -> V2 0 (-1) 26 | 'L' -> V2 (-1) 0 27 | parsePoint _ = [] 28 | ``` 29 | 30 | Now, our list of points is simply a cumulative sum, which comes from our best 31 | friend `scanl'` (and family). We use `scanl1` to get the running sum of all 32 | the direction pieces, and get the set of all points. 33 | 34 | ```haskell 35 | visited :: [V2 Int] -> Set (V2 Int) 36 | visited = S.fromList . scanl1 (+) 37 | ``` 38 | 39 | Now Part 1 is: 40 | 41 | ```haskell 42 | part1 :: String -> Int 43 | part1 str = minimum (S.map mannDist (S.intersection xs ys)) 44 | where 45 | [xs, ys] = map (visited . parsePath) (lines str) 46 | mannDist (V2 x y) = abs x + abs y 47 | ``` 48 | 49 | Once we get the intersection (the set of points that are 50 | visited by both), we can map the `mannDist` over each intersection and find the 51 | minimum. 52 | 53 | Part 2 adds an "extra twist", in that now we also want to keep track of the 54 | time it takes to reach each point. This requires only a small tweak to 55 | `visited`: 56 | 57 | ```haskell 58 | visited2 :: [V2 Int] -> Map (V2 Int) Int 59 | visited2 = M.fromListWith min -- turn it into a map, keeping first seen 60 | . flip zip [1..] -- list of (sum, time taken) 61 | . scanl1 (+) -- running sum 62 | ``` 63 | 64 | We pair each item in the running sum with the time taken, and so get a map of 65 | points seen to time taken to get to that point. We make sure to use 66 | `M.fromListWith min` so that we keep the *lowest* time at each point. 67 | 68 | Part 2 is very similar, then: 69 | 70 | ```haskell 71 | part2 :: String -> Int 72 | part2 str = minimum (M.intersectionWith (+) xs ys) 73 | where 74 | [xs, ys] = map (visited2 . parsePath) (lines str) 75 | ``` 76 | 77 | Using `M.intersectionWith (+)` instead of `S.intersection`, because we want the 78 | map that has the same keys in both paths, while adding together the times at 79 | each key. 80 | 81 | Note that we can actually solve `part1` using `visited2` instead of 82 | `visited`...because we can "forget" the values in a `Map (V2 Int) Int` by using 83 | `M.keysSet :: Map k a -> Set k`. 84 | -------------------------------------------------------------------------------- /reflections/day04.md: -------------------------------------------------------------------------------- 1 | I should probably appreciate these Haskell freebies while they still last :) I 2 | have a feeling they're not going to be this frictionless for long! 3 | 4 | It's handy to have a function for giving us consecutive pairs of items: 5 | 6 | ```haskell 7 | consecs :: [a] -> [(a,a)] 8 | consecs xs = zip xs (tail xs) 9 | ``` 10 | 11 | Now for the fun part: making our filters! For part 1, we have two filters on 12 | the digits: first, that the digits are monotonic, and second, that at least one 13 | pair of consecutive digits matches: 14 | 15 | ```haskell 16 | mono :: Ord a => [a] -> Bool 17 | mono = all (\(x,y) -> y >= x) . consecs 18 | 19 | dups :: Eq a => [a] -> Bool 20 | dups = any (\(x,y) -> x == y) . consecs 21 | ``` 22 | 23 | For part 2, we have two filters: the same `mono` filter, but also that we have 24 | a group that is *exactly* length two. For that we can use `group`, which 25 | groups a list into chunks of equal items: `group "abbbcc" == ["a","bbb","cc"]`. 26 | We then check if any of the chunks have a length of exactly two: 27 | 28 | ```haskell 29 | strictDups :: Eq a => [a] -> Bool 30 | strictDups = any ((== 2) . length) . group 31 | ``` 32 | 33 | And from here, we just run our filters on the range and count the number of 34 | items: 35 | 36 | ```haskell 37 | part1 :: Int -> Int -> Int 38 | part1 mn mx = length . filter (\x -> all ($ show x) [mono, dups ]) 39 | $ [mn .. mx] 40 | 41 | part2 :: Int -> Int -> Int 42 | part2 mn mx = length . filter (\x -> all ($ show x) [mono, strictDups]) . range 43 | $ [mn .. mx] 44 | ``` 45 | 46 | For parsing the range, we can use `splitOn` again: 47 | 48 | ```haskell 49 | range :: String -> (x, y) 50 | range str = (x, y) 51 | where 52 | [x, y] = map read (splitOn "-" str) 53 | ``` 54 | 55 | (Also, note to self next time ... if going for time, if you just have two 56 | numbers in your input, just enter the numbers directly into the source file at 57 | first, heh, instead of trying to parse them) 58 | 59 | -------------------------------------------------------------------------------- /reflections/day06.md: -------------------------------------------------------------------------------- 1 | This one is pretty fun in Haskell because you get to use a trick that everyone 2 | loves but nobody gets to use often enough --- [recursive knot tying][knot]! 3 | Basically it's an idiomatic way to do [dynamic programming][dp] in Haskell by 4 | taking advantage of lazy data structures ([this blog post][jelvis] is my 5 | favorite explanation of it). 6 | 7 | [knot]: https://wiki.haskell.org/Tying_the_Knot 8 | [dp]: https://en.wikipedia.org/wiki/Dynamic_programming 9 | [jelvis]: http://jelv.is/blog/Lazy-Dynamic-Programming/ 10 | 11 | The general idea is: let's say we had a map of children to parents, `Map String 12 | String`. To get the count of all indirect orbits, we can get a `Map String 13 | Int`, a map of children to the number of parents and indirect parents above 14 | them, and get the sum of those. 15 | 16 | But how do we compute that? 17 | 18 | Here, I'm going to show the "finale" first, and explain the way to get there: 19 | 20 | ```haskell 21 | type Parent = String 22 | type Child = String 23 | 24 | parents :: Map Child Parent 25 | 26 | parentsCount :: Map Child Int 27 | parentsCount = parents <&> \p -> case M.lookup p parentsCount of 28 | Nothing -> 1 29 | Just n -> n + 1 30 | 31 | parentsOfParents :: Map Child [Parent] 32 | parentsOfParents = parents <&> \p -> case M.lookup p parentsOfParents of 33 | Nothing -> [] 34 | Just ps -> p:ps 35 | ``` 36 | 37 | Fun, right? And satisfyingly symmetrical. That's more or less it! 38 | 39 | So, how do we get there? 40 | 41 | Let's call the child-parent map and the parent counts map as: 42 | 43 | ```haskell 44 | type Parent = String 45 | type Child = String 46 | 47 | parents :: Map Child Parent 48 | parentsCount :: Map Child Int 49 | ``` 50 | 51 | 52 | We see that the two have the same keys, so we can "map" a function over the 53 | `parents` map to get `parentsCount`: 54 | 55 | ```haskell 56 | parentsCount :: Map Child Int 57 | parentsCount = fmap countTheParents parents 58 | 59 | countTheParents :: Parent -> Int 60 | countTheParents p = -- ? 61 | ``` 62 | 63 | So how do we `countTheParents`? Well, we can look the parent up in 64 | `parentsCount`, add one to the answer. That's because if the parent has `n` 65 | indirect parents, then the child has `n + 1` indirect parents: 66 | 67 | ```haskell 68 | parentsCount :: Map Child Int 69 | parentsCount = fmap countTheParents parents 70 | 71 | countTheParents :: Parent -> Int 72 | countTheParents p = case M.lookup p parentsCount of 73 | Nothing -> 1 -- count is 1 74 | Just n -> n + 1 -- count is 1 + number of parents of parents 75 | ``` 76 | 77 | And that's it! 78 | 79 | 80 | ```haskell 81 | part1 :: Int 82 | part1 = sum parentsCount 83 | ```` 84 | 85 | The interesting thing here is that the leaves of `parentsCount` are lazily 86 | evaluated --- so they can recursively refer to each other! 87 | 88 | We can do `part2` in the same way, basically: we can build a list of parents of 89 | parents of parents `"YOU"`, and then a list of parents of parents of parents of 90 | `"SAN"`, and count the number of items that are unique to each. 91 | 92 | ```haskell 93 | parentsOfParents :: Map Child [Parent] 94 | parentsOfParents = fmap getPP parents 95 | 96 | getPP :: Parent -> [Parent] 97 | getPP p = case M.lookup p parentsOfParents of 98 | Nothing -> [] -- no parents 99 | Just pp -> p : pp -- parent consed to parents of parents 100 | ``` 101 | 102 | Note that we actually could have defined `parentsCount` this way too: 103 | 104 | ```haskell 105 | -- we could have done this 106 | parentsCount :: Map Child Int 107 | parentsCount = fmap length parentsOfParents 108 | ``` 109 | 110 | (But this is worse than the way we did it originally. Do you see why?) 111 | 112 | 113 | But anyway, for part 2, we will get the parents of parents of `"YOU"` and the 114 | parents of parents of `"SAN"` and count the items that are unique to each: 115 | 116 | 117 | ```haskell 118 | import qualified Data.Set as S 119 | 120 | part2 :: Int 121 | part2 = S.size onlyYou + S.size onlySan 122 | where 123 | Just you = M.lookup "YOU" parentsOfParents 124 | Just san = M.lookup "SAN" parentsOfParents 125 | onlyYou = you S.\\ san -- remove all items in `san` from `you` 126 | onlySan = san S.\\ you -- remove all items in `you` from `san` 127 | ``` 128 | 129 | Note that because the leaves in a `Map` are lazy, this will only actually 130 | construct a list `[Parent]` for the keys that you look up --- parents lists for 131 | keys you don't care about are never assembled. 132 | 133 | The nice thing about recursive knot tying is that it gives a very concise and 134 | readable way of saying "what you want": 135 | 136 | ```haskell 137 | parentsCount :: Map Child Int 138 | parentsCount = fmap countTheParents parents 139 | 140 | countTheParents :: Parent -> Int 141 | countTheParents p = case M.lookup p parentsCount of 142 | Nothing -> 1 143 | Just n -> n + 1 144 | ``` 145 | 146 | This code is pretty easy to walk through, and logic of getting the parent count 147 | (`countTheParents`) can be easily read as English: "If you get nothing when 148 | you look up the parent in the parents count, then you only have one parent. 149 | If you *do* get something, then it's one plus that something". 150 | 151 | The recursive way here makes it much more readable in a "denotative" sense: you 152 | say what it *is*, and the program/compiler figures out the rest for you. 153 | Because of this, knot tying is often cited as one of the flashy "tech demos" of 154 | denotative programming. You might have seen someone write `fibs = 1 : 1 : 155 | zipWith (+) fibs (tail fibs)` --- that's the same thing going on here. 156 | 157 | And, with a lazy language like Haskell, it means that the leaves remain 158 | unevaluated until we need them. This will explode in your face in other 159 | languages: if you evaluate all of the leaves "in order", then the first item 160 | will depend on another unevaluated item, which might cause an error in other 161 | languages. 162 | 163 | It's always fun when a puzzle demonstrates so well a trick that is essential in 164 | every Haskeller's tool belt :) 165 | -------------------------------------------------------------------------------- /reflections/day08.md: -------------------------------------------------------------------------------- 1 | This one feels like another Haskell freebie from the early days. I'm not 2 | complaining, we'll take what we can get :) 3 | 4 | We'll define a useful function that counts the number of items in a list that 5 | is equal to a given value: 6 | 7 | ```haskell 8 | numMatches :: Eq a => a -> [a] -> Int 9 | numMatches x = length . filter (== x) 10 | ``` 11 | 12 | We can use the [`chunksOf`][chunksOf] function from the amazing *[split][]* 13 | package to split our input into chunks of 150. Then we can find the maximum of 14 | those lines based on their zero count. Then we encode the answer. 15 | 16 | [chunksOf]: https://hackage.haskell.org/package/split/docs/Data-List-Split.html#v:chunksOf 17 | [split]: https://hackage.haskell.org/package/split 18 | 19 | ```haskell 20 | part1 :: String -> Int 21 | part1 = encodeAnswer 22 | . minimumBy (comparing (numMatches '0')) 23 | . chunksOf 150 24 | where 25 | encodeAnswer xs = numMatches '1' xs * numMatches '2' xs 26 | ``` 27 | 28 | For part 2, we can use `transpose` turn a list of lines into a list where every 29 | item is all of the pixel data for that pixel. So it would turn 30 | 31 | ``` 32 | ["1234" 33 | ,"1234" 34 | ,"1234" 35 | ] 36 | ``` 37 | 38 | into 39 | 40 | ``` 41 | ["111" 42 | ,"222" 43 | ,"333" 44 | ,"333" 45 | ] 46 | ``` 47 | 48 | which is exactly what we need to process it. 49 | 50 | Finding the 'pixel value' of each pixel is basically the first non-`2` pixel in 51 | each list. The first way that came to my mind was to use `dropWhile (== 52 | '2')`, but `filter (/= '2')` would have worked as well. 53 | 54 | ```haskell 55 | part2 :: String -> String 56 | part2 = map (head . dropWhile (== '2')) 57 | . transpose 58 | . chunksOf 150 59 | ``` 60 | 61 | And that's it! Well, almost. Part 2 requires looking at 0/1 transparency data 62 | and deducing our image. For me, I wrote a function to display it nicely: 63 | 64 | ```haskell 65 | showImage :: String -> String 66 | showImage = unlines 67 | . chunksOf 25 -- number of columns 68 | . map (\case '0' -> ' '; _ -> '#') 69 | ``` 70 | 71 | ``` 72 | # # ### # # #### ### 73 | # # # # # # # # # 74 | # # ### # # ### # # 75 | # # # # # # # ### 76 | # # # # # # # # 77 | ## ### ## # # 78 | ``` 79 | 80 | -------------------------------------------------------------------------------- /reflections/day10.md: -------------------------------------------------------------------------------- 1 | Ah, a 2D lattice map problem -- a staple of Advent of Code, and a favorite to 2 | many (including me!) 3 | 4 | The first thing to do is get our map into a format we can use. Using `V2 Int` 5 | to represent a 2d point (because of its useful instances like `Num` and 6 | `Applicative`), we want to get things into a `Set` of all asteroids. This is 7 | common enough that I have a pre-made utility function to handle this, but for 8 | demonstration's sake we can implement it like: 9 | 10 | ```haskell 11 | import qualified Data.Set as S 12 | 13 | type Point = V2 Int 14 | 15 | asteroidSet :: String -> Set Point 16 | asteroidSet = ifoldMap (\y -> ifoldMap (\x -> crunch (V2 x y))) 17 | . lines 18 | where 19 | crunch p '#' = S.singleton p 20 | crunch _ _ = S.empty 21 | ``` 22 | 23 | Here I'm using the very handy `ifoldMap :: Monoid m => (Int -> a -> m) -> [a]` 24 | from *[Control.Lens.Indexed][cli]*, which is a very useful function that I hope 25 | will some day make it to *base*. It's like `foldMap` with also the indices 26 | available. 27 | 28 | [cli]: https://www.stackage.org/haddock/lts-14.17/lens-4.17.1/Control-Lens-Indexed.html#v:ifoldMap 29 | 30 | Anyway, how do we check if an asteroid is obscured? There are probably many 31 | good methods, but for me I found all the points in a straight line between two 32 | asteroids, and checked if any of those items are in the asteroid field. (I did 33 | attempt also to get the set of all unique angles, but that method ended up 34 | being 10x slower for some reason? also using floating point equality makes me 35 | feel queasy to my core) 36 | 37 | ```haskell 38 | lineTo :: Point -> Point -> [Point] 39 | lineTo p0 p1 = [ p0 + t *^ step | t <- [1 .. gcf - 1] ] 40 | where 41 | d@(V2 dx dy) = p1 - p0 42 | gcf = gcd dx dy 43 | step = (`div` gcf) <$> d 44 | ``` 45 | 46 | Hopefully this shows at least is a good demonstration of why I like `V2 Int` as 47 | `Point` so much. We take advantages of its instances a lot, including: 48 | 49 | * Using the `Num` instance to compute the deltas, `V2 dx dy = p1 - p0` 50 | * Using the `Functor` instance to compute the step, `(`div` gcf) <$> d` 51 | * The handy scalar multiplication function `c *^ v` 52 | 53 | I love `V2` :D 54 | 55 | Anyway, the main crux of this algorithm is the list comprehension, which 56 | computes the "steps" between the start and finish. 57 | 58 | We can now check all the viewable points. 59 | 60 | ```haskell 61 | viewableIn 62 | :: Set Point -- ^ asteroid field 63 | -> Point -- ^ vantage point 64 | -> Set Point -- ^ all viewable points 65 | viewableIn asteroids p = S.filter good (toList asteroids) 66 | where 67 | good q = p /= q 68 | && all (`S.notMember` asteroids) (lineTo p q) 69 | ``` 70 | 71 | Now we can do part 1: 72 | 73 | ```haskell 74 | part1 :: Set Point -> Int 75 | part1 asteroids = S.findMax $ 76 | S.map (S.length . viewableIn asteroids) asteroids 77 | ``` 78 | 79 | For part 2, we are going to structure our program as an `unfoldr`. Unfoldr 80 | generates items while keeping some internal state. We'll use the "currently 81 | aimed at asteroid" and "asteroids left" as our state, and emit newly eliminated 82 | asteroids. Then we can simply get the 200th item in the resulting list: 83 | 84 | ```haskell 85 | part2 :: Set Point -> Point 86 | part2 asteroids = 87 | unfoldr (shootFrom station) (Nothing, asteroids) !! 199 88 | where 89 | station = maximumBy (comparing (S.size . viewableIn asteroids)) 90 | asteroids 91 | ``` 92 | 93 | So we have `shootFrom` as our iterating function. Our "state" will be `Maybe 94 | Point` (the asteroid our blaster is aimed at) and `Set Point`, the asteroid 95 | field remaining. We'll return `Nothing` when we run out of asteroids to 96 | eliminate. 97 | 98 | To implement `shootFrom`, it's useful to be able to sort all viewable asteroids 99 | by the angle they make. To do that, I made a function `angleFrom` which 100 | computes the angle between two points, clockwise from vertical. I use `atan2` 101 | with some algebraic finessing to make sure north is the *minimal* amount, and 102 | the direction moves appropriately (we flip its arguments and remember to invert 103 | the `y` axis). 104 | 105 | ```haskell 106 | angleTo :: Point -> Point -> Double 107 | angleTo p0 p1 = atan2 (-fromIntegral dx) (fromIntegral dy) 108 | where 109 | V2 dx dy = p1 - p0 110 | ``` 111 | 112 | We now have all the parts to write `shootFrom`: 113 | 114 | ```haskell 115 | shootFrom 116 | :: Point -- ^ station 117 | -> (Maybe Point, Set Point) -- ^ current aim and remaining asteroids 118 | -> Maybe (Point, Maybe Point, Set Point)) -- ^ blasted asteroid, new aim, leftover field 119 | shootFrom station (aim, asteroids) = guard (not (S.null asteroids)) $> 120 | case aim of 121 | Nothing -> 122 | let targ:next:_ = targetList 123 | in (targ, (Just next, S.delete targ asteroids)) 124 | Just a -> 125 | let targ:next:_ = dropWhile (/= a) targetList 126 | in (targ, (Just next, S.delete targ asteroids)) 127 | where 128 | targetList = cycle 129 | . sortOn (angleTo station) 130 | . toList 131 | $ viewableIn asteroids station 132 | ``` 133 | 134 | Our `targetList` is all of the remaining asteroids that are viewable from our 135 | station, sorted by their angle from the station (0 being north, going 136 | clockwise). We `cycle :: [a] -> [a]` it, which loops it on itself forever, so 137 | that the "next target" will always be the item *after* the current target. It 138 | turns `[a,b,c]` into `[a,b,c,a,b,c,a,b,c...]`, so if we want to ask "what 139 | target comes after `c`?", we can see that `a` is after `c` in the cycled 140 | version. 141 | 142 | First, we use `guard` to return `Nothing` immediately if there are no asteroids 143 | left. But if there are asteroids left, we then check what we are aiming at. If 144 | we aren't aiming at anything, just find the first item in the target list and 145 | blast at that. Otherwise, eat up the target list until we find the item we are 146 | aiming at, and blast at that. In both cases, the item after our target will be 147 | the new item we are aiming at. 148 | 149 | We just then need to make sure we delete our target in the new `Set Point`, to 150 | remove it from the pool. 151 | 152 | This one was a nice mix of math, geometry, spatial awareness, and a sense of 153 | iterative algorithms (like `shootFrom`) -- for me, all of the best parts of an 154 | Advent of Code challenge :) 155 | -------------------------------------------------------------------------------- /reflections/day17.md: -------------------------------------------------------------------------------- 1 | It's been a while since one of these! I spent a lot of last week traveling and 2 | it's been tough getting through the backlog :) 3 | 4 | For today I'm only going to be discussing some parts of the solution that I 5 | think are particularly interesting in Haskell: in particular, Part 2's path 6 | construction and compression. 7 | 8 | Once you have a set of points, it's useful to try to figure out the path to the 9 | end. From the constraints of the problem, we can make an educated guess that 10 | our "pathfinding" has to be extremely simple in order to accommodate for the 11 | small program size we can give. Basically, it will be: 12 | 13 | 1. Is there a spot in front of us? If so, step forward and repeat from step 1. 14 | 2. Otherwise, is there a spot to our left? If so, turn left and repeat from 15 | step 1. 16 | 3. Otherwise, is there a spot to our right? If so, turn right and repeat from 17 | step 1. 18 | 4. Otherwise, we've reached the end. 19 | 20 | I'm going to use `Set Point` (where `Point` is `V2 Int`, for reasons discussed in 21 | earlier problems) to describe our scaffolding, and a data type to keep track of 22 | bot state. The directionality will be tracked by keeping a unit vector in the 23 | direction the bot is facing. 24 | 25 | ```haskell 26 | type Point = V2 Int 27 | data BotState = BS { bsPos :: Point, bsDir :: Point } 28 | data Move = TurnLeft | GoForward | TurnRight 29 | deriving Eq 30 | 31 | findPath :: Set Point -> BotState -> [Move] 32 | findPath scaff = unfoldr go 33 | where 34 | go (BS p0 d0@(V2 dx dy)) 35 | | forward `S.member` scaff = Just (GoForward, BS forward d0 ) 36 | | leftward `S.member` scaff = Just (TurnLeft , BS p0 turnLeft ) 37 | | rightward `S.member` scaff = Just (TurnRight, BS p0 turnRight) 38 | where 39 | forward = p0 + d0 40 | turnLeft = V2 dy (-dx) 41 | turnRight = V2 (-dy) dx 42 | leftward = p0 + turnLeft 43 | rightward = p0 + turnRight 44 | ``` 45 | 46 | To turn our path into a "run-length encoding" of instructions, we will convert 47 | them into `Either Int Int`, where `Left n` means "turn left and go `n` 48 | forward", and `Right n` means "turn right and go `n` forwards". The easiest 49 | way to do that is probably to use `group` and `chunksOf` 50 | 51 | ```haskell 52 | pathToProg :: [Move] -> [Either Int Int] 53 | pathToProg = traverse toInstr . chunksOf 2 . group 54 | where 55 | toInstr [[TurnLeft ],fs] = Just $ Left (length fs) 56 | toInstr [[TurnRight],fs] = Just $ Right (length fs) 57 | toInstr _ = Nothing 58 | ``` 59 | 60 | Alright, so now form a `Set Point` and a `BotState` starting point, we get the 61 | run-length encoding of our journey. However, we now need to turn that into 62 | repetitions of three distinct chunks, `A`, `B`, and `C`. 63 | 64 | To do this, we can write a general combinator to turn *any* `[a]` into 65 | encodings in terms of `A`, `B`, and `C` subprograms. Let's call it: 66 | 67 | ```haskell 68 | findProgs :: Eq a => [a] -> Maybe ([a], [a], [a]) 69 | ``` 70 | 71 | If we start thinking about how we can pick these things, we notice some 72 | interesting properties. For example, for a string like `abcdefg`, we have many 73 | possible options for `A`: it's either `a` or `ab` or `abc` or `abcd`, etc. `A` 74 | must be a prefix of our string. However, once we "commit" to an `A`, then that 75 | also gives us our possibilities for `b`: in the same way, `b` must be a prefix 76 | of the remaining string after we "eliminate" `A`. So if we "pick" `A` to be 77 | `abc`, the `B` can be either `d` or `de` or `def` or `defg`, etc. 78 | 79 | This sort of "if we pick this ... then we can pick that ... and if we pick that 80 | ..." system is exactly what *Logic Programming* is great for! And we can 81 | actually do some nice logic programing in Haskell using the List monad. I've 82 | actually written about using the list monad for this purpose [multiple][wgc] 83 | [times][money] over the years. 84 | 85 | [wgc]: https://blog.jle.im/entries/series/+monadplus-success-failure-monads.html 86 | [money]: https://blog.jle.im/entry/unique-sample-drawing-searches-with-list-and-statet.html 87 | 88 | So let's lay out our full algorithm: 89 | 90 | 1. We can pick `A` from any prefix of our string. 91 | 2. Once we break out occurrences of our chosen `A` from the string, we can now 92 | pick `B` from any unbroken prefix of the remaining string. 93 | 3. Once we break out occurrences of our chosen `B` from the string, we can now 94 | pick `C` from any unbroken prefix of the remaining string. 95 | 4. Once we break out occurrences of our chosen `C` from the string, we only 96 | have a "real" solution if there are no other unclaimed items in the string. 97 | 98 | This all translates pretty directly to usage of the `List` monad. `findProgs` 99 | will now return all valid `A`/`B`/`C` pairs: 100 | 101 | ```haskell 102 | findProgs :: Eq a => [a] -> [([a], [a], [a])] 103 | findProgs p0 = do 104 | a <- validPrefix p0 105 | 106 | let withoutA = splitOn' a p0 107 | b <- case withoutA of 108 | [] -> empty -- 'A' consumed everything, whoops 109 | bs : _ -> validPrefix bs 110 | 111 | let withoutB = splitOn' b =<< withoutA 112 | c <- case withoutB of 113 | [] -> empty -- 'A' and 'B' consumed everything, whoops 114 | cs : _ -> validPrefix cs 115 | 116 | let withoutC = splitOn' c =<< withoutB 117 | guard $ null withoutC 118 | 119 | pure (a, b, c) 120 | where 121 | -- | Get all valid prefixes 122 | validPrefix = take 4 . filter (not . null) . inits 123 | -- | a version of splitOn that only returns non-empty lists 124 | splitOn' x = filter (not . null) . splitOn x 125 | ``` 126 | 127 | Note that here I am using a simple predicate to filter out subprograms that are 128 | "too long" (the `take 4` in `validPrefix`). For a more robust solution, we can 129 | do `validPrefix = filter validLength . inits`, testing on the length of the 130 | strings that encode the programs. 131 | 132 | And that is mostly it! We can reconstruct our original program by using 133 | iterated applications of `stripPrefix`, taking whatever prefix is *valid* at 134 | every point: 135 | 136 | ```haskell 137 | -- | Given an association list of subroutines and their "label", iteratively 138 | -- chomp through a string replacing each occurence of the subroutine with the 139 | -- label. 140 | chomp :: Eq a => [([a], b)] -> [a] -> [b] 141 | chomp progs = unfoldr go 142 | where 143 | go xs = asum 144 | [ (r,) <$> stripPrefix prog xs 145 | | (prog, r) <- progs 146 | ] 147 | ``` 148 | 149 | The nice thing about writing these functions "in general" (instead of just for 150 | `Either Int Int`) is that it forces us to ignore some of the unimportant 151 | details, and allows us only to use properties of lists (like lengths) and 152 | equality testing. 153 | 154 | And our final solution is, given a set of scaffolding points and an initial bot 155 | state: 156 | 157 | ```haskell 158 | data Prog = A | B | C 159 | 160 | data Output = O 161 | { oProg :: [Prog] 162 | , oA :: [Either Int Int] 163 | , oB :: [Either Int Int] 164 | , oC :: [Either Int Int] 165 | } 166 | 167 | part2 :: Set Point -> BotState -> Maybe Output 168 | part2 scaff b0 = listToMaybe (findProgs path) <&> \(a,b,c) -> -- <&> is flip fmap 169 | O { oProg = chomp [(a, A), (b, B), (c, C)] path 170 | , oA = a 171 | , oB = b 172 | , oC = c 173 | } 174 | where 175 | path = findPath scaff b0 176 | ``` 177 | -------------------------------------------------------------------------------- /script/generate_days.hs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env stack 2 | -- stack --install-ghc runghc --resolver nightly-2018-11-30 --package template --package text --package filepath --package directory -- -Wall 3 | 4 | {-# LANGUAGE LambdaCase #-} 5 | {-# LANGUAGE OverloadedStrings #-} 6 | 7 | import Control.Monad 8 | import Data.Text.Template 9 | import System.FilePath 10 | import System.Directory 11 | import Text.Printf 12 | import qualified Data.Text as T 13 | import qualified Data.Text.IO as T 14 | import qualified Data.Text.Lazy.IO as TL 15 | 16 | outRoot :: FilePath 17 | outRoot = "src/AOC/Challenge" 18 | 19 | main :: IO () 20 | main = do 21 | temp <- template <$> T.readFile "template/DayXX.hs" 22 | forM_ [1..25] $ \i -> do 23 | let newFilePath = outRoot printf "Day%02d.hs" i 24 | Just newFile = renderA temp (ctx i) 25 | skip <- doesFileExist newFilePath 26 | unless skip $ 27 | TL.writeFile newFilePath newFile 28 | 29 | ctx :: Int -> ContextA Maybe 30 | ctx i = \case 31 | "day" -> Just . T.pack $ printf "%02d" i 32 | "day_short" -> Just . T.pack $ printf "%d" i 33 | _ -> Nothing 34 | -------------------------------------------------------------------------------- /script/open_files.vim: -------------------------------------------------------------------------------- 1 | " 2 | " open_files.vim 3 | " ============== 4 | " 5 | " use: 6 | " 7 | " :source script/open_files.vim 8 | " 9 | " to load the function into scope, where you can call with: 10 | " 11 | " :call OpenAoC(day) 12 | " 13 | " If you use the :source command in a buffer where the filename has a number 14 | " in it (like Day16.hs), this will automatically open all the files associated 15 | " with that day. 16 | " 17 | " Change s:year below to open test data for a different year 18 | " 19 | 20 | let s:year = 2019 21 | 22 | 23 | function! OpenAoC(day) 24 | let l:daystr = printf("%02d",a:day) 25 | let l:yearstr = printf("%04d",s:year) 26 | let l:files = [ "prompt/" . l:daystr . "a.md", 27 | \"prompt/" . l:daystr . "b.md", 28 | \"test-data/" . l:yearstr . "/" . l:daystr . "a.txt", 29 | \"test-data/" . l:yearstr . "/" . l:daystr . "b.txt", 30 | \"data/" . l:daystr . ".txt", 31 | \"src/AOC/Challenge/Day" . l:daystr . ".hs" 32 | \] 33 | 34 | for fn in l:files 35 | execute "e " . fnameescape(fn) 36 | endfor 37 | endfunction 38 | 39 | let s:buffday = str2nr(matchstr(expand('%:t:r'), '\d\+')) 40 | 41 | if (s:buffday == 0) 42 | echo "no valid file found in buffer; use :call OpenAoC(day) to open a day" 43 | else 44 | echo "found day" . string(s:buffday) 45 | call OpenAoC(s:buffday) 46 | endif 47 | -------------------------------------------------------------------------------- /src/AOC.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC 3 | -- Copyright : (c) Justin Le 2018 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : justin@jle.im 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Single-stop entry point for the library's functionality and all 11 | -- challenge solutions. 12 | -- 13 | 14 | module AOC ( 15 | module AOC 16 | ) where 17 | 18 | import AOC.Challenge as AOC 19 | import AOC.Run as AOC 20 | import AOC.Run.Config as AOC 21 | import AOC.Run.Interactive as AOC 22 | import AOC.Run.Load as AOC 23 | import AOC.Solver as AOC 24 | import AOC.Util as AOC 25 | 26 | -------------------------------------------------------------------------------- /src/AOC/Challenge.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TemplateHaskell #-} 2 | {-# OPTIONS_GHC -Wno-dodgy-exports #-} 3 | {-# OPTIONS_GHC -Wno-unused-imports #-} 4 | 5 | -- | 6 | -- Module : AOC.Challenge 7 | -- Copyright : (c) Justin Le 2018 8 | -- License : BSD3 9 | -- 10 | -- Maintainer : justin@jle.im 11 | -- Stability : experimental 12 | -- Portability : non-portable 13 | -- 14 | -- Gather together all challenges and collect them into a single map. 15 | -- 16 | 17 | module AOC.Challenge ( 18 | module AOC 19 | , ChallengeMap 20 | , ChallengeSpec(..), Part(..) 21 | , challengeMap 22 | , lookupSolution 23 | , Day(..), dayInt, mkDay, mkDay_ 24 | , solSpec 25 | , charPart 26 | ) where 27 | 28 | import AOC.Challenge.Day01 as AOC 29 | import AOC.Challenge.Day02 as AOC 30 | import AOC.Challenge.Day03 as AOC 31 | import AOC.Challenge.Day04 as AOC 32 | import AOC.Challenge.Day05 as AOC 33 | import AOC.Challenge.Day06 as AOC 34 | import AOC.Challenge.Day07 as AOC 35 | import AOC.Challenge.Day08 as AOC 36 | import AOC.Challenge.Day09 as AOC 37 | import AOC.Challenge.Day10 as AOC 38 | import AOC.Challenge.Day11 as AOC 39 | import AOC.Challenge.Day12 as AOC 40 | import AOC.Challenge.Day13 as AOC 41 | import AOC.Challenge.Day14 as AOC 42 | import AOC.Challenge.Day15 as AOC 43 | import AOC.Challenge.Day16 as AOC 44 | import AOC.Challenge.Day17 as AOC 45 | import AOC.Challenge.Day18 as AOC 46 | import AOC.Challenge.Day19 as AOC 47 | import AOC.Challenge.Day20 as AOC 48 | import AOC.Challenge.Day21 as AOC 49 | import AOC.Challenge.Day22 as AOC 50 | import AOC.Challenge.Day23 as AOC 51 | import AOC.Challenge.Day24 as AOC 52 | import AOC.Challenge.Day25 as AOC 53 | 54 | import AOC.Discover 55 | import AOC.Solver 56 | import Advent 57 | import Control.Monad 58 | import Data.Finite 59 | import Data.Map (Map) 60 | import qualified Data.Map as M 61 | 62 | -- | A map of all challenges. 63 | challengeMap :: ChallengeMap 64 | challengeMap = mkChallengeMap $$(solutionList "src/AOC/Challenge") 65 | 66 | -- | Lookup up a solution from a 'ChallengeMap' 67 | lookupSolution :: ChallengeSpec -> Map Day (Map Part a) -> Maybe a 68 | lookupSolution CS{..} = M.lookup _csPart <=< M.lookup _csDay 69 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day01.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day01 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 1. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day01 ( 11 | day01a 12 | , day01b 13 | ) where 14 | 15 | import AOC.Solver ((:~>)(..)) 16 | import Text.Read (readMaybe) 17 | 18 | fuel :: Int -> Int 19 | fuel = subtract 2 . (`div` 3) 20 | 21 | day01a :: [Int] :~> Int 22 | day01a = MkSol 23 | { sParse = traverse readMaybe . lines 24 | , sShow = show 25 | , sSolve = Just . sum . map fuel 26 | } 27 | 28 | day01b :: [Int] :~> Int 29 | day01b = MkSol 30 | { sParse = traverse readMaybe . lines 31 | , sShow = show 32 | , sSolve = Just . sum . map (sum . drop 1 . takeWhile (>= 0) . iterate fuel) 33 | } 34 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day02.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day02 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 2. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day02 ( 11 | day02a 12 | , day02b 13 | ) where 14 | 15 | import AOC.Common.Intcode (Memory(..), IErr(..), parseMem, stepForever) 16 | import AOC.Common.Search (binaryMinSearch) 17 | import AOC.Solver ((:~>)(..), dyno_) 18 | import AOC.Util (eitherToMaybe) 19 | import Control.Monad.Except (throwError) 20 | import Data.Conduino (runPipe, (.|), (|.)) 21 | import qualified Data.Conduino.Combinators as C 22 | import qualified Data.Map as M 23 | 24 | setMem :: Maybe Int -> Maybe Int -> Memory -> Memory 25 | setMem noun verb m = m { mRegs = maybe id (M.insert 2) verb 26 | . maybe id (M.insert 1) noun 27 | $ mRegs m 28 | } 29 | 30 | 31 | runProg :: Memory -> Maybe Int 32 | runProg m = eitherToMaybe . runPipe $ 33 | throwError IENoInput 34 | .| ((M.! 0) . mRegs <$> stepForever m) 35 | |. C.sinkNull 36 | 37 | day02a :: Memory :~> Int 38 | day02a = MkSol 39 | { sParse = parseMem 40 | , sShow = show 41 | , sSolve = runProg 42 | . setMem (Just (dyno_ "noun" 12)) (Just (dyno_ "verb" 2)) 43 | } 44 | 45 | day02b :: Memory :~> (Int, Int) 46 | day02b = MkSol 47 | { sParse = parseMem 48 | , sShow = \(noun,verb) -> show $ noun * 100 + verb 49 | , sSolve = \m -> do 50 | -- for my code, noun makes big jumps and verb makes small ones 51 | -- search for noun first 52 | noun <- binaryMinSearch (\i -> 53 | (> Just moon) . runProg . setMem (Just (i + 1)) Nothing $ m 54 | ) 0 99 55 | let m' = setMem (Just noun) Nothing m 56 | -- search for verb next 57 | verb <- binaryMinSearch (\j -> 58 | (> Just moon) . runProg . setMem Nothing (Just (j + 1)) $ m' 59 | ) 0 99 60 | pure (noun, verb) 61 | } 62 | where 63 | moon = 19690720 64 | 65 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day03.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day03 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 3. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day03 ( 11 | day03a 12 | , day03b 13 | ) where 14 | 15 | import AOC.Common (Point, mannDist, Dir, dirPoint, parseDir) 16 | import AOC.Solver ((:~>)(..)) 17 | import Control.Monad ((<=<)) 18 | import Data.List.NonEmpty (NonEmpty(..)) 19 | import Data.List.Split (splitOn) 20 | import Data.Map (Map) 21 | import Data.Semigroup (Min(..)) 22 | import Safe (scanl1Def) 23 | import Safe.Foldable (minimumMay) 24 | import Text.Read (readMaybe) 25 | import qualified Data.List.NonEmpty as NE 26 | import qualified Data.Map as M 27 | 28 | type Path = [(Dir, Int)] 29 | 30 | parsePath :: String -> Maybe Path 31 | parsePath = traverse parsePoint . splitOn "," 32 | where 33 | parsePoint (d:ns) = (,) <$> parseDir d <*> readMaybe ns 34 | parsePoint _ = Nothing 35 | 36 | -- | From a list of paths, get a Map of the points where they cross, along 37 | -- with the minimum time sum to get to that point. 38 | crossings :: NonEmpty Path -> Map Point Int 39 | crossings = foldr1 (M.intersectionWith (+)) . fmap follow 40 | where 41 | -- a map of every point visted to the steps taken to visit it 42 | follow :: Path -> Map Point Int 43 | follow = M.fromListWith min 44 | . flip zip [1..] 45 | . scanl1Def [] (+) 46 | . concatMap (uncurry expandDir) 47 | expandDir d ns = replicate ns (dirPoint d) 48 | 49 | day03a :: NonEmpty Path :~> Int 50 | day03a = MkSol 51 | { sParse = NE.nonEmpty <=< traverse parsePath . lines 52 | , sShow = show 53 | , sSolve = fmap getMin 54 | . foldMap (Just . Min . mannDist 0) 55 | . M.keys 56 | . crossings 57 | } 58 | 59 | day03b :: NonEmpty Path :~> Int 60 | day03b = MkSol 61 | { sParse = NE.nonEmpty <=< traverse parsePath . lines 62 | , sShow = show 63 | , sSolve = minimumMay . crossings 64 | } 65 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day04.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day04 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 4. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day04 ( 11 | day04a 12 | , day04b 13 | ) where 14 | 15 | import AOC.Solver ((:~>)(..)) 16 | import Data.List (group) 17 | import Data.List.Split (splitOn) 18 | import Text.Read (readMaybe) 19 | 20 | range :: String -> Maybe [Int] 21 | range str = do 22 | [x,y] <- traverse readMaybe . splitOn "-" $ str 23 | pure [x..y] 24 | 25 | consecs :: [a] -> [(a,a)] 26 | consecs xs = zip xs (drop 1 xs) 27 | 28 | monotonic :: Ord a => [a] -> Bool 29 | monotonic = all (\(x,y) -> y >= x) . consecs 30 | 31 | doubles :: Eq a => [a] -> Bool 32 | doubles = any (uncurry (==)) . consecs 33 | 34 | strictDoubles :: Eq a => [a] -> Bool 35 | strictDoubles = any ((== 2) . length) . group 36 | 37 | -- NOTE TO SELF: next time just literally type in the numbers here, heh, no 38 | -- need to parse 39 | day04a :: [Int] :~> Int 40 | day04a = MkSol 41 | { sParse = range 42 | , sShow = show 43 | , sSolve = Just 44 | . length 45 | . filter (\x -> all ($ show x) [monotonic, doubles ]) 46 | } 47 | 48 | day04b :: [Int] :~> Int 49 | day04b = MkSol 50 | { sParse = range 51 | , sShow = show 52 | , sSolve = Just 53 | . length 54 | . filter (\x -> all ($ show x) [monotonic, strictDoubles]) 55 | } 56 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day05.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ExistentialQuantification #-} 2 | 3 | -- | 4 | -- Module : AOC.Challenge.Day05 5 | -- License : BSD3 6 | -- 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Day 5. See "AOC.Solver" for the types used in this module! 11 | 12 | module AOC.Challenge.Day05 ( 13 | day05a 14 | , day05b 15 | ) where 16 | 17 | import AOC.Common.Intcode (Memory, IErr, parseMem, yieldAndDie, stepForever) 18 | import AOC.Solver ((:~>)(..)) 19 | import Data.Conduino ((.|), runPipe) 20 | import Data.Either (fromRight) 21 | import qualified Data.Conduino.Combinators as C 22 | 23 | runProg :: Int -> Memory -> Either IErr (Maybe Int) 24 | runProg i m = runPipe $ yieldAndDie i 25 | .| stepForever m 26 | .| C.last 27 | 28 | day05a :: Memory :~> Int 29 | day05a = MkSol 30 | { sParse = parseMem 31 | , sShow = show 32 | , sSolve = fromRight Nothing . runProg 1 33 | } 34 | 35 | day05b :: Memory :~> Int 36 | day05b = MkSol 37 | { sParse = parseMem 38 | , sShow = show 39 | , sSolve = fromRight Nothing . runProg 5 40 | } 41 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day06.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day06 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 6. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day06 ( 11 | day06a 12 | , day06b 13 | ) where 14 | 15 | import AOC.Solver ((:~>)(..)) 16 | import Data.Functor ((<&>)) 17 | import Data.List.Split (splitOn) 18 | import Data.Map (Map) 19 | import qualified Data.Map as M 20 | import qualified Data.Set as S 21 | 22 | parseParents :: String -> Map String String 23 | parseParents str = M.fromList [ 24 | (y, x) 25 | | ln <- lines str 26 | , [x,y] <- [splitOn ")" ln] 27 | ] 28 | 29 | day06a :: Map String String :~> Int 30 | day06a = MkSol 31 | { sParse = Just . parseParents 32 | , sShow = show 33 | , sSolve = \parents -> Just $ 34 | let orbits :: Map String Int 35 | orbits = parents <&> \v -> 36 | case M.lookup v orbits of 37 | Nothing -> 1 38 | Just s -> s + 1 39 | in sum orbits 40 | } 41 | 42 | day06b :: Map String String :~> Int 43 | day06b = MkSol 44 | { sParse = Just . parseParents 45 | , sShow = show 46 | , sSolve = \parents -> do 47 | let orbits :: Map String [String] 48 | orbits = parents <&> \v -> 49 | case M.lookup v orbits of 50 | Nothing -> [] 51 | Just ss -> v:ss 52 | you <- S.fromList <$> M.lookup "YOU" orbits 53 | san <- S.fromList <$> M.lookup "SAN" orbits 54 | let onlyYou = you S.\\ san 55 | onlySan = san S.\\ you 56 | pure $ S.size onlyYou + S.size onlySan 57 | } 58 | 59 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day07.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day07 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 7. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day07 ( 11 | day07a 12 | , day07b 13 | ) where 14 | 15 | import AOC.Common.Intcode (Memory, VM, IErr, untilHalt, stepForeverAndDie, parseMem, yieldAndDie, yieldAndPass) 16 | import AOC.Solver ((:~>)(..)) 17 | import AOC.Util (eitherToMaybe) 18 | import Control.Monad.Except (MonadError) 19 | import Data.Conduino ((.|), runPipePure, runPipe, awaitSurely, feedbackPipe) 20 | import Data.List (permutations) 21 | import Data.Semigroup (Max(..)) 22 | import Data.Void (Void) 23 | import qualified Data.Conduino.Combinators as C 24 | 25 | setupChain :: MonadError IErr m => Memory -> [Int] -> VM m Void 26 | setupChain m = foldr ((.|) . prime) (C.map id) 27 | where 28 | prime i = yieldAndPass i 29 | .| stepForeverAndDie m 30 | 31 | day07a :: Memory :~> Int 32 | day07a = MkSol 33 | { sParse = parseMem 34 | , sShow = show 35 | , sSolve = \m -> fmap getMax . flip foldMap (permutations [0..4]) $ \xs -> 36 | let res = runPipe $ yieldAndDie 0 37 | .| setupChain m xs 38 | .| awaitSurely 39 | in Max <$> eitherToMaybe res 40 | } 41 | 42 | day07b :: Memory :~> Int 43 | day07b = MkSol 44 | { sParse = parseMem 45 | , sShow = show 46 | , sSolve = \m -> fmap getMax . flip foldMap (permutations [5..9]) $ \xs -> 47 | let res = runPipePure $ untilHalt ( yieldAndDie 0 48 | .| feedbackPipe (setupChain m xs) 49 | ) 50 | .| C.last 51 | in Max <$> res 52 | } 53 | 54 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day08.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day08 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 8. See "AOC.Solver" for the types used in this module! 9 | -- 10 | -- After completing the challenge, it is recommended to: 11 | 12 | module AOC.Challenge.Day08 ( 13 | day08a 14 | , day08b 15 | ) where 16 | 17 | import AOC.Common (parseAsciiMap, countTrue) 18 | import AOC.Solver ((:~>)(..), dyno_) 19 | import Advent.OCR (parseLettersWith) 20 | import Control.Monad (guard) 21 | import Control.Lens (view) 22 | import Data.List (transpose) 23 | import Data.List.Split (chunksOf) 24 | import Data.Maybe (fromMaybe) 25 | import Data.Maybe (listToMaybe, fromJust) 26 | import Data.Ord (comparing) 27 | import Linear (_x, _y) 28 | import Safe (minimumByMay) 29 | import qualified Data.Map as M 30 | 31 | day08a :: String :~> Int 32 | day08a = MkSol 33 | { sParse = Just 34 | , sShow = show 35 | , sSolve = fmap answer 36 | . minimumByMay (comparing (countTrue (== '0'))) 37 | . chunksOf (dyno_ "w" 25 * dyno_ "h" 6) 38 | } 39 | where 40 | answer x = countTrue (== '1') x * countTrue (== '2') x 41 | 42 | day08b :: [String] :~> String 43 | day08b = MkSol 44 | { sParse = Just . chunksOf 150 45 | -- , sShow = unlines . chunksOf 25 . map (\case '0' -> ' '; _ -> '#') 46 | , sShow = fromMaybe "" . parseLettersWith (view _x) (view _y) 47 | . M.keysSet 48 | . parseAsciiMap (guard . (== '1')) 49 | . unlines 50 | . chunksOf 25 51 | , sSolve = traverse (listToMaybe . filter (/= '2')) . transpose 52 | } 53 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day09.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day09 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 9. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day09 ( 11 | day09a 12 | , day09b 13 | ) where 14 | 15 | import AOC.Common.Intcode (Memory, IErr, yieldAndDie, stepForever, parseMem) 16 | import AOC.Solver ((:~>)(..)) 17 | import AOC.Util (eitherToMaybe) 18 | import Control.Monad (join) 19 | import Data.Conduino (runPipe, (.|), await) 20 | 21 | runProg :: Int -> Memory -> Either IErr (Maybe Int) 22 | runProg i m = runPipe $ yieldAndDie i 23 | .| stepForever m 24 | .| await 25 | 26 | day09a :: Memory :~> Int 27 | day09a = MkSol 28 | { sParse = parseMem 29 | , sShow = show 30 | , sSolve = join . eitherToMaybe . runProg 1 31 | } 32 | 33 | day09b :: Memory :~> Int 34 | day09b = MkSol 35 | { sParse = parseMem 36 | , sShow = show 37 | , sSolve = join . eitherToMaybe . runProg 2 38 | } 39 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day10.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day10 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 10. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day10 ( 11 | day10a 12 | , day10b 13 | ) where 14 | 15 | import AOC.Common (Point, parseAsciiMap, maximumValNE, lineTo, drop') 16 | import AOC.Solver ((:~>)(..)) 17 | import Control.Monad (guard) 18 | import Data.Foldable (toList) 19 | import Data.List (sortOn, unfoldr) 20 | import Data.Maybe (listToMaybe) 21 | import Data.Semigroup (Max(..)) 22 | import Data.Semigroup.Foldable (foldMap1) 23 | import Data.Set.NonEmpty (NESet) 24 | import Linear (V2(..)) 25 | import qualified Data.Map as M 26 | import qualified Data.Map.NonEmpty as NEM 27 | import qualified Data.Set.NonEmpty as NES 28 | 29 | angleTo :: Point -> Point -> Double 30 | angleTo p0 p1 = atan2 (-fromIntegral dx) (fromIntegral dy) 31 | where 32 | V2 dx dy = p1 - p0 33 | 34 | viewableIn :: NESet Point -> Point -> [Point] 35 | viewableIn s p = filter good . toList . NES.delete p $ s 36 | where 37 | good q = all (`NES.notMember` s) (lineTo p q) 38 | 39 | day10a :: NESet Point :~> Int 40 | day10a = MkSol 41 | { sParse = NES.nonEmptySet . M.keysSet . parseAsciiMap (\c -> guard (c == '#')) 42 | , sShow = show 43 | , sSolve = \as -> Just . getMax . foldMap1 (Max . length . viewableIn as) $ as 44 | } 45 | 46 | day10b :: NESet Point :~> Point 47 | day10b = MkSol 48 | { sParse = NES.nonEmptySet . M.keysSet . parseAsciiMap (\c -> guard (c == '#')) 49 | , sShow = \case V2 x y -> show $ x * 100 + y 50 | , sSolve = \as -> 51 | let (station, _) = maximumValNE $ NEM.fromSet (length . viewableIn as) as 52 | as' = NES.delete station as 53 | in listToMaybe . drop' 199 $ 54 | unfoldr (uncurry (shootFrom station)) (Nothing, as') 55 | } 56 | where 57 | shootFrom p aim as = do 58 | as' <- NES.nonEmptySet as 59 | let targ:next:_ = dropper . cycle . sortOn (angleTo p) $ viewableIn as' p 60 | pure (targ, (Just next, NES.delete targ as')) 61 | where 62 | dropper = case aim of 63 | Nothing -> id 64 | Just a -> dropWhile (/= a) 65 | 66 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day11.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day11 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 11. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day11 ( 11 | day11a 12 | , day11b 13 | ) where 14 | 15 | import AOC.Common (Dir(..), dirPoint, Point) 16 | import AOC.Common.Intcode (Memory, parseMem, stepForeverAndDie, untilHalt) 17 | import AOC.Solver ((:~>)(..)) 18 | import Advent.OCR (parseLettersWith) 19 | import Control.DeepSeq (NFData) 20 | import Control.Lens (view) 21 | import Control.Monad (forever) 22 | import Control.Monad.State (MonadState, gets, execState, modify) 23 | import Data.Conduino (Pipe, (.|), runPipe, awaitSurely) 24 | import Data.Functor ((<&>)) 25 | import Data.Map (Map) 26 | import Data.Maybe (fromMaybe) 27 | import Data.Void (Void) 28 | import GHC.Generics (Generic) 29 | import Linear (_x, _y) 30 | import qualified Data.Conduino.Combinators as C 31 | import qualified Data.Map as M 32 | 33 | data Hull = Hull 34 | { hDir :: Dir 35 | , hPos :: Point 36 | , hMap :: Map Point Color 37 | } 38 | deriving (Eq, Ord, Show, Generic) 39 | instance NFData Hull 40 | 41 | data Color = Black | White 42 | deriving (Eq, Ord, Enum, Show, Generic) 43 | instance NFData Color 44 | 45 | -- | Empty hull 46 | emptyHull :: Hull 47 | emptyHull = Hull North 0 M.empty 48 | 49 | -- | Empty hull with a single colored item at the origin 50 | singletonHull :: Color -> Hull 51 | singletonHull c = Hull North 0 (M.singleton 0 c) 52 | 53 | -- | The producer of signals. Sends 0 or 1 by detecting color under 54 | -- current position on 'Hull'. 55 | sensor 56 | :: MonadState Hull m 57 | => Pipe () Int u m Void 58 | sensor = C.repeatM . gets $ \(Hull _ p h) -> 59 | case M.lookup p h of 60 | Just White -> 1 61 | _ -> 0 62 | 63 | -- | The consumer of signals. Takes 0's and 1's to indicate color to paint 64 | -- and direction to turn and step. 65 | painterMover 66 | :: MonadState Hull m 67 | => Pipe Int Void Void m Void 68 | painterMover = forever $ do 69 | color <- awaitSurely <&> \case 70 | 0 -> Black 71 | 1 -> White 72 | _ -> undefined 73 | turn <- awaitSurely <&> \case 74 | 0 -> West 75 | 1 -> East 76 | _ -> undefined 77 | modify $ \(Hull d p h) -> Hull 78 | { hDir = d <> turn 79 | , hPos = p + dirPoint (d <> turn) 80 | , hMap = M.insert p color h 81 | } 82 | 83 | -- | This is it 84 | fullPipe 85 | :: MonadState Hull m 86 | => Memory 87 | -> Pipe () Void u m () 88 | fullPipe m = untilHalt $ sensor 89 | .| stepForeverAndDie m 90 | .| painterMover 91 | 92 | day11a :: Memory :~> Int 93 | day11a = MkSol 94 | { sParse = parseMem 95 | , sShow = show 96 | , sSolve = \m -> Just . M.size . hMap 97 | $ execState (runPipe (fullPipe m)) emptyHull 98 | } 99 | 100 | day11b :: Memory :~> Map Point Color 101 | day11b = MkSol 102 | { sParse = parseMem 103 | , sShow = fromMaybe "" . parseLettersWith (view _x) (view _y) 104 | . M.keysSet . M.filter (== White) 105 | , sSolve = \m -> Just . hMap 106 | $ execState (runPipe (fullPipe m)) (singletonHull White) 107 | } 108 | 109 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day12.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day12 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 12. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day12 ( 11 | day12a 12 | , day12b 13 | ) where 14 | 15 | import AOC.Common ((!!!), clearOut) 16 | import AOC.Solver ((:~>)(..), dyno_) 17 | import Data.Char (isDigit) 18 | import Data.List (findIndex) 19 | import Data.Semigroup (Sum(..)) 20 | import Linear (V3(..), V4(..)) 21 | import Text.Read (readMaybe) 22 | import qualified Data.List.NonEmpty as NE 23 | 24 | type Point = V3 Int 25 | 26 | data Phase a = Phase { pPos :: !a, pVel :: !a } 27 | deriving (Show, Eq, Ord, Functor, Foldable, Traversable) 28 | 29 | parsePos :: String -> Maybe (Phase Point) 30 | parsePos str = do 31 | [x,y,z] <- traverse readMaybe . words . clearOut p $ str 32 | pure $ Phase { pPos = V3 x y z, pVel = 0 } 33 | where 34 | p '-' = False 35 | p c = not (isDigit c) 36 | 37 | getAccels 38 | :: Num a 39 | => V4 (Phase a) 40 | -> V4 a 41 | getAccels xs = fmap acc xs 42 | where 43 | acc (Phase x _) = getSum 44 | . foldMap (Sum . signum . subtract x . pPos) 45 | $ xs 46 | 47 | step 48 | :: Num a 49 | => V4 (Phase a) 50 | -> V4 (Phase a) 51 | step ps = update <$> ps <*> getAccels ps 52 | where 53 | update (Phase x v) a = Phase (x + v') v' 54 | where 55 | v' = v + a 56 | 57 | day12a :: V4 (Phase Point) :~> Int 58 | day12a = MkSol 59 | { sParse = \str -> do 60 | [a,b,c,d] <- traverse parsePos . lines $ str 61 | pure $ V4 a b c d 62 | , sShow = show 63 | , sSolve = Just . getSum 64 | . foldMap (Sum . energy) 65 | . (!!! dyno_ "steps" 1000) 66 | . iterate step 67 | } 68 | where 69 | energy (Phase x v) = sum (abs x) * sum (abs v) 70 | 71 | 72 | -- here we run three independent simulations of 4 one-dimensional planets 73 | day12b :: V3 (V4 (Phase Int)) :~> Int 74 | day12b = MkSol 75 | { sParse = \str -> do 76 | [a,b,c,d] <- traverse parsePos . lines $ str 77 | pure . traverse sequenceA $ V4 a b c d 78 | , sShow = show 79 | , sSolve = fmap (foldl1 lcm) 80 | . traverse (findCycle . NE.tail . NE.iterate step) 81 | -- find the cycle in each three independent simulations 82 | } 83 | 84 | -- | The cycle is halfway done when the velocities invert (that is, become 85 | -- 0) 86 | findCycle :: (Eq a, Num a) => [V4 (Phase a)] -> Maybe Int 87 | findCycle = fmap ((*2) . (+1)) . findIndex ((== 0) . fmap pVel) 88 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day13.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingStrategies #-} 2 | {-# LANGUAGE DerivingVia #-} 3 | {-# LANGUAGE TypeApplications #-} 4 | 5 | -- | 6 | -- Module : AOC.Challenge.Day13 7 | -- License : BSD3 8 | -- 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- Day 13. See "AOC.Solver" for the types used in this module! 13 | 14 | module AOC.Challenge.Day13 ( 15 | day13a 16 | , day13b 17 | , playDay13 18 | ) where 19 | 20 | import AOC.Common (Point, displayAsciiMap) 21 | import AOC.Common.Intcode (parseMem, Memory(..), VMErr, mRegLens, stepForever, untilHalt) 22 | import AOC.Solver ((:~>)(..)) 23 | import Control.Applicative (empty) 24 | import Control.DeepSeq (NFData) 25 | import Control.Lens ((&), (.~), set) 26 | import Control.Monad (join) 27 | import Control.Monad.IO.Class (liftIO) 28 | import Control.Monad.State (get, put, evalState) 29 | import Control.Monad.Trans.Maybe (MaybeT(..)) 30 | import Data.Coerce (coerce) 31 | import Data.Conduino ((.|), Pipe, runPipe, yield, await) 32 | import Data.Foldable (forM_) 33 | import Data.Map (Map) 34 | import Data.Monoid.OneLiner (GMonoid(..)) 35 | import Data.Semigroup (Last(..), Max(..), Dual(..)) 36 | import Data.Set (Set) 37 | import GHC.Generics (Generic) 38 | import Linear.V2 (V2(..)) 39 | import Linear.V3 (V3(..)) 40 | import qualified Data.Conduino.Combinators as C 41 | import qualified Data.Map as M 42 | import qualified Data.Set as S 43 | import qualified Graphics.Vty as V 44 | 45 | data Tile = Blank | Wall | Block | Paddle | Ball 46 | deriving (Eq, Ord, Enum, Generic) 47 | instance NFData Tile 48 | 49 | tileMap :: Map Int Tile 50 | tileMap = M.fromList $ zip [0..] [Blank ..] 51 | 52 | displayWith 53 | :: (Monoid o, Monad m) 54 | => (Either Int (Point, Tile) -> o) -- ^ what do we want to aggregate? 55 | -> Pipe Int o u m () 56 | displayWith f = parseOutput 57 | .| C.map f 58 | .| C.scan (<>) mempty 59 | where 60 | parseOutput = do 61 | outs <- sequenceA $ V3 await await await 62 | forM_ (sequenceA outs) $ \(V3 x y z) -> do 63 | if (x, y) == (-1, 0) 64 | then yield (Left z) 65 | else forM_ (M.lookup z tileMap) $ \t -> 66 | yield (Right (V2 x y, t)) 67 | parseOutput 68 | 69 | day13a :: Memory :~> Int 70 | day13a = MkSol 71 | { sParse = parseMem 72 | , sShow = show 73 | , sSolve = fmap S.size . getTiles 74 | } 75 | where 76 | getTiles m = join . runPipe $ 77 | empty 78 | .| untilHalt (stepForever @VMErr m) 79 | .| displayWith (\case Right (p, Block) -> S.singleton p 80 | _ -> mempty 81 | ) 82 | .| C.last 83 | 84 | 85 | day13b :: Memory :~> Int 86 | day13b = MkSol 87 | { sParse = parseMem 88 | , sShow = show 89 | , sSolve = \m -> do 90 | (Just scr, 0) <- ai $ set (mRegLens 0) 2 m 91 | pure scr 92 | } 93 | 94 | data AI = AI { aiScore :: !(Maybe (Last Int)) 95 | , aiPaddle :: !(Maybe (Last Int)) 96 | , aiBall :: !(Maybe (Last Int)) 97 | , aiBlocks :: !(Set Point) 98 | , aiBlanks :: !(Set Point) 99 | } 100 | deriving Generic 101 | deriving Semigroup via (GMonoid AI) 102 | deriving Monoid via (GMonoid AI) 103 | 104 | ai :: Memory -> Maybe (Maybe Int, Int) 105 | ai m = flip evalState (Nothing, Nothing) . runPipe $ 106 | C.repeatM controller 107 | .| untilHalt (stepForever @VMErr m) 108 | .| displayWith aggregator 109 | .| C.iterM (\AI{..} -> put . coerce $ ( aiPaddle, aiBall )) 110 | .| (fmap outScore <$> C.last) 111 | where 112 | controller = do 113 | (paddlePos, ballPos) <- get 114 | case (,) <$> paddlePos <*> ballPos of 115 | Nothing -> pure 0 116 | Just (p, b) -> pure $ signum (b - p) 117 | aggregator = \case 118 | Left s -> mempty { aiScore = Just (Last s) } 119 | Right (V2 x _, Paddle) -> mempty { aiPaddle = Just (Last x) } 120 | Right (V2 x _, Ball ) -> mempty { aiBall = Just (Last x) } 121 | Right (p , Block ) -> mempty { aiBlocks = S.singleton p } 122 | Right (p , Blank ) -> mempty { aiBlanks = S.singleton p } 123 | _ -> mempty 124 | outScore AI{..} = (coerce aiScore, S.size $ aiBlocks S.\\ aiBlanks) 125 | 126 | 127 | data Display = Disp 128 | { dispScore :: !(Maybe (Max Int)) 129 | , dispScreen :: !(Dual (Map Point Tile)) 130 | } 131 | deriving Generic 132 | deriving Semigroup via (GMonoid Display) 133 | deriving Monoid via (GMonoid Display) 134 | 135 | playDay13 :: String -> IO () 136 | playDay13 str = do 137 | Just m <- pure $ parseMem str 138 | cfg <- V.standardIOConfig 139 | vty <- V.mkVty cfg 140 | disp <- fmap join . runMaybeT . runPipe $ 141 | C.repeatM (inputter vty) 142 | .| untilHalt (stepForever @VMErr (m & mRegLens 0 .~ 2)) 143 | .| displayWith aggregator 144 | .| C.iterM (liftIO . V.update vty . V.picForImage . mkImage . render) 145 | .| C.last 146 | V.shutdown vty 147 | forM_ (dispScore =<< disp) $ \(Max s) -> 148 | putStrLn $ "final score: " ++ show s 149 | where 150 | inputter vty = do 151 | l <- liftIO $ V.nextEvent vty 152 | case l of 153 | V.EvKey V.KLeft _ -> pure (-1) 154 | V.EvKey V.KRight _ -> pure 1 155 | V.EvKey V.KEsc _ -> empty 156 | V.EvKey (V.KChar 'a') _ -> pure (-1) 157 | V.EvKey (V.KChar 'd') _ -> pure 1 158 | V.EvKey (V.KChar 'q') _ -> empty 159 | _ -> pure 0 160 | render Disp{..} = unlines 161 | [ displayAsciiMap ' ' $ fmap tileChar (coerce dispScreen) 162 | , case dispScore of 163 | Nothing -> "No score" 164 | Just (Max s) -> show s 165 | , "←/a left" 166 | , "↓/s neutral" 167 | , "→/d right" 168 | , "esc/q quit" 169 | ] 170 | aggregator = \case 171 | Left s -> mempty { dispScore = Just (Max s) } 172 | Right (p, t) -> mempty { dispScreen = Dual $ M.singleton p t } 173 | mkImage = V.vertCat . map (V.string mempty) . lines 174 | 175 | tileChar :: Tile -> Char 176 | tileChar = \case 177 | Blank -> ' ' 178 | Wall -> '|' 179 | Block -> '#' 180 | Paddle -> '-' 181 | Ball -> 'o' 182 | 183 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day14.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day14 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | 8 | module AOC.Challenge.Day14 ( 9 | day14a 10 | , day14b 11 | ) where 12 | 13 | import AOC.Common (clearOut, loopEither) 14 | import AOC.Common.Search (exponentialMinSearch) 15 | import AOC.Solver ((:~>)(..)) 16 | import Control.DeepSeq (NFData) 17 | import Data.List.NonEmpty (NonEmpty(..)) 18 | import Data.List.Split (chunksOf) 19 | import Data.Map (Map) 20 | import Data.Map.NonEmpty (NEMap) 21 | import GHC.Generics (Generic) 22 | import Text.Read (readMaybe) 23 | import qualified Data.Map as M 24 | import qualified Data.Map.NonEmpty as NEM 25 | 26 | type Recipes = Map String (Int, NEMap String Int) 27 | 28 | parseRecipeLine :: String -> Maybe Recipes 29 | parseRecipeLine = (agg . reverse =<<) 30 | . traverse parseChunk 31 | . chunksOf 2 32 | . words 33 | . clearOut (`elem` (",=>" :: String)) 34 | where 35 | parseChunk [readMaybe->Just x, y] = Just (y, x) 36 | parseChunk _ = Nothing 37 | agg ((x,c):k:ks) = Just $ M.singleton x (c, NEM.fromList (k :| ks)) 38 | agg _ = Nothing 39 | 40 | data Basket = B { bOre :: Int 41 | , bNeed :: NEMap String Int 42 | , bExcess :: Map String Int 43 | } 44 | deriving (Show, Eq, Ord, Generic) 45 | instance NFData Basket 46 | 47 | splitCosts :: NEMap String Int -> (Int, Map String Int) 48 | splitCosts = NEM.alterF (\x -> (sum x,Nothing)) "ORE" 49 | 50 | splitBasket :: Recipes -> Basket -> Either (Int, Map String Int) Basket 51 | splitBasket rs B{..} = case need' of 52 | NEM.IsEmpty -> Left (bOre + newOre, newExc) 53 | NEM.IsNonEmpty needNE -> Right $ B 54 | { bOre = bOre + newOre 55 | , bNeed = needNE 56 | , bExcess = newExc 57 | } 58 | where 59 | ((ingr, amt), rest) = NEM.deleteFindMin bNeed 60 | (amt', excess') = case M.lookup ingr bExcess of 61 | Nothing -> (Just amt, bExcess) 62 | Just exc -> case compare amt exc of 63 | GT -> (Just $ amt - exc, M.delete ingr bExcess) 64 | EQ -> (Nothing , M.delete ingr bExcess) 65 | LT -> (Nothing , M.insert ingr (exc - amt) bExcess) 66 | (newOre, need', newExc) = case amt' of 67 | Nothing -> (0, rest, excess') 68 | Just a -> 69 | let (quant, costs) = rs M.! ingr 70 | buyAmt = (a + quant - 1) `div` quant 71 | leftover = (buyAmt * quant) - a 72 | (o, c') 73 | | buyAmt == 0 = (0, M.empty) 74 | | otherwise = splitCosts $ fmap (* buyAmt) costs 75 | exc | leftover == 0 = excess' 76 | | otherwise = M.insertWith (+) ingr leftover excess' 77 | in (o, M.unionWith (+) c' rest, exc) 78 | 79 | oreForFuel :: Recipes -> Int -> Int 80 | oreForFuel rs i = fst . loopEither (splitBasket rs) $ B 81 | { bOre = 0 82 | , bNeed = NEM.singleton "FUEL" i 83 | , bExcess = M.empty 84 | } 85 | 86 | day14a :: Recipes :~> Int 87 | day14a = MkSol 88 | { sParse = foldMap parseRecipeLine . lines 89 | , sShow = show 90 | , sSolve = Just . (`oreForFuel` 1) 91 | } 92 | 93 | day14b :: Recipes :~> Int 94 | day14b = MkSol 95 | { sParse = foldMap parseRecipeLine . lines 96 | , sShow = show 97 | , sSolve = \rs -> subtract 1 <$> 98 | exponentialMinSearch (\fuel -> oreForFuel rs fuel > 1e12) 1 99 | } 100 | 101 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day15.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | -- | 4 | -- Module : AOC.Challenge.Day15 5 | -- License : BSD3 6 | -- 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Day 15. See "AOC.Solver" for the types used in this module! 11 | 12 | module AOC.Challenge.Day15 ( 13 | day15a 14 | , day15b 15 | ) where 16 | 17 | import AOC.Common (Point, Dir(..), floodFillCount, dirPoint) 18 | import AOC.Common.Intcode (Memory, VMErr, parseMem, stepForever, untilHalt) 19 | import AOC.Common.Search (bfs) 20 | import AOC.Solver ((:~>)(..)) 21 | import Control.Applicative (empty) 22 | import Control.DeepSeq (NFData) 23 | import Data.Conduino (Pipe, squeezePipe) 24 | import Data.Functor.Identity (Identity(..)) 25 | import Data.Semigroup (Arg(..)) 26 | import Data.Set (Set) 27 | import Data.Void (Void) 28 | import GHC.Generics (Generic) 29 | import Safe (lastMay) 30 | import qualified Data.Set as S 31 | 32 | data Tile = Floor | Oxygen 33 | deriving (Eq, Ord, Show, Generic) 34 | instance NFData Tile 35 | 36 | data Spot = S 37 | { sCoord :: !Point 38 | , sTile :: !Tile 39 | } 40 | deriving (Eq, Ord, Show, Generic) 41 | instance NFData Spot 42 | 43 | type Bot = Int -> Pipe Int Int Void Identity () 44 | 45 | -- | We use 'Arg' becase we only compare on the 'Spot', not the 'Bot' 46 | type BotState = Arg Spot Bot 47 | 48 | findOxygen :: Memory -> Maybe [BotState] 49 | findOxygen mem = bfs 50 | stepAround 51 | (Arg (S 0 Floor) initBot) 52 | (\(Arg (S _ t) _) -> t == Oxygen) 53 | where 54 | initBot :: Bot 55 | initBot = c 56 | where 57 | Identity ([], Left c) = squeezePipe (untilHalt (stepForever @VMErr mem)) 58 | 59 | stepAround :: BotState -> Set BotState 60 | stepAround (Arg S{..} bot) = S.fromList $ do 61 | dir <- [ North .. ] 62 | let p = sCoord + dirPoint dir 63 | (o:_, Left c) <- pure . runIdentity $ squeezePipe (bot (dNum dir)) 64 | case o of 65 | 1 -> pure $ Arg (S p Floor ) c 66 | 2 -> pure $ Arg (S p Oxygen) c 67 | _ -> empty 68 | 69 | dNum :: Dir -> Int 70 | dNum = \case 71 | North -> 1 72 | East -> 4 73 | South -> 2 74 | West -> 3 75 | 76 | day15a :: Memory :~> Int 77 | day15a = MkSol 78 | { sParse = parseMem 79 | , sShow = show 80 | , sSolve = fmap length . findOxygen 81 | } 82 | 83 | day15b :: Memory :~> Int 84 | day15b = MkSol 85 | { sParse = parseMem 86 | , sShow = show 87 | , sSolve = \m -> do 88 | a0 <- lastMay =<< findOxygen m 89 | Just . fst $ floodFillCount stepAround (S.singleton a0) 90 | } 91 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day16.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day16 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 16. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day16 ( 11 | day16a 12 | , day16b 13 | , binom99 14 | ) where 15 | 16 | import AOC.Common ((!!!), digitToIntSafe) 17 | import AOC.Solver ((:~>)(..)) 18 | import Control.Monad 19 | import Control.Monad.ST (runST) 20 | import Control.Monad.State (evalStateT, get, put) 21 | import Data.Foldable (forM_) 22 | import Data.List (tails, unfoldr) 23 | import Data.Maybe (mapMaybe) 24 | import qualified Data.Vector.Storable as VS 25 | import qualified Data.Vector.Storable.Mutable as MVS 26 | 27 | day16a :: [Int] :~> [Int] 28 | day16a = MkSol 29 | { sParse = Just . mapMaybe digitToIntSafe 30 | , sShow = concatMap show 31 | , sSolve = Just 32 | . VS.toList 33 | . VS.take 8 34 | . (!!! 100) 35 | . iterate stepVec 36 | . VS.fromList 37 | } 38 | 39 | 40 | day16b :: [Int] :~> [Int] 41 | day16b = MkSol 42 | { sParse = Just . mapMaybe digitToIntSafe 43 | , sShow = concatMap show 44 | , sSolve = \str -> 45 | let origLen = length str 46 | n = read . concatMap show $ take 7 str 47 | startPoint = n `mod` origLen 48 | endPoint = origLen * 10000 - n 49 | xs = take endPoint . drop startPoint . cycle $ str 50 | result = map (`dot` binom99) (tails xs) 51 | good = n >= (origLen * 5000) 52 | 53 | in take 8 result <$ guard good 54 | } 55 | where 56 | dot xs ys = (`mod` 10) . sum . map (`mod` 10) $ zipWith (*) xs ys 57 | 58 | -- | Binomial(n+99,99) 59 | binom99 :: [Int] 60 | binom99 = fromIntegral . (`mod` 10) <$> unfoldr go (99, fac99) 61 | where 62 | fac99 :: Integer 63 | fac99 = product [1..99] 64 | go (id->(!n, !nfac)) = Just (x, (n', nfac')) 65 | where 66 | x = nfac `div` fac99 67 | n' = n + 1 68 | nfac' = (nfac `div` (n' - 99)) * n' 69 | 70 | 71 | -- | needlessly over-optimized 72 | stepVec :: VS.Vector Int -> VS.Vector Int 73 | stepVec v = runST $ do 74 | mv <- MVS.replicate (VS.length v) 0 75 | flip evalStateT (0,[]) . flip VS.mapM_ v $ \x -> do 76 | (i, steps0) <- get 77 | let !i' = i + 1 78 | !steps = newStep (i + 1) : map succStep steps0 79 | put (i', steps) 80 | forM_ (zip [0..] steps) $ \(j, s) -> 81 | forM_ (stepOut s) $ \q -> 82 | MVS.modify mv ((q * x) +) (i - j) 83 | VS.map ((`mod` 10) . abs) <$> VS.freeze mv 84 | 85 | data Step = Step { sSize :: !Int, sPhase :: !Int } 86 | deriving Show 87 | 88 | stepOut :: Step -> Maybe Int 89 | stepOut Step{..} = case (sPhase `div` sSize) `mod` 4 of 90 | 0 -> Just 1 91 | 2 -> Just (-1) 92 | _ -> Nothing 93 | 94 | succStep :: Step -> Step 95 | succStep Step{..} = Step sSize (sPhase + 1) 96 | 97 | newStep :: Int -> Step 98 | newStep n = Step n 0 99 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day17.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | -- | 4 | -- Module : AOC.Challenge.Day17 5 | -- License : BSD3 6 | -- 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Day 17. See "AOC.Solver" for the types used in this module! 11 | 12 | module AOC.Challenge.Day17 ( 13 | day17a 14 | , day17b 15 | ) where 16 | 17 | import AOC.Common (Point, Dir(..), dirPoint', cardinalNeighbs, parseAsciiMap) 18 | import AOC.Common.Intcode (Memory, parseMem, IErr, stepForever, mRegLens) 19 | import AOC.Solver ((:~>)(..)) 20 | import AOC.Util (eitherToMaybe) 21 | import Control.Applicative (empty) 22 | import Control.DeepSeq (NFData) 23 | import Control.Lens (set) 24 | import Control.Monad (guard, (<=<)) 25 | import Data.Char (chr, ord) 26 | import Data.Conduino (feedPipe) 27 | import Data.Foldable (asum) 28 | import Data.List (group, unfoldr, inits, stripPrefix, intercalate) 29 | import Data.List.Split (chunksOf, splitOn) 30 | import Data.Maybe (mapMaybe, listToMaybe) 31 | import Data.Set (Set) 32 | import GHC.Generics (Generic) 33 | import Safe (lastMay) 34 | import qualified Data.Map as M 35 | import qualified Data.Set as S 36 | 37 | data AState = AS { asPos :: Point 38 | , asDir :: Dir 39 | } 40 | deriving (Show, Eq, Ord, Generic) 41 | instance NFData AState 42 | 43 | parseMap :: Memory -> Maybe (Set Point, Maybe AState) 44 | parseMap m = do 45 | (os, _) <- eitherToMaybe $ feedPipe [] (stepForever @IErr m) 46 | let mp = parseAsciiMap parseTile (map chr os) 47 | scaff = M.keysSet mp 48 | sOut = do 49 | (p, d) <- listToMaybe . M.toList . M.mapMaybe id $ mp 50 | pure (AS p d) 51 | pure (scaff, sOut) 52 | where 53 | parseTile = \case 54 | '#' -> Just Nothing 55 | '^' -> Just (Just North) 56 | '>' -> Just (Just East) 57 | 'v' -> Just (Just South) 58 | '<' -> Just (Just West) 59 | _ -> Nothing 60 | 61 | 62 | day17a :: Set Point :~> Int 63 | day17a = MkSol 64 | { sParse = fmap fst . parseMap <=< parseMem 65 | , sShow = show 66 | , sSolve = Just . sum . S.map product . findNeighbs 67 | } 68 | where 69 | findNeighbs scaff = S.filter allScaff scaff 70 | where 71 | allScaff = all (`S.member` scaff) . cardinalNeighbs 72 | 73 | day17b :: (Set Point, AState, Memory) :~> (String, Memory) 74 | day17b = MkSol 75 | { sParse = \str -> do 76 | m <- set (mRegLens 0) 2 <$> parseMem str 77 | (scaff, as0) <- sequenceA =<< parseMap m 78 | pure (scaff, as0, m) 79 | , sShow = \(map ord -> inp, m) -> foldMap show $ do 80 | output <- fst <$> eitherToMaybe (feedPipe inp (stepForever @IErr m)) 81 | lastMay output 82 | , sSolve = \(scaff, as0, m) -> do 83 | let path = findPath scaff as0 84 | (a,b,c) <- findProgs path 85 | let mainProg = chomp [(a,"A"),(b,"B"),(c,"C")] path 86 | inp = unlines . map (intercalate ",") $ 87 | [ mainProg 88 | , showPC <$> a 89 | , showPC <$> b 90 | , showPC <$> c 91 | , ["n"] 92 | ] 93 | pure (inp, m) 94 | } 95 | 96 | 97 | findProgs :: Eq a => [a] -> Maybe ([a], [a], [a]) 98 | findProgs p0 = listToMaybe $ do 99 | a <- validPrefix p0 100 | 101 | let withoutA = neSplitOn a p0 102 | b <- case withoutA of 103 | [] -> empty 104 | bs : _ -> validPrefix bs 105 | 106 | let withoutB = neSplitOn b =<< withoutA 107 | c <- case withoutB of 108 | [] -> empty 109 | cs : _ -> validPrefix cs 110 | 111 | let withoutC = neSplitOn c =<< withoutB 112 | guard $ null withoutC 113 | 114 | pure (a, b, c) 115 | where 116 | validPrefix = take 4 . filter (not . null) . inits 117 | neSplitOn x = filter (not . null) . splitOn x 118 | 119 | chomp :: Eq a => [([a], b)] -> [a] -> [b] 120 | chomp progs = unfoldr go 121 | where 122 | go xs = asum 123 | [ (r,) <$> stripPrefix prog xs 124 | | (prog, r) <- progs 125 | ] 126 | 127 | 128 | type PathComp = Either Int Int 129 | 130 | showPC :: PathComp -> String 131 | showPC = \case 132 | Left x -> "L," ++ show x 133 | Right x -> "R," ++ show x 134 | 135 | findPath :: Set Point -> AState -> [PathComp] 136 | findPath scaff = mapMaybe process . chunksOf 2 . group . unfoldr go 137 | where 138 | process = \case 139 | [Just turnRight :_, steps] 140 | | turnRight -> Just $ Right (length steps) 141 | | otherwise -> Just $ Left (length steps) 142 | _ -> Nothing 143 | go AS{..} 144 | | forward `S.member` scaff = Just (Nothing , AS forward asDir ) 145 | | turnLeft `S.member` scaff = Just (Just False, AS asPos (asDir <> West)) 146 | | turnRight `S.member` scaff = Just (Just True , AS asPos (asDir <> East)) 147 | | otherwise = Nothing 148 | where 149 | forward = asPos + dirPoint' asDir 150 | turnLeft = asPos + dirPoint' (asDir <> West) 151 | turnRight = asPos + dirPoint' (asDir <> East) 152 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day18.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE Strict #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | {-# LANGUAGE UndecidableInstances #-} 4 | 5 | -- | 6 | -- Module : AOC.Challenge.Day18 7 | -- License : BSD3 8 | -- 9 | -- Stability : experimental 10 | -- Portability : non-portable 11 | -- 12 | -- Day 18. See "AOC.Solver" for the types used in this module! 13 | 14 | module AOC.Challenge.Day18 ( 15 | day18a 16 | , day18b 17 | ) where 18 | 19 | 20 | import AOC.Common (Point, charFinite, _CharFinite, Letter, parseAsciiMap, cardinalNeighbsSet) 21 | import AOC.Common.FinitarySet (FinitarySet) 22 | import AOC.Common.Search (aStar) 23 | import AOC.Solver ((:~>)(..)) 24 | import Control.DeepSeq (NFData) 25 | import Control.Lens (preview, review, (?~), (^.)) 26 | import Data.Bifunctor (second) 27 | import Data.Foldable (toList) 28 | import Data.Function ((&)) 29 | import Data.Functor ((<&>)) 30 | import Data.Functor.Rep as R 31 | import Data.Generics.Labels () 32 | import Data.List (intercalate) 33 | import Data.Map (Map) 34 | import Data.Semigroup (First(..)) 35 | import Data.Set (Set) 36 | import Data.Tuple (swap) 37 | import GHC.Generics (Generic) 38 | import Linear (V1(..), V2(..), V4(..)) 39 | import Linear.Vector (E(..)) 40 | import Text.Printf (printf) 41 | import qualified AOC.Common.FinitarySet as FS 42 | import qualified Data.Map as M 43 | import qualified Data.Set as S 44 | 45 | data Maze f = Maze 46 | { mWalls :: Set Point 47 | , mKeys :: Map Point Letter 48 | , mDoors :: Map Point Letter 49 | , mKeyLoc :: Map Letter Point 50 | , mStart :: f Point 51 | } 52 | deriving (Generic) 53 | deriving instance Eq (f Point) => Eq (Maze f) 54 | deriving instance Ord (f Point) => Ord (Maze f) 55 | deriving instance Show (f Point) => Show (Maze f) 56 | instance NFData (f Point) => NFData (Maze f) 57 | 58 | -- | From a given point, a map to every visible key, with the distance and 59 | -- the set of keys and doors in the way. 60 | type KeyMap = Map Letter (Int, FinitarySet Letter) 61 | 62 | -- | Do a DFS to build the key map 63 | keysFrom :: Maze f -> Point -> KeyMap 64 | keysFrom Maze{..} = go 0 mWalls FS.empty 65 | where 66 | go !dist seen doors p = addKey 67 | . M.unionsWith better 68 | $ map (go (dist + 1) seen' doors') neighbs 69 | where 70 | neighbs = S.toList $ cardinalNeighbsSet p `S.difference` seen 71 | seen' = S.insert p seen 72 | doors' = addDoor $ case M.lookup p mDoors of 73 | Nothing -> doors 74 | Just d -> FS.insert d doors 75 | keyHere = M.lookup p mKeys 76 | addDoor = case keyHere of 77 | Nothing -> id 78 | Just c -> FS.insert c 79 | addKey = case keyHere of 80 | Nothing -> id 81 | Just c -> M.insertWith better c (dist, doors) 82 | better (a,x) (b,y) 83 | | b < a = (b, y) 84 | | otherwise = (a, x) 85 | 86 | 87 | data KeyToKey f = K 88 | { kStart :: f KeyMap 89 | , kKeys :: Map Letter KeyMap 90 | } 91 | deriving (Generic) 92 | deriving instance Show (f KeyMap) => Show (KeyToKey f) 93 | instance NFData (f KeyMap) => NFData (KeyToKey f) 94 | 95 | keyToKey :: Functor f => Maze f -> KeyToKey f 96 | keyToKey mz@Maze{..} = K 97 | { kStart = keysFrom mz <$> mStart 98 | , kKeys = M.mapWithKey (\c -> M.delete c . keysFrom mz) mKeyLoc 99 | } 100 | 101 | data AState f = AS 102 | { aKeys :: !(FinitarySet Letter) 103 | , aPos :: !(f (Maybe Letter)) 104 | } 105 | deriving (Generic) 106 | deriving instance Eq (f (Maybe Letter)) => Eq (AState f) 107 | deriving instance Ord (f (Maybe Letter)) => Ord (AState f) 108 | instance NFData (f (Maybe Letter)) => NFData (AState f) 109 | 110 | aHeuristic :: Maze f -> AState f -> Int 111 | aHeuristic Maze{..} AS{..} = M.size mKeyLoc - FS.size aKeys 112 | 113 | aStep 114 | :: forall f. (Foldable f, Representable f, Rep f ~ E f, Ord (AState f)) 115 | => KeyToKey f 116 | -> AState f 117 | -> Map (AState f) Int 118 | aStep K{..} AS{..} = M.fromList 119 | [ (AS aKeys' aPos', cost) 120 | | e <- toList $ tabulate @f id 121 | , let p = aPos ^. el e 122 | , (goal, (cost, doors)) <- M.toList $ case p of 123 | Nothing -> kStart ^. el e 124 | Just c -> kKeys M.! c 125 | , goal `FS.notMember` aKeys 126 | , FS.null $ doors `FS.difference` aKeys 127 | , let aKeys' = FS.insert goal aKeys 128 | aPos' = aPos & el e ?~ goal 129 | ] 130 | 131 | 132 | day18a :: Maze V1 :~> Int 133 | day18a = MkSol 134 | { sParse = parseMaze 135 | , sShow = show 136 | , sSolve = \mz -> fst <$> 137 | aStar (aHeuristic mz) 138 | (aStep (keyToKey mz)) 139 | (AS FS.empty (pure Nothing)) 140 | ((== 0) . aHeuristic mz) 141 | } 142 | 143 | reMaze :: Maze V1 -> Maze V4 144 | reMaze m@Maze{..} = m 145 | { mWalls = S.union (cardinalNeighbsSet p0) . S.insert p0 $ mWalls 146 | , mStart = (+p0) <$> V4 (V2 (-1) (-1)) 147 | (V2 1 (-1)) 148 | (V2 (-1) 1 ) 149 | (V2 1 1 ) 150 | } 151 | where 152 | V1 p0 = mStart 153 | 154 | day18b :: Maze V4 :~> Int 155 | day18b = MkSol 156 | { sParse = fmap reMaze . parseMaze 157 | , sShow = show 158 | , sSolve = \mz -> fst <$> 159 | aStar (aHeuristic mz) 160 | (aStep (keyToKey mz)) 161 | (AS FS.empty (pure Nothing)) 162 | ((== 0) . aHeuristic mz) 163 | } 164 | 165 | 166 | -- utilities 167 | 168 | instance Foldable f => Show (AState f) where 169 | showsPrec _ AS{..} = 170 | showString "AS<" 171 | . showString (FS.foldMap ((:[]) . dispKey) aKeys) 172 | . showString "," 173 | . showString (foldMap ((:[]) . maybe '@' dispKey) aPos) 174 | . showString ">" 175 | 176 | dispKey :: Letter -> Char 177 | dispKey = review _CharFinite . (False,) 178 | 179 | dispDoor :: Letter -> Char 180 | dispDoor = review _CharFinite . (True,) 181 | 182 | _dispKeyMap :: KeyMap -> String 183 | _dispKeyMap = intercalate ", " . map go . M.toList 184 | where 185 | go (c, (d, xs)) = printf "%c:%d[%s]" (dispKey c) d (FS.foldMap ((:[]).dispDoor) xs) 186 | 187 | data Item = IKey Letter 188 | | IDoor Letter 189 | | IWall 190 | deriving (Eq, Ord, Show, Generic) 191 | instance NFData Item 192 | 193 | toMaze :: Map Point Item -> Point -> Maze V1 194 | toMaze mp p = Maze{..} 195 | where 196 | mWalls = M.keysSet . M.filter (== IWall) $ mp 197 | mKeys = M.mapMaybe (preview #_IKey ) mp 198 | mDoors = M.mapMaybe (preview #_IDoor) mp 199 | mKeyLoc = M.fromList . map swap . M.toList $ mKeys 200 | mStart = V1 p 201 | 202 | parseMap :: String -> (Map Point Item, Maybe Point) 203 | parseMap str = second (fmap getFirst) . swap 204 | . flip M.traverseMaybeWithKey mp 205 | $ \p -> \case 206 | Nothing -> (Just (First p), Nothing) 207 | Just t -> (mempty , Just t ) 208 | where 209 | mp = flip parseAsciiMap str $ \case 210 | '#' -> Just $ Just IWall 211 | '@' -> Just Nothing 212 | c -> charFinite c <&> \(up, d) -> Just $ 213 | if up then IDoor d 214 | else IKey d 215 | 216 | parseMaze :: String -> Maybe (Maze V1) 217 | parseMaze = fmap (uncurry toMaze) . sequenceA . parseMap 218 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day19.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | -- | 4 | -- Module : AOC.Challenge.Day19 5 | -- License : BSD3 6 | -- 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Day 19. See "AOC.Solver" for the types used in this module! 11 | 12 | module AOC.Challenge.Day19 ( 13 | day19a 14 | , day19b 15 | ) where 16 | 17 | import AOC.Common (Point, countTrue) 18 | import AOC.Common.Intcode (Memory, IErr, parseMem, stepForever, untilHalt) 19 | import AOC.Common.Search (binaryMinSearch, binaryFindMin) 20 | import AOC.Solver ((:~>)(..)) 21 | import AOC.Util (firstJust) 22 | import Control.Applicative (empty) 23 | import Control.Lens (view) 24 | import Control.Monad (guard, join) 25 | import Data.Conduino (runPipe, (.|), yield, await) 26 | import Data.List (find) 27 | import Data.Map (Map) 28 | import Data.Maybe (fromJust) 29 | import Linear.V2 (V2(..), _x, _y) 30 | import qualified Data.Map as M 31 | import qualified Data.Set as S 32 | 33 | day19a :: Memory :~> Int 34 | day19a = MkSol 35 | { sParse = parseMem 36 | , sShow = show 37 | , sSolve = \m -> Just $ countTrue (checkBeam m) (V2 <$> [0..49] <*> [0..49]) 38 | } 39 | 40 | checkBeam :: Memory -> Point -> Bool 41 | checkBeam m (V2 x y) = (== 1) . fromJust . join $ 42 | runPipe $ (yield x *> yield y *> empty) 43 | .| untilHalt (stepForever @IErr m) 44 | .| await 45 | 46 | data Ranges = R 47 | { xMins :: !(Map Int (Maybe Int)) 48 | , xMaxs :: !(Map Int (Maybe Int)) 49 | , yMins :: !(Map Int (Maybe Int)) 50 | , yMaxs :: !(Map Int (Maybe Int)) 51 | } 52 | 53 | mkRanges :: Memory -> Ranges 54 | mkRanges m = R{..} 55 | where 56 | cache = M.fromSet (checkBeam m) (S.fromList $ V2 <$> [0..1500] <*> [0..1500]) 57 | rangeRange = S.fromAscList [0..1250] 58 | xMins = flip M.fromSet rangeRange $ \y -> 59 | case M.lookup (y - 1) xMins of 60 | Just (Just xm) -> view _x <$> find (cache M.!) ((`V2` y) . (+ xm) <$> [0..10]) 61 | _ -> view _x <$> find (cache M.!) ((`V2` y) <$> [0..10]) 62 | xMaxs = flip M.fromSet rangeRange $ \y -> 63 | case M.lookup y xMins of 64 | Just (Just xm) -> subtract 1 <$> binaryMinSearch (not . (cache M.!) . (`V2` y)) xm (xm + 250) 65 | _ -> Nothing 66 | yMins = flip M.fromSet rangeRange $ \x -> 67 | case M.lookup (x - 1) yMins of 68 | Just (Just ym) -> view _y <$> find (cache M.!) (V2 x . (+ ym) <$> [0..10]) 69 | _ -> view _y <$> find (cache M.!) (V2 x <$> [0..10]) 70 | yMaxs = flip M.fromSet rangeRange $ \x -> 71 | case M.lookup x yMins of 72 | Just (Just ym) -> subtract 1 <$> binaryMinSearch (not . (cache M.!) . V2 x) ym (ym + 250) 73 | _ -> Nothing 74 | 75 | day19b :: Memory :~> (Int, Int) 76 | day19b = MkSol 77 | { sParse = parseMem 78 | , sShow = \(x,y) -> show $ x * 10000 + y 79 | , sSolve = \m -> do 80 | let R{..} = mkRanges m 81 | goodY y = do 82 | guard $ (xmax - xmin + 1) >= 100 83 | binaryFindMin goodX xmin (xmax - 100 + 1) 84 | where 85 | Just xmin = xMins M.! y 86 | Just xmax = xMaxs M.! y 87 | goodX x = do 88 | let Just ymin = yMins M.! x 89 | Just ymax = yMaxs M.! x 90 | guard $ y >= ymin 91 | guard $ (ymax - y + 1) >= 100 92 | pure (x, y) 93 | (_,y) <- binaryFindMin goodY 500 1500 94 | -- this has a hole, how weird 95 | -- works for 825, 828, 829, 830... 96 | -- so it will get a false match on 828 97 | -- check a couple lower ys to be safe 98 | firstJust goodY [y-4 .. y] 99 | } 100 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day21.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | 4 | -- | 5 | -- Module : AOC.Challenge.Day21 6 | -- License : BSD3 7 | -- 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Day 21. See "AOC.Solver" for the types used in this module! 12 | 13 | module AOC.Challenge.Day21 ( 14 | day21a 15 | , day21b 16 | ) where 17 | 18 | import AOC.Common (_CharFinite) 19 | import AOC.Common.Intcode (Memory, parseMem, untilHalt, stepForever, IErr, preAscii) 20 | import AOC.Solver ((:~>)(..)) 21 | import Control.Applicative (empty) 22 | import Control.Lens (review) 23 | import Control.Monad ((<=<)) 24 | import Data.Char (ord) 25 | import Data.Conduino (Pipe, runPipe, (.|), yield) 26 | import Data.Finite (Finite, weakenN) 27 | import Data.List (find) 28 | import Data.Text (Text) 29 | import Data.Void (Void) 30 | import Text.Printf (printf) 31 | import qualified Data.Conduino.Combinators as C 32 | import qualified Data.Text as T 33 | 34 | 35 | data Reg = RTemp | RJump | RInp (Finite 9) 36 | deriving (Eq, Ord, Show) 37 | 38 | data Com = CAnd | COr | CNot 39 | deriving (Eq, Ord, Show) 40 | 41 | data Instr = I Com Reg Reg 42 | deriving (Eq, Ord, Show) 43 | 44 | type Program = [Instr] 45 | 46 | runSpringbot 47 | :: Monad m 48 | => Pipe () Text u m Void 49 | -> Memory 50 | -> m [Int] 51 | runSpringbot src m = runPipe $ src 52 | .| preAscii 53 | .| untilHalt (stepForever @IErr m) 54 | .| C.sinkList 55 | 56 | sourceWalk :: Program -> Pipe i Text u m () 57 | sourceWalk p = do 58 | C.sourceList (instrCode <$> p) 59 | yield "WALK" 60 | 61 | theProg :: Program 62 | theProg = [ 63 | I COr (RInp 3) RJump -- jump if target is stable 64 | , I CNot RTemp RTemp -- RTemp == True 65 | , I CAnd (RInp 0) RTemp -- RTemp &&= r0 66 | , I CAnd (RInp 1) RTemp -- RTemp &&= r1 67 | , I CAnd (RInp 2) RTemp -- RTemp &&= r2 68 | , I CNot RTemp RTemp -- then don't jump 69 | , I CAnd RTemp RJump 70 | ] 71 | 72 | -- the logic: 73 | -- 74 | -- jump whenever it is safe to do so. but don't jump frivolously (if there 75 | -- is no hole in sight) 76 | -- 77 | -- 0 #### No 78 | -- 1 ###. No 79 | -- 2 ##.# Yes 80 | -- 3 ##.. No 81 | -- 4 #.## Yes 82 | -- 5 #.#. No 83 | -- 6 #..# Yes 84 | -- 7 #... No 85 | -- 8 .### Yes 86 | -- 9 .##. Give Up 87 | -- a .#.# Yes 88 | -- b .#.. Give Up 89 | -- c ..## Yes 90 | -- d ..#. Give Up 91 | -- e ...# Yes 92 | -- f .... Give Up 93 | -- 94 | 95 | day21a :: Memory :~> Int 96 | day21a = MkSol 97 | { sParse = parseMem 98 | , sShow = show 99 | , sSolve = isGood <=< runSpringbot (sourceWalk theProg *> empty) 100 | } 101 | 102 | sourceRun :: Program -> Pipe i Text u m () 103 | sourceRun p = do 104 | C.sourceList (instrCode <$> p) 105 | yield "RUN" 106 | 107 | -- the logic: 108 | -- 109 | -- the same but also try to 'double jump' if you can. 110 | theProg2 :: Program 111 | theProg2 = [ 112 | I CNot (RInp 0) RJump -- jump if next spot is bad 113 | , I COr (RInp 3) RTemp -- jump if target is stable 114 | , I CAnd (RInp 7) RTemp -- and double-target is stable 115 | , I COr RTemp RJump 116 | , I CNot (RInp 0) RTemp 117 | , I CNot RTemp RTemp 118 | , I CAnd (RInp 1) RTemp -- RTemp &&= r1 119 | , I CAnd (RInp 2) RTemp -- RTemp &&= r2 120 | , I CNot RTemp RTemp -- then don't jump 121 | , I CAnd RTemp RJump 122 | ] 123 | 124 | 125 | day21b :: Memory :~> Int 126 | day21b = MkSol 127 | { sParse = parseMem 128 | , sShow = show 129 | , sSolve = isGood <=< runSpringbot (sourceRun theProg2 *> empty) 130 | } 131 | 132 | isGood :: [Int] -> Maybe Int 133 | isGood = find (> ord maxBound) 134 | 135 | regCode :: Reg -> Char 136 | regCode = \case 137 | RTemp -> 'T' 138 | RJump -> 'J' 139 | RInp c -> review _CharFinite (True, weakenN c) 140 | 141 | comCode :: Com -> String 142 | comCode = \case 143 | CAnd -> "AND" 144 | COr -> "OR" 145 | CNot -> "NOT" 146 | 147 | instrCode :: Instr -> Text 148 | instrCode (I c x y) = T.pack $ printf "%s %c %c" (comCode c) (regCode x) (regCode y) 149 | 150 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day22.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveAnyClass #-} 2 | {-# LANGUAGE TypeApplications #-} 3 | 4 | -- | 5 | -- Module : AOC.Challenge.Day22 6 | -- License : BSD3 7 | -- 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Day 22. See "AOC.Solver" for the types used in this module! 12 | 13 | module AOC.Challenge.Day22 ( 14 | day22a 15 | , day22b 16 | ) where 17 | 18 | import AOC.Solver ((:~>)(..)) 19 | import Control.DeepSeq (NFData) 20 | import Data.Finite (Finite, modulo) 21 | import Data.Group (Group(..)) 22 | import GHC.Generics (Generic) 23 | import GHC.TypeNats (KnownNat) 24 | import Text.Read (readMaybe) 25 | 26 | data Affine n = Aff { affA :: !(Finite n) 27 | , affB :: !(Finite n) 28 | } 29 | deriving (Eq, Ord, Show, Generic, NFData) 30 | 31 | instance KnownNat n => Semigroup (Affine n) where 32 | Aff a2 b2 <> Aff a1 b1 = Aff (a2 * a1) (a2 * b1 + b2) 33 | instance KnownNat n => Monoid (Affine n) where 34 | mempty = Aff 1 0 35 | instance KnownNat n => Group (Affine n) where 36 | invert (Aff a b) = Aff a' b' 37 | where 38 | a' = recipFin a 39 | b' = negate (a' * b) 40 | 41 | 42 | 43 | (@$) :: KnownNat n => Affine n -> Finite n -> Finite n 44 | Aff a b @$ x = a * x + b 45 | 46 | data Shuff n = SCut (Finite n) 47 | | SIncr (Finite n) 48 | | SReverse 49 | deriving (Eq, Ord, Show, Generic, NFData) 50 | 51 | shuffAff :: KnownNat n => Shuff n -> Affine n 52 | shuffAff = \case 53 | SReverse -> Aff (negate 1) (negate 1) 54 | SCut c -> Aff 1 (negate c) 55 | SIncr c -> Aff c 0 56 | 57 | 58 | day22a :: [Shuff 10007] :~> Int 59 | day22a = MkSol 60 | { sParse = fmap reverse . traverse parseLine . lines 61 | , sShow = show 62 | , sSolve = \shuffs -> fmap fromIntegral . Just $ 63 | foldMap shuffAff shuffs @$ 2019 64 | } 65 | 66 | day22b :: [Shuff 119315717514047] :~> Int 67 | day22b = MkSol 68 | { sParse = fmap reverse . traverse parseLine . lines 69 | , sShow = show 70 | , sSolve = \shuffs -> fmap fromIntegral . Just $ 71 | let bigShuff = foldMap shuffAff shuffs 72 | in (bigShuff `pow` (-numReps)) @$ 2020 73 | } 74 | where 75 | numReps :: Int 76 | numReps = 101741582076661 77 | 78 | parseLine :: KnownNat n => String -> Maybe (Shuff n) 79 | parseLine xs = case words xs of 80 | "cut":n:_ -> SCut . modulo <$> readMaybe n 81 | "deal":"into":_ -> Just SReverse 82 | "deal":"with":_:n:_ -> SIncr . modulo <$> readMaybe n 83 | _ -> Nothing 84 | 85 | recipFin :: forall n. KnownNat n => Finite n -> Finite n 86 | recipFin x = x ^ (maxBound @(Finite n) - 1) 87 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day23.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE TypeApplications #-} 2 | 3 | -- | 4 | -- Module : AOC.Challenge.Day23 5 | -- License : BSD3 6 | -- 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Day 23. See "AOC.Solver" for the types used in this module! 11 | 12 | module AOC.Challenge.Day23 ( 13 | day23a 14 | , day23b 15 | ) where 16 | 17 | import AOC.Common (Point) 18 | import AOC.Common.Intcode (Memory, parseMem, VM, stepForever, VMErr) 19 | import AOC.Solver ((:~>)(..)) 20 | import AOC.Util (firstJust) 21 | import Control.Lens (view, (%%~), at) 22 | import Control.Monad (guard, ap) 23 | import Data.Conduino (feedPipe, squeezePipe) 24 | import Data.Function ((&)) 25 | import Data.List.Split (chunksOf) 26 | import Data.Map (Map) 27 | import Data.Sequence (Seq(..)) 28 | import Data.Traversable (for) 29 | import Data.Witherable (forMaybe, mapMaybe, catMaybes) 30 | import Linear.V2 (V2(..), _y) 31 | import qualified Data.Map as M 32 | import qualified Data.Sequence as Seq 33 | 34 | data Network = MM 35 | { nPipes :: !(Map Int (Int -> VM (Either VMErr) Memory)) 36 | , nQueue :: !(Seq (Int, Point)) -- ^ use one big global queue 37 | , nNAT :: !(Maybe Point) 38 | } 39 | 40 | initNetwork :: Memory -> Network 41 | initNetwork m = MM 42 | { nPipes = M.fromList (catMaybes pipes') 43 | , nQueue = parseOuts outList 44 | , nNAT = Nothing 45 | } 46 | where 47 | (outList, pipes') = for [0..49] $ \i -> 48 | case feedPipe [i] (stepForever @VMErr m) of 49 | Left _ -> ([], Nothing) 50 | Right (os, r) -> case r of 51 | Left n -> (os, Just (i, n)) 52 | Right _ -> (os, Nothing ) 53 | 54 | 55 | stepNetwork :: Network -> Network 56 | stepNetwork mm@MM{..} = case nQueue of 57 | Empty -> case nNAT of 58 | Just a -> mm { nQueue = Seq.singleton (0, a) } 59 | Nothing -> 60 | let (outList, pipes') = forMaybe nPipes $ \n -> 61 | case squeezePipe (n (-1)) of 62 | Left _ -> ([], Nothing) 63 | Right (os, r) -> case r of 64 | Left n' -> (os, Just n') 65 | Right _ -> (os, Nothing) 66 | in mm { nPipes = pipes', nQueue = parseOuts outList } 67 | (i, p@(V2 x y)) :<| ps 68 | | i == 255 -> mm { nNAT = Just p, nQueue = ps } 69 | | otherwise -> 70 | let (outList, pipes') = nPipes & at i %%~ \case 71 | Nothing -> ([], Nothing) 72 | Just n -> case feedPipe [y] (n x) of 73 | Left _ -> ([], Nothing) 74 | Right (os, r) -> case r of 75 | Left n' -> (os, Just n') 76 | Right _ -> (os, Nothing) 77 | queue' = ps <> parseOuts outList 78 | in MM pipes' queue' nNAT 79 | 80 | parseOuts :: [a] -> Seq (a, V2 a) 81 | parseOuts = Seq.fromList . mapMaybe splitOut . chunksOf 3 82 | where 83 | splitOut [i,x,y] = Just (i, V2 x y) 84 | splitOut _ = Nothing 85 | 86 | day23a :: Memory :~> Int 87 | day23a = MkSol 88 | { sParse = parseMem 89 | , sShow = show 90 | , sSolve = firstJust (firstJust find255 . nQueue) 91 | . iterate stepNetwork 92 | . initNetwork 93 | } 94 | where 95 | find255 (255, V2 _ y) = Just y 96 | find255 _ = Nothing 97 | 98 | day23b :: Memory :~> Int 99 | day23b = MkSol 100 | { sParse = parseMem 101 | , sShow = show 102 | , sSolve = firstJust (\(x,y) -> x <$ guard (x == y)) 103 | . (zip`ap`tail) 104 | . mapMaybe natted 105 | . iterate stepNetwork 106 | . initNetwork 107 | } 108 | where 109 | natted MM{..} = do 110 | guard $ Seq.null nQueue 111 | view _y <$> nNAT 112 | 113 | -------------------------------------------------------------------------------- /src/AOC/Challenge/Day24.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Challenge.Day24 3 | -- License : BSD3 4 | -- 5 | -- Stability : experimental 6 | -- Portability : non-portable 7 | -- 8 | -- Day 24. See "AOC.Solver" for the types used in this module! 9 | 10 | module AOC.Challenge.Day24 ( 11 | day24a 12 | , day24b 13 | ) where 14 | 15 | import AOC.Common (Point, cardinalNeighbsSet, parseAsciiMap, firstRepeated, (!!!), Dir(..)) 16 | import AOC.Solver ((:~>)(..), dyno_) 17 | import Control.DeepSeq (NFData) 18 | import Data.Finite (Finite, finites) 19 | import Data.Semigroup (Min(..), Max(..), Sum(..)) 20 | import Data.Set (Set) 21 | import GHC.Generics (Generic) 22 | import Linear.V2 (V2(..)) 23 | import qualified Data.Map as M 24 | import qualified Data.Set as S 25 | 26 | allPoints :: Set Point 27 | allPoints = S.fromList $ V2 <$> [0..4] <*> [0..4] 28 | 29 | stepWith 30 | :: Ord a 31 | => (Set a -> Set a) -- ^ get the set of all points to check, from current alive 32 | -> (a -> Set a) -- ^ neighbors 33 | -> Set a -- ^ initial 34 | -> [Set a] -- ^ yipee 35 | stepWith universe neighbs = iterate go 36 | where 37 | go s0 = flip S.filter (universe s0) $ \p -> 38 | let n = S.size $ neighbs p `S.intersection` s0 39 | in if p `S.member` s0 40 | then n == 1 41 | else n == 1 || n == 2 42 | 43 | day24a :: Set Point :~> Set Point 44 | day24a = MkSol 45 | { sParse = Just . parseMap 46 | , sShow = show . getSum . foldMap (Sum . biodiversity) 47 | , sSolve = firstRepeated . stepWith (const allPoints) cardinalNeighbsSet 48 | } 49 | where 50 | biodiversity :: Point -> Int 51 | biodiversity (V2 x y) = 2 ^ (y * 5 + x) 52 | 53 | -- | Position in layer. Cannot be (2,2). Use 'mkP5' if you're not sure. 54 | type P5 = V2 (Finite 5) 55 | 56 | -- | Safely construct a 'P5' that is not (2,2) 57 | mkP5 :: Finite 5 -> Finite 5 -> Maybe P5 58 | mkP5 2 2 = Nothing 59 | mkP5 x y = Just (V2 x y) 60 | 61 | data Loc = L 62 | { lLevel :: !Int -- ^ positive: zoom in, negative: zoom out 63 | , lPoint :: !P5 -- ^ position in layer. 64 | } 65 | deriving (Eq, Ord, Show, Generic) 66 | instance NFData Loc 67 | 68 | stepLoc :: Loc -> Dir -> [Loc] 69 | stepLoc (L n p@(V2 x y)) = \case 70 | North -> case p of 71 | V2 2 3 -> L (n + 1) . (`V2` 4) <$> finites 72 | V2 _ 0 -> [L (n - 1) (V2 2 1)] 73 | _ -> [L n (V2 x (y - 1))] 74 | East -> case p of 75 | V2 1 2 -> L (n + 1) . V2 0 <$> finites 76 | V2 4 _ -> [L (n - 1) (V2 3 2)] 77 | _ -> [L n (V2 (x + 1) y)] 78 | South -> case p of 79 | V2 2 1 -> L (n + 1) . (`V2` 0) <$> finites 80 | V2 _ 4 -> [L (n - 1) (V2 2 3)] 81 | _ -> [L n (V2 x (y + 1))] 82 | West -> case p of 83 | V2 3 2 -> L (n + 1) . V2 4 <$> finites 84 | V2 0 _ -> [L (n - 1) (V2 1 2)] 85 | _ -> [L n (V2 (x - 1) y)] 86 | 87 | day24b :: Set Loc :~> Set Loc 88 | day24b = MkSol 89 | { sParse = Just . S.map (L 0 . fmap fromIntegral) . parseMap 90 | , sShow = show . S.size 91 | , sSolve = Just . (!!! dyno_ "steps" 200) . stepWith getUniverse getNeighbs 92 | } 93 | where 94 | getNeighbs p = S.fromList $ foldMap (stepLoc p) [North ..] 95 | getUniverse s = oldLocs <> zoomOut 96 | where 97 | oldLocs = S.fromList 98 | [ L n p 99 | | n <- [mn .. mx + 1] 100 | , Just p <- mkP5 <$> finites <*> finites 101 | ] 102 | -- a little optimization: only check the center 9 points in the zoomed 103 | -- out layer 104 | zoomOut = S.fromList 105 | [ L (mn - 1) p 106 | | Just p <- mkP5 <$> [1..3] <*> [1..3] 107 | ] 108 | (Min mn, Max mx) = foldMap (\(lLevel->l) -> (Min l, Max l)) . S.toList $ s 109 | 110 | parseMap :: String -> Set Point 111 | parseMap = M.keysSet . M.filter (== '#') . parseAsciiMap Just 112 | -------------------------------------------------------------------------------- /src/AOC/Common/FinitarySet.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoStarIsType #-} 2 | {-# LANGUAGE TypeOperators #-} 3 | 4 | module AOC.Common.FinitarySet ( 5 | FinitarySet(..) 6 | , empty, singleton, insert, delete, fromList, toList 7 | , intersection, union, unions, difference, (\\) 8 | , isSubsetOf, isProperSubsetOf, disjoint 9 | , size, member, notMember, null 10 | , cartesianProduct, disjointUnion 11 | , foldr, foldr', foldl, foldl', map, foldMap, filter 12 | , alterF, generate, powerSet, mapMaybe 13 | , partition 14 | ) where 15 | 16 | import Control.DeepSeq (NFData) 17 | import Data.Bifunctor 18 | import Data.Bit 19 | import Data.Bits 20 | import Data.Finitary 21 | import Data.Finite 22 | import Data.Functor 23 | import GHC.Generics (Generic) 24 | import GHC.TypeNats 25 | import Prelude (Bool(..), Maybe(..), Either(..), Int, Monoid, Eq(..), Ord, Show, (&&), ($), (.), otherwise, Semigroup(..), not, fromIntegral, id) 26 | import qualified Data.List as L 27 | import qualified Data.Maybe as M 28 | import qualified Data.Vector.Generic.Sized.Internal as VG 29 | import qualified Data.Vector.Unboxed.Sized as V 30 | import qualified Prelude as P 31 | 32 | newtype FinitarySet a = FinitarySet (V.Vector (Cardinality a) Bit) 33 | deriving (Show, Generic, Eq, Ord) 34 | 35 | instance (Finitary a, KnownNat (2 ^ Cardinality a)) => Finitary (FinitarySet a) 36 | instance NFData (FinitarySet a) 37 | 38 | foldr :: Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b 39 | foldr f z (FinitarySet xs) = 40 | V.ifoldr (\i (Bit x) -> if x then f (fromFinite i) else id) z xs 41 | {-# INLINE foldr #-} 42 | 43 | foldr' :: Finitary a => (a -> b -> b) -> b -> FinitarySet a -> b 44 | foldr' f z (FinitarySet xs) = 45 | V.ifoldr' (\i (Bit x) -> if x then f (fromFinite i) else id) z xs 46 | {-# INLINE foldr' #-} 47 | 48 | foldl :: Finitary a => (b -> a -> b) -> b -> FinitarySet a -> b 49 | foldl f z (FinitarySet xs) = 50 | V.ifoldl (\r i (Bit x) -> if x then f r (fromFinite i) else r) z xs 51 | {-# INLINE foldl #-} 52 | 53 | foldl' :: Finitary a => (b -> a -> b) -> b -> FinitarySet a -> b 54 | foldl' f z (FinitarySet xs) = 55 | V.ifoldl' (\r i (Bit x) -> if x then f r (fromFinite i) else r) z xs 56 | {-# INLINE foldl' #-} 57 | 58 | map :: (Finitary a, Finitary b) => (a -> b) -> FinitarySet a -> FinitarySet b 59 | map f = fromList . fmap f . toList 60 | {-# INLINE map #-} 61 | 62 | foldMap :: (Finitary a, Monoid m) => (a -> m) -> FinitarySet a -> m 63 | foldMap f = P.foldMap f . toList 64 | {-# INLINE foldMap #-} 65 | 66 | toList :: Finitary a => FinitarySet a -> [a] 67 | toList = foldr (:) [] 68 | {-# INLINE toList #-} 69 | 70 | empty :: KnownNat (Cardinality a) => FinitarySet a 71 | empty = FinitarySet $ V.replicate (Bit False) 72 | {-# INLINE empty #-} 73 | 74 | -- could be made unsafe 75 | singleton :: Finitary a => a -> FinitarySet a 76 | singleton x = FinitarySet $ bit (fromIntegral (toFinite x)) 77 | {-# INLINE singleton #-} 78 | 79 | fromList :: Finitary a => [a] -> FinitarySet a 80 | fromList xs = FinitarySet $ 81 | 0 V.// fmap go xs 82 | where 83 | go x = (toFinite x, Bit True) 84 | {-# INLINE fromList #-} 85 | 86 | intersection :: FinitarySet a -> FinitarySet a -> FinitarySet a 87 | intersection (FinitarySet (VG.Vector xs)) (FinitarySet (VG.Vector ys)) = FinitarySet (VG.Vector (xs .&. ys)) 88 | {-# INLINE intersection #-} 89 | 90 | union :: FinitarySet a -> FinitarySet a -> FinitarySet a 91 | union (FinitarySet (VG.Vector xs)) (FinitarySet (VG.Vector ys)) = FinitarySet (VG.Vector (xs .|. ys)) 92 | {-# INLINE union #-} 93 | 94 | unions :: Finitary a => [FinitarySet a] -> FinitarySet a 95 | unions = L.foldl' union empty 96 | {-# INLINE unions #-} 97 | 98 | insert :: Finitary a => a -> FinitarySet a -> FinitarySet a 99 | insert x (FinitarySet xs) = FinitarySet $ xs V.// [(toFinite x, Bit True)] 100 | {-# INLINE insert #-} 101 | 102 | delete :: Finitary a => a -> FinitarySet a -> FinitarySet a 103 | delete x (FinitarySet xs) = FinitarySet $ xs V.// [(toFinite x, Bit False)] 104 | {-# INLINE delete #-} 105 | 106 | member :: Finitary a => a -> FinitarySet a -> Bool 107 | member x (FinitarySet xs) = unBit $ xs `V.index` toFinite x 108 | {-# INLINE member #-} 109 | 110 | notMember :: Finitary a => a -> FinitarySet a -> Bool 111 | notMember x = not . member x 112 | {-# INLINE notMember #-} 113 | 114 | null :: FinitarySet a -> Bool 115 | null (FinitarySet (VG.Vector xs)) = popCount xs == 0 116 | {-# INLINE null #-} 117 | 118 | size :: FinitarySet a -> Int 119 | size (FinitarySet (VG.Vector xs)) = popCount xs 120 | {-# INLINE size #-} 121 | 122 | isSubsetOf :: FinitarySet a -> FinitarySet a -> Bool 123 | isSubsetOf (FinitarySet (VG.Vector xs)) (FinitarySet (VG.Vector ys)) = (xs .&. ys) == xs 124 | {-# INLINE isSubsetOf #-} 125 | 126 | isProperSubsetOf :: FinitarySet a -> FinitarySet a -> Bool 127 | isProperSubsetOf (FinitarySet (VG.Vector xs)) (FinitarySet (VG.Vector ys)) = 128 | xs /= ys 129 | && (xs .&. ys) == xs 130 | {-# INLINE isProperSubsetOf #-} 131 | 132 | disjoint :: FinitarySet a -> FinitarySet a -> Bool 133 | disjoint xs ys = null (xs `intersection` ys) 134 | {-# INLINE disjoint #-} 135 | 136 | difference :: FinitarySet a -> FinitarySet a -> FinitarySet a 137 | difference (FinitarySet (VG.Vector xs)) (FinitarySet (VG.Vector ys)) = 138 | FinitarySet (VG.Vector (xs .&. complement ys)) 139 | {-# INLINE difference #-} 140 | 141 | (\\) :: FinitarySet a -> FinitarySet a -> FinitarySet a 142 | (\\) = difference 143 | {-# INLINE (\\) #-} 144 | infixl 9 \\ 145 | 146 | cartesianProduct 147 | :: (KnownNat (Cardinality a), KnownNat (Cardinality a * Cardinality b)) 148 | => FinitarySet a 149 | -> FinitarySet b 150 | -> FinitarySet (a, b) 151 | cartesianProduct (FinitarySet xs) (FinitarySet ys) = FinitarySet $ V.generate $ \i -> 152 | let (j, k) = separateProduct i 153 | in (xs `V.index` j) .&. (ys `V.index` k) 154 | 155 | disjointUnion :: FinitarySet a -> FinitarySet b -> FinitarySet (Either a b) 156 | disjointUnion (FinitarySet (VG.Vector xs)) (FinitarySet (VG.Vector ys)) = 157 | FinitarySet (VG.Vector (xs <> ys)) 158 | {-# INLINE disjointUnion #-} 159 | 160 | partition 161 | :: Finitary a 162 | => (a -> Bool) 163 | -> FinitarySet a 164 | -> (FinitarySet a, FinitarySet a) 165 | partition f = bimap fromList fromList . L.partition f . toList 166 | {-# INLINE partition #-} 167 | 168 | mapMaybe 169 | :: (Finitary a, Finitary b) 170 | => (a -> Maybe b) 171 | -> FinitarySet a 172 | -> FinitarySet b 173 | mapMaybe f = fromList . M.mapMaybe f . toList 174 | {-# INLINE mapMaybe #-} 175 | 176 | powerSet 177 | :: (Finitary a, KnownNat (2 ^ Cardinality a)) 178 | => FinitarySet a 179 | -> FinitarySet (FinitarySet a) 180 | powerSet = fromList . fmap fromList . L.subsequences . toList 181 | {-# INLINE powerSet #-} 182 | 183 | alterF 184 | :: (Finitary a, Functor f) 185 | => (Bool -> f Bool) 186 | -> a 187 | -> FinitarySet a 188 | -> f (FinitarySet a) 189 | alterF f x xs 190 | | x `member` xs = f True <&> \case 191 | False -> x `delete` xs 192 | True -> xs 193 | | otherwise = f False <&> \case 194 | False -> xs 195 | True -> x `insert` xs 196 | 197 | generate :: Finitary a => (a -> Bool) -> FinitarySet a 198 | generate f = FinitarySet $ V.generate (Bit . f . fromFinite) 199 | {-# INLINE generate #-} 200 | 201 | filter 202 | :: Finitary a 203 | => (a -> Bool) 204 | -> FinitarySet a 205 | -> FinitarySet a 206 | filter f (FinitarySet xs) = FinitarySet $ V.imap go xs 207 | where 208 | go i (Bit x) = Bit $ x && f (fromFinite i) 209 | {-# INLINE filter #-} 210 | 211 | 212 | -------------------------------------------------------------------------------- /src/AOC/Common/Intcode/Memory.hs: -------------------------------------------------------------------------------- 1 | 2 | module AOC.Common.Intcode.Memory ( 3 | MonadMem(..) 4 | , Memory(..) 5 | , mRegLens 6 | , MemRef(..) 7 | , initMemRef 8 | , freezeMemRef 9 | ) where 10 | 11 | import Control.DeepSeq 12 | import Control.Lens 13 | import Control.Monad.Except 14 | import Control.Monad.Primitive 15 | import Control.Monad.Reader 16 | import Control.Monad.State 17 | import Data.Conduino 18 | import Data.Generics.Labels () 19 | import Data.Map (Map) 20 | import Data.Primitive.MutVar 21 | import GHC.Generics 22 | import Numeric.Natural (Natural) 23 | import qualified Data.Map as M 24 | import qualified Data.Vector.Storable as VS 25 | import qualified Data.Vector.Storable.Mutable as MVS 26 | 27 | 28 | class Monad m => MonadMem m where 29 | mRead :: m Int 30 | mCurr :: m Natural 31 | mPeek :: Natural -> m Int 32 | mSeek :: Natural -> m () 33 | mWrite :: Natural -> Int -> m () 34 | mShiftBase :: Int -> m () 35 | mWithBase :: Int -> m Int 36 | 37 | -- mFreeze :: m Memory 38 | -- mPutMem :: Memory -> m () 39 | 40 | 41 | data Memory = Mem 42 | { mPos :: Natural 43 | , mBase :: Int 44 | , mRegs :: Map Natural Int 45 | } 46 | deriving (Eq, Ord, Show, Generic) 47 | instance NFData Memory 48 | 49 | instance Monad m => MonadMem (StateT Memory m) where 50 | mRead = do 51 | m@Mem{..} <- get 52 | M.findWithDefault 0 mPos mRegs <$ put (m { mPos = mPos + 1 }) 53 | mCurr = gets mPos 54 | mPeek i = gets $ M.findWithDefault 0 i . mRegs 55 | mSeek z = modify $ \m -> m { mPos = z } 56 | mWrite i x = modify $ \m -> m { mRegs = M.insert i x (mRegs m) } 57 | mShiftBase b = modify $ \m -> m { mBase = mBase m + b } 58 | mWithBase i = gets $ (+ i) . mBase 59 | 60 | -- mFreeze = get 61 | -- mPutMem = put 62 | 63 | instance MonadMem m => MonadMem (Pipe i o u m) where 64 | mRead = lift mRead 65 | mCurr = lift mCurr 66 | mPeek = lift . mPeek 67 | mSeek = lift . mSeek 68 | mWrite i = lift . mWrite i 69 | mShiftBase = lift . mShiftBase 70 | mWithBase = lift . mWithBase 71 | -- mFreeze = lift mFreeze 72 | -- mPutMem = lift . mPutMem 73 | 74 | instance MonadMem m => MonadMem (ExceptT e m) where 75 | mRead = lift mRead 76 | mCurr = lift mCurr 77 | mPeek = lift . mPeek 78 | mSeek = lift . mSeek 79 | mWrite i = lift . mWrite i 80 | mShiftBase = lift . mShiftBase 81 | mWithBase = lift . mWithBase 82 | -- mFreeze = lift mFreeze 83 | -- mPutMem = lift . mPutMem 84 | 85 | mRegLens :: Natural -> Lens' Memory Int 86 | mRegLens i = #mRegs . at i . non 0 87 | 88 | data MemRef s = MemRef 89 | { mrPos :: MutVar s Natural 90 | , mrBase :: MutVar s Int 91 | , mrRegs :: MutVar s (VS.MVector s Int) 92 | } 93 | 94 | initMemRef :: (PrimMonad m, s ~ PrimState m) => Memory -> m (MemRef s) 95 | initMemRef Mem{..} = do 96 | mrPos <- newMutVar mPos 97 | mrBase <- newMutVar mBase 98 | mrRegs <- case M.lookupMax mRegs of 99 | Nothing -> newMutVar =<< MVS.new 0 100 | Just (n, _) -> do 101 | let r = VS.generate (fromIntegral n * 10 + 1) $ \i -> M.findWithDefault 0 (fromIntegral i) mRegs 102 | newMutVar =<< VS.thaw r 103 | pure MemRef{..} 104 | 105 | freezeMemRef :: (PrimMonad m, s ~ PrimState m) => MemRef s -> m Memory 106 | freezeMemRef MemRef{..} = do 107 | mPos <- readMutVar mrPos 108 | mBase <- readMutVar mrBase 109 | mRegs <- fmap toRegs . VS.freeze =<< readMutVar mrRegs 110 | pure Mem{..} 111 | where 112 | toRegs = M.filter (/= 0) . M.fromList . zip [0..] . VS.toList 113 | 114 | 115 | instance (PrimMonad m, s ~ PrimState m) => MonadMem (ReaderT (MemRef s) m) where 116 | mRead = ask >>= \MemRef{..} -> do 117 | i <- fromIntegral <$> atomicModifyMutVar' mrPos (\i -> (i+1, i)) 118 | mPeek i 119 | mCurr = readMutVar =<< asks mrPos 120 | mPeek i = do 121 | r <- readMutVar =<< asks mrRegs 122 | if i' < MVS.length r 123 | then MVS.unsafeRead r i' 124 | else pure 0 125 | where 126 | i' = fromIntegral i 127 | mSeek i = (`writeMutVar` i) =<< asks mrPos 128 | mWrite i x = ask >>= \MemRef{..} -> do 129 | r <- readMutVar mrRegs 130 | let l0 = MVS.length r 131 | if i' < MVS.length r 132 | then MVS.unsafeWrite r i' x 133 | -- else trace "grow" $ do 134 | else do 135 | let l1 = (i' + 1) * 2 136 | regs' <- MVS.unsafeGrow r (l1 - l0) 137 | forM_ [l0 .. l1 - 1] $ \j -> 138 | MVS.unsafeWrite regs' j 0 139 | MVS.unsafeWrite regs' i' x 140 | writeMutVar mrRegs regs' 141 | where 142 | i' = fromIntegral i 143 | mShiftBase b = (`modifyMutVar'` (+ b)) =<< asks mrBase 144 | mWithBase i = fmap (+ i) . readMutVar =<< asks mrBase 145 | 146 | -- mFreeze = freezeMemRef =<< ask 147 | -- mPutMem Mem{..} = ask >>= \MemRef{..} -> do 148 | -- writeMutVar mrPos mPos 149 | -- writeMutVar mrBase mBase 150 | -- case M.lookupMax mRegs of 151 | -- Nothing -> writeMutVar mrRegs =<< MVS.new 0 152 | -- Just (n, _) -> do 153 | -- let r = VS.generate (fromIntegral n + 1) $ \i -> M.findWithDefault 0 (fromIntegral i) mRegs 154 | -- writeMutVar mrRegs =<< VS.thaw r 155 | 156 | -------------------------------------------------------------------------------- /src/AOC/Common/Numeric.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE TypeInType #-} 4 | {-# LANGUAGE TypeOperators #-} 5 | {-# OPTIONS_GHC -fplugin GHC.TypeLits.KnownNat.Solver #-} 6 | {-# OPTIONS_GHC -fplugin GHC.TypeLits.Normalise #-} 7 | 8 | module AOC.Common.Numeric ( 9 | fft 10 | , ifft 11 | , convolve 12 | , rconvolve 13 | , zconvolve 14 | , FFT.FFTWReal 15 | ) where 16 | 17 | import Data.Complex 18 | import GHC.TypeNats 19 | import qualified Data.Array.CArray as CA 20 | import qualified Data.Array.IArray as IA 21 | import qualified Data.Ix as Ix 22 | import qualified Data.Vector.Generic as VG 23 | import qualified Data.Vector.Generic.Sized as SVG 24 | import qualified Foreign.Storable as FS 25 | import qualified Math.FFT as FFT 26 | import qualified Math.FFT.Base as FFT 27 | 28 | fft :: (FFT.FFTWReal a, VG.Vector v (Complex a)) 29 | => SVG.Vector v n (Complex a) 30 | -> SVG.Vector v n (Complex a) 31 | fft = SVG.withVectorUnsafe $ 32 | fromCA 33 | . FFT.dft 34 | . toCA 35 | 36 | ifft 37 | :: (FFT.FFTWReal a, VG.Vector v (Complex a)) 38 | => SVG.Vector v n (Complex a) 39 | -> SVG.Vector v n (Complex a) 40 | ifft = SVG.withVectorUnsafe $ 41 | fromCA 42 | . FFT.idft 43 | . toCA 44 | 45 | fromCA 46 | :: (FS.Storable a, VG.Vector v (Complex a)) 47 | => CA.CArray Int (Complex a) 48 | -> v (Complex a) 49 | fromCA v = VG.generate (Ix.rangeSize (IA.bounds v)) (v IA.!) 50 | 51 | toCA 52 | :: (FS.Storable a, VG.Vector v (Complex a)) 53 | => v (Complex a) 54 | -> CA.CArray Int (Complex a) 55 | toCA v = IA.listArray (0, VG.length v - 1) (VG.toList v) 56 | 57 | -- | FFT-based convolution 58 | convolve 59 | :: ( VG.Vector v (Complex a) 60 | , KnownNat n, 1 <= n 61 | , KnownNat m, 1 <= m 62 | , FFT.FFTWReal a 63 | ) 64 | => SVG.Vector v n (Complex a) 65 | -> SVG.Vector v m (Complex a) 66 | -> SVG.Vector v (n + m - 1) (Complex a) 67 | convolve x y = ifft $ fft x' * fft y' 68 | where 69 | x' = x SVG.++ 0 70 | y' = y SVG.++ 0 71 | 72 | -- | FFT-based real-valued convolution 73 | rconvolve 74 | :: ( VG.Vector v (Complex a) 75 | , VG.Vector v a 76 | , KnownNat n, 1 <= n 77 | , KnownNat m, 1 <= m 78 | , FFT.FFTWReal a 79 | ) 80 | => SVG.Vector v n a 81 | -> SVG.Vector v m a 82 | -> SVG.Vector v (n + m - 1) a 83 | rconvolve x y = SVG.map realPart $ convolve (SVG.map (:+ 0) x) (SVG.map (:+ 0) y) 84 | 85 | -- | FFT-based integral convolution 86 | zconvolve 87 | :: ( VG.Vector v (Complex Double) 88 | , VG.Vector v Double 89 | , VG.Vector v a 90 | , KnownNat n, 1 <= n 91 | , KnownNat m, 1 <= m 92 | , Integral a 93 | ) 94 | => SVG.Vector v n a 95 | -> SVG.Vector v m a 96 | -> SVG.Vector v (n + m - 1) a 97 | zconvolve x y = SVG.map (round @Double) $ 98 | rconvolve (SVG.map fromIntegral x) (SVG.map fromIntegral y) 99 | -------------------------------------------------------------------------------- /src/AOC/Common/Subset.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DerivingVia #-} 2 | {-# LANGUAGE TypeFamilies #-} 3 | 4 | 5 | module AOC.Common.Subset ( 6 | findSubset 7 | , testFinder 8 | , allBranches 9 | , buildDTree 10 | , renderBranches 11 | , renderBranchesChar 12 | , DTree(..), dTestF, dLTF, dGTF 13 | ) where 14 | 15 | import AOC.Util 16 | import Control.Monad.Reader 17 | import Control.Monad.State 18 | import Control.Monad.Trans.Maybe 19 | import Control.Monad.Writer hiding (First(..)) 20 | import Data.Bitraversable 21 | import Data.Foldable 22 | import Data.Functor 23 | import Data.Functor.Foldable 24 | import Data.Functor.Foldable.TH 25 | import Data.Graph.Inductive.PatriciaTree (Gr) 26 | import Data.List.NonEmpty (NonEmpty(..)) 27 | import Data.Map (Map) 28 | import Data.Maybe 29 | import Data.Ord 30 | import Data.Semigroup 31 | import Data.Set (Set) 32 | import qualified Data.Graph.Inductive.Graph as G 33 | import qualified Data.GraphViz as GV 34 | import qualified Data.GraphViz.Printing as GV 35 | import qualified Data.List.NonEmpty as NE 36 | import qualified Data.Map as M 37 | import qualified Data.Set as S 38 | import qualified Data.Set.NonEmpty as NES 39 | import qualified Data.Text.Lazy as TL 40 | 41 | attrEntropy :: Ord a => Set (Set a) -> Set a -> Double 42 | attrEntropy xs x = pLT * hLT + pGT * hGT 43 | where 44 | ltWeight = 2 * lt + unknown 45 | gtWeight = 2 * gt + unknown 46 | pLT = ltWeight / (fromIntegral (S.size xs) * 2) 47 | pGT = gtWeight / (fromIntegral (S.size xs) * 2) 48 | hLT = lt * entroRecip (ltWeight/2) + unknown * entroRecip ltWeight 49 | hGT = gt * entroRecip (gtWeight/2) + unknown * entroRecip gtWeight 50 | (Sum lt, Sum gt, Sum _, Sum unknown) = flip foldMap xs $ \y -> 51 | if | y == x -> (mempty, mempty, Sum (1 :: Int), mempty) 52 | | x `S.isProperSubsetOf` y -> (Sum 1 , mempty, mempty, mempty) 53 | | y `S.isProperSubsetOf` x -> (mempty, Sum 1 , mempty, mempty) 54 | | otherwise -> (mempty, mempty, mempty, Sum 1 ) 55 | 56 | filterTest :: Ord a => Set (Set a) -> Set a -> Ordering -> Set (Set a) 57 | filterTest xs x = \case 58 | LT -> flip S.filter xs $ \y -> not $ y `S.isSubsetOf` x 59 | EQ -> S.singleton x 60 | GT -> flip S.filter xs $ \y -> not $ x `S.isSubsetOf` y 61 | 62 | findSubset 63 | :: (Monad m, Ord a) 64 | => (Set a -> m Ordering) -- ^ tester 65 | -> Bool -- ^ whether or not to include empty set and full set 66 | -> Set a -- ^ full set of items 67 | -> m (Maybe (Set a)) -- ^ subset that matches tester 68 | findSubset tester includeEdge x0 = runMaybeT . go . ruleOut . S.powerSet $ x0 69 | where 70 | ruleOut 71 | | includeEdge = id 72 | | otherwise = S.filter (`notElem` [S.empty, x0]) 73 | go xs = do 74 | (subset, _) <- maybeAlt $ 75 | minimumBy (comparing snd) <$> NE.nonEmpty entropies 76 | s0@(NES.IsNonEmpty rest) <- filterTest xs subset <$> lift (tester subset) 77 | let res :| others = NES.toList rest 78 | if null others 79 | then pure res 80 | else go s0 81 | where 82 | entropies = M.toList $ M.fromSet (attrEntropy xs) xs 83 | 84 | entroRecip :: Double -> Double 85 | entroRecip 0 = 0 86 | entroRecip p = -(1/p) * log (1/p) 87 | 88 | 89 | -- | Get the number of guesses needed for each possible subset, for 90 | -- n items. 91 | testFinder 92 | :: Bool -- ^ whether or not to include empty set and full set 93 | -> Int 94 | -> Map (Set Int) Int 95 | testFinder incl n = M.fromSet (\x -> getSum . execWriter $ findSubset (go x) incl xs) $ S.powerSet xs 96 | where 97 | xs = S.fromList [0 .. n - 1] 98 | go goal x = compare (sumSet x) goalAmt <$ tell (Sum 1) 99 | where 100 | goalAmt = sumSet goal 101 | sumSet :: Set Int -> Int 102 | sumSet = getSum . foldMap (Sum . (2 ^)) 103 | 104 | 105 | data DTree a = DNode { dTest :: Set a 106 | , dLT :: Maybe (DTree a) 107 | , dGT :: Maybe (DTree a) 108 | } 109 | deriving (Show) 110 | makeBaseFunctor ''DTree 111 | 112 | renderBranches :: (Ord a, Show a) => Bool -> Set a -> Maybe TL.Text 113 | renderBranches incl = fmap (printGraph (show . toList) . dTreeGraph) . buildDTree incl 114 | 115 | renderBranchesChar :: Bool -> Set Char -> Maybe TL.Text 116 | renderBranchesChar incl = fmap (printGraph toList . dTreeGraph) . buildDTree incl 117 | 118 | buildDTree :: Ord a => Bool -> Set a -> Maybe (DTree a) 119 | buildDTree incl xs = do 120 | bs <- (traverse . traverse) NE.nonEmpty . allBranches incl $ xs 121 | branchesToDTree <$> NE.nonEmpty bs 122 | 123 | allBranches :: Ord a => Bool -> Set a -> [(Set a, [(Set a, Ordering)])] 124 | allBranches incl = mapMaybe (bitraverse id pure) . runWriterT . findSubset branchOut incl 125 | where 126 | branchOut x = asum [ LT <$ tell [(x, LT)] 127 | , EQ <$ tell [(x, EQ)] 128 | , GT <$ tell [(x, GT)] 129 | ] 130 | 131 | branchesToDTree 132 | :: forall a. () 133 | => NonEmpty (Set a, NonEmpty (Set a, Ordering)) 134 | -> DTree a 135 | branchesToDTree = apo go 136 | where 137 | go :: NonEmpty (Set a, NonEmpty (Set a, Ordering)) 138 | -> DTreeF a (Either (DTree a) (NonEmpty (Set a, NonEmpty (Set a, Ordering)))) 139 | go xs@((_, (t, _) :| _) :| _) = DNodeF t (uncurry reshape lt) (uncurry reshape gt) 140 | where 141 | lt = flip foldMap (toList xs) $ \case 142 | (r, (_, LT) :| (y:ys)) -> (mempty , [(r, y :| ys)]) 143 | (r, (_, LT) :| [] ) -> (Just (First (DNode r Nothing Nothing)), mempty ) 144 | _ -> mempty 145 | gt = flip foldMap (toList xs) $ \case 146 | (r, (_, GT) :| (y:ys)) -> (mempty , [(r, y :| ys)]) 147 | (r, (_, GT) :| [] ) -> (Just (First (DNode r Nothing Nothing)), mempty ) 148 | _ -> mempty 149 | reshape = \case 150 | Just (First x) -> \_ -> Just $ Left x 151 | Nothing -> fmap Right . NE.nonEmpty 152 | 153 | printGraph :: forall a. Show a => (Set a -> String) -> Gr (Set a) Bool -> TL.Text 154 | printGraph f = GV.printIt . GV.graphToDot params 155 | where 156 | params :: GV.GraphvizParams G.Node (Set a) Bool _ _ 157 | params = GV.nonClusteredParams 158 | { GV.fmtNode = \(_, xs) -> [GV.toLabel (f xs)] 159 | , GV.fmtEdge = \(_, _, b) -> [GV.toLabel $ if b then "GT" else "LT"] 160 | } 161 | 162 | 163 | dTreeGraph :: forall a. DTree a -> Gr (Set a) Bool 164 | dTreeGraph = flip evalState 0 . cata go 165 | where 166 | go :: DTreeF a (State Int (Gr (Set a) Bool)) 167 | -> State Int (Gr (Set a) Bool) 168 | go (DNodeF x lt gt) = do 169 | n <- fresh 170 | lt' <- sequence lt 171 | gt' <- sequence gt 172 | let ltRoot = lt' <&> \g -> 173 | let (r, _) = G.nodeRange g 174 | in G.insEdge (n, r, False) 175 | gtRoot = gt' <&> \g -> 176 | let (r, _) = G.nodeRange g 177 | in G.insEdge (n, r, True) 178 | pure $ fromMaybe id ltRoot 179 | . fromMaybe id gtRoot 180 | . G.insNode (n, x) 181 | $ foldr (G.ufold (G.&)) G.empty (catMaybes [lt', gt']) 182 | 183 | fresh :: State Int Int 184 | fresh = state $ \i -> (i, i + 1) 185 | -------------------------------------------------------------------------------- /src/AOC/Prelude.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Prelude 3 | -- Copyright : (c) Justin Le 2018 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : justin@jle.im 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Custom Prelude while developing challenges. Ideally, once challenges 11 | -- are completed, an import to this module would be replaced with explicit 12 | -- ones for future readers. 13 | -- 14 | 15 | 16 | module AOC.Prelude ( 17 | module P 18 | ) where 19 | 20 | import AOC.Common as P 21 | import AOC.Common.Search as P 22 | import AOC.Solver as P 23 | import AOC.Util as P 24 | import Control.Applicative as P 25 | import Control.DeepSeq as P 26 | import Control.Lens as P hiding (uncons, Empty) 27 | import Control.Monad as P 28 | import Control.Monad.Except as P 29 | import Control.Monad.State as P 30 | import Data.Bifunctor as P 31 | import Data.Char as P 32 | import Data.Coerce as P 33 | import Data.Containers.ListUtils as P 34 | import Data.Containers.NonEmpty as P (withNonEmpty, nonEmpty) 35 | import Data.Either as P 36 | import Data.Finite as P (Finite, packFinite, getFinite, modulo, finites) 37 | import Data.Foldable as P 38 | import Data.Function as P 39 | import Data.Functor as P 40 | import Data.IntMap as P (IntMap) 41 | import Data.IntMap.NonEmpty as P (NEIntMap) 42 | import Data.IntSet as P (IntSet) 43 | import Data.IntSet.NonEmpty as P (NEIntSet) 44 | import Data.Kind as P 45 | import Data.List as P hiding (filter) 46 | import Data.List.NonEmpty as P (NonEmpty(..)) 47 | import Data.List.Split as P 48 | import Data.Map as P (Map) 49 | import Data.Map.NonEmpty as P (NEMap) 50 | import Data.Maybe as P hiding (mapMaybe, catMaybes) 51 | import Data.Ord as P 52 | import Data.Profunctor as P (Profunctor(..)) 53 | import Data.Semigroup as P 54 | import Data.Sequence as P (Seq(..)) 55 | import Data.Sequence.NonEmpty as P (NESeq(..)) 56 | import Data.Set as P (Set) 57 | import Data.Set.NonEmpty as P (NESet) 58 | import Data.Text as P (Text) 59 | import Data.Text.Encoding as P (encodeUtf8, decodeUtf8) 60 | import Data.Time as P hiding (Day) 61 | import Data.Traversable as P 62 | import Data.Tuple as P 63 | import Data.Void as P 64 | import Data.Witherable as P hiding (filter) 65 | import Debug.Trace as P 66 | import GHC.Generics as P (Generic) 67 | import Linear as P (V1(..), V2(..), V3(..), V4(..)) 68 | import Numeric.Natural as P 69 | import Safe as P hiding (at, maximumDef, maximumNote, maximumMay, maximumByDef, maximumByNote, maximumByMay, minimumDef, minimumNote, minimumMay, minimumByDef, minimumByNote, minimumByMay, foldr1Def, foldr1May, foldr1Note, foldl1Def, foldl1May, foldl1Note, findJust, findJustDef, findJustNote, minimumBound, maximumBounded, maximumBoundBy, minimumBoundBy, maximumBound, minimumBounded) 70 | import Safe.Foldable as P 71 | import Text.Printf as P 72 | import Text.Read as P (readMaybe) 73 | -------------------------------------------------------------------------------- /src/AOC/Run/Config.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Run.Config 3 | -- Copyright : (c) Justin Le 2018 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : justin@jle.im 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Utilities for loading configuration file. 11 | -- 12 | 13 | 14 | module AOC.Run.Config ( 15 | Config(..), configFile, defConfPath 16 | , session 17 | ) where 18 | 19 | import Control.Exception 20 | import Control.Monad 21 | import Data.Default.Class 22 | import GHC.Generics (Generic) 23 | import System.IO.Error 24 | import Text.Printf 25 | import qualified Data.Aeson as A 26 | import qualified Data.ByteString as BS 27 | import qualified Data.Yaml as Y 28 | 29 | 30 | -- | Configuration for auto-runner. 31 | data Config = Cfg 32 | { _cfgSession :: Maybe String -- ^ Default: 'Nothing' 33 | , _cfgYear :: Integer -- ^ Default: 2015 34 | } 35 | deriving (Generic) 36 | 37 | -- | No session key, and 2015. 38 | instance Default Config where 39 | def = Cfg { _cfgSession = Nothing 40 | , _cfgYear = 2015 41 | } 42 | 43 | -- | Default math to find a configuration file. 44 | defConfPath :: FilePath 45 | defConfPath = "aoc-conf.yaml" 46 | 47 | -- | Load a 'Config' from a given filepath. 48 | configFile :: FilePath -> IO Config 49 | configFile fp = do 50 | cfgInp <- tryJust (guard . isDoesNotExistError) 51 | $ BS.readFile fp 52 | case cfgInp of 53 | Left () -> do 54 | Y.encodeFile @Config fp def 55 | return def 56 | Right b -> 57 | case Y.decodeEither' b of 58 | Left e -> do 59 | printf "Configuration file at %s could not be parsed:\n" fp 60 | print e 61 | return def 62 | Right cfg -> return cfg 63 | 64 | -- | Load a session token from the configuration file at a given filepath. 65 | session :: FilePath -> IO (Maybe String) 66 | session = fmap _cfgSession . configFile 67 | 68 | configJSON :: A.Options 69 | configJSON = A.defaultOptions 70 | { A.fieldLabelModifier = A.camelTo2 '-' . drop 4 } 71 | 72 | instance A.ToJSON Config where 73 | toJSON = A.genericToJSON configJSON 74 | toEncoding = A.genericToEncoding configJSON 75 | instance A.FromJSON Config where 76 | parseJSON = A.genericParseJSON configJSON 77 | -------------------------------------------------------------------------------- /src/AOC/Run/Interactive.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Run.Interactive 3 | -- Copyright : (c) Justin Le 2018 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : justin@jle.im 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Versions of loaders and runners meant to be used in GHCI. 11 | -- 12 | 13 | module AOC.Run.Interactive ( 14 | -- * Fetch and Run 15 | -- ** Return Answers 16 | execSolution 17 | , execSolutionWith 18 | , testSolution 19 | , viewPrompt 20 | , waitForPrompt 21 | , submitSolution 22 | -- ** No Answers 23 | , execSolution_ 24 | , execSolutionWith_ 25 | , testSolution_ 26 | , viewPrompt_ 27 | , waitForPrompt_ 28 | , submitSolution_ 29 | -- * Load Inputs 30 | , loadInput 31 | , loadParseInput 32 | , loadTests 33 | , loadParseTests 34 | -- * Util 35 | , mkSpec 36 | ) where 37 | 38 | import AOC.Challenge 39 | import AOC.Run 40 | import AOC.Run.Config 41 | import AOC.Run.Load 42 | import AOC.Solver 43 | import AOC.Util 44 | import Advent 45 | import Control.Monad.Except 46 | import Data.Bifunctor 47 | import Data.Text (Text) 48 | 49 | -- | Run the solution indicated by the challenge spec on the official 50 | -- puzzle input. Get answer as result. 51 | execSolution :: ChallengeSpec -> IO String 52 | execSolution cs = eitherIO $ do 53 | cfg <- liftIO $ configFile defConfPath 54 | out <- mainRun cfg . defaultMRO $ TSDayPart cs 55 | res <- maybeToEither ["Result not found in result map (Internal Error)"] $ 56 | lookupSolution cs out 57 | liftEither $ snd res 58 | 59 | -- | Run the solution indicated by the challenge spec on a custom input. 60 | -- Get answer as result. 61 | execSolutionWith 62 | :: ChallengeSpec 63 | -> String -- ^ custom puzzle input 64 | -> IO String 65 | execSolutionWith cs inp = eitherIO $ do 66 | cfg <- liftIO $ configFile defConfPath 67 | out <- mainRun cfg $ (defaultMRO (TSDayPart cs)) 68 | { _mroInput = \_ _ -> pure $ Just inp 69 | } 70 | res <- maybeToEither ["Result not found in result map (Internal Error)"] $ 71 | lookupSolution cs out 72 | liftEither $ snd res 73 | 74 | -- | Run test suite for a given challenge spec. 75 | -- 76 | -- Returns 'Just' if any tests were run, with a 'Bool' specifying whether 77 | -- or not all tests passed. 78 | testSolution :: ChallengeSpec -> IO (Maybe Bool) 79 | testSolution cs = eitherIO $ do 80 | cfg <- liftIO $ configFile defConfPath 81 | out <- mainRun cfg $ (defaultMRO (TSDayPart cs)) 82 | { _mroTest = True 83 | } 84 | res <- maybeToEither ["Result not found in result map (Internal Error)"] $ 85 | lookupSolution cs out 86 | pure $ fst res 87 | 88 | -- | View the prompt for a given challenge spec. 89 | viewPrompt :: ChallengeSpec -> IO Text 90 | viewPrompt cs@CS{..} = eitherIO $ do 91 | cfg <- liftIO $ configFile defConfPath 92 | out <- mainView cfg . defaultMVO $ TSDayPart cs 93 | maybeToEither ["Prompt not found in result map (Internal Error)"] $ 94 | lookupSolution cs out 95 | 96 | -- | Countdown to get the prompt for a given challenge spec, if not yet 97 | -- available. 98 | waitForPrompt :: ChallengeSpec -> IO Text 99 | waitForPrompt cs@CS{..} = eitherIO $ do 100 | cfg <- liftIO $ configFile defConfPath 101 | out <- mainView cfg $ (defaultMVO (TSDayPart cs)) 102 | { _mvoWait = True 103 | } 104 | maybeToEither ["Prompt not found in result map (Internal Error)"] $ 105 | lookupSolution cs out 106 | 107 | -- | Submit solution for a given challenge spec, and lock if correct. 108 | submitSolution :: ChallengeSpec -> IO (Text, SubmitRes) 109 | submitSolution cs = eitherIO $ do 110 | cfg <- liftIO $ configFile defConfPath 111 | mainSubmit cfg . defaultMSO $ cs 112 | 113 | -- | Result-suppressing version of 'execSolution'. 114 | execSolution_ :: ChallengeSpec -> IO () 115 | execSolution_ = void . execSolution 116 | 117 | -- | Result-suppressing version of 'execSolutionWith'. 118 | execSolutionWith_ 119 | :: ChallengeSpec 120 | -> String -- ^ custom puzzle input 121 | -> IO () 122 | execSolutionWith_ cs = void . execSolutionWith cs 123 | 124 | -- | Result-suppressing version of 'testSolution'. 125 | testSolution_ :: ChallengeSpec -> IO () 126 | testSolution_ = void . testSolution 127 | 128 | -- | Result-suppressing version of 'viewPrompt'. 129 | viewPrompt_ :: ChallengeSpec -> IO () 130 | viewPrompt_ = void . viewPrompt 131 | 132 | -- | Result-suppressing version of 'waitForPrompt'. 133 | waitForPrompt_ :: ChallengeSpec -> IO () 134 | waitForPrompt_ = void . waitForPrompt 135 | 136 | -- | Result-suppressing version of 'submitSolution'. 137 | submitSolution_ :: ChallengeSpec -> IO () 138 | submitSolution_ = void . submitSolution 139 | 140 | -- | Run the parser of a solution, given its 'ChallengeSpec'. 141 | -- 142 | -- @ 143 | -- 'loadParseInput' (solSpec 'day01a) day01a 144 | -- @ 145 | loadParseInput :: ChallengeSpec -> a :~> b -> IO a 146 | loadParseInput cs s = eitherIO $ do 147 | i <- liftIO $ loadInput cs 148 | maybeToEither ["No parse"] $ sParse s i 149 | 150 | -- | Run the parser of a solution on test data, given its 'ChallengeSpec'. 151 | -- 152 | -- @ 153 | -- 'loadParseTests' (solSpec 'day01a) day01a 154 | -- @ 155 | loadParseTests :: ChallengeSpec -> a :~> b -> IO [(Maybe a, TestMeta)] 156 | loadParseTests cs s = (map . first) (sParse s) <$> loadTests cs 157 | 158 | -- | Load input for a given challenge 159 | loadInput :: ChallengeSpec -> IO String 160 | loadInput cs = eitherIO $ do 161 | CD{..} <- liftIO $ do 162 | Cfg{..} <- configFile defConfPath 163 | challengeData _cfgSession _cfgYear cs 164 | liftEither _cdInput 165 | 166 | -- | Load test cases for a given challenge 167 | loadTests :: ChallengeSpec -> IO [(String, TestMeta)] 168 | loadTests cs = do 169 | Cfg{..} <- configFile defConfPath 170 | _cdTests <$> challengeData _cfgSession _cfgYear cs 171 | 172 | -- | Unsafely create a 'ChallengeSpec' from a day number and part. 173 | -- 174 | -- Is undefined if given a day number out of range (1-25). 175 | mkSpec :: Integer -> Part -> ChallengeSpec 176 | mkSpec i = CS (mkDay_ i) 177 | 178 | eitherIO :: ExceptT [String] IO a -> IO a 179 | eitherIO act = runExceptT act >>= \case 180 | Right x -> pure x 181 | Left es -> fail $ unlines es 182 | 183 | -------------------------------------------------------------------------------- /src/AOC/Solver.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Solver 3 | -- Copyright : (c) Justin Le 2018 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : justin@jle.im 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Types to drive the challenge runner and help speed up/clean up 11 | -- solutions. 12 | -- 13 | 14 | module AOC.Solver ( 15 | (:~>)(..) 16 | , withSolver, withSolver' 17 | , SomeSolution(.., MkSomeSol) 18 | , SolutionError(..) 19 | , runSolution 20 | , runSomeSolution 21 | , ssIsNF 22 | -- * 'DynoMap' 23 | , runSolutionWith 24 | , runSomeSolutionWith 25 | , dyno 26 | , dyno_ 27 | ) where 28 | 29 | import AOC.Util 30 | import AOC.Util.DynoMap 31 | import Control.DeepSeq 32 | import Data.Dynamic 33 | import Data.Map (Map) 34 | import GHC.Generics (Generic) 35 | 36 | -- | Abstracting over the type of a challenge solver to help with cleaner 37 | -- solutions. 38 | -- 39 | -- A @a ':~>' b@ encapsulates something that solves a challenge with input 40 | -- type @a@ into a response of type @b@. 41 | -- 42 | -- Consists of a parser, a shower, and a solver. The solver solves 43 | -- a general @a -> 'Maybe' b@ function, and the parser and shower are used 44 | -- to handle the boilerplate of parsing and printing the solution. 45 | data a :~> b = MkSol 46 | { sParse :: String -> Maybe a -- ^ parse input into an @a@ 47 | , sSolve :: (?dyno :: DynoMap) 48 | => a -> Maybe b -- ^ solve an @a@ input to a @b@ solution 49 | , sShow :: b -> String -- ^ print out the @b@ solution in a pretty way 50 | } 51 | 52 | -- | Wrap an @a ':~>' b@ and hide the type variables so we can put 53 | -- different solutions in a container. 54 | data SomeSolution where 55 | MkSomeSolWH :: a :~> b -> SomeSolution 56 | MkSomeSolNF :: (NFData a, NFData b) => a :~> b -> SomeSolution 57 | 58 | -- | Check if a 'SomeSolution' is equipped with an 'NFData' instance on the 59 | -- types 60 | ssIsNF :: SomeSolution -> Bool 61 | ssIsNF = \case 62 | MkSomeSolWH _ -> False 63 | MkSomeSolNF _ -> True 64 | 65 | data SomeSolHelp where 66 | SSH :: a :~> b -> SomeSolHelp 67 | 68 | toHelp :: SomeSolution -> SomeSolHelp 69 | toHelp (MkSomeSolWH x) = SSH x 70 | toHelp (MkSomeSolNF x) = SSH x 71 | 72 | -- | Handy pattern to work with both 'MkSomeSolWH' and 'MkSomeSolNF'. As 73 | -- a constructor, just uses 'MkSomeSolWH', so might not be desirable. 74 | pattern MkSomeSol :: () => forall a b. () => a :~> b -> SomeSolution 75 | pattern MkSomeSol s <- (toHelp->SSH s) 76 | where 77 | MkSomeSol x = MkSomeSolWH x 78 | {-# COMPLETE MkSomeSol #-} 79 | 80 | -- | Errors that might happen when running a ':~>' on some input. 81 | data SolutionError = SEParse 82 | | SESolve 83 | deriving (Show, Eq, Ord, Generic) 84 | 85 | instance NFData SolutionError 86 | 87 | -- | Construct a ':~>' from just a normal @String -> String@ solver. 88 | -- Does no parsing or special printing treatment. 89 | withSolver' :: (String -> String) -> String :~> String 90 | withSolver' f = withSolver (Just . f) 91 | 92 | -- | Construct a ':~>' from a @String -> 'Maybe' String@ solver, which 93 | -- might fail. Does no parsing or special printing treatment. 94 | withSolver :: (String -> Maybe String) -> String :~> String 95 | withSolver f = MkSol 96 | { sParse = Just 97 | , sShow = id 98 | , sSolve = f 99 | } 100 | 101 | -- | Run a ':~>' on some input. 102 | runSolution :: a :~> b -> String -> Either SolutionError String 103 | runSolution = runSolutionWith mempty 104 | 105 | -- | Run a ':~>' on some input, with a map of dynamic values for testing 106 | runSolutionWith 107 | :: Map String Dynamic -- ^ map of dynamic values for testing with 'lookupDyno'. 108 | -> a :~> b 109 | -> String 110 | -> Either SolutionError String 111 | runSolutionWith dm MkSol{..} (stripNewline->s) = do 112 | x <- maybeToEither SEParse . sParse $ s 113 | y <- maybeToEither SESolve . sSolve $ x 114 | pure $ sShow y 115 | where 116 | ?dyno = Dyno dm 117 | 118 | -- | Run a 'SomeSolution' on some input. 119 | runSomeSolution 120 | :: SomeSolution 121 | -> String 122 | -> Either SolutionError String 123 | runSomeSolution = runSomeSolutionWith mempty 124 | 125 | -- | Run a 'SomeSolution' on some input, with a map of dynamic values for 126 | -- testing 127 | runSomeSolutionWith 128 | :: Map String Dynamic -- ^ map of dynamic values for testing with 'lookupDyno'. 129 | -> SomeSolution 130 | -> String 131 | -> Either SolutionError String 132 | runSomeSolutionWith dm (MkSomeSol c) = runSolutionWith dm c 133 | 134 | -- | From a @?dyno@ Implicit Params, look up a value at a given key. Meant 135 | -- to be used with TypeApplications: 136 | -- 137 | -- > 'dyno' @"hello" 138 | -- 139 | -- This can be used within the body of 'sSolve', since it will always be 140 | -- called with the implicit parameter. 141 | -- 142 | -- When called on actual puzzle input, result will always be 'Nothing'. 143 | -- But, for some test inputs, there might be supplied values. 144 | -- 145 | -- This is useful for when some problems have parameters that are 146 | -- different with test inputs than for actual inputs. 147 | dyno 148 | :: forall a. (Typeable a, ?dyno :: DynoMap) 149 | => String 150 | -> Maybe a 151 | dyno = (`lookupDyno` ?dyno) 152 | 153 | -- | A version of 'dyno' taking a default value in case the key is not 154 | -- in the map. When called on actual puzzle input, this is always 'id'. 155 | -- However, for some test inputs, there might be supplied values. 156 | -- 157 | -- Meant to be used with TypeApplications: 158 | -- 159 | -- > 'dyno_' @"hello" 7 160 | -- 161 | -- This is useful for when some problems have parameters that are 162 | -- different with test inputs than for actual inputs. 163 | dyno_ 164 | :: forall a. (Typeable a, ?dyno :: DynoMap) 165 | => String 166 | -> a -- ^ default 167 | -> a 168 | dyno_ str def = lookupDynoWith str def ?dyno 169 | -------------------------------------------------------------------------------- /src/AOC/Util.hs: -------------------------------------------------------------------------------- 1 | -- | 2 | -- Module : AOC.Util 3 | -- Copyright : (c) Justin Le 2018 4 | -- License : BSD3 5 | -- 6 | -- Maintainer : justin@jle.im 7 | -- Stability : experimental 8 | -- Portability : non-portable 9 | -- 10 | -- Assorted utility functions and orphans used for solutions. 11 | -- 12 | 13 | module AOC.Util ( 14 | strip 15 | , stripNewline 16 | , eitherToMaybe 17 | , firstJust 18 | , maybeToEither 19 | , maybeAlt 20 | , traceShowIdMsg 21 | , traceShowMsg 22 | ) where 23 | 24 | import Control.Applicative 25 | import Control.Monad.Except 26 | import Data.Foldable 27 | import Debug.Trace 28 | import qualified Data.Text as T 29 | 30 | -- | Strip trailing and leading whitespace. 31 | strip :: String -> String 32 | strip = T.unpack . T.strip . T.pack 33 | 34 | -- | Strip trailing newline 35 | stripNewline :: String -> String 36 | stripNewline = reverse . dropWhile (== '\n') . reverse 37 | 38 | -- | Convert an 'Either' into a 'Maybe', or any 'Alternative' instance, 39 | -- forgetting the error value. 40 | eitherToMaybe :: Alternative m => Either e a -> m a 41 | eitherToMaybe = either (const empty) pure 42 | 43 | -- | Convert a 'Maybe' into an 'Either', or any 'MonadError' instance, by 44 | -- providing an error value in case 'Nothing' was given. 45 | maybeToEither :: MonadError e m => e -> Maybe a -> m a 46 | maybeToEither e = maybe (throwError e) pure 47 | 48 | -- | Like 'find', but instead of taking an @a -> Bool@, takes an @a -> 49 | -- Maybe b@ and returns the first success. 50 | firstJust 51 | :: Foldable t 52 | => (a -> Maybe b) 53 | -> t a 54 | -> Maybe b 55 | firstJust p = asum . map p . toList 56 | 57 | -- | Generalize a 'Maybe' to any 'Alternative' 58 | maybeAlt :: Alternative m => Maybe a -> m a 59 | maybeAlt = maybe empty pure 60 | 61 | -- | Like 'traceShowId' but with an extra message 62 | traceShowIdMsg :: Show a => String -> a -> a 63 | traceShowIdMsg msg x = trace (msg ++ show x) x 64 | 65 | -- | Like 'traceShow' but with an extra message 66 | traceShowMsg :: Show a => String -> a -> b -> b 67 | traceShowMsg msg x = trace (msg ++ show x) 68 | -------------------------------------------------------------------------------- /src/AOC/Util/DynoMap.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE NoDeriveAnyClass #-} 2 | 3 | module AOC.Util.DynoMap ( 4 | DynoMap(..) 5 | , lookupDyno 6 | , lookupDynoWith 7 | ) where 8 | 9 | import Control.Monad 10 | import Data.Dynamic 11 | import Data.Map (Map) 12 | import Data.Maybe 13 | import qualified Data.Map as M 14 | 15 | newtype DynoMap = Dyno { runDyno :: Map String Dynamic } 16 | deriving (Semigroup, Monoid) 17 | 18 | -- | Lookup the value at a given key in a 'Dyno'. 19 | -- 20 | -- > lookupDyno "hello" 21 | lookupDyno 22 | :: forall a. Typeable a 23 | => String 24 | -> DynoMap 25 | -> Maybe a 26 | lookupDyno sym = fromDynamic 27 | <=< M.lookup sym 28 | . runDyno 29 | 30 | -- | Like 'lookupDyno', but with a default value to be returned if the key 31 | -- is not found or has the wrong type. 32 | lookupDynoWith 33 | :: forall a. (Typeable a) 34 | => String 35 | -> a 36 | -> DynoMap 37 | -> a 38 | lookupDynoWith sym def = fromMaybe def . lookupDyno sym 39 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | # This file was automatically generated by 'stack init' 2 | # 3 | # Some commonly used options have been documented as comments in this file. 4 | # For advanced use and comprehensive documentation of the format, please see: 5 | # https://docs.haskellstack.org/en/stable/yaml_configuration/ 6 | 7 | # Resolver to choose a 'specific' stackage snapshot or a compiler version. 8 | # A snapshot resolver dictates the compiler version and the set of packages 9 | # to be used for project dependencies. For example: 10 | # 11 | # resolver: lts-3.5 12 | # resolver: nightly-2015-09-21 13 | # resolver: ghc-7.10.2 14 | # 15 | # The location of a snapshot can be provided as a file or url. Stack assumes 16 | # a snapshot provided as a file might change, whereas a url resource does not. 17 | # 18 | # resolver: ./custom-snapshot.yaml 19 | # resolver: https://example.com/snapshots/2018-01-01.yaml 20 | resolver: lts-16.24 21 | 22 | # User packages to be built. 23 | # Various formats can be used as shown in the example below. 24 | # 25 | # packages: 26 | # - some-directory 27 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 28 | # - location: 29 | # git: https://github.com/commercialhaskell/stack.git 30 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 31 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 32 | # subdirs: 33 | # - auto-update 34 | # - wai 35 | packages: 36 | - . 37 | 38 | # Dependency packages to be pulled from upstream that are not in the resolver 39 | # using the same syntax as the packages field. 40 | # (e.g., acme-missiles-0.3) 41 | extra-deps: 42 | - advent-of-code-api-0.2.7.0 43 | - advent-of-code-ocr-0.1.0.0 44 | - constraints-extras-0.3.0.2 45 | - astar-0.3.0.0 46 | - conduino-0.2.2.0 47 | - dependent-sum-0.7.1.0 48 | - finitary-2.0.0.0 49 | - lens-regex-pcre-1.1.0.0 50 | - list-transformer-1.0.6 51 | - monoidal-containers-0.6.0.1 52 | - typelits-witnesses-0.4.0.0 53 | - witherable-0.3.5 54 | - github: mstksg/vector-sized 55 | commit: 4295e08076ab248bf0ba0924e4addbf6f19f6893 56 | # - hashable-1.3.0.0 57 | # - list-transformer-1.0.6 58 | # - megaparsec-8.0.0 59 | # - nonempty-containers-0.3.3.0 60 | # - nonempty-vector-0.2.0.1 61 | # - parser-combinators-1.2.1 62 | 63 | # allow-newer: true 64 | 65 | # Override default flag values for local packages and extra-deps 66 | # flags: {} 67 | 68 | # Extra package databases containing global packages 69 | # extra-package-dbs: [] 70 | 71 | # Control whether we use the GHC we find on the path 72 | # system-ghc: true 73 | # 74 | # Require a specific version of stack, using version ranges 75 | # require-stack-version: -any # Default 76 | # require-stack-version: ">=1.9" 77 | # 78 | # Override the architecture used by stack, especially useful on Windows 79 | # arch: i386 80 | # arch: x86_64 81 | # 82 | # Extra directories used by stack for building 83 | # extra-include-dirs: [/path/to/dir] 84 | # extra-lib-dirs: [/path/to/dir] 85 | # 86 | # Allow a newer minor version of GHC than the snapshot specifies 87 | # compiler-check: newer-minor 88 | 89 | build: 90 | haddock-arguments: 91 | haddock-args: 92 | - --optghc=-fdefer-type-errors 93 | 94 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: 7 | - completed: 8 | hackage: advent-of-code-api-0.2.7.0@sha256:d16c39e5f149bb046b05adf94ba2c3232a24d21587cb75b3c4c4480f1e270564,2351 9 | pantry-tree: 10 | size: 1185 11 | sha256: 1688c03a530c5eaf1581e1d5104e8481d3b2199ce973eb8599eb64168edc3908 12 | original: 13 | hackage: advent-of-code-api-0.2.7.0 14 | - completed: 15 | hackage: advent-of-code-ocr-0.1.0.0@sha256:997fa1608b61d908d2cc0acf15bb8327831a9a1a6a587254148078395a4e906e,2927 16 | pantry-tree: 17 | size: 614 18 | sha256: 81c307cd6eeab113677a9aa638a6c1732641ed5b17a46f7c06806d164464c5ae 19 | original: 20 | hackage: advent-of-code-ocr-0.1.0.0 21 | - completed: 22 | hackage: constraints-extras-0.3.0.2@sha256:013b8d0392582c6ca068e226718a4fe8be8e22321cc0634f6115505bf377ad26,1853 23 | pantry-tree: 24 | size: 594 25 | sha256: 3ce1012bfb02e4d7def9df19ce80b8cd2b472c691b25b181d9960638673fecd1 26 | original: 27 | hackage: constraints-extras-0.3.0.2 28 | - completed: 29 | hackage: astar-0.3.0.0@sha256:8bf6350542e9db9451490e8993560ee843dc48a61d46a206985430f9b62461c8,967 30 | pantry-tree: 31 | size: 213 32 | sha256: c4176cc3fc9ad39f2a9fc7eb4346c87b6e60b70ba23d8e2adbdfc81fe544b808 33 | original: 34 | hackage: astar-0.3.0.0 35 | - completed: 36 | hackage: conduino-0.2.2.0@sha256:1fe73859f8d518af7182c76248d0573bf69a6a6e12d79da85438a530f0227c9f,1621 37 | pantry-tree: 38 | size: 527 39 | sha256: 45719113d47d7ce62da867f7d36f7518b925036867ab3a06db7b557a97c8fe43 40 | original: 41 | hackage: conduino-0.2.2.0 42 | - completed: 43 | hackage: dependent-sum-0.7.1.0@sha256:5599aa89637db434431b1dd3fa7c34bc3d565ee44f0519bfbc877be1927c2531,2068 44 | pantry-tree: 45 | size: 290 46 | sha256: 9cbfb32b5a8a782b7a1c941803fd517633cb699159b851c1d82267a9e9391b50 47 | original: 48 | hackage: dependent-sum-0.7.1.0 49 | - completed: 50 | hackage: finitary-2.0.0.0@sha256:1044c9048ef920787fc9600634e6a66c890dada612cfda1d4820669306324c43,2373 51 | pantry-tree: 52 | size: 438 53 | sha256: 8b6df70650871d989a55702619ee94ac6a646157d0ef294511fa7e6297b26c89 54 | original: 55 | hackage: finitary-2.0.0.0 56 | - completed: 57 | hackage: lens-regex-pcre-1.1.0.0@sha256:a6053fefae59f6b53b4741e5a75c5fae350af80dbf62e8673b565e1c3f34f8b9,2209 58 | pantry-tree: 59 | size: 630 60 | sha256: 84a02d84433d92c5e2a9a7bfd662244be607b4004c7d4d6fd1ba53adbc655022 61 | original: 62 | hackage: lens-regex-pcre-1.1.0.0 63 | - completed: 64 | hackage: list-transformer-1.0.6@sha256:e214728decb4844b1c6ea0e3243324cfc11ad6da5629d16f06b92f00b6a5bed0,1455 65 | pantry-tree: 66 | size: 280 67 | sha256: 7d2a46b5ade8b57a62888af490d6fb20b217e6fa92b5bf40d53c6e9fd7a3809c 68 | original: 69 | hackage: list-transformer-1.0.6 70 | - completed: 71 | hackage: monoidal-containers-0.6.0.1@sha256:ffdfae0fde7a08e9e314667a78d86454d2d23137d85f226ec6e757c190fb28ad,2583 72 | pantry-tree: 73 | size: 569 74 | sha256: 61d5a73cb768aa4d59db7365418a2fc1bb24b8c3e53ca496372656b6ba4d31ab 75 | original: 76 | hackage: monoidal-containers-0.6.0.1 77 | - completed: 78 | hackage: typelits-witnesses-0.4.0.0@sha256:1d7092ba98fdc33f4b413e04144eb3ead7b105f74b2998e3c74a8a0feee685a9,1985 79 | pantry-tree: 80 | size: 403 81 | sha256: 2ee741f6bb4dba710e6449da335fdcf8940adb767798b29fdb8ae2606d22e0cb 82 | original: 83 | hackage: typelits-witnesses-0.4.0.0 84 | - completed: 85 | hackage: witherable-0.3.5@sha256:6590a15735b50ac14dcc138d4265ff1585d5f3e9d3047d5ebc5abf4cd5f50084,1476 86 | pantry-tree: 87 | size: 271 88 | sha256: b99f21dbac28da031eb7c787fbffbe5e77e0aee42b64b5dda082470e907d5ab5 89 | original: 90 | hackage: witherable-0.3.5 91 | - completed: 92 | size: 61645 93 | url: https://github.com/mstksg/vector-sized/archive/4295e08076ab248bf0ba0924e4addbf6f19f6893.tar.gz 94 | name: vector-sized 95 | version: 1.4.2 96 | sha256: 45242435b343ec6ec8b4da6ff1406c22ba718728c8fbacceeaf72e44da89f4ad 97 | pantry-tree: 98 | size: 1408 99 | sha256: d36ddb46cf11d173e147dd3373ae27c34b53fcfbdee7bfb1c51a0ce786d1fdbd 100 | original: 101 | url: https://github.com/mstksg/vector-sized/archive/4295e08076ab248bf0ba0924e4addbf6f19f6893.tar.gz 102 | snapshots: 103 | - completed: 104 | size: 532835 105 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/16/24.yaml 106 | sha256: cf2b52420b2262fe9cf0f6744929120131abd6675b1c3fb2d8b155a47f80d103 107 | original: lts-16.24 108 | -------------------------------------------------------------------------------- /template/DayXX.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_GHC -Wno-unused-imports #-} 2 | {-# OPTIONS_GHC -Wno-unused-top-binds #-} 3 | 4 | -- | 5 | -- Module : AOC.Challenge.Day${day} 6 | -- License : BSD3 7 | -- 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Day ${day_short}. See "AOC.Solver" for the types used in this module! 12 | -- 13 | -- After completing the challenge, it is recommended to: 14 | -- 15 | -- * Replace "AOC.Prelude" imports to specific modules (with explicit 16 | -- imports) for readability. 17 | -- * Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@ 18 | -- pragmas. 19 | -- * Replace the partial type signatures underscores in the solution 20 | -- types @_ :~> _@ with the actual types of inputs and outputs of the 21 | -- solution. You can delete the type signatures completely and GHC 22 | -- will recommend what should go in place of the underscores. 23 | 24 | module AOC.Challenge.Day${day} ( 25 | -- day${day}a 26 | -- , day${day}b 27 | ) where 28 | 29 | import AOC.Prelude 30 | 31 | day${day}a :: _ :~> _ 32 | day${day}a = MkSol 33 | { sParse = Just 34 | , sShow = show 35 | , sSolve = Just 36 | } 37 | 38 | day${day}b :: _ :~> _ 39 | day${day}b = MkSol 40 | { sParse = Just 41 | , sShow = show 42 | , sSolve = Just 43 | } 44 | -------------------------------------------------------------------------------- /template/feed-item.xml.template: -------------------------------------------------------------------------------- 1 | 2 | Day ${day} 3 | ${body} 4 | https://github.com/${github}/advent-of-code-${year}/blob/master/reflections.md#day-${day} 5 | ${time} 6 | 7 | -------------------------------------------------------------------------------- /template/feed.xml.template: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | ${name}'s Advent of Code ${year} Reflections 6 | Reflections for my Advent of Code solutions as I try to solve them all in fun ways using Haskell! 7 | https://github.com/${github}/advent-of-code-${year}/blob/master/reflections.md 8 | Copyright ${year} ${name} 9 | en-us 10 | ${time} 11 | ${email} 12 | ${time} 13 | ${email} 14 | Shake + Template 15 | ${body} 16 | 17 | 18 | -------------------------------------------------------------------------------- /template/reflection.md.template: -------------------------------------------------------------------------------- 1 | Day ${dayshort} 2 | ------ 3 | 4 | 9 | 10 | *[Prompt][d${daylong}p]* / *[Code][d${daylong}g]* / *[Rendered][d${daylong}h]* 11 | 12 | [d${daylong}p]: https://adventofcode.com/${year}/day/${dayshort} 13 | [d${daylong}g]: https://github.com/${github}/advent-of-code-${year}/blob/master/src/AOC/Challenge/Day${daylong}.hs 14 | [d${daylong}h]: https://${github}.github.io/advent-of-code-${year}/src/AOC.Challenge.Day${daylong}.html 15 | 16 | ${body} 17 | 18 | ### Day ${dayshort} Benchmarks 19 | 20 | ``` 21 | ${benchmarks} 22 | ``` 23 | -------------------------------------------------------------------------------- /template/reflections.md.template: -------------------------------------------------------------------------------- 1 | Reflections 2 | =========== 3 | 4 | 8 | 9 | ${other_years} 10 | 11 | ${other_links} 12 | 13 | [Available as an RSS Feed][rss] 14 | 15 | [rss]: ${rss} 16 | 17 | Table of Contents 18 | ----------------- 19 | 20 | ${toc} 21 | 22 | ${body} 23 | -------------------------------------------------------------------------------- /test-data/2016/01a.txt: -------------------------------------------------------------------------------- 1 | R2, L3 2 | >>> 5 3 | R2, R2, R2 4 | >>> 2 5 | R5, L5, R5, R3 6 | >>> 12 7 | -------------------------------------------------------------------------------- /test-data/2016/01b.txt: -------------------------------------------------------------------------------- 1 | R8, R4, R4, R8 2 | >>> 4 3 | -------------------------------------------------------------------------------- /test-data/2016/02a.txt: -------------------------------------------------------------------------------- 1 | ULL 2 | RRDDD 3 | LURDL 4 | UUUUD 5 | >>> 1985 6 | -------------------------------------------------------------------------------- /test-data/2016/02b.txt: -------------------------------------------------------------------------------- 1 | ULL 2 | RRDDD 3 | LURDL 4 | UUUUD 5 | >>> 5DB3 6 | -------------------------------------------------------------------------------- /test-data/2016/03a.txt: -------------------------------------------------------------------------------- 1 | 5 10 25 2 | >>> 0 3 | -------------------------------------------------------------------------------- /test-data/2016/04a.txt: -------------------------------------------------------------------------------- 1 | aaaaa-bbb-z-y-x-123[abxyz] 2 | a-b-c-d-e-f-g-h-987[abcde] 3 | not-a-real-room-404[oarel] 4 | totally-real-room-200[decoy] 5 | >>> 1514 6 | -------------------------------------------------------------------------------- /test-data/2016/05a.txt: -------------------------------------------------------------------------------- 1 | abc 2 | >>> 18f47a30 3 | -------------------------------------------------------------------------------- /test-data/2016/05b.txt: -------------------------------------------------------------------------------- 1 | abc 2 | >>> 05ace8e3 3 | -------------------------------------------------------------------------------- /test-data/2016/06a.txt: -------------------------------------------------------------------------------- 1 | eedadn 2 | drvtee 3 | eandsr 4 | raavrd 5 | atevrs 6 | tsrnev 7 | sdttsa 8 | rasrtv 9 | nssdts 10 | ntnada 11 | svetve 12 | tesnvt 13 | vntsnd 14 | vrdear 15 | dvrsen 16 | enarar 17 | >>> easter 18 | -------------------------------------------------------------------------------- /test-data/2016/06b.txt: -------------------------------------------------------------------------------- 1 | eedadn 2 | drvtee 3 | eandsr 4 | raavrd 5 | atevrs 6 | tsrnev 7 | sdttsa 8 | rasrtv 9 | nssdts 10 | ntnada 11 | svetve 12 | tesnvt 13 | vntsnd 14 | vrdear 15 | dvrsen 16 | enarar 17 | >>> advent 18 | -------------------------------------------------------------------------------- /test-data/2017/01a.txt: -------------------------------------------------------------------------------- 1 | 1122 2 | >>> 3 3 | 1111 4 | >>> 4 5 | 1234 6 | >>> 0 7 | 91212129 8 | >>> 9 9 | -------------------------------------------------------------------------------- /test-data/2017/01b.txt: -------------------------------------------------------------------------------- 1 | 1212 2 | >>> 6 3 | 1221 4 | >>> 0 5 | 123425 6 | >>> 4 7 | 123123 8 | >>> 12 9 | 12131415 10 | >>> 4 11 | -------------------------------------------------------------------------------- /test-data/2017/02a.txt: -------------------------------------------------------------------------------- 1 | 5 1 9 5 2 | 7 5 3 3 | 2 4 6 8 4 | >>> 18 5 | -------------------------------------------------------------------------------- /test-data/2017/02b.txt: -------------------------------------------------------------------------------- 1 | 5 9 2 8 2 | 9 4 7 3 3 | 3 8 6 5 4 | >>> 9 5 | -------------------------------------------------------------------------------- /test-data/2017/03a.txt: -------------------------------------------------------------------------------- 1 | 1 2 | >>> 0 3 | 12 4 | >>> 3 5 | 23 6 | >>> 2 7 | 1024 8 | >>> 31 9 | -------------------------------------------------------------------------------- /test-data/2017/03b.txt: -------------------------------------------------------------------------------- 1 | 12 2 | >>> 23 3 | 60 4 | >>> 122 5 | 748 6 | >>> 806 7 | -------------------------------------------------------------------------------- /test-data/2017/04a.txt: -------------------------------------------------------------------------------- 1 | aa bb cc dd ee 2 | >>> 1 3 | aa bb cc dd aa 4 | >>> 0 5 | aa bb cc dd aaa 6 | >>> 1 7 | aa bb cc dd ee 8 | aa bb cc dd aa 9 | aa bb cc dd aaa 10 | >>> 2 11 | -------------------------------------------------------------------------------- /test-data/2017/04b.txt: -------------------------------------------------------------------------------- 1 | abcde fghij 2 | >>> 1 3 | abcde xyz ecdab 4 | >>> 0 5 | a ab abc abd abf abj 6 | >>> 1 7 | iiii oiii ooii oooi oooo 8 | >>> 1 9 | oiii ioii iioi iiio 10 | >>> 0 11 | abcde fghij 12 | abcde xyz ecdab 13 | a ab abc abd abf abj 14 | iiii oiii ooii oooi oooo 15 | oiii ioii iioi iiio 16 | >>> 3 17 | -------------------------------------------------------------------------------- /test-data/2017/05a.txt: -------------------------------------------------------------------------------- 1 | 0 2 | 3 3 | 0 4 | 1 5 | -3 6 | >>> 5 7 | -------------------------------------------------------------------------------- /test-data/2017/05b.txt: -------------------------------------------------------------------------------- 1 | 0 2 | 3 3 | 0 4 | 1 5 | -3 6 | >>> 10 7 | -------------------------------------------------------------------------------- /test-data/2017/06a.txt: -------------------------------------------------------------------------------- 1 | 0 2 7 0 2 | >>> 5 3 | -------------------------------------------------------------------------------- /test-data/2017/06b.txt: -------------------------------------------------------------------------------- 1 | 0 2 7 0 2 | >>> 4 3 | -------------------------------------------------------------------------------- /test-data/2017/07a.txt: -------------------------------------------------------------------------------- 1 | pbga (66) 2 | xhth (57) 3 | ebii (61) 4 | havc (66) 5 | ktlj (57) 6 | fwft (72) -> ktlj, cntj, xhth 7 | qoyq (66) 8 | padx (45) -> pbga, havc, qoyq 9 | tknk (41) -> ugml, padx, fwft 10 | jptl (61) 11 | ugml (68) -> gyxo, ebii, jptl 12 | gyxo (61) 13 | cntj (57) 14 | >>> tknk 15 | -------------------------------------------------------------------------------- /test-data/2017/07b.txt: -------------------------------------------------------------------------------- 1 | pbga (66) 2 | xhth (57) 3 | ebii (61) 4 | havc (66) 5 | ktlj (57) 6 | fwft (72) -> ktlj, cntj, xhth 7 | qoyq (66) 8 | padx (45) -> pbga, havc, qoyq 9 | tknk (41) -> ugml, padx, fwft 10 | jptl (61) 11 | ugml (68) -> gyxo, ebii, jptl 12 | gyxo (61) 13 | cntj (57) 14 | >>> 60 15 | -------------------------------------------------------------------------------- /test-data/2017/08a.txt: -------------------------------------------------------------------------------- 1 | b inc 5 if a > 1 2 | a inc 1 if b < 5 3 | c dec -10 if a >= 1 4 | c inc -20 if c == 10 5 | >>> 1 6 | -------------------------------------------------------------------------------- /test-data/2017/08b.txt: -------------------------------------------------------------------------------- 1 | b inc 5 if a > 1 2 | a inc 1 if b < 5 3 | c dec -10 if a >= 1 4 | c inc -20 if c == 10 5 | >>> 10 6 | -------------------------------------------------------------------------------- /test-data/2017/09a.txt: -------------------------------------------------------------------------------- 1 | {} 2 | >>> 1 3 | {{{}}} 4 | >>> 6 5 | {{},{}} 6 | >>> 5 7 | {{{},{},{{}}}} 8 | >>> 16 9 | {,,,} 10 | >>> 1 11 | {{},{},{},{}} 12 | >>> 9 13 | {{},{},{},{}} 14 | >>> 9 15 | {{},{},{},{}} 16 | >>> 3 17 | -------------------------------------------------------------------------------- /test-data/2017/09b.txt: -------------------------------------------------------------------------------- 1 | <> 2 | >>> 0 3 | 4 | >>> 17 5 | <<<<> 6 | >>> 3 7 | <{!>}> 8 | >>> 2 9 | 10 | >>> 0 11 | > 12 | >>> 0 13 | <{o"i!a,<{i 14 | >>> 10 15 | -------------------------------------------------------------------------------- /test-data/2017/10b.txt: -------------------------------------------------------------------------------- 1 | 2 | >>> a2582a3a0e66e6e86e3812dcb672a272 3 | AoC 2017 4 | >>> 33efeb34ea91902bb2f59c9920caa6cd 5 | 1,2,3 6 | >>> 3efbe78a8d82f29979031a4aa0b16a9d 7 | 1,2,4 8 | >>> 63960835bcdc130f0b66d7ff4f6a5a8e 9 | -------------------------------------------------------------------------------- /test-data/2017/11a.txt: -------------------------------------------------------------------------------- 1 | ne,ne,ne 2 | >>> 3 3 | ne,ne,sw,sw 4 | >>> 0 5 | ne,ne,s,s 6 | >>> 2 7 | se,sw,se,sw,sw 8 | >>> 3 9 | -------------------------------------------------------------------------------- /test-data/2017/11b.txt: -------------------------------------------------------------------------------- 1 | ne,ne,ne 2 | >>> 3 3 | ne,ne,sw,sw 4 | >>> 2 5 | ne,ne,s,s 6 | >>> 2 7 | se,sw,se,sw,sw 8 | >>> 3 9 | -------------------------------------------------------------------------------- /test-data/2017/13a.txt: -------------------------------------------------------------------------------- 1 | 0: 3 2 | 1: 2 3 | 4: 4 4 | 6: 4 5 | >>> 24 6 | -------------------------------------------------------------------------------- /test-data/2017/13b.txt: -------------------------------------------------------------------------------- 1 | 0: 3 2 | 1: 2 3 | 4: 4 4 | 6: 4 5 | >>> 10 6 | -------------------------------------------------------------------------------- /test-data/2017/14a.txt: -------------------------------------------------------------------------------- 1 | flqrgnkx 2 | >>> 8108 3 | -------------------------------------------------------------------------------- /test-data/2017/14b.txt: -------------------------------------------------------------------------------- 1 | flqrgnkx 2 | >>> 1242 3 | -------------------------------------------------------------------------------- /test-data/2017/17a.txt: -------------------------------------------------------------------------------- 1 | 3 2 | >>> 638 3 | -------------------------------------------------------------------------------- /test-data/2017/18b.txt: -------------------------------------------------------------------------------- 1 | snd 1 2 | snd 2 3 | snd p 4 | rcv a 5 | rcv b 6 | rcv c 7 | rcv d 8 | >>> 3 9 | -------------------------------------------------------------------------------- /test-data/2017/19a.txt: -------------------------------------------------------------------------------- 1 | | 2 | | +--+ 3 | A | C 4 | F---|----E|--+ 5 | | | | D 6 | +B-+ +--+ 7 | >>> ABCDEF 8 | -------------------------------------------------------------------------------- /test-data/2017/19b.txt: -------------------------------------------------------------------------------- 1 | | 2 | | +--+ 3 | A | C 4 | F---|----E|--+ 5 | | | | D 6 | +B-+ +--+ 7 | >>> 38 8 | -------------------------------------------------------------------------------- /test-data/2017/20a.txt: -------------------------------------------------------------------------------- 1 | p=< 3,0,0>, v=< 2,0,0>, a=<-1,0,0> 2 | p=< 4,0,0>, v=< 0,0,0>, a=<-2,0,0> 3 | >>> 0 4 | -------------------------------------------------------------------------------- /test-data/2017/20b.txt: -------------------------------------------------------------------------------- 1 | p=<-6,0,0>, v=< 3,0,0>, a=< 0,0,0> 2 | p=<-4,0,0>, v=< 2,0,0>, a=< 0,0,0> 3 | p=<-2,0,0>, v=< 1,0,0>, a=< 0,0,0> 4 | p=< 3,0,0>, v=<-1,0,0>, a=< 0,0,0> 5 | >>> 1 6 | -------------------------------------------------------------------------------- /test-data/2018/01a.txt: -------------------------------------------------------------------------------- 1 | +1 2 | -2 3 | +3 4 | +1 5 | >>> 3 6 | +1 7 | +1 8 | +1 9 | >>> 3 10 | +1 11 | +1 12 | -2 13 | >>> 0 14 | -1 15 | -2 16 | -3 17 | >>> -6 18 | -------------------------------------------------------------------------------- /test-data/2018/01b.txt: -------------------------------------------------------------------------------- 1 | +1 2 | -2 3 | +3 4 | +1 5 | >>> 2 6 | +1 7 | -1 8 | >>> 0 9 | +3 10 | +3 11 | +4 12 | -2 13 | -4 14 | >>> 10 15 | -6 16 | +3 17 | +8 18 | +5 19 | -6 20 | >>> 5 21 | +7 22 | +7 23 | -2 24 | -7 25 | -4 26 | >>> 14 27 | -------------------------------------------------------------------------------- /test-data/2018/02a.txt: -------------------------------------------------------------------------------- 1 | abcdef 2 | bababc 3 | abbcde 4 | abcccd 5 | aabcdd 6 | abcdee 7 | ababab 8 | >>> 12 9 | -------------------------------------------------------------------------------- /test-data/2018/02b.txt: -------------------------------------------------------------------------------- 1 | abcde 2 | fghij 3 | klmno 4 | pqrst 5 | fguij 6 | axcye 7 | wvxyz 8 | >>> fgij 9 | -------------------------------------------------------------------------------- /test-data/2018/03a.txt: -------------------------------------------------------------------------------- 1 | #1 @ 1,3: 4x4 2 | #2 @ 3,1: 4x4 3 | #3 @ 5,5: 2x2 4 | >>> 4 5 | -------------------------------------------------------------------------------- /test-data/2018/03b.txt: -------------------------------------------------------------------------------- 1 | #1 @ 1,3: 4x4 2 | #2 @ 3,1: 4x4 3 | #3 @ 5,5: 2x2 4 | >>> 3 5 | -------------------------------------------------------------------------------- /test-data/2018/04a.txt: -------------------------------------------------------------------------------- 1 | [1518-11-01 00:00] Guard #10 begins shift 2 | [1518-11-01 00:05] falls asleep 3 | [1518-11-01 00:25] wakes up 4 | [1518-11-01 00:30] falls asleep 5 | [1518-11-01 00:55] wakes up 6 | [1518-11-01 23:58] Guard #99 begins shift 7 | [1518-11-02 00:40] falls asleep 8 | [1518-11-02 00:50] wakes up 9 | [1518-11-03 00:05] Guard #10 begins shift 10 | [1518-11-03 00:24] falls asleep 11 | [1518-11-03 00:29] wakes up 12 | [1518-11-04 00:02] Guard #99 begins shift 13 | [1518-11-04 00:36] falls asleep 14 | [1518-11-04 00:46] wakes up 15 | [1518-11-05 00:03] Guard #99 begins shift 16 | [1518-11-05 00:45] falls asleep 17 | [1518-11-05 00:55] wakes up 18 | >>> 240 19 | -------------------------------------------------------------------------------- /test-data/2018/04b.txt: -------------------------------------------------------------------------------- 1 | [1518-11-01 00:00] Guard #10 begins shift 2 | [1518-11-01 00:05] falls asleep 3 | [1518-11-01 00:25] wakes up 4 | [1518-11-01 00:30] falls asleep 5 | [1518-11-01 00:55] wakes up 6 | [1518-11-01 23:58] Guard #99 begins shift 7 | [1518-11-02 00:40] falls asleep 8 | [1518-11-02 00:50] wakes up 9 | [1518-11-03 00:05] Guard #10 begins shift 10 | [1518-11-03 00:24] falls asleep 11 | [1518-11-03 00:29] wakes up 12 | [1518-11-04 00:02] Guard #99 begins shift 13 | [1518-11-04 00:36] falls asleep 14 | [1518-11-04 00:46] wakes up 15 | [1518-11-05 00:03] Guard #99 begins shift 16 | [1518-11-05 00:45] falls asleep 17 | [1518-11-05 00:55] wakes up 18 | >>> 4455 19 | -------------------------------------------------------------------------------- /test-data/2018/05a.txt: -------------------------------------------------------------------------------- 1 | aA 2 | >>> 0 3 | abBA 4 | >>> 0 5 | abAB 6 | >>> 4 7 | aabAAB 8 | >>> 6 9 | dabAcCaCBAcCcaDA 10 | >>> 10 11 | -------------------------------------------------------------------------------- /test-data/2018/05b.txt: -------------------------------------------------------------------------------- 1 | dabAcCaCBAcCcaDA 2 | >>> 4 3 | -------------------------------------------------------------------------------- /test-data/2018/06a.txt: -------------------------------------------------------------------------------- 1 | 1, 1 2 | 1, 6 3 | 8, 3 4 | 3, 4 5 | 5, 5 6 | 8, 9 7 | >>> 17 8 | -------------------------------------------------------------------------------- /test-data/2018/06b.txt: -------------------------------------------------------------------------------- 1 | 1, 1 2 | 1, 6 3 | 8, 3 4 | 3, 4 5 | 5, 5 6 | 8, 9 7 | >>>lim:32:int 8 | >>> 16 9 | -------------------------------------------------------------------------------- /test-data/2018/07a.txt: -------------------------------------------------------------------------------- 1 | Step C must be finished before step A can begin. 2 | Step C must be finished before step F can begin. 3 | Step A must be finished before step B can begin. 4 | Step A must be finished before step D can begin. 5 | Step B must be finished before step E can begin. 6 | Step D must be finished before step E can begin. 7 | Step F must be finished before step E can begin. 8 | >>> CABDFE 9 | -------------------------------------------------------------------------------- /test-data/2018/07b.txt: -------------------------------------------------------------------------------- 1 | Step C must be finished before step A can begin. 2 | Step C must be finished before step F can begin. 3 | Step A must be finished before step B can begin. 4 | Step A must be finished before step D can begin. 5 | Step B must be finished before step E can begin. 6 | Step D must be finished before step E can begin. 7 | Step F must be finished before step E can begin. 8 | >>>cap:2:int 9 | >>>wait:0:int 10 | >>> 15 11 | -------------------------------------------------------------------------------- /test-data/2018/08a.txt: -------------------------------------------------------------------------------- 1 | 2 3 0 3 10 11 12 1 1 0 1 99 2 1 1 2 2 | >>> 138 3 | -------------------------------------------------------------------------------- /test-data/2018/08b.txt: -------------------------------------------------------------------------------- 1 | 2 3 0 3 10 11 12 1 1 0 1 99 2 1 1 2 2 | >>> 66 3 | -------------------------------------------------------------------------------- /test-data/2018/09a.txt: -------------------------------------------------------------------------------- 1 | 9 25 2 | >>> 32 3 | 10 1618 4 | >>> 8317 5 | 13 players; last marble is worth 7999 points 6 | >>> 146373 7 | 17 1104 8 | >>> 2764 9 | 21 6111 10 | >>> 54718 11 | 30 5807 12 | >>> 37305 13 | -------------------------------------------------------------------------------- /test-data/2018/10b.txt: -------------------------------------------------------------------------------- 1 | position=< 9, 1> velocity=< 0, 2> 2 | position=< 7, 0> velocity=<-1, 0> 3 | position=< 3, -2> velocity=<-1, 1> 4 | position=< 6, 10> velocity=<-2, -1> 5 | position=< 2, -4> velocity=< 2, 2> 6 | position=<-6, 10> velocity=< 2, -2> 7 | position=< 1, 8> velocity=< 1, -1> 8 | position=< 1, 7> velocity=< 1, 0> 9 | position=<-3, 11> velocity=< 1, -2> 10 | position=< 7, 6> velocity=<-1, -1> 11 | position=<-2, 3> velocity=< 1, 0> 12 | position=<-4, 3> velocity=< 2, 0> 13 | position=<10, -3> velocity=<-1, 1> 14 | position=< 5, 11> velocity=< 1, -2> 15 | position=< 4, 7> velocity=< 0, -1> 16 | position=< 8, -2> velocity=< 0, 1> 17 | position=<15, 0> velocity=<-2, 0> 18 | position=< 1, 6> velocity=< 1, 0> 19 | position=< 8, 9> velocity=< 0, -1> 20 | position=< 3, 3> velocity=<-1, 1> 21 | position=< 0, 5> velocity=< 0, -1> 22 | position=<-2, 2> velocity=< 2, 0> 23 | position=< 5, -2> velocity=< 1, 2> 24 | position=< 1, 4> velocity=< 2, 1> 25 | position=<-2, 7> velocity=< 2, -2> 26 | position=< 3, 6> velocity=<-1, -1> 27 | position=< 5, 0> velocity=< 1, 0> 28 | position=<-6, 0> velocity=< 2, 0> 29 | position=< 5, 9> velocity=< 1, -2> 30 | position=<14, 7> velocity=<-2, 0> 31 | position=<-3, 6> velocity=< 2, -1> 32 | >>> 3 33 | -------------------------------------------------------------------------------- /test-data/2018/11a.txt: -------------------------------------------------------------------------------- 1 | 18 2 | >>> 33,45 3 | 42 4 | >>> 21,61 5 | -------------------------------------------------------------------------------- /test-data/2018/11b.txt: -------------------------------------------------------------------------------- 1 | 18 2 | >>> 90,269,16 3 | 42 4 | >>> 232,251,12 5 | -------------------------------------------------------------------------------- /test-data/2018/14a.txt: -------------------------------------------------------------------------------- 1 | 9 2 | >>> 5158916779 3 | 5 4 | >>> 0124515891 5 | 18 6 | >>> 9251071085 7 | 2018 8 | >>> 5941429882 9 | -------------------------------------------------------------------------------- /test-data/2018/14b.txt: -------------------------------------------------------------------------------- 1 | 51589 2 | >>> 9 3 | 01245 4 | >>> 5 5 | 92510 6 | >>> 18 7 | 59414 8 | >>> 2018 9 | 5891 10 | >>> 11 11 | -------------------------------------------------------------------------------- /test-data/2018/15a.txt: -------------------------------------------------------------------------------- 1 | ######### 2 | #G..G..G# 3 | #.......# 4 | #.......# 5 | #G..E..G# 6 | #.......# 7 | #.......# 8 | #G..G..G# 9 | ######### 10 | >>> 27828 11 | ####### 12 | #.G...# 13 | #...EG# 14 | #.#.#G# 15 | #..G#E# 16 | #.....# 17 | ####### 18 | >>> 27730 19 | ####### 20 | #G..#E# 21 | #E#E.E# 22 | #G.##.# 23 | #...#E# 24 | #...E.# 25 | ####### 26 | >>> 36334 27 | ####### 28 | #E..EG# 29 | #.#G.E# 30 | #E.##E# 31 | #G..#.# 32 | #..E#.# 33 | ####### 34 | >>> 39514 35 | ####### 36 | #E.G#.# 37 | #.#G..# 38 | #G.#.G# 39 | #G..#.# 40 | #...E.# 41 | ####### 42 | >>> 27755 43 | ####### 44 | #.E...# 45 | #.#..G# 46 | #.###.# 47 | #E#G#G# 48 | #...#G# 49 | ####### 50 | >>> 28944 51 | ######### 52 | #G......# 53 | #.E.#...# 54 | #..##..G# 55 | #...##..# 56 | #...#...# 57 | #.G...G.# 58 | #.....G.# 59 | ######### 60 | >>> 18740 61 | -------------------------------------------------------------------------------- /test-data/2018/15b.txt: -------------------------------------------------------------------------------- 1 | ####### 2 | #.G...# 3 | #...EG# 4 | #.#.#G# 5 | #..G#E# 6 | #.....# 7 | ####### 8 | >>> 4988 9 | ####### 10 | #E..EG# 11 | #.#G.E# 12 | #E.##E# 13 | #G..#.# 14 | #..E#.# 15 | ####### 16 | >>> 31284 17 | ####### 18 | #E.G#.# 19 | #.#G..# 20 | #G.#.G# 21 | #G..#.# 22 | #...E.# 23 | ####### 24 | >>> 3478 25 | ####### 26 | #.E...# 27 | #.#..G# 28 | #.###.# 29 | #E#G#G# 30 | #...#G# 31 | ####### 32 | >>> 6474 33 | ######### 34 | #G......# 35 | #.E.#...# 36 | #..##..G# 37 | #...##..# 38 | #...#...# 39 | #.G...G.# 40 | #.....G.# 41 | ######### 42 | >>> 1140 43 | -------------------------------------------------------------------------------- /test-data/2018/17a.txt: -------------------------------------------------------------------------------- 1 | x=495, y=2..7 2 | y=7, x=495..501 3 | x=501, y=3..7 4 | x=498, y=2..4 5 | x=506, y=1..2 6 | x=498, y=10..13 7 | x=504, y=10..13 8 | y=13, x=498..504 9 | >>> 57 10 | x=493, y=1..2 11 | x=497, y=2..4 12 | x=503, y=2..4 13 | y=4, x=497..503 14 | x=494, y=8..9 15 | x=506, y=7..9 16 | y=9, x=495..505 17 | >>> 55 18 | -------------------------------------------------------------------------------- /test-data/2018/18a.txt: -------------------------------------------------------------------------------- 1 | .#.#...|#. 2 | .....#|##| 3 | .|..|...#. 4 | ..|#.....# 5 | #.#|||#|#| 6 | ...#.||... 7 | .|....|... 8 | ||...#|.#| 9 | |.||||..|. 10 | ...#.|..|. 11 | >>> 1147 12 | -------------------------------------------------------------------------------- /test-data/2018/20a.txt: -------------------------------------------------------------------------------- 1 | ^WNE$ 2 | >>> 3 3 | ^ENWWW(NEEE|SSE(EE|N))$ 4 | >>> 10 5 | ^ENNWSWW(NEWS|)SSSEEN(WNSE|)EE(SWEN|)NNN$ 6 | >>> 18 7 | -------------------------------------------------------------------------------- /test-data/2018/22a.txt: -------------------------------------------------------------------------------- 1 | depth: 510 2 | target: 10,10 3 | >>> 114 4 | -------------------------------------------------------------------------------- /test-data/2018/22b.txt: -------------------------------------------------------------------------------- 1 | depth: 510 2 | target: 10,10 3 | >>> 45 4 | -------------------------------------------------------------------------------- /test-data/2018/23a.txt: -------------------------------------------------------------------------------- 1 | pos=<0,0,0>, r=4 2 | pos=<1,0,0>, r=1 3 | pos=<4,0,0>, r=3 4 | pos=<0,2,0>, r=1 5 | pos=<0,5,0>, r=3 6 | pos=<0,0,3>, r=1 7 | pos=<1,1,1>, r=1 8 | pos=<1,1,2>, r=1 9 | pos=<1,3,1>, r=1 10 | >>> 7 11 | -------------------------------------------------------------------------------- /test-data/2018/23b.txt: -------------------------------------------------------------------------------- 1 | pos=<10,12,12>, r=2 2 | pos=<12,14,12>, r=2 3 | pos=<16,12,12>, r=4 4 | pos=<14,14,14>, r=6 5 | pos=<50,50,50>, r=200 6 | pos=<10,10,10>, r=5 7 | >>> 36 8 | -------------------------------------------------------------------------------- /test-data/2018/24a.txt: -------------------------------------------------------------------------------- 1 | Immune System: 2 | 17 units each with 5390 hit points (weak to radiation, bludgeoning) with an attack that does 4507 fire damage at initiative 2 3 | 989 units each with 1274 hit points (immune to fire; weak to bludgeoning, slashing) with an attack that does 25 slashing damage at initiative 3 4 | 5 | Infection: 6 | 801 units each with 4706 hit points (weak to radiation) with an attack that does 116 bludgeoning damage at initiative 1 7 | 4485 units each with 2961 hit points (immune to radiation; weak to fire, cold) with an attack that does 12 slashing damage at initiative 4 8 | >>> 5216 9 | -------------------------------------------------------------------------------- /test-data/2018/24b.txt: -------------------------------------------------------------------------------- 1 | Immune System: 2 | 17 units each with 5390 hit points (weak to radiation, bludgeoning) with an attack that does 4507 fire damage at initiative 2 3 | 989 units each with 1274 hit points (immune to fire; weak to bludgeoning, slashing) with an attack that does 25 slashing damage at initiative 3 4 | 5 | Infection: 6 | 801 units each with 4706 hit points (weak to radiation) with an attack that does 116 bludgeoning damage at initiative 1 7 | 4485 units each with 2961 hit points (immune to radiation; weak to fire, cold) with an attack that does 12 slashing damage at initiative 4 8 | >>> 51 9 | -------------------------------------------------------------------------------- /test-data/2019/01a.txt: -------------------------------------------------------------------------------- 1 | 12 2 | >>> 2 3 | 14 4 | >>> 2 5 | 1969 6 | >>> 654 7 | 100756 8 | >>> 33583 9 | -------------------------------------------------------------------------------- /test-data/2019/01b.txt: -------------------------------------------------------------------------------- 1 | 14 2 | >>> 2 3 | 1969 4 | >>> 966 5 | 100756 6 | >>> 50346 7 | -------------------------------------------------------------------------------- /test-data/2019/02a.txt: -------------------------------------------------------------------------------- 1 | 1,9,10,3,2,3,11,0,99,30,40,50 2 | >>>noun:9:int 3 | >>>verb:10:int 4 | >>> 3500 5 | 1,0,0,0,99 6 | >>>noun:0:int 7 | >>>verb:0:int 8 | >>> 2 9 | 2,3,0,3,99 10 | >>>noun:3:int 11 | >>>verb:0:int 12 | >>> 2 13 | 2,4,4,5,99,0 14 | >>>noun:4:int 15 | >>>verb:4:int 16 | >>> 2 17 | 1,1,1,4,99,5,6,0,99 18 | >>>noun:1:int 19 | >>>verb:1:int 20 | >>> 30 21 | -------------------------------------------------------------------------------- /test-data/2019/03a.txt: -------------------------------------------------------------------------------- 1 | R8,U5,L5,D3 2 | U7,R6,D4,L4 3 | >>> 6 4 | R75,D30,R83,U83,L12,D49,R71,U7,L72 5 | U62,R66,U55,R34,D71,R55,D58,R83 6 | >>> 159 7 | R98,U47,R26,D63,R33,U87,L62,D20,R33,U53,R51 8 | U98,R91,D20,R16,D67,R40,U7,R15,U6,R7 9 | >>> 135 10 | -------------------------------------------------------------------------------- /test-data/2019/03b.txt: -------------------------------------------------------------------------------- 1 | R8,U5,L5,D3 2 | U7,R6,D4,L4 3 | >>> 30 4 | R75,D30,R83,U83,L12,D49,R71,U7,L72 5 | U62,R66,U55,R34,D71,R55,D58,R83 6 | >>> 610 7 | R98,U47,R26,D63,R33,U87,L62,D20,R33,U53,R51 8 | U98,R91,D20,R16,D67,R40,U7,R15,U6,R7 9 | >>> 410 10 | -------------------------------------------------------------------------------- /test-data/2019/04a.txt: -------------------------------------------------------------------------------- 1 | 111111-111111 2 | >>> 1 3 | 223450-223450 4 | >>> 0 5 | 123789-123789 6 | >>> 0 7 | -------------------------------------------------------------------------------- /test-data/2019/04b.txt: -------------------------------------------------------------------------------- 1 | 112233-112233 2 | >>> 1 3 | 123444-123444 4 | >>> 0 5 | 111122-111122 6 | >>> 1 7 | -------------------------------------------------------------------------------- /test-data/2019/05a.txt: -------------------------------------------------------------------------------- 1 | 3,0,4,0,99 2 | >>> 1 3 | -------------------------------------------------------------------------------- /test-data/2019/06a.txt: -------------------------------------------------------------------------------- 1 | COM)B 2 | B)C 3 | C)D 4 | D)E 5 | E)F 6 | B)G 7 | G)H 8 | D)I 9 | E)J 10 | J)K 11 | K)L 12 | >>> 42 13 | -------------------------------------------------------------------------------- /test-data/2019/06b.txt: -------------------------------------------------------------------------------- 1 | COM)B 2 | B)C 3 | C)D 4 | D)E 5 | E)F 6 | B)G 7 | G)H 8 | D)I 9 | E)J 10 | J)K 11 | K)L 12 | K)YOU 13 | I)SAN 14 | >>> 4 15 | -------------------------------------------------------------------------------- /test-data/2019/07a.txt: -------------------------------------------------------------------------------- 1 | 3,15,3,16,1002,16,10,16,1,16,15,15,4,15,99,0,0 2 | >>> 43210 3 | 3,23,3,24,1002,24,10,24,1002,23,-1,23, 101,5,23,23,1,24,23,23,4,23,99,0,0 4 | >>> 54321 5 | 3,31,3,32,1002,32,10,32,1001,31,-2,31,1007,31,0,33, 1002,33,7,33,1,33,31,31,1,32,31,31,4,31,99,0,0,0 6 | >>> 65210 7 | -------------------------------------------------------------------------------- /test-data/2019/07b.txt: -------------------------------------------------------------------------------- 1 | 3,26,1001,26,-4,26,3,27,1002,27,2,27,1,27,26,27,4,27,1001,28,-1,28,1005,28,6,99,0,0,5 2 | >>> 139629729 3 | 3,52,1001,52,-5,52,3,53,1,52,56,54,1007,54,5,55,1005,55,26,1001,54,-5,54,1105,1,12,1,53,54,53,1008,54,0,55,1001,55,1,55,2,53,55,53,4,53,1001,56,-1,56,1005,56,6,99,0,0,0,0,10 4 | >>> 18216 5 | -------------------------------------------------------------------------------- /test-data/2019/08a.txt: -------------------------------------------------------------------------------- 1 | 123456789012 2 | >>>w:3:int 3 | >>>h:2:int 4 | >>> 1 5 | -------------------------------------------------------------------------------- /test-data/2019/09a.txt: -------------------------------------------------------------------------------- 1 | 109,1,204,-1,1001,100,1,100,1008,100,16,101,1006,101,0,99 2 | >>> 109 3 | 1102,34915192,34915192,7,4,7,99,0 4 | >>> 1219070632396864 5 | 104,1125899906842624,99 6 | >>> 1125899906842624 7 | -------------------------------------------------------------------------------- /test-data/2019/10a.txt: -------------------------------------------------------------------------------- 1 | .#..# 2 | ..... 3 | ##### 4 | ....# 5 | ...## 6 | >>> 8 7 | ......#.#. 8 | #..#.#.... 9 | ..#######. 10 | .#.#.###.. 11 | .#..#..... 12 | ..#....#.# 13 | #..#....#. 14 | .##.#..### 15 | ##...#..#. 16 | .#....#### 17 | >>> 33 18 | #.#...#.#. 19 | .###....#. 20 | .#....#... 21 | ##.#.#.#.# 22 | ....#.#.#. 23 | .##..###.# 24 | ..#...##.. 25 | ..##....## 26 | ......#... 27 | .####.###. 28 | >>> 35 29 | .#..#..### 30 | ####.###.# 31 | ....###.#. 32 | ..###.##.# 33 | ##.##.#.#. 34 | ....###..# 35 | ..#.#..#.# 36 | #..#.#.### 37 | .##...##.# 38 | .....#.#.. 39 | >>> 41 40 | .#..##.###...####### 41 | ##.############..##. 42 | .#.######.########.# 43 | .###.#######.####.#. 44 | #####.##.#.##.###.## 45 | ..#####..#.######### 46 | #################### 47 | #.####....###.#.#.## 48 | ##.################# 49 | #####.##.###..####.. 50 | ..######..##.####### 51 | ####.##.####...##..# 52 | .#####..#.######.### 53 | ##...#.##########... 54 | #.##########.####### 55 | .####.#.###.###.#.## 56 | ....##.##.###..##### 57 | .#.#.###########.### 58 | #.#.#.#####.####.### 59 | ###.##.####.##.#..## 60 | >>> 210 61 | -------------------------------------------------------------------------------- /test-data/2019/10b.txt: -------------------------------------------------------------------------------- 1 | .#..##.###...####### 2 | ##.############..##. 3 | .#.######.########.# 4 | .###.#######.####.#. 5 | #####.##.#.##.###.## 6 | ..#####..#.######### 7 | #################### 8 | #.####....###.#.#.## 9 | ##.################# 10 | #####.##.###..####.. 11 | ..######..##.####### 12 | ####.##.####...##..# 13 | .#####..#.######.### 14 | ##...#.##########... 15 | #.##########.####### 16 | .####.#.###.###.#.## 17 | ....##.##.###..##### 18 | .#.#.###########.### 19 | #.#.#.#####.####.### 20 | ###.##.####.##.#..## 21 | >>> 802 22 | -------------------------------------------------------------------------------- /test-data/2019/12a.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | >>>steps:10:int 6 | >>> 179 7 | 8 | 9 | 10 | 11 | >>>steps:100:int 12 | >>> 1940 13 | -------------------------------------------------------------------------------- /test-data/2019/12b.txt: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | >>> 2772 6 | 7 | 8 | 9 | 10 | >>> 4686774924 11 | -------------------------------------------------------------------------------- /test-data/2019/14a.txt: -------------------------------------------------------------------------------- 1 | 10 ORE => 10 A 2 | 1 ORE => 1 B 3 | 7 A, 1 B => 1 C 4 | 7 A, 1 C => 1 D 5 | 7 A, 1 D => 1 E 6 | 7 A, 1 E => 1 FUEL 7 | >>> 31 8 | 9 ORE => 2 A 9 | 8 ORE => 3 B 10 | 7 ORE => 5 C 11 | 3 A, 4 B => 1 AB 12 | 5 B, 7 C => 1 BC 13 | 4 C, 1 A => 1 CA 14 | 2 AB, 3 BC, 4 CA => 1 FUEL 15 | >>> 165 16 | 157 ORE => 5 NZVS 17 | 165 ORE => 6 DCFZ 18 | 44 XJWVT, 5 KHKGT, 1 QDVJ, 29 NZVS, 9 GPVTF, 48 HKGWZ => 1 FUEL 19 | 12 HKGWZ, 1 GPVTF, 8 PSHF => 9 QDVJ 20 | 179 ORE => 7 PSHF 21 | 177 ORE => 5 HKGWZ 22 | 7 DCFZ, 7 PSHF => 2 XJWVT 23 | 165 ORE => 2 GPVTF 24 | 3 DCFZ, 7 NZVS, 5 HKGWZ, 10 PSHF => 8 KHKGT 25 | >>> 13312 26 | 2 VPVL, 7 FWMGM, 2 CXFTF, 11 MNCFX => 1 STKFG 27 | 17 NVRVD, 3 JNWZP => 8 VPVL 28 | 53 STKFG, 6 MNCFX, 46 VJHF, 81 HVMC, 68 CXFTF, 25 GNMV => 1 FUEL 29 | 22 VJHF, 37 MNCFX => 5 FWMGM 30 | 139 ORE => 4 NVRVD 31 | 144 ORE => 7 JNWZP 32 | 5 MNCFX, 7 RFSQX, 2 FWMGM, 2 VPVL, 19 CXFTF => 3 HVMC 33 | 5 VJHF, 7 MNCFX, 9 VPVL, 37 CXFTF => 6 GNMV 34 | 145 ORE => 6 MNCFX 35 | 1 NVRVD => 8 CXFTF 36 | 1 VJHF, 6 MNCFX => 4 RFSQX 37 | 176 ORE => 6 VJHF 38 | >>> 180697 39 | 171 ORE => 8 CNZTR 40 | 7 ZLQW, 3 BMBT, 9 XCVML, 26 XMNCP, 1 WPTQ, 2 MZWV, 1 RJRHP => 4 PLWSL 41 | 114 ORE => 4 BHXH 42 | 14 VRPVC => 6 BMBT 43 | 6 BHXH, 18 KTJDG, 12 WPTQ, 7 PLWSL, 31 FHTLT, 37 ZDVW => 1 FUEL 44 | 6 WPTQ, 2 BMBT, 8 ZLQW, 18 KTJDG, 1 XMNCP, 6 MZWV, 1 RJRHP => 6 FHTLT 45 | 15 XDBXC, 2 LTCX, 1 VRPVC => 6 ZLQW 46 | 13 WPTQ, 10 LTCX, 3 RJRHP, 14 XMNCP, 2 MZWV, 1 ZLQW => 1 ZDVW 47 | 5 BMBT => 4 WPTQ 48 | 189 ORE => 9 KTJDG 49 | 1 MZWV, 17 XDBXC, 3 XCVML => 2 XMNCP 50 | 12 VRPVC, 27 CNZTR => 2 XDBXC 51 | 15 KTJDG, 12 BHXH => 5 XCVML 52 | 3 BHXH, 2 VRPVC => 7 MZWV 53 | 121 ORE => 7 VRPVC 54 | 7 XCVML => 6 RJRHP 55 | 5 BHXH, 4 VRPVC => 5 LTCX 56 | >>> 2210736 57 | -------------------------------------------------------------------------------- /test-data/2019/14b.txt: -------------------------------------------------------------------------------- 1 | 157 ORE => 5 NZVS 2 | 165 ORE => 6 DCFZ 3 | 44 XJWVT, 5 KHKGT, 1 QDVJ, 29 NZVS, 9 GPVTF, 48 HKGWZ => 1 FUEL 4 | 12 HKGWZ, 1 GPVTF, 8 PSHF => 9 QDVJ 5 | 179 ORE => 7 PSHF 6 | 177 ORE => 5 HKGWZ 7 | 7 DCFZ, 7 PSHF => 2 XJWVT 8 | 165 ORE => 2 GPVTF 9 | 3 DCFZ, 7 NZVS, 5 HKGWZ, 10 PSHF => 8 KHKGT 10 | >>> 82892753 11 | 2 VPVL, 7 FWMGM, 2 CXFTF, 11 MNCFX => 1 STKFG 12 | 17 NVRVD, 3 JNWZP => 8 VPVL 13 | 53 STKFG, 6 MNCFX, 46 VJHF, 81 HVMC, 68 CXFTF, 25 GNMV => 1 FUEL 14 | 22 VJHF, 37 MNCFX => 5 FWMGM 15 | 139 ORE => 4 NVRVD 16 | 144 ORE => 7 JNWZP 17 | 5 MNCFX, 7 RFSQX, 2 FWMGM, 2 VPVL, 19 CXFTF => 3 HVMC 18 | 5 VJHF, 7 MNCFX, 9 VPVL, 37 CXFTF => 6 GNMV 19 | 145 ORE => 6 MNCFX 20 | 1 NVRVD => 8 CXFTF 21 | 1 VJHF, 6 MNCFX => 4 RFSQX 22 | 176 ORE => 6 VJHF 23 | >>> 5586022 24 | 171 ORE => 8 CNZTR 25 | 7 ZLQW, 3 BMBT, 9 XCVML, 26 XMNCP, 1 WPTQ, 2 MZWV, 1 RJRHP => 4 PLWSL 26 | 114 ORE => 4 BHXH 27 | 14 VRPVC => 6 BMBT 28 | 6 BHXH, 18 KTJDG, 12 WPTQ, 7 PLWSL, 31 FHTLT, 37 ZDVW => 1 FUEL 29 | 6 WPTQ, 2 BMBT, 8 ZLQW, 18 KTJDG, 1 XMNCP, 6 MZWV, 1 RJRHP => 6 FHTLT 30 | 15 XDBXC, 2 LTCX, 1 VRPVC => 6 ZLQW 31 | 13 WPTQ, 10 LTCX, 3 RJRHP, 14 XMNCP, 2 MZWV, 1 ZLQW => 1 ZDVW 32 | 5 BMBT => 4 WPTQ 33 | 189 ORE => 9 KTJDG 34 | 1 MZWV, 17 XDBXC, 3 XCVML => 2 XMNCP 35 | 12 VRPVC, 27 CNZTR => 2 XDBXC 36 | 15 KTJDG, 12 BHXH => 5 XCVML 37 | 3 BHXH, 2 VRPVC => 7 MZWV 38 | 121 ORE => 7 VRPVC 39 | 7 XCVML => 6 RJRHP 40 | 5 BHXH, 4 VRPVC => 5 LTCX 41 | >>> 460664 42 | -------------------------------------------------------------------------------- /test-data/2019/16a.txt: -------------------------------------------------------------------------------- 1 | 80871224585914546619083218645595 2 | >>> 24176176 3 | 19617804207202209144916044189917 4 | >>> 73745418 5 | 69317163492948606335995924319873 6 | >>> 52432133 7 | -------------------------------------------------------------------------------- /test-data/2019/16b.txt: -------------------------------------------------------------------------------- 1 | 03036732577212944063491565474664 2 | >>> 84462026 3 | 02935109699940807407585447034323 4 | >>> 78725270 5 | 03081770884921959731165446850517 6 | >>> 53553731 7 | -------------------------------------------------------------------------------- /test-data/2019/18a.txt: -------------------------------------------------------------------------------- 1 | ######### 2 | #b.A.@.a# 3 | ######### 4 | >>> 8 5 | ######################## 6 | #f.D.E.e.C.b.A.@.a.B.c.# 7 | ######################.# 8 | #d.....................# 9 | ######################## 10 | >>> 86 11 | ######################## 12 | #...............b.C.D.f# 13 | #.###################### 14 | #.....@.a.B.c.d.A.e.F.g# 15 | ######################## 16 | >>> 132 17 | ################# 18 | #i.G..c...e..H.p# 19 | ########.######## 20 | #j.A..b...f..D.o# 21 | ########@######## 22 | #k.E..a...g..B.n# 23 | ########.######## 24 | #l.F..d...h..C.m# 25 | ################# 26 | >>> 136 27 | ######################## 28 | #@..............ac.GI.b# 29 | ###d#e#f################ 30 | ###A#B#C################ 31 | ###g#h#i################ 32 | ######################## 33 | >>> 81 34 | -------------------------------------------------------------------------------- /test-data/2019/18b.txt: -------------------------------------------------------------------------------- 1 | ############### 2 | #d.ABC.#.....a# 3 | ######...###### 4 | ######.@.###### 5 | ######...###### 6 | #b.....#.....c# 7 | ############### 8 | >>> 24 9 | ############# 10 | #DcBa.#.GhKl# 11 | #.###...#I### 12 | #e#d#.@.#j#k# 13 | ###C#...###J# 14 | #fEbA.#.FgHi# 15 | ############# 16 | >>> 32 17 | ############# 18 | #g#f.D#..h#l# 19 | #F###e#E###.# 20 | #dCba...BcIJ# 21 | #####.@.##### 22 | #nK.L...G...# 23 | #M###N#H###.# 24 | #o#m..#i#jk.# 25 | ############# 26 | >>> 72 27 | -------------------------------------------------------------------------------- /test-data/2019/20a.txt: -------------------------------------------------------------------------------- 1 | A 2 | A 3 | #######.######### 4 | #######.........# 5 | #######.#######.# 6 | #######.#######.# 7 | #######.#######.# 8 | ##### B ###.# 9 | BC...## C ###.# 10 | ##.## ###.# 11 | ##...DE F ###.# 12 | ##### G ###.# 13 | #########.#####.# 14 | DE..#######...###.# 15 | #.#########.###.# 16 | FG..#########.....# 17 | ###########.##### 18 | Z 19 | Z 20 | >>> 23 21 | A 22 | A 23 | #################.############# 24 | #.#...#...................#.#.# 25 | #.#.#.###.###.###.#########.#.# 26 | #.#.#.......#...#.....#.#.#...# 27 | #.#########.###.#####.#.#.###.# 28 | #.............#.#.....#.......# 29 | ###.###########.###.#####.#.#.# 30 | #.....# A C #.#.#.# 31 | ####### S P #####.# 32 | #.#...# #......VT 33 | #.#.#.# #.##### 34 | #...#.# YN....#.# 35 | #.###.# #####.# 36 | DI....#.# #.....# 37 | #####.# #.###.# 38 | ZZ......# QG....#..AS 39 | ###.### ####### 40 | JO..#.#.# #.....# 41 | #.#.#.# ###.#.# 42 | #...#..DI BU....#..LF 43 | #####.# #.##### 44 | YN......# VT..#....QG 45 | #.###.# #.###.# 46 | #.#...# #.....# 47 | ###.### J L J #.#.### 48 | #.....# O F P #.#...# 49 | #.###.#####.#.#####.#####.###.# 50 | #...#.#.#...#.....#.....#.#...# 51 | #.#####.###.###.#.#.#########.# 52 | #...#.#.....#...#.#.#.#.....#.# 53 | #.###.#####.###.###.#.#.####### 54 | #.#.........#...#.............# 55 | #########.###.###.############# 56 | B J C 57 | U P P 58 | >>> 58 59 | -------------------------------------------------------------------------------- /test-data/2019/20b.txt: -------------------------------------------------------------------------------- 1 | A 2 | A 3 | #######.######### 4 | #######.........# 5 | #######.#######.# 6 | #######.#######.# 7 | #######.#######.# 8 | ##### B ###.# 9 | BC...## C ###.# 10 | ##.## ###.# 11 | ##...DE F ###.# 12 | ##### G ###.# 13 | #########.#####.# 14 | DE..#######...###.# 15 | #.#########.###.# 16 | FG..#########.....# 17 | ###########.##### 18 | Z 19 | Z 20 | >>> 26 21 | Z L X W C 22 | Z P Q B K 23 | ###########.#.#.#.#######.############### 24 | #...#.......#.#.......#.#.......#.#.#...# 25 | ###.#.#.#.#.#.#.#.###.#.#.#######.#.#.### 26 | #.#...#.#.#...#.#.#...#...#...#.#.......# 27 | #.###.#######.###.###.#.###.###.#.####### 28 | #...#.......#.#...#...#.............#...# 29 | #.#########.#######.#.#######.#######.### 30 | #...#.# F R I Z #.#.#.# 31 | #.###.# D E C H #.#.#.# 32 | #.#...# #...#.# 33 | #.###.# #.###.# 34 | #.#....OA WB..#.#..ZH 35 | #.###.# #.#.#.# 36 | CJ......# #.....# 37 | ####### ####### 38 | #.#....CK #......IC 39 | #.###.# #.###.# 40 | #.....# #...#.# 41 | ###.### #.#.#.# 42 | XF....#.# RF..#.#.# 43 | #####.# ####### 44 | #......CJ NM..#...# 45 | ###.#.# #.###.# 46 | RE....#.# #......RF 47 | ###.### X X L #.#.#.# 48 | #.....# F Q P #.#.#.# 49 | ###.###########.###.#######.#########.### 50 | #.....#...#.....#.......#...#.....#.#...# 51 | #####.#.###.#######.#######.###.###.#.#.# 52 | #.......#.......#.#.#.#.#...#...#...#.#.# 53 | #####.###.#####.#.#.#.#.###.###.#.###.### 54 | #.......#.....#.#...#...............#...# 55 | #############.#.#.###.################### 56 | A O F N 57 | A A D M 58 | >>> 396 59 | -------------------------------------------------------------------------------- /test-data/2019/24b.txt: -------------------------------------------------------------------------------- 1 | ....# 2 | #..#. 3 | #.?## 4 | ..#.. 5 | #.... 6 | >>>steps:10:int 7 | >>> 99 8 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | 2 | import AOC 3 | import Control.Monad.Except 4 | import Data.Semigroup 5 | import System.Exit 6 | import Text.Printf 7 | import qualified System.Console.ANSI as ANSI 8 | 9 | main :: IO () 10 | main = do 11 | putStrLn "" 12 | cfg <- configFile defConfPath 13 | out <- runExceptT $ do 14 | runOut <- mainRun cfg $ (defaultMRO TSAll) 15 | { _mroTest = True 16 | } 17 | let Sum totErrors = (foldMap . foldMap) (uncurry numErrors) runOut 18 | when (totErrors > 0) $ throwError [printf "Failed %d test(s)." totErrors] 19 | case out of 20 | Left e -> do 21 | withColor ANSI.Vivid ANSI.Red $ 22 | putStrLn "[ERROR]" 23 | mapM_ putStrLn e 24 | exitFailure 25 | Right () -> pure () 26 | 27 | numErrors 28 | :: Maybe Bool 29 | -> Either [String] String 30 | -> Sum Int 31 | numErrors m e = contM m <> contE e 32 | where 33 | contM Nothing = 0 34 | contM (Just r) 35 | | r = Sum 0 36 | | otherwise = Sum 1 37 | contE (Left es) 38 | | null es = Sum 0 39 | | otherwise = Sum 1 40 | contE (Right _) = Sum 0 41 | --------------------------------------------------------------------------------