├── test-data ├── 17a.txt ├── 06a.txt ├── 06b.txt ├── 14a.txt ├── 14b.txt ├── 05a.txt ├── 02a.txt ├── 02b.txt ├── 05b.txt ├── 13a.txt ├── 13b.txt ├── 03b.txt ├── 03a.txt ├── 01a.txt ├── 18b.txt ├── 20a.txt ├── 08a.txt ├── 08b.txt ├── 11a.txt ├── 11b.txt ├── 01b.txt ├── 19a.txt ├── 19b.txt ├── 20b.txt ├── 04a.txt ├── 09b.txt ├── 10b.txt ├── 09a.txt ├── 07a.txt ├── 07b.txt └── 04b.txt ├── Setup.hs ├── test └── Spec.hs ├── .gitignore ├── src ├── AOC2017 │ ├── Types.hs │ ├── Day04.hs │ ├── Day02.hs │ ├── Day01.hs │ ├── Day17.hs │ ├── Day05.hs │ ├── Util.hs │ ├── Util │ │ ├── Disjoints.hs │ │ ├── Accum.hs │ │ └── Tape.hs │ ├── Day12.hs │ ├── Day13.hs │ ├── Day06.hs │ ├── Day15.hs │ ├── Day11.hs │ ├── Day08.hs │ ├── Day14.hs │ ├── Day10.hs │ ├── Day24.hs │ ├── Day09.hs │ ├── Day16.hs │ ├── Day19.hs │ ├── Day20.hs │ ├── Day03.hs │ ├── Day21.hs │ ├── Day07.hs │ ├── Day22.hs │ ├── Day25.hs │ ├── Day23.hs │ └── Day18.hs └── AOC2017.hs ├── scratch └── 23.txt ├── LICENSE ├── package.yaml ├── stack.yaml ├── app └── Main.hs ├── README.md └── reflections.md /test-data/17a.txt: -------------------------------------------------------------------------------- 1 | 3 2 | >>> 638 3 | -------------------------------------------------------------------------------- /test-data/06a.txt: -------------------------------------------------------------------------------- 1 | 0 2 7 0 2 | >>> 5 3 | -------------------------------------------------------------------------------- /test-data/06b.txt: -------------------------------------------------------------------------------- 1 | 0 2 7 0 2 | >>> 4 3 | -------------------------------------------------------------------------------- /test-data/14a.txt: -------------------------------------------------------------------------------- 1 | flqrgnkx 2 | >>> 8108 3 | -------------------------------------------------------------------------------- /test-data/14b.txt: -------------------------------------------------------------------------------- 1 | flqrgnkx 2 | >>> 1242 3 | -------------------------------------------------------------------------------- /test-data/05a.txt: -------------------------------------------------------------------------------- 1 | 0 2 | 3 3 | 0 4 | 1 5 | -3 6 | >>> 5 7 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /test-data/02a.txt: -------------------------------------------------------------------------------- 1 | 5 1 9 5 2 | 7 5 3 3 | 2 4 6 8 4 | >>> 18 5 | -------------------------------------------------------------------------------- /test-data/02b.txt: -------------------------------------------------------------------------------- 1 | 5 9 2 8 2 | 9 4 7 3 3 | 3 8 6 5 4 | >>> 9 5 | -------------------------------------------------------------------------------- /test-data/05b.txt: -------------------------------------------------------------------------------- 1 | 0 2 | 3 3 | 0 4 | 1 5 | -3 6 | >>> 10 7 | -------------------------------------------------------------------------------- /test-data/13a.txt: -------------------------------------------------------------------------------- 1 | 0: 3 2 | 1: 2 3 | 4: 4 4 | 6: 4 5 | >>> 24 6 | -------------------------------------------------------------------------------- /test-data/13b.txt: -------------------------------------------------------------------------------- 1 | 0: 3 2 | 1: 2 3 | 4: 4 4 | 6: 4 5 | >>> 10 6 | -------------------------------------------------------------------------------- /test-data/03b.txt: -------------------------------------------------------------------------------- 1 | 12 2 | >>> 23 3 | 60 4 | >>> 122 5 | 748 6 | >>> 806 7 | -------------------------------------------------------------------------------- /test/Spec.hs: -------------------------------------------------------------------------------- 1 | main :: IO () 2 | main = putStrLn "Test suite not yet implemented" 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | /.stack-work 3 | /data 4 | /aoc2017-conf.yaml 5 | /aoc2017.cabal 6 | -------------------------------------------------------------------------------- /test-data/03a.txt: -------------------------------------------------------------------------------- 1 | 1 2 | >>> 0 3 | 12 4 | >>> 3 5 | 23 6 | >>> 2 7 | 1024 8 | >>> 31 9 | -------------------------------------------------------------------------------- /test-data/01a.txt: -------------------------------------------------------------------------------- 1 | 1122 2 | >>> 3 3 | 1111 4 | >>> 4 5 | 1234 6 | >>> 0 7 | 91212129 8 | >>> 9 9 | -------------------------------------------------------------------------------- /test-data/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/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/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/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/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/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 | -------------------------------------------------------------------------------- /src/AOC2017/Types.hs: -------------------------------------------------------------------------------- 1 | 2 | module AOC2017.Types ( 3 | Challenge 4 | ) where 5 | 6 | type Challenge = String -> String 7 | 8 | -------------------------------------------------------------------------------- /test-data/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/19a.txt: -------------------------------------------------------------------------------- 1 | | 2 | | +--+ 3 | A | C 4 | F---|----E|--+ 5 | | | | D 6 | +B-+ +--+ 7 | >>> ABCDEF 8 | -------------------------------------------------------------------------------- /test-data/19b.txt: -------------------------------------------------------------------------------- 1 | | 2 | | +--+ 3 | A | C 4 | F---|----E|--+ 5 | | | | D 6 | +B-+ +--+ 7 | >>> 38 8 | -------------------------------------------------------------------------------- /test-data/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/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/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/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/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/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/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/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 | -------------------------------------------------------------------------------- /src/AOC2017/Day04.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day04 (day04a, day04b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.List (sort, nub) 5 | 6 | uniq :: Eq a => [a] -> Bool 7 | uniq xs = length xs == length (nub xs) 8 | 9 | day04a :: Challenge 10 | day04a = show . length . filter (uniq . words) . lines 11 | 12 | day04b :: Challenge 13 | day04b = show . length . filter (uniq . map sort . words) . lines 14 | -------------------------------------------------------------------------------- /src/AOC2017/Day02.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day02 (day02a, day02b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.List (sort, tails) 5 | 6 | parse :: String -> [[Int]] 7 | parse = map (map read . words) . lines 8 | 9 | day02a :: Challenge 10 | day02a = show . sum . map check . parse 11 | where 12 | check xs = maximum xs - minimum xs 13 | 14 | day02b :: Challenge 15 | day02b = show . sum . map check . parse 16 | where 17 | -- a bit of prolog never hurt anyone? 18 | check xs = head $ do 19 | y:ys <- tails (sort xs) 20 | (d, 0) <- (`divMod` y) <$> ys 21 | return d 22 | -------------------------------------------------------------------------------- /src/AOC2017/Day01.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day01 (day01a, day01b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.Char (isDigit, digitToInt) 5 | 6 | conseqs :: [a] -> [(a,a)] 7 | conseqs [] = [] 8 | conseqs (x:xs) = zip (x:xs) (xs ++ [x]) 9 | 10 | bisect :: [a] -> ([a], [a]) 11 | bisect xs = splitAt (length xs `div` 2) xs 12 | 13 | matchings :: Eq a => [(a,a)] -> [a] 14 | matchings = map fst . filter (uncurry (==)) 15 | 16 | parse :: String -> [Int] 17 | parse = map digitToInt . filter isDigit 18 | 19 | day01a :: Challenge 20 | day01a = show . sum . matchings . conseqs . parse 21 | 22 | day01b :: Challenge 23 | day01b = show . (*2) . sum . matchings . uncurry zip . bisect . parse 24 | -------------------------------------------------------------------------------- /src/AOC2017/Day17.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day17 (day17a, day17b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import AOC2017.Util.Tape (Tape(..), moveC) 5 | import Data.List (elemIndices, foldl') 6 | 7 | unshift :: a -> Tape a -> Tape a 8 | unshift y (Tape ls x rs) = Tape (x:ls) y rs 9 | 10 | step :: Int -> Tape a -> a -> Tape a 11 | step n t0 x = unshift x . moveC n $ t0 12 | 13 | day17a :: Challenge 14 | day17a (read->n) = show r 15 | where 16 | Tape _ _ (r:_) = foldl' (step n) (Tape [] 0 []) [1 .. 2017] 17 | 18 | day17b :: Challenge 19 | day17b (read->n) = show . last 20 | . elemIndices @Int 1 21 | $ scanl jump 0 [1 .. 5e7] 22 | where 23 | jump i x = ((i + n) `mod` x) + 1 24 | -------------------------------------------------------------------------------- /src/AOC2017/Day05.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day05 (day05a, day05b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import AOC2017.Util (iterateMaybe) 5 | import AOC2017.Util.Tape (Tape(..), move, unsafeTape) 6 | 7 | -- | Update the focused cell and follow the requested jump, if possible 8 | step 9 | :: (Int -> Int) -- ^ cell update function 10 | -> Tape Int 11 | -> Maybe (Tape Int) 12 | step f (Tape ls x rs) = move x (Tape ls (f x) rs) 13 | 14 | parse :: String -> Tape Int 15 | parse = unsafeTape . map read . lines 16 | 17 | day05a :: Challenge 18 | day05a = show . length . iterateMaybe (step succ ) . parse 19 | 20 | day05b :: Challenge 21 | day05b = show . length . iterateMaybe (step update) . parse 22 | where 23 | update x 24 | | x >= 3 = x - 1 25 | | otherwise = x + 1 26 | 27 | -------------------------------------------------------------------------------- /src/AOC2017/Util.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Util ( 2 | strip 3 | , iterateMaybe 4 | , (!!!) 5 | , dup 6 | , scanlT 7 | , scanrT 8 | ) where 9 | 10 | import Data.List 11 | import qualified Data.Text as T 12 | 13 | -- | Strict (!!) 14 | (!!!) :: [a] -> Int -> a 15 | [] !!! _ = error "Out of range" 16 | (x:_ ) !!! 0 = x 17 | (x:xs) !!! n = x `seq` (xs !!! (n - 1)) 18 | 19 | strip :: String -> String 20 | strip = T.unpack . T.strip . T.pack 21 | 22 | iterateMaybe :: (a -> Maybe a) -> a -> [a] 23 | iterateMaybe f x0 = x0 : unfoldr (fmap dup . f) x0 24 | 25 | dup :: a -> (a, a) 26 | dup x = (x, x) 27 | 28 | scanlT :: Traversable t => (b -> a -> b) -> b -> t a -> t b 29 | scanlT f z = snd . mapAccumL (\x -> dup . f x) z 30 | 31 | scanrT :: Traversable t => (a -> b -> b) -> b -> t a -> t b 32 | scanrT f z = snd . mapAccumR (\x -> dup . flip f x) z 33 | -------------------------------------------------------------------------------- /src/AOC2017/Util/Disjoints.hs: -------------------------------------------------------------------------------- 1 | 2 | module AOC2017.Util.Disjoints ( 3 | Disjoints(..) 4 | , disjoint 5 | ) where 6 | 7 | import Data.List 8 | import qualified Data.IntSet as IS 9 | import qualified Data.Set as S 10 | 11 | -- | Monoid representing a collection of disjoint "connected sets" 12 | newtype Disjoints = D { getD :: S.Set IS.IntSet } 13 | instance Monoid Disjoints where 14 | mempty = D S.empty 15 | -- | mappend is much faster if the smaller set is second 16 | mappend xs ys = foldl' go ys (getD xs) 17 | where 18 | go (D zs) z = D (newGroup `S.insert` disjoints) 19 | where 20 | overlaps = S.filter (not . IS.null . (`IS.intersection` z)) zs 21 | disjoints = zs `S.difference` overlaps 22 | newGroup = IS.unions $ z : S.toList overlaps 23 | 24 | disjoint :: IS.IntSet -> Disjoints 25 | disjoint = D . S.singleton 26 | -------------------------------------------------------------------------------- /src/AOC2017/Day12.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day12 (day12a, day12b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import AOC2017.Util.Disjoints (Disjoints(..), disjoint) 5 | import Data.Char (isDigit) 6 | import Data.List (find) 7 | import Data.Maybe (fromJust) 8 | import qualified Data.IntSet as IS 9 | import qualified Data.Set as S 10 | 11 | parseLine :: String -> IS.IntSet 12 | parseLine (words->n:_:ns) = IS.fromList $ read n 13 | : map (read . filter isDigit) ns 14 | parseLine _ = error "No parse" 15 | 16 | build :: String -> Disjoints 17 | build = foldMap (disjoint . parseLine) . lines 18 | 19 | day12a :: Challenge 20 | day12a = show . IS.size . fromJust . find (0 `IS.member`) 21 | . getD . build 22 | 23 | day12b :: Challenge 24 | day12b = show . S.size 25 | . getD . build 26 | -------------------------------------------------------------------------------- /src/AOC2017/Day13.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day13 (day13a, day13b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.Char (isDigit) 5 | import Data.Foldable (find) 6 | import Data.Maybe (fromJust) 7 | 8 | 9 | caughtAt 10 | :: Int -- delay 11 | -> (Int, Int) -- depth, range 12 | -> Bool 13 | caughtAt delay (d, r) = triangle (r - 1) (d + delay) == 0 14 | where 15 | triangle n x = abs ((x - n) `mod` (n * 2) - n) 16 | 17 | parse :: String -> [(Int, Int)] 18 | parse = map parseLine . lines 19 | where 20 | parseLine (words->x:n:_) = (read (filter isDigit x), read n) 21 | parseLine _ = error "No parse" 22 | 23 | day13a :: Challenge 24 | day13a = show . sum . map (uncurry (*)) 25 | . filter (caughtAt 0) 26 | . parse 27 | 28 | day13b :: Challenge 29 | day13b (parse->xs) = show . fromJust $ find neverCaughtWith [0..] 30 | where 31 | neverCaughtWith delay = all (not . caughtAt delay) xs 32 | -------------------------------------------------------------------------------- /src/AOC2017/Day06.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day06 (day06a, day06b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import qualified Data.Map as M 5 | import qualified Data.Vector as V 6 | 7 | step :: V.Vector Int -> V.Vector Int 8 | step v = V.accum (+) v' [ (i `mod` V.length v, 1) 9 | | i <- [maxIx + 1 .. maxIx + maxBlocks] 10 | ] 11 | where 12 | maxIx = V.maxIndex v 13 | maxBlocks = v V.! maxIx 14 | v' = v V.// [(maxIx, 0)] 15 | 16 | -- | Returns the location of the first loop, and the length of the loop 17 | findLoop :: Ord a => [a] -> (Int, Int) 18 | findLoop = go 0 M.empty 19 | where 20 | go _ _ [] = error "Infinite list expected." 21 | go n m (x:xs) = case M.lookup x m of 22 | Just l -> (n, l) 23 | Nothing -> go (n + 1) (M.insert x 1 m') xs 24 | where 25 | m' = succ <$> m 26 | 27 | day06 :: String -> (Int, Int) 28 | day06 = findLoop . iterate step 29 | . V.fromList . map read . words 30 | 31 | day06a :: Challenge 32 | day06a = show . fst . day06 33 | 34 | day06b :: Challenge 35 | day06b = show . snd . day06 36 | -------------------------------------------------------------------------------- /src/AOC2017/Day15.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day15 (day15a, day15b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.Char (isDigit) 5 | import Data.Function (on) 6 | import Data.Word (Word16) 7 | 8 | generate :: Int -> Int -> Int 9 | generate fac = go 10 | where 11 | go = (`mod` 2147483647) . (* fac) 12 | 13 | facA, facB :: Int 14 | facA = 16807 15 | facB = 48271 16 | 17 | parse :: String -> (Int, Int) 18 | parse inp = (a, b) 19 | where 20 | a:b:_ = read . filter isDigit <$> lines inp 21 | 22 | day15a :: Challenge 23 | day15a (parse->(seedA, seedB)) = 24 | show 25 | . countFirst 4e7 26 | $ zip (iterate (generate facA) seedA) 27 | (iterate (generate facB) seedB) 28 | 29 | day15b :: Challenge 30 | day15b (parse->(seedA, seedB)) = 31 | show 32 | . countFirst 5e6 33 | $ zip (filter (`divBy` 4) . iterate (generate facA) $ seedA) 34 | (filter (`divBy` 8) . iterate (generate facB) $ seedB) 35 | where 36 | x `divBy` b = x `mod` b == 0 37 | 38 | countFirst 39 | :: Int 40 | -> [(Int, Int)] 41 | -> Int 42 | countFirst n = length 43 | . filter (uncurry p) 44 | . take n 45 | where 46 | p = (==) @Word16 `on` fromIntegral 47 | -------------------------------------------------------------------------------- /src/AOC2017/Day11.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day11 (day11a, day11b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.Char (isAlpha) 5 | import Data.List (foldl') 6 | import Data.List.Split (splitOn) 7 | import Data.Maybe (fromJust) 8 | import Math.Geometry.Grid (distance, neighbour) 9 | import Math.Geometry.Grid.Hexagonal2 (UnboundedHexGrid(..)) 10 | import Math.Geometry.Grid.HexagonalInternal2 (HexDirection(..)) 11 | 12 | parse :: String -> [HexDirection] 13 | parse = map (parseDir . filter isAlpha) . splitOn "," 14 | where 15 | parseDir = \case 16 | "nw" -> Northwest 17 | "n" -> North 18 | "ne" -> Northeast 19 | "se" -> Southeast 20 | "s" -> South 21 | "sw" -> Southwest 22 | d -> error $ "Bad direction " ++ d 23 | 24 | step :: (Int, Int) -> HexDirection -> (Int, Int) 25 | step p = fromJust . neighbour UnboundedHexGrid p 26 | 27 | day11a :: Challenge 28 | day11a = show . distance UnboundedHexGrid (0,0) 29 | . foldl' step (0,0) 30 | . parse 31 | 32 | day11b :: Challenge 33 | day11b = show . maximum . map (distance UnboundedHexGrid (0,0)) 34 | . scanl step (0,0) 35 | . parse 36 | -------------------------------------------------------------------------------- /src/AOC2017/Util/Accum.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE FunctionalDependencies #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | 6 | module AOC2017.Util.Accum ( 7 | MonadAccum(..) 8 | , A.AccumT(..) 9 | , A.execAccumT 10 | , A.evalAccumT 11 | , A.Accum 12 | , A.accum 13 | , A.runAccum 14 | , A.execAccum 15 | , A.evalAccum 16 | ) where 17 | 18 | import Control.Monad.Trans.Maybe 19 | import Control.Monad.Trans.State 20 | import Control.Monad.Writer 21 | import qualified Control.Monad.Trans.Accum as A 22 | 23 | instance (Monoid a, Monoid w, MonadWriter w m) => MonadWriter w (A.AccumT a m) where 24 | tell = lift . tell 25 | listen m = A.AccumT $ fmap (\case ~((a,s),w) -> ((a,w),s)) . listen . A.runAccumT m 26 | pass m = A.AccumT $ pass . fmap (\case ~((a,f),s) -> ((a,s),f)) . A.runAccumT m 27 | 28 | class (Monoid w, Monad m) => MonadAccum w m | m -> w where 29 | add :: w -> m () 30 | look :: Monoid w => m w 31 | 32 | instance (Monoid w, Monad m) => MonadAccum w (A.AccumT w m) where 33 | add = A.add 34 | look = A.look 35 | 36 | instance MonadAccum w m => MonadAccum w (MaybeT m) where 37 | add = lift . add 38 | look = lift look 39 | 40 | instance MonadAccum w m => MonadAccum w (StateT s m) where 41 | add = lift . add 42 | look = lift look 43 | 44 | -------------------------------------------------------------------------------- /scratch/23.txt: -------------------------------------------------------------------------------- 1 | set b 99 2 | set c b 3 | jnz a 2 4 | jnz 1 5 5 | mul b 100 6 | sub b -100000 7 | set c b 8 | sub c -17000 # a: 1, b: 109900, c: 126900 9 | set f 1 10 | set d 2 11 | set e 2 12 | set g d 13 | mul g e 14 | sub g b # g = (d * e) - b 15 | jnz g 2 # if d*e == b, then f = 0, else f = 1. so if d*e == b, incr h 16 | set f 0 17 | sub e -1 18 | set g e 19 | sub g b 20 | jnz g -8 21 | sub d -1 22 | set g d 23 | sub g b 24 | jnz g -13 # jump to 11 unless d != b 25 | jnz f 2 # if f == 0, increment h by 1 26 | sub h -1 # increment h by 1, only if f != 0 27 | set g b # if b = c, then terminate 28 | sub g c # if b = c, then terminate 29 | jnz g 2 # if g = 0, then terminate 30 | jnz 1 3 # terminate here 31 | sub b -17 32 | jnz 1 -23 # jump to 9, with b being 17 more every time 33 | 34 | set b 99 35 | set c b 36 | jnz a 2 37 | jnz 1 5 38 | mul b 100 39 | sub b -100000 40 | set c b 41 | sub c -17000 # a: 1, b: 109900, c: 126900 42 | jpm b 2 43 | sub h -1 # increment h by 1, only if f != 0 44 | set g b # if b = c, then terminate 45 | sub g c # if b = c, then terminate 46 | jnz g 2 # if g = 0, then terminate 47 | jnz 1 3 # terminate here 48 | sub b -17 49 | jnz 1 -23 # jump to 9, with b being 17 more every time 50 | -------------------------------------------------------------------------------- /src/AOC2017/Day08.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day08 (day08a, day08b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.Foldable (toList) 5 | import Data.List (foldl', scanl') 6 | import qualified Data.Map as M 7 | 8 | data Instr = Instr { _iRegister :: String 9 | , _iUpdate :: Int 10 | , _iCondReg :: String 11 | , _iPredicate :: Int -> Bool 12 | } 13 | 14 | step :: M.Map String Int -> Instr -> M.Map String Int 15 | step m (Instr r u c p) 16 | | p (M.findWithDefault 0 c m) = M.insertWith (+) r u m 17 | | otherwise = m 18 | 19 | parse :: String -> [Instr] 20 | parse = map parseLine . lines 21 | 22 | day08a :: Challenge 23 | day08a = show . maximum 24 | . foldl' step M.empty 25 | . parse 26 | 27 | day08b :: Challenge 28 | day08b = show . maximum . foldMap toList 29 | . scanl' step M.empty 30 | . parse 31 | 32 | parseLine :: String -> Instr 33 | parseLine (words->r:f:u:_:c:o:x:_) = 34 | Instr { _iRegister = r 35 | , _iUpdate = f' (read u) 36 | , _iCondReg = c 37 | , _iPredicate = (`op` read x) 38 | } 39 | where 40 | f' = case f of 41 | "dec" -> negate 42 | _ -> id 43 | op = case o of 44 | ">" -> (>) 45 | ">=" -> (>=) 46 | "<" -> (<) 47 | "<=" -> (<=) 48 | "==" -> (==) 49 | "!=" -> (/=) 50 | _ -> error "Invalid op" 51 | parseLine _ = error "No parse" 52 | 53 | -------------------------------------------------------------------------------- /src/AOC2017/Day14.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day14 (day14a, day14b) where 2 | 3 | import AOC2017.Day10 (knothash) 4 | import AOC2017.Types (Challenge) 5 | import AOC2017.Util (strip) 6 | import AOC2017.Util.Disjoints (Disjoints(..), disjoint) 7 | import Data.Ix (index, range) 8 | import Text.Printf (printf) 9 | import qualified Data.IntSet as IS 10 | import qualified Data.Set as S 11 | 12 | mkGrid :: String -> [[Bool]] 13 | mkGrid (strip->k) = map mkRow [0..127] 14 | where 15 | mkRow :: Int -> [Bool] 16 | mkRow n = map (== '1') . concatMap (printf "%08b") . knothash 17 | $ k ++ "-" ++ show n 18 | 19 | day14a :: Challenge 20 | day14a = show . length . filter id . concat . mkGrid 21 | 22 | day14b :: Challenge 23 | day14b = show . S.size . getD . litGroups . mkGrid 24 | 25 | litGroups :: [[Bool]] -> Disjoints 26 | litGroups grid = foldMap go (range r) 27 | where 28 | r = ((0,0),(127,127)) 29 | isLit (x,y) = grid !! y !! x 30 | go p | isLit p = disjoint . IS.fromList 31 | . map (index r) . (p:) . filter isLit 32 | $ neighbors p 33 | | otherwise = mempty 34 | 35 | neighbors :: (Int, Int) -> [(Int, Int)] 36 | neighbors (x,y) = [ (x+dx, y+dy) | (dx, dy) <- [(0,1),(0,-1),(1,0),(-1,0)] 37 | , inBounds (x + dx) && inBounds (y + dy) 38 | ] 39 | where 40 | inBounds z = z >= 0 && z < 128 41 | -------------------------------------------------------------------------------- /src/AOC2017/Day10.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day10 (day10a, day10b, knothash) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import AOC2017.Util (strip) 5 | import Data.Bits (xor) 6 | import Data.Char (ord) 7 | import Data.List (foldl') 8 | import Data.List.Split (chunksOf, splitOn) 9 | import Data.Word (Word8) 10 | import Text.Printf (printf) 11 | import qualified Data.Vector.Storable as V 12 | 13 | data HashState = HS { _hsVec :: V.Vector Word8 14 | , _hsPos :: Word8 15 | , _hsSkip :: Word8 16 | } 17 | 18 | step :: HashState -> Word8 -> HashState 19 | step (HS v0 p0 s0) n = HS v1 p1 s1 20 | where 21 | ixes = fromIntegral . (+ p0) <$> init [0 .. n] 22 | vals = (v0 V.!) <$> ixes 23 | v1 = v0 V.// zip ixes (reverse vals) 24 | p1 = p0 + n + s0 25 | s1 = s0 + 1 26 | 27 | process :: [Word8] -> V.Vector Word8 28 | process = _hsVec . foldl' step hs0 29 | where 30 | hs0 = HS (V.generate 256 fromIntegral) 0 0 31 | 32 | day10a :: Challenge 33 | day10a = show . V.product . V.take 2 34 | . process 35 | . map read . splitOn "," 36 | 37 | day10b :: Challenge 38 | day10b = concatMap (printf "%02x") . knothash . strip 39 | 40 | knothash :: String -> [Word8] 41 | knothash = map (foldr xor 0) . chunksOf 16 . V.toList . process 42 | . concat . replicate 64 . (++ salt) 43 | . map (fromIntegral . ord) 44 | where 45 | salt = [17, 31, 73, 47, 23] 46 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright Justin Le (c) 2017 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. -------------------------------------------------------------------------------- /src/AOC2017/Day24.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day24 (day24a, day24b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Control.Applicative (Alternative(..)) 5 | import Control.Monad.Trans.State (StateT(..), evalStateT) 6 | import Data.Bifunctor (first) 7 | import Data.List.Split (splitOn) 8 | import Data.Ord (Down(..)) 9 | import Data.Tuple (swap) 10 | 11 | type Comp = (Int, Int) 12 | 13 | -- | All possible ways of selecting a single item from a list 14 | select :: [a] -> [(a,[a])] 15 | select = go [] 16 | where 17 | go _ [] = [] 18 | go xs (y:ys) = (y,xs++ys) : go (y:xs) ys 19 | 20 | bridge :: Int -> StateT [Comp] [] Int 21 | bridge frm = do 22 | (x,y) <- StateT select 23 | next <- if | x == frm -> return y 24 | | y == frm -> return x 25 | | otherwise -> empty 26 | rest <- return 0 -- account for a bridge that ends here 27 | <|> bridge next -- account for a continued bridge 28 | return $ x + y + rest 29 | 30 | day24a :: Challenge 31 | day24a = show . maximum 32 | . evalStateT (bridge 0) . parse 33 | 34 | day24b :: Challenge 35 | day24b = show . snd . maximum 36 | . map (first (Down . length) . swap) -- sort by lowest leftovers 37 | . runStateT (bridge 0) . parse -- runState gives leftover components 38 | 39 | parse :: String -> [Comp] 40 | parse = map parseLine . lines 41 | where 42 | parseLine (splitOn "/"->(x:y:_)) = (read x, read y) 43 | parseLine _ = error "No parse" 44 | -------------------------------------------------------------------------------- /src/AOC2017/Day09.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day09 (day09a, day09b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Control.Applicative (many) 5 | import Data.Maybe (catMaybes) 6 | import Data.Void (Void) 7 | import qualified Text.Megaparsec as P 8 | import qualified Text.Megaparsec.Char as P 9 | 10 | data Tree = Garbage String 11 | | Group [Tree] 12 | 13 | type Parser = P.Parsec Void String 14 | 15 | parseTree :: Parser Tree 16 | parseTree = P.choice [ Group <$> parseGroup 17 | , Garbage <$> parseGarbage 18 | ] 19 | where 20 | parseGroup :: Parser [Tree] 21 | parseGroup = P.between (P.char '{') (P.char '}') $ 22 | parseTree `P.sepBy` P.char ',' 23 | parseGarbage :: Parser String 24 | parseGarbage = P.between (P.char '<') (P.char '>') $ 25 | catMaybes <$> many garbageTok 26 | where 27 | garbageTok :: Parser (Maybe Char) 28 | garbageTok = P.choice 29 | [ Nothing <$ (P.char '!' *> P.anyChar) 30 | , Just <$> P.noneOf ">" 31 | ] 32 | 33 | treeScore :: Tree -> Int 34 | treeScore = go 1 35 | where 36 | go _ (Garbage _ ) = 0 37 | go n (Group ts) = n + sum (go (n + 1) <$> ts) 38 | 39 | treeGarbage :: Tree -> Int 40 | treeGarbage (Garbage n ) = length n 41 | treeGarbage (Group ts) = sum (treeGarbage <$> ts) 42 | 43 | parse :: String -> Tree 44 | parse = either (error . show) id . P.runParser parseTree "" 45 | 46 | day09a :: Challenge 47 | day09a = show . treeScore . parse 48 | 49 | day09b :: Challenge 50 | day09b = show . treeGarbage . parse 51 | -------------------------------------------------------------------------------- /src/AOC2017/Day16.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day16 (day16a, day16b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Data.Char (chr, ord) 5 | import Data.List.Split (splitOn) 6 | import Data.Semigroup (Semigroup(..), stimes, Dual(..)) 7 | import qualified Data.Map as M 8 | 9 | newtype Perm a = P { permMap :: M.Map a a } 10 | deriving Show 11 | 12 | lookupPerm :: Ord a => Perm a -> a -> a 13 | lookupPerm p k = M.findWithDefault k k (permMap p) 14 | 15 | instance Ord a => Semigroup (Perm a) where 16 | x <> y = P $ (lookupPerm x <$> permMap y) `M.union` permMap x 17 | instance Ord a => Monoid (Perm a) where 18 | mappend = (<>) 19 | mempty = P M.empty 20 | 21 | type Dance = (Perm Int, Dual (Perm Char)) 22 | 23 | runDance :: Dance -> String 24 | runDance (pI, pN) = lookupPerm (getDual pN) 25 | . toName 26 | . lookupPerm pI 27 | <$> [0..15] 28 | where 29 | toName c = chr (c + ord 'a') 30 | 31 | parseMove :: String -> Dance 32 | parseMove = \case 33 | 's':(read->n) -> (rotator n , mempty ) 34 | 'x':(map read.splitOn "/"->n:m:_) -> (swapper n m, mempty ) 35 | 'p':n:_:m:_ -> (mempty , Dual (swapper n m)) 36 | _ -> error "No parse" 37 | where 38 | rotator :: Int -> Perm Int 39 | rotator n = P $ M.fromList [ (i, (i - n) `mod` 16) | i <- [0..15] ] 40 | swapper :: Ord a => a -> a -> Perm a 41 | swapper x y = P $ M.fromList [ (x, y), (y, x) ] 42 | 43 | parse :: String -> Dance 44 | parse = foldMap parseMove . splitOn "," 45 | 46 | day16a :: Challenge 47 | day16a = runDance . parse 48 | 49 | day16b :: Challenge 50 | day16b = runDance . stimes (1e9 :: Int) . parse 51 | -------------------------------------------------------------------------------- /src/AOC2017/Day19.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day19 (day19a, day19b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Control.Applicative (many) 5 | import Control.Lens (ix, (^?)) 6 | import Control.Monad (guard) 7 | import Control.Monad.Trans.Class (lift) 8 | import Control.Monad.Trans.State (StateT, evalStateT, get, put) 9 | import Data.Char (isAlpha) 10 | import qualified Data.Vector as V 11 | import qualified Linear as L 12 | 13 | type Grid = V.Vector (V.Vector Char) 14 | type Point = L.V2 Int 15 | 16 | neighborsOf :: Point -> [Point] 17 | neighborsOf p0 = (+ p0) <$> [ L.V2 0 1, L.V2 0 (-1), L.V2 1 0, L.V2 (-1) 0 ] 18 | 19 | -- | Expand search by one step 20 | follow :: Grid -> StateT (Point, Point) [] Char 21 | follow g = get >>= \(p0, p1) -> do -- last position, current position 22 | Just currChar <- return $ gridAt p1 23 | p2 <- case currChar of 24 | '+' -> lift $ neighborsOf p1 25 | _ -> return $ p1 + (p1 - p0) 26 | Just nextChar <- return $ gridAt p2 27 | guard $ p2 /= p0 28 | guard $ nextChar /= ' ' 29 | put (p1, p2) 30 | return nextChar 31 | where 32 | gridAt (L.V2 x y) = g ^? ix y . ix x 33 | 34 | -- | Repeat search many times until a dead end is found, using 'many' 35 | followToTheEnd :: Grid -> StateT (Point, Point) [] String 36 | followToTheEnd g = ('|':) <$> many (follow g) 37 | 38 | -- head is safe because 'many' always succeeds 39 | day19 :: Grid -> String 40 | day19 g = head . flip evalStateT p0 $ followToTheEnd g 41 | where 42 | p0 = (L.V2 x0 (-1), L.V2 x0 0) 43 | Just x0 = V.elemIndex '|' (g V.! 0) 44 | 45 | day19a :: Challenge 46 | day19a = filter isAlpha . day19 . parse 47 | 48 | day19b :: Challenge 49 | day19b = show . length . day19 . parse 50 | 51 | parse :: String -> V.Vector (V.Vector Char) 52 | parse = V.fromList . map V.fromList . lines 53 | 54 | -------------------------------------------------------------------------------- /package.yaml: -------------------------------------------------------------------------------- 1 | name: aoc2017 2 | version: 0.1.0.0 3 | github: mstksg/advent-of-code-2017 4 | license: BSD3 5 | author: Justin Le 6 | maintainer: justin@jle.im 7 | copyright: (c) Justin Le 2018 8 | 9 | extra-source-files: 10 | - README.md 11 | - reflections.md 12 | 13 | synopsis: Advent of Code 2017 14 | category: Puzzle 15 | 16 | description: | 17 | Advent of Code 2017! 18 | 19 | ghc-options: 20 | - -Wall 21 | 22 | dependencies: 23 | - base >= 4.7 && < 5 24 | - containers >=0.5.10.2 25 | - finite-typelits 26 | - text 27 | - deepseq 28 | 29 | default-extensions: 30 | - BangPatterns 31 | - DeriveFoldable 32 | - DeriveFunctor 33 | - DeriveTraversable 34 | - LambdaCase 35 | - MonadComprehensions 36 | - MultiWayIf 37 | - NumDecimals 38 | - RankNTypes 39 | - RecordWildCards 40 | - ScopedTypeVariables 41 | - TemplateHaskell 42 | - TupleSections 43 | - TypeApplications 44 | - ViewPatterns 45 | 46 | library: 47 | source-dirs: src 48 | dependencies: 49 | - aeson 50 | - arithmoi 51 | - bytestring 52 | - comonad 53 | - curl 54 | - filepath 55 | - grid 56 | - lens 57 | - linear 58 | - megaparsec 59 | - mmorph 60 | - monad-control 61 | - monad-loops 62 | - mtl 63 | - operational 64 | - pointedlist 65 | - reflection 66 | - split 67 | - transformers >=0.5.5.0 68 | - type-combinators 69 | - vector 70 | - vector-sized 71 | - yaml 72 | 73 | executables: 74 | aoc2017: 75 | main: Main.hs 76 | source-dirs: app 77 | ghc-options: 78 | - -threaded 79 | - -rtsopts 80 | - -with-rtsopts=-N 81 | dependencies: 82 | - ansi-terminal 83 | - aoc2017 84 | - criterion 85 | - optparse-applicative 86 | - time 87 | 88 | # tests: 89 | # aoc2017-test: 90 | # main: Spec.hs 91 | # source-dirs: test 92 | # ghc-options: 93 | # - -threaded 94 | # - -rtsopts 95 | # - -with-rtsopts=-N 96 | # dependencies: 97 | # - base 98 | # - aoc2017 99 | -------------------------------------------------------------------------------- /src/AOC2017/Day20.hs: -------------------------------------------------------------------------------- 1 | -- module AOC2017.Day20 (day20a, day20b) where 2 | module AOC2017.Day20 where 3 | 4 | import AOC2017.Types (Challenge) 5 | import AOC2017.Util (scanlT) 6 | import Data.Char (isDigit) 7 | import Data.Foldable (toList) 8 | import Data.List (find) 9 | import Data.List.Split (splitOn) 10 | import Data.Maybe (fromJust) 11 | import qualified Data.Map as M 12 | import qualified Data.Set as S 13 | import qualified Data.Vector as V 14 | import qualified Linear as L 15 | 16 | type Point = L.V3 Int 17 | 18 | data Particle a = P { _pAcc :: !a 19 | , _pVel :: !a 20 | , _pPos :: !a 21 | } 22 | deriving (Functor, Foldable, Traversable, Show, Eq, Ord) 23 | 24 | type System = [Particle Point] 25 | 26 | step :: Num a => Particle a -> Particle a 27 | step = scanlT (+) 0 28 | 29 | collide :: System -> System 30 | collide s0 = filter ((`S.notMember` collisions) . _pPos) s0 31 | where 32 | collisions :: S.Set Point 33 | collisions = M.keysSet . M.filter @Int (> 1) 34 | . M.fromListWith (+) 35 | . map ((,1) . _pPos) 36 | $ toList s0 37 | 38 | norm :: Point -> Int 39 | norm = sum . fmap abs 40 | 41 | day20a :: Challenge 42 | day20a = show . V.minIndex . V.fromList 43 | . (map . fmap) norm 44 | . parse 45 | 46 | day20b :: Challenge 47 | day20b = show . length . fromJust . find stop 48 | . iterate (collide . map step) 49 | . parse 50 | where 51 | stop = (> 1000) . minimum . map (norm . _pPos) 52 | 53 | parse :: String -> System 54 | parse = map parseLine . lines 55 | where 56 | parseLine :: String -> Particle Point 57 | parseLine (map(read.filter num).splitOn","->[pX,pY,pZ,vX,vY,vZ,aX,aY,aZ]) 58 | = P { _pAcc = L.V3 aX aY aZ 59 | , _pVel = L.V3 vX vY vZ 60 | , _pPos = L.V3 pX pY pZ 61 | } 62 | parseLine _ = error "No parse" 63 | num :: Char -> Bool 64 | num c = isDigit c || c == '-' 65 | -------------------------------------------------------------------------------- /src/AOC2017/Day03.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day03 (day03a, day03b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Control.Monad.Trans.State (State, state, evalState) 5 | import Data.List (find) 6 | import Data.Maybe (mapMaybe, fromJust) 7 | import Data.Semigroup (Semigroup(..), Sum(..)) 8 | import qualified Data.Map as M 9 | 10 | -- | Monoid that composes functions, and aggregates logs that the functions 11 | -- emit 12 | newtype Trail a = Trail { runTrail :: a -> ([a], a) } 13 | instance Semigroup (Trail a) where 14 | f <> g = Trail $ \x -> let (xs, y) = runTrail f x 15 | (ys, z) = runTrail g y 16 | in (xs ++ ys, z) 17 | instance Monoid (Trail a) where 18 | mempty = Trail ([],) 19 | mappend = (<>) 20 | 21 | -- | 'Sum' just so I can add two points together with '(<>)' 22 | type Pos = (Sum Int, Sum Int) 23 | 24 | move :: Pos -> Trail Pos 25 | move p = Trail $ \p0 -> ([p0 <> p], p0 <> p) 26 | 27 | spiral :: Trail Pos 28 | spiral = move (0,0) 29 | <> foldMap loop [1..] 30 | where 31 | loop :: Int -> Trail Pos 32 | loop n = stimes (2*n-1) (move ( 1, 0)) 33 | <> stimes (2*n-1) (move ( 0, 1)) 34 | <> stimes (2*n ) (move (-1, 0)) 35 | <> stimes (2*n ) (move ( 0,-1)) 36 | 37 | ulam :: [Pos] 38 | ulam = fst $ runTrail spiral (0,0) 39 | 40 | day03a :: Challenge 41 | day03a (read->i) = show . norm $ ulam !! (i - 1) 42 | where 43 | norm (Sum x, Sum y) = abs x + abs y 44 | 45 | updateMap :: Pos -> State (M.Map Pos Int) Int 46 | updateMap p = state $ \m0 -> 47 | let newPos = sum . mapMaybe (`M.lookup` m0) $ 48 | [ p <> (Sum x, Sum y) | x <- [-1 .. 1] 49 | , y <- [-1 .. 1] 50 | , x /= 0 || y /= 0 51 | ] 52 | in (newPos, M.insertWith (const id) p newPos m0) 53 | 54 | cellNums :: [Int] 55 | cellNums = flip evalState (M.singleton (0, 0) 1) $ 56 | traverse updateMap ulam 57 | 58 | day03b :: Challenge 59 | day03b (read->i) = show . fromJust $ find (> i) cellNums 60 | -------------------------------------------------------------------------------- /src/AOC2017/Day21.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | 3 | module AOC2017.Day21 (day21a, day21b) where 4 | 5 | import AOC2017.Types (Challenge) 6 | import AOC2017.Util ((!!!), strip) 7 | import Data.List (transpose) 8 | import Data.List.Split (chunksOf, splitOn) 9 | import qualified Data.Map as M 10 | 11 | type Grid = [[Bool]] 12 | 13 | type Rules = M.Map Grid Grid 14 | 15 | -- | Split a grid into a grid of subgrids 16 | splitGrid :: Int -> Grid -> [[Grid]] 17 | splitGrid n = transpose 18 | . map (map transpose . chunksOf n . transpose) 19 | . chunksOf n 20 | 21 | -- | Join a grid of subgrids into a grid 22 | joinGrid :: [[Grid]] -> Grid 23 | joinGrid = transpose . concatMap (transpose . concat) 24 | 25 | step :: Rules -> Grid -> Grid 26 | step r g = joinGrid . (map . map) (r M.!) . splitGrid n $ g 27 | where 28 | n | length g `mod` 2 == 0 = 2 29 | | length g `mod` 3 == 0 = 3 30 | | otherwise = error "hello there" 31 | 32 | day21 :: Int -> Rules -> Int 33 | day21 n r = length . filter id . concat 34 | $ iterate (step r) grid0 !!! n 35 | where 36 | grid0 = map (== '#') <$> [".#.","..#","###"] 37 | 38 | day21a :: Challenge 39 | day21a = show . day21 5 . parse 40 | 41 | day21b :: Challenge 42 | day21b = show . day21 18 . parse 43 | 44 | -- | All 8 symmetries (elements of D8) 45 | -- 46 | -- Generated by r, r^2, r^3, r^4, and flip times all of those 47 | -- 48 | -- Thanks to https://en.wikipedia.org/wiki/Dihedral_group_of_order_8 49 | symmetries :: Grid -> [Grid] 50 | symmetries g = do 51 | r <- take 4 (iterate rot90 g) -- from the four rotations 52 | [r, mirror r] -- ... include the rotation plus its flip 53 | where 54 | -- rotate 90 degrees 55 | rot90 = map reverse . transpose 56 | -- flip 57 | mirror = reverse 58 | 59 | parse :: String -> Rules 60 | parse = M.unions . map (M.fromList . parseLine) . lines 61 | where 62 | parseLine :: String -> [(Grid, Grid)] 63 | parseLine (map(splitOn "/".strip).splitOn"=>"->[xs,ys]) = 64 | [ (g, gridOut) | g <- symmetries gridIn ] 65 | where 66 | gridIn = fmap (== '#') <$> xs 67 | gridOut = fmap (== '#') <$> ys 68 | parseLine _ = error "No parse" 69 | 70 | -------------------------------------------------------------------------------- /src/AOC2017/Day07.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day07 (day07a, day07b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Control.Applicative ((<|>)) 5 | import Data.Char (isAlpha) 6 | import Data.Foldable (toList) 7 | import Data.List (sortOn) 8 | import Data.Maybe (mapMaybe, listToMaybe, fromJust) 9 | import Data.Tree 10 | import qualified Data.Map as M 11 | import qualified Data.Set as S 12 | 13 | parseLine :: String -> (String, (Int, S.Set String)) 14 | parseLine (words->p:w:ws) = 15 | (p, (read w, S.fromList (filter isAlpha <$> drop 1 ws))) 16 | parseLine _ = error "No parse" 17 | 18 | -- | Returns the root label and the tree 19 | buildTree 20 | :: M.Map String (Int, S.Set String) 21 | -> (String, Tree Int) 22 | buildTree m = (root, result) 23 | where 24 | allChildren :: S.Set String 25 | allChildren = S.unions (snd <$> toList m) 26 | root :: String 27 | root = S.findMax $ M.keysSet m `S.difference` allChildren 28 | 29 | result :: Tree Int 30 | result = flip unfoldTree root $ \p -> 31 | let (w, cs) = m M.! p 32 | in (w, toList cs) 33 | 34 | -- | Check if any children are bad; otherwise, check yourself 35 | findBad :: Tree Int -> Maybe Int 36 | findBad t0 = listToMaybe badChildren <|> anomaly 37 | where 38 | badChildren :: [Int] 39 | badChildren = mapMaybe findBad $ subForest t0 40 | weightMap :: M.Map Int [Int] 41 | weightMap = M.fromListWith (++) 42 | . map (\t -> (sum t, [rootLabel t])) 43 | $ subForest t0 44 | anomaly :: Maybe Int 45 | anomaly = case sortOn (length . snd) (M.toList weightMap) of 46 | -- end of the line 47 | [] -> Nothing 48 | -- all weights match 49 | [_] -> Nothing 50 | -- exactly one anomaly 51 | [(wTot1, [w]),(wTot2,_)] -> Just (w + (wTot2 - wTot1)) 52 | -- should not happen 53 | _ -> error "More than one anomaly for node" 54 | 55 | parse :: String -> (String, Tree Int) 56 | parse = buildTree . M.fromList . map parseLine . lines 57 | 58 | day07a :: Challenge 59 | day07a = fst . parse 60 | 61 | day07b :: Challenge 62 | day07b = show . fromJust . findBad . snd . parse 63 | -------------------------------------------------------------------------------- /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 | # resolver: ghcjs-0.1.0_ghc-7.10.2 15 | # resolver: 16 | # name: custom-snapshot 17 | # location: "./custom-snapshot.yaml" 18 | resolver: lts-10.3 19 | 20 | # User packages to be built. 21 | # Various formats can be used as shown in the example below. 22 | # 23 | # packages: 24 | # - some-directory 25 | # - https://example.com/foo/bar/baz-0.0.2.tar.gz 26 | # - location: 27 | # git: https://github.com/commercialhaskell/stack.git 28 | # commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a 29 | # - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a 30 | # extra-dep: true 31 | # subdirs: 32 | # - auto-update 33 | # - wai 34 | # 35 | # A package marked 'extra-dep: true' will only be built if demanded by a 36 | # non-dependency (i.e. a user package), and its test suites and benchmarks 37 | # will not be run. This is useful for tweaking upstream packages. 38 | packages: 39 | - . 40 | # - location: 41 | # git: https://github.com/ekmett/transformers-compat.git 42 | # commit: c83a8bc7c8d2f4576001d24778d4356725c96c6b 43 | # extra-dep: true 44 | 45 | # Dependency packages to be pulled from upstream that are not in the resolver 46 | # (e.g., acme-missiles-0.3) 47 | extra-deps: 48 | - grid-7.8.9 49 | - transformers-0.5.5.0 50 | 51 | # Override default flag values for local packages and extra-deps 52 | flags: {} 53 | 54 | # Extra package databases containing global packages 55 | extra-package-dbs: [] 56 | 57 | allow-newer: true 58 | 59 | # Control whether we use the GHC we find on the path 60 | # system-ghc: true 61 | # 62 | # Require a specific version of stack, using version ranges 63 | # require-stack-version: -any # Default 64 | # require-stack-version: ">=1.5" 65 | # 66 | # Override the architecture used by stack, especially useful on Windows 67 | # arch: i386 68 | # arch: x86_64 69 | # 70 | # Extra directories used by stack for building 71 | # extra-include-dirs: [/path/to/dir] 72 | # extra-lib-dirs: [/path/to/dir] 73 | # 74 | # Allow a newer minor version of GHC than the snapshot specifies 75 | # compiler-check: newer-minor 76 | -------------------------------------------------------------------------------- /src/AOC2017/Day22.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day22 (day22a, day22b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import Control.Lens (makeClassy, use, at, non, zoom, (+=), (<<>=)) 5 | import Control.Monad (replicateM) 6 | import Control.Monad.Trans.State (State, state, evalState) 7 | import qualified Data.Map as M 8 | import qualified Linear as L 9 | 10 | data Flag = FC | FW | FI | FF 11 | deriving Eq 12 | data Dir = N | E | S | W 13 | deriving Enum 14 | instance Monoid Dir where 15 | mempty = N 16 | mappend h t = toEnum $ (fromEnum h + fromEnum t) `mod` 4 17 | 18 | data St = MkSt { _sWorld :: !(M.Map (L.V2 Int) Flag) 19 | , _sPos :: !(L.V2 Int) 20 | , _sDir :: !Dir 21 | } 22 | makeClassy ''St 23 | 24 | delta :: Dir -> L.V2 Int 25 | delta = \case 26 | N -> L.V2 0 1 27 | E -> L.V2 1 0 28 | S -> L.V2 0 (-1) 29 | W -> L.V2 (-1) 0 30 | 31 | -- | Lift a 'State Flag Dir' (modify a Flag and produce a direction change) 32 | -- to a 'State St Flag' (modify the simulation state and produce the 33 | -- updated Flag) 34 | step 35 | :: State Flag Dir -- ^ Modify a Flag and produce a direction change 36 | -> State St Flag -- ^ Modify the state and produce the updated Flag 37 | step stF = do 38 | p <- use sPos 39 | turn <- zoom (sWorld . at p . non FC) stF 40 | newDir <- sDir <<>= turn 41 | sPos += delta newDir 42 | use (sWorld . at p . non FC) 43 | 44 | day22 :: State Flag Dir -> Int -> M.Map (L.V2 Int) Flag -> Int 45 | day22 stF n w0 = length . filter (== FI) 46 | $ evalState (replicateM n (step stF)) st0 47 | where 48 | st0 = MkSt w0 p0 N 49 | p0 = (`div` 2) <$> fst (M.findMax w0) 50 | 51 | day22a :: Challenge 52 | day22a = show . day22 partA 1e4 . parse 53 | where 54 | partA :: State Flag Dir 55 | partA = state $ \case 56 | FC -> (W, FI) -- turn left, become Infected 57 | FI -> (E, FC) -- turn right, become Clean 58 | _ -> error "Shouldn't happen" 59 | 60 | day22b :: Challenge 61 | day22b = show . day22 partB 1e7 . parse 62 | where 63 | partB :: State Flag Dir 64 | partB = state $ \case 65 | FC -> (W, FW) -- turn left, become Weakened 66 | FW -> (N, FI) -- no turn, become Infected 67 | FI -> (E, FF) -- turn right, become Flagged 68 | FF -> (S, FC) -- turn around, become Clean 69 | 70 | parse :: String -> M.Map (L.V2 Int) Flag 71 | parse = M.unions . zipWith mkRow [0..] . reverse . lines 72 | where 73 | fl = \case '#' -> FI 74 | _ -> FC 75 | mkRow y = M.fromList . zip ixes . map fl 76 | where 77 | ixes = [ L.V2 x y | x <- [0..] ] 78 | -------------------------------------------------------------------------------- /src/AOC2017/Day25.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day25 (day25a) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import AOC2017.Util ((!!!)) 5 | import Control.Applicative (Applicative(..), Alternative(..)) 6 | import Control.Lens.At (Contains(..)) 7 | import Control.Monad (replicateM) 8 | import Data.Bifunctor (first) 9 | import Data.Semigroup (Semigroup(..), Last(..), Sum(..)) 10 | import Data.Void (Void) 11 | import qualified Data.IntSet as IS 12 | import qualified Data.Map as M 13 | import qualified Text.Megaparsec as P 14 | import qualified Text.Megaparsec.Char as P 15 | import qualified Text.Megaparsec.Char.Lexer as PL 16 | 17 | type St = Last Char 18 | type Step = (Sum Int, St) 19 | type RuleMap = M.Map St ((Step, Bool), (Step, Bool)) 20 | 21 | runRule :: RuleMap -> St -> Bool -> (Step, Bool) 22 | runRule rm st = \case 23 | False -> fst $ rm M.! st 24 | True -> snd $ rm M.! st 25 | 26 | step :: RuleMap -> Step -> IS.IntSet -> (Step, IS.IntSet) 27 | step rm s0@(Sum i,st) = first (s0 <>) . contains i (runRule rm st) 28 | 29 | day25a :: Challenge 30 | day25a (parse->RS{..}) = show . IS.size . snd . (!!! rsSteps) 31 | . iterate (uncurry (step rsRuleMap)) 32 | $ ((0, rsStart), IS.empty) 33 | 34 | 35 | 36 | -- Ugly parser stuff below 37 | 38 | data RuleSet = RS { rsStart :: St 39 | , rsSteps :: Int 40 | , rsRuleMap :: RuleMap 41 | } 42 | deriving Show 43 | 44 | type Parser = P.Parsec Void String 45 | 46 | parse :: String -> RuleSet 47 | parse = either (error . P.parseErrorPretty) id . P.runParser ruleSet "" 48 | 49 | ruleSet :: Parser RuleSet 50 | ruleSet = do 51 | st0 <- parseLine "Begin in state" P.anyChar 52 | stp <- parseLine "Perform a diagnostic checksum after" PL.decimal 53 | rules <- many rule 54 | return RS { rsStart = Last st0 55 | , rsSteps = stp 56 | , rsRuleMap = M.fromList rules 57 | } 58 | where 59 | rule :: Parser (Last Char, ((Step, Bool), (Step, Bool))) 60 | rule = do 61 | st <- parseLine "In state" P.anyChar 62 | [r0,r1] <- replicateM 2 $ do 63 | _ <- parseLine "If the current value is" P.anyChar 64 | b <- (== '1') 65 | <$> parseLine "- Write the value" P.anyChar 66 | d <- (\case "left" -> -1; _ -> 1) 67 | <$> parseLine "- Move one slot to the" (P.many P.letterChar) 68 | c <- parseLine "- Continue with state" P.anyChar 69 | return ((Sum d, Last c), b) 70 | return (Last st, (r0, r1)) 71 | parseLine :: String -> Parser a -> Parser a 72 | parseLine str = P.between (P.space *> P.string str *> P.space) 73 | (P.skipManyTill P.anyChar P.newline) 74 | -------------------------------------------------------------------------------- /src/AOC2017/Util/Tape.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveFunctor #-} 2 | {-# LANGUAGE FlexibleInstances #-} 3 | {-# LANGUAGE FunctionalDependencies #-} 4 | {-# LANGUAGE MultiParamTypeClasses #-} 5 | {-# LANGUAGE TemplateHaskell #-} 6 | 7 | module AOC2017.Util.Tape ( 8 | Tape(..) 9 | , HasTape(..) 10 | , toTape, listToTape, unsafeTape 11 | , moveLeft, moveRight 12 | , move 13 | , moveLeftC, moveRightC 14 | , moveC 15 | , moveRightD, moveLeftD 16 | ) where 17 | 18 | import AOC2017.Util 19 | import Control.Comonad 20 | import Control.Lens 21 | import Data.List.NonEmpty (NonEmpty(..)) 22 | import Data.Maybe 23 | import Data.Monoid 24 | import qualified Data.List.NonEmpty as NE 25 | 26 | data Tape a = Tape { _tLefts :: ![a] 27 | , _tFocus :: !a 28 | , _tRights :: ![a] 29 | } 30 | deriving (Show, Functor) 31 | makeClassy ''Tape 32 | 33 | instance Foldable Tape where 34 | foldMap f (Tape ls x rs) = foldMap f (reverse ls) <> f x <> foldMap f rs 35 | instance Traversable Tape where 36 | traverse f (Tape ls x rs) = Tape <$> (reverse <$> traverse f (reverse ls)) 37 | <*> f x 38 | <*> traverse f rs 39 | 40 | instance Comonad Tape where 41 | extract = _tFocus 42 | duplicate t = Tape ls t rs 43 | where 44 | _:ls = iterateMaybe moveLeft t 45 | _:rs = iterateMaybe moveRight t 46 | 47 | toTape :: NonEmpty a -> Tape a 48 | toTape (x :| xs) = Tape [] x xs 49 | 50 | listToTape :: [a] -> Maybe (Tape a) 51 | listToTape [] = Nothing 52 | listToTape (x:xs) = Just (Tape [] x xs) 53 | 54 | unsafeTape :: [a] -> Tape a 55 | unsafeTape = fromMaybe (error "unsafeTape: Empty list") . listToTape 56 | 57 | moveLeft :: Tape a -> Maybe (Tape a) 58 | moveLeft (Tape ls x rs) = case ls of 59 | [] -> Nothing 60 | l:ls' -> Just (Tape ls' l (x:rs)) 61 | 62 | moveRight :: Tape a -> Maybe (Tape a) 63 | moveRight (Tape ls x rs) = case rs of 64 | [] -> Nothing 65 | r:rs' -> Just (Tape (x:ls) r rs') 66 | 67 | -- | Shifts the Tape to the left or right by a given amount 68 | move :: Int -> Tape a -> Maybe (Tape a) 69 | move n = case compare n 0 of 70 | LT -> (!!! abs n) . iterate (moveLeft =<<) . Just 71 | EQ -> Just 72 | GT -> (!!! n ) . iterate (moveRight =<<) . Just 73 | 74 | -- | One step to the right, but cycling 75 | moveLeftC :: Tape a -> Tape a 76 | moveLeftC (Tape ls x rs) = case ls of 77 | [] -> let r :| rs' = NE.reverse (x :| rs) 78 | in Tape rs' r [] 79 | l:ls' -> Tape ls' l (x:rs) 80 | 81 | -- | One step to the right, but cycling 82 | moveRightC :: Tape a -> Tape a 83 | moveRightC (Tape ls x rs) = case rs of 84 | [] -> let l :| ls' = NE.reverse (x :| ls) 85 | in Tape [] l ls' 86 | r:rs' -> Tape (x:ls) r rs' 87 | 88 | -- | Shifts the Tape to the left or right by a given amount, cyclicly 89 | moveC :: Int -> Tape a -> Tape a 90 | moveC n = case compare n 0 of 91 | LT -> (!!! abs n) . iterate moveLeftC 92 | EQ -> id 93 | GT -> (!!! n ) . iterate moveRightC 94 | 95 | moveLeftD :: a -> Tape a -> Tape a 96 | moveLeftD d (Tape ls x rs) = case ls of 97 | [] -> Tape [] d (x:rs) 98 | l:ls' -> Tape ls' l (x:rs) 99 | 100 | moveRightD :: a -> Tape a -> Tape a 101 | moveRightD d (Tape ls x rs) = case rs of 102 | [] -> Tape (x:ls) d [] 103 | r:rs' -> Tape (x:ls) r rs' 104 | -------------------------------------------------------------------------------- /src/AOC2017/Day23.hs: -------------------------------------------------------------------------------- 1 | module AOC2017.Day23 (day23a, day23b) where 2 | 3 | import AOC2017.Types (Challenge) 4 | import AOC2017.Util.Tape (Tape(..), HasTape(..), unsafeTape, move) 5 | import Control.Applicative (many) 6 | import Control.Lens (set, use, at, non, _last, forMOf_, Iso', iso) 7 | import Control.Lens.Operators ((.=), (%=)) 8 | import Control.Lens.TH (makeClassy, makePrisms) 9 | import Control.Lens.Tuple (_1, _2, _3) 10 | import Control.Monad.State (StateT(..), lift) 11 | import Control.Monad.Trans.Maybe (MaybeT(..)) 12 | import Control.Monad.Writer (Writer, runWriter, tell, Sum(..)) 13 | import Data.Char (isAlpha) 14 | import Math.NumberTheory.Primes.Testing (isPrime) 15 | import qualified Data.Map as M 16 | 17 | type Addr = Either Char Int 18 | 19 | addr :: String -> Addr 20 | addr [c] | isAlpha c = Left c 21 | addr str = Right (read str) 22 | 23 | data BinOp = BOSet | BOSub | BOMul 24 | makePrisms ''BinOp 25 | runBO :: BinOp -> Int -> Int -> Int 26 | runBO = \case { BOSet -> const id; BOSub -> (-); BOMul -> (*) } 27 | 28 | data JumpCond = JCNotZero | JCPrime 29 | runJC :: JumpCond -> Int -> Bool 30 | runJC = \case { JCNotZero -> (/= 0); JCPrime -> isPrime . fromIntegral } 31 | 32 | data Op = OBin BinOp Char Addr 33 | | OJmp JumpCond Addr Int 34 | makePrisms ''Op 35 | 36 | parseOp :: String -> Op 37 | parseOp inp = case words inp of 38 | "set":(x:_):(addr->y):_ -> OBin BOSet x y 39 | "sub":(x:_):(addr->y):_ -> OBin BOSub x y 40 | "mul":(x:_):(addr->y):_ -> OBin BOMul x y 41 | "jnz":(addr->x):(read->y):_ -> OJmp JCNotZero x y 42 | "jpm":(addr->x):(read->y):_ -> OJmp JCPrime x y 43 | _ -> error "Bad parse" 44 | 45 | parse :: String -> [Op] 46 | parse = map parseOp . lines 47 | 48 | -- | Replaces the two inner loops with a simple prime check 49 | optimize :: [Op] -> [Op] 50 | optimize = set ( _last . _OJmp . _3 ) (-7) 51 | . set (splot 8 . _2 . splot 17 . _1) [parseOp "jpm b 2"] 52 | where 53 | -- split by prefix and suffx 54 | splot :: Int -> Iso' [a] ([a], [a]) 55 | splot n = iso (splitAt n) (uncurry (++)) 56 | 57 | data ProgState = PS { _psTape :: Tape Op 58 | , _psRegs :: M.Map Char Int 59 | } 60 | makeClassy ''ProgState 61 | 62 | -- | Context in which Tape commands are run. Writer parameter records 63 | -- number of Mul's 64 | -- 65 | -- Nothing = program terminates by running out of bounds 66 | type TapeProg = MaybeT (StateT ProgState (Writer (Sum Int))) 67 | runTapeProg :: TapeProg a -> ProgState -> ((Maybe a, ProgState), Sum Int) 68 | runTapeProg tp ps = runWriter . flip runStateT ps . runMaybeT $ tp 69 | 70 | -- | Single step through program tape. 71 | stepTape :: TapeProg () 72 | stepTape = use (psTape . tFocus) >>= \case 73 | OBin bo x y -> do 74 | yVal <- addrVal y 75 | psRegs . at x . non 0 %= \xVal -> runBO bo xVal yVal 76 | forMOf_ _BOMul bo $ \_ -> 77 | lift . lift $ tell (Sum 1) 78 | advance 1 79 | OJmp jc x y -> do 80 | xVal <- addrVal x 81 | let moveAmt | runJC jc xVal = y 82 | | otherwise = 1 83 | advance moveAmt 84 | where 85 | addrVal (Left r) = use (psRegs . at r . non 0) 86 | addrVal (Right x) = return x 87 | advance n = do 88 | Just t' <- move n <$> use psTape 89 | psTape .= t' 90 | 91 | day23a :: Challenge 92 | day23a = show . getSum . snd 93 | . runTapeProg (many stepTape) -- stepTape until program terminates 94 | . (`PS` M.empty) . unsafeTape 95 | . parse 96 | 97 | day23b :: Challenge 98 | day23b = show . M.findWithDefault 0 'h' . _psRegs . snd . fst 99 | . runTapeProg (many stepTape) 100 | . (`PS` M.singleton 'a' 1) . unsafeTape 101 | . optimize . parse 102 | -------------------------------------------------------------------------------- /app/Main.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE ApplicativeDo #-} 2 | {-# LANGUAGE DataKinds #-} 3 | {-# LANGUAGE LambdaCase #-} 4 | {-# LANGUAGE RecordWildCards #-} 5 | {-# LANGUAGE ViewPatterns #-} 6 | 7 | import AOC2017 8 | import Control.Applicative 9 | import Control.DeepSeq 10 | import Control.Exception 11 | import Control.Monad 12 | import Criterion 13 | import Data.Char 14 | import Data.Finite 15 | import Data.Maybe 16 | import Data.Semigroup 17 | import Options.Applicative 18 | import Text.Printf 19 | import Text.Read 20 | import qualified Data.IntMap as IM 21 | import qualified Data.Map as M 22 | import qualified System.Console.ANSI as ANSI 23 | 24 | data TestSpec = TSAll 25 | | TSDayAll { _tsDay :: Finite 25 } 26 | | TSDayPart { _tsDay :: Finite 25 27 | , _tsPart :: Char 28 | } 29 | deriving Show 30 | 31 | data Opts = O { _oTestSpec :: TestSpec 32 | , _oTests :: Bool 33 | , _oBench :: Bool 34 | , _oLock :: Bool 35 | , _oConfig :: Maybe FilePath 36 | } 37 | 38 | main :: IO () 39 | main = do 40 | O{..} <- execParser $ info (parseOpts <**> helper) 41 | ( fullDesc 42 | <> header "aoc2017 - Advent of Code 2017 challenge runner" 43 | <> progDesc "Run challenges from Advent of Code 2017" 44 | ) 45 | Cfg{..} <- configFile $ fromMaybe "aoc2017-conf.yaml" _oConfig 46 | let toRun = case _oTestSpec of 47 | TSAll -> Right challengeMap 48 | TSDayAll (succ.fromIntegral->d) -> 49 | case IM.lookup d challengeMap of 50 | Nothing -> Left $ printf "Day not yet available: %d" d 51 | Just cs -> Right $ IM.singleton d cs 52 | TSDayPart (succ.fromIntegral->d) p -> do 53 | ps <- maybe (Left $ printf "Day not yet available: %d" d) Right $ 54 | IM.lookup d challengeMap 55 | c <- maybe (Left $ printf "Part not found: %c" p) Right $ 56 | M.lookup p ps 57 | return $ IM.singleton d (M.singleton p c) 58 | case toRun of 59 | Left e -> putStrLn e 60 | Right cs -> flip (runAll _cfgSession _oLock) cs $ \c CD{..} -> do 61 | case _cdInp of 62 | Left err | not _oTests || _oBench -> do 63 | putStrLn "[ERROR]" 64 | mapM_ (putStrLn . (" " ++)) err 65 | _ -> 66 | return () 67 | when _oTests $ do 68 | testRes <- mapMaybe fst <$> mapM (uncurry (testCase True c)) _cdTests 69 | unless (null testRes) $ do 70 | let (mark, color) 71 | | and testRes = ('✓', ANSI.Green) 72 | | otherwise = ('✗', ANSI.Red ) 73 | ANSI.setSGR [ ANSI.SetColor ANSI.Foreground ANSI.Vivid color ] 74 | printf "[%c] Passed %d out of %d test(s)\n" 75 | mark 76 | (length (filter id testRes)) 77 | (length testRes) 78 | ANSI.setSGR [ ANSI.Reset ] 79 | when (_oTests || not _oBench) . forM_ _cdInp $ \inp -> 80 | testCase False c inp _cdAns 81 | 82 | when _oBench . forM_ _cdInp $ \inp -> 83 | benchmark (nf c inp) 84 | 85 | runAll 86 | :: Maybe String 87 | -> Bool 88 | -> (Challenge -> ChallengeData -> IO ()) 89 | -> IM.IntMap (M.Map Char Challenge) 90 | -> IO () 91 | runAll sess lock f = fmap void $ 92 | IM.traverseWithKey $ \d -> 93 | M.traverseWithKey $ \p c -> do 94 | let CP{..} = challengePaths d p 95 | printf ">> Day %02d%c\n" d p 96 | when lock $ do 97 | CD{..} <- challengeData sess d p 98 | forM_ _cdInp $ \inp -> 99 | writeFile _cpAnswer =<< evaluate (force (c inp)) 100 | f c =<< challengeData sess d p 101 | 102 | testCase 103 | :: Bool 104 | -> Challenge 105 | -> String 106 | -> Maybe String 107 | -> IO (Maybe Bool, String) 108 | testCase emph c inp ans = do 109 | ANSI.setSGR [ ANSI.SetColor ANSI.Foreground ANSI.Vivid color ] 110 | printf "[%c]" mark 111 | ANSI.setSGR [ ANSI.Reset ] 112 | if emph 113 | then printf " (%s)\n" res 114 | else printf " %s\n" res 115 | forM_ showAns $ \a -> do 116 | ANSI.setSGR [ ANSI.SetColor ANSI.Foreground ANSI.Vivid ANSI.Red ] 117 | printf "(Expected: %s)\n" a 118 | ANSI.setSGR [ ANSI.Reset ] 119 | return (status, res) 120 | where 121 | res = c inp 122 | (mark, showAns, status) = case ans of 123 | Just (strip->ex) 124 | | strip res == ex -> ('✓', Nothing, Just True ) 125 | | otherwise -> ('✗', Just ex, Just False) 126 | Nothing -> ('?', Nothing, Nothing ) 127 | color = case status of 128 | Just True -> ANSI.Green 129 | Just False -> ANSI.Red 130 | Nothing -> ANSI.Blue 131 | 132 | parseOpts :: Parser Opts 133 | parseOpts = do 134 | d <- argument pDay ( metavar "DAY" 135 | <> help "Day of challenge (1 - 25), or \"all\"" 136 | ) 137 | p <- optional $ argument pPart ( metavar "PART" 138 | <> help "Challenge part (a, b, c, etc.)" 139 | ) 140 | t <- switch $ long "tests" 141 | <> short 't' 142 | <> help "Run sample tests" 143 | b <- switch $ long "bench" 144 | <> short 'b' 145 | <> help "Run benchmarks" 146 | l <- switch $ long "lock" 147 | <> short 'l' 148 | <> help "Lock in results as \"correct\" answers" 149 | c <- optional $ strOption 150 | ( long "config" 151 | <> short 'c' 152 | <> metavar "PATH" 153 | <> help "Path to configuration file (default: aoc2017-conf.yaml)" 154 | ) 155 | pure $ let ts = case d of 156 | Just d' -> case p of 157 | Just p' -> TSDayPart d' p' 158 | Nothing -> TSDayAll d' 159 | Nothing -> TSAll 160 | in O ts t b l c 161 | where 162 | pFin = eitherReader $ \s -> do 163 | n <- maybe (Left "Invalid day") Right $ readMaybe s 164 | maybe (Left "Day out of range") Right $ packFinite (n - 1) 165 | pDay = Nothing <$ maybeReader (guard . (== "all") . map toLower) 166 | <|> Just <$> pFin 167 | pPart = eitherReader $ \case 168 | [] -> Left "No part" 169 | [p] | isAlpha p -> Right (toLower p) 170 | | otherwise -> Left "Invalid part (not an alphabet letter)" 171 | _ -> Left "Invalid part (not a single alphabet letter)" 172 | 173 | -------------------------------------------------------------------------------- /src/AOC2017/Day18.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DataKinds #-} 2 | {-# LANGUAGE FlexibleContexts #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE FunctionalDependencies #-} 5 | {-# LANGUAGE GADTs #-} 6 | {-# LANGUAGE KindSignatures #-} 7 | {-# LANGUAGE MultiParamTypeClasses #-} 8 | {-# LANGUAGE TemplateHaskell #-} 9 | {-# LANGUAGE TypeOperators #-} 10 | {-# LANGUAGE UndecidableInstances #-} 11 | 12 | module AOC2017.Day18 (day18a, day18b) where 13 | 14 | import AOC2017.Types (Challenge) 15 | import AOC2017.Util.Accum 16 | import Control.Applicative 17 | import Control.Lens 18 | import Control.Monad 19 | import Control.Monad.Fail 20 | import Control.Monad.Operational 21 | import Control.Monad.State (MonadState, StateT(..), State, execStateT, evalState) 22 | import Control.Monad.Trans.Maybe (MaybeT(..)) 23 | import Control.Monad.Writer 24 | import Data.Char (isAlpha) 25 | import Data.Kind (Type) 26 | import Data.Maybe (fromJust) 27 | import Data.Monoid (First(..), Last(..)) 28 | import Data.Type.Disjunction 29 | import qualified Data.List.PointedList as P 30 | import qualified Data.Map as M 31 | import qualified Data.Vector.Sized as V 32 | 33 | {- 34 | ****************** 35 | * The Language * 36 | ****************** 37 | -} 38 | 39 | type Addr = Either Char Int 40 | 41 | addr :: String -> Addr 42 | addr [c] | isAlpha c = Left c 43 | addr str = Right (read str) 44 | 45 | data Op = OSnd Addr 46 | | OBin (Int -> Int -> Int) Char Addr 47 | | ORcv Char 48 | | OJgz Addr Addr 49 | 50 | parseOp :: String -> Op 51 | parseOp inp = case words inp of 52 | "snd":(addr->c):_ -> OSnd c 53 | "set":(x:_):(addr->y):_ -> OBin (const id) x y 54 | "add":(x:_):(addr->y):_ -> OBin (+) x y 55 | "mul":(x:_):(addr->y):_ -> OBin (*) x y 56 | "mod":(x:_):(addr->y):_ -> OBin mod x y 57 | "rcv":(x:_):_ -> ORcv x 58 | "jgz":(addr->x):(addr->y):_ -> OJgz x y 59 | _ -> error "Bad parse" 60 | 61 | parse :: String -> P.PointedList Op 62 | parse = fromJust . P.fromList . map parseOp . lines 63 | 64 | {- 65 | ************************** 66 | * The Abstract Machine * 67 | ************************** 68 | -} 69 | 70 | data Memory :: Type -> Type where 71 | MGet :: Char -> Memory Int 72 | MSet :: Char -> Int -> Memory () 73 | MMov :: Int -> Memory () 74 | MPk :: Memory Op 75 | 76 | -- | Abstract data type describing "IO" available to the abstract machine 77 | data Command :: Type -> Type where 78 | CRcv :: Int -> Command Int -- ^ input is current value of buffer 79 | CSnd :: Int -> Command () -- ^ input is thing being sent 80 | 81 | type Machine = Program (Memory :|: Command) 82 | 83 | cRcv :: Int -> Machine Int 84 | cRcv = singleton . R . CRcv 85 | cSnd :: Int -> Machine () 86 | cSnd = singleton . R . CSnd 87 | cGet :: Char -> Machine Int 88 | cGet = singleton . L . MGet 89 | cSet :: Char -> Int -> Machine () 90 | cSet r = singleton . L . MSet r 91 | cMov :: Int -> Machine () 92 | cMov = singleton . L . MMov 93 | cPk :: Machine Op 94 | cPk = singleton $ L MPk 95 | 96 | data ProgState = PS { _psTape :: P.PointedList Op 97 | , _psRegs :: M.Map Char Int 98 | } 99 | makeClassy ''ProgState 100 | 101 | -- | Single step through program tape. 102 | stepTape :: Machine () 103 | stepTape = cPk >>= \case 104 | OSnd x -> do 105 | cSnd =<< addrVal x 106 | cMov 1 107 | OBin f x y -> do 108 | yVal <- addrVal y 109 | cSet x . (`f` yVal) =<< cGet x 110 | cMov 1 111 | ORcv x -> do 112 | y <- cRcv =<< cGet x 113 | cSet x y 114 | cMov 1 115 | OJgz x y -> do 116 | xVal <- addrVal x 117 | cMov =<< if xVal > 0 118 | then addrVal y 119 | else return 1 120 | where 121 | addrVal (Left r ) = cGet r 122 | addrVal (Right x) = return x 123 | 124 | interpMem 125 | :: (MonadState s m, MonadPlus m, HasProgState s) 126 | => Memory a 127 | -> m a 128 | interpMem = \case 129 | MGet c -> use (psRegs . at c . non 0) 130 | MSet c x -> psRegs . at c . non 0 .= x 131 | MMov n -> do 132 | Just t' <- P.moveN n <$> use psTape 133 | psTape .= t' 134 | MPk -> use (psTape . P.focus) 135 | 136 | {- 137 | ************************ 138 | * Context for Part A * 139 | ************************ 140 | -} 141 | 142 | execPartA 143 | :: MaybeT (StateT ProgState (AccumT (Last Int) (Writer (First Int)))) a 144 | -> ProgState 145 | -> Int 146 | execPartA p s = fromJust . getFirst . execWriter 147 | . flip execAccumT mempty 148 | . flip execStateT s 149 | . runMaybeT 150 | $ p 151 | 152 | -- | Interpet Command for Part A 153 | interpA 154 | :: (MonadAccum (Last Int) m, MonadWriter (First Int) m) 155 | => Command a 156 | -> m a 157 | interpA = \case 158 | CRcv x -> do 159 | when (x /= 0) $ 160 | tell . First . getLast =<< look 161 | return x 162 | CSnd x -> 163 | add (Last (Just x)) 164 | 165 | day18a :: Challenge 166 | day18a = show 167 | . execPartA (many . interpretWithMonad (interpMem >|< interpA) $ stepTape) 168 | . (`PS` M.empty) 169 | . parse 170 | 171 | {- 172 | ************************ 173 | * Context for Part B * 174 | ************************ 175 | -} 176 | 177 | data Thread = T { _tState :: ProgState 178 | , _tBuffer :: [Int] 179 | } 180 | makeClassy ''Thread 181 | 182 | instance HasProgState Thread where 183 | progState = tState 184 | 185 | -- | Interpet Command for Part B, with an [Int] writer side-channel 186 | interpB 187 | :: (MonadFail m, MonadState s m, HasThread s) 188 | => Command a 189 | -> WriterT [Int] m a 190 | interpB = \case 191 | CSnd x -> tell [x] 192 | CRcv _ -> do 193 | x:xs <- use tBuffer 194 | tBuffer .= xs 195 | return x 196 | 197 | type MultiState = V.Vector 2 Thread 198 | 199 | -- | Single step through both threads. Nothing = both threads terminate 200 | stepThreads 201 | :: MaybeT (State MultiState) Int 202 | stepThreads = do 203 | outA <- execWriterT . zoom (V.ix 0) $ 204 | many $ interpretWithMonad (interpMem >|< interpB) stepTape 205 | outB <- execWriterT . zoom (V.ix 1) $ 206 | many $ interpretWithMonad (interpMem >|< interpB) stepTape 207 | V.ix 0 . tBuffer .= outB 208 | V.ix 1 . tBuffer .= outA 209 | guard . not $ null outA && null outB 210 | return $ length outB 211 | 212 | day18b :: Challenge 213 | day18b (parse->t) = show . sum . concat 214 | . evalState (runMaybeT (many stepThreads)) 215 | $ ms 216 | where 217 | Just ms = V.fromList [ T (PS t (M.singleton 'p' 0)) [] 218 | , T (PS t (M.singleton 'p' 1)) [] 219 | ] 220 | 221 | -------------------------------------------------------------------------------- /src/AOC2017.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE RecordWildCards #-} 3 | {-# LANGUAGE ViewPatterns #-} 4 | 5 | module AOC2017 ( 6 | module AOC 7 | , challengeMap 8 | , ChallengePaths(..), challengePaths 9 | , ChallengeData(..), challengeData 10 | , Config(..), configFile, defConfPath 11 | , session 12 | ) where 13 | 14 | import AOC2017.Day01 as AOC 15 | import AOC2017.Day02 as AOC 16 | import AOC2017.Day03 as AOC 17 | import AOC2017.Day04 as AOC 18 | import AOC2017.Day05 as AOC 19 | import AOC2017.Day06 as AOC 20 | import AOC2017.Day07 as AOC 21 | import AOC2017.Day08 as AOC 22 | import AOC2017.Day09 as AOC 23 | import AOC2017.Day10 as AOC 24 | import AOC2017.Day11 as AOC 25 | import AOC2017.Day12 as AOC 26 | import AOC2017.Day13 as AOC 27 | import AOC2017.Day14 as AOC 28 | import AOC2017.Day15 as AOC 29 | import AOC2017.Day16 as AOC 30 | import AOC2017.Day17 as AOC 31 | import AOC2017.Day18 as AOC 32 | import AOC2017.Day19 as AOC 33 | import AOC2017.Day20 as AOC 34 | import AOC2017.Day21 as AOC 35 | import AOC2017.Day22 as AOC 36 | import AOC2017.Day23 as AOC 37 | import AOC2017.Day24 as AOC 38 | import AOC2017.Day25 as AOC 39 | 40 | import AOC2017.Types as AOC 41 | import AOC2017.Util as AOC 42 | import Control.DeepSeq 43 | import Control.Exception 44 | import Control.Monad 45 | import Control.Monad.IO.Class 46 | import Control.Monad.Trans.Except 47 | import Data.Foldable 48 | import Data.List 49 | import Data.Monoid 50 | import GHC.Generics (Generic) 51 | import Network.Curl 52 | import System.FilePath 53 | import System.IO.Error 54 | import Text.Printf 55 | import qualified Data.Aeson as A 56 | import qualified Data.ByteString as BS 57 | import qualified Data.IntMap as IM 58 | import qualified Data.Map as M 59 | import qualified Data.Yaml as Y 60 | 61 | challengeMap :: IM.IntMap (M.Map Char Challenge) 62 | challengeMap = IM.fromList 63 | [ (d, M.fromList (zip ['a'..] ps)) 64 | | (d, ps) <- challenges 65 | ] 66 | <> IM.singleton 25 (M.singleton 'a' day25a) 67 | 68 | challenges :: [(Int, [Challenge])] 69 | challenges = [ ( 1, [day01a, day01b]) 70 | , ( 2, [day02a, day02b]) 71 | , ( 3, [day03a, day03b]) 72 | , ( 4, [day04a, day04b]) 73 | , ( 5, [day05a, day05b]) 74 | , ( 6, [day06a, day06b]) 75 | , ( 7, [day07a, day07b]) 76 | , ( 8, [day08a, day08b]) 77 | , ( 9, [day09a, day09b]) 78 | , (10, [day10a, day10b]) 79 | , (11, [day11a, day11b]) 80 | , (12, [day12a, day12b]) 81 | , (13, [day13a, day13b]) 82 | , (14, [day14a, day14b]) 83 | , (15, [day15a, day15b]) 84 | , (16, [day16a, day16b]) 85 | , (17, [day17a, day17b]) 86 | , (18, [day18a, day18b]) 87 | , (19, [day19a, day19b]) 88 | , (20, [day20a, day20b]) 89 | , (21, [day21a, day21b]) 90 | , (22, [day22a, day22b]) 91 | , (23, [day23a, day23b]) 92 | , (24, [day24a, day24b]) 93 | , (25, [day25a ]) 94 | ] 95 | 96 | data ChallengePaths = CP { _cpDataUrl :: !FilePath 97 | , _cpInput :: !FilePath 98 | , _cpAnswer :: !FilePath 99 | , _cpTests :: !FilePath 100 | } 101 | deriving Show 102 | 103 | data ChallengeData = CD { _cdInp :: !(Either [String] String) 104 | , _cdAns :: !(Maybe String) 105 | , _cdTests :: ![(String, Maybe String)] 106 | } 107 | 108 | challengePaths 109 | :: Int 110 | -> Char 111 | -> ChallengePaths 112 | challengePaths d p = CP 113 | { _cpDataUrl = printf "http://adventofcode.com/2017/day/%d/input" d 114 | , _cpInput = "data" printf "%02d" d <.> "txt" 115 | , _cpAnswer = "data/ans" printf "%02d%c" d p <.> "txt" 116 | , _cpTests = "test-data" printf "%02d%c" d p <.> "txt" 117 | } 118 | 119 | challengeData 120 | :: Maybe String 121 | -> Int 122 | -> Char 123 | -> IO ChallengeData 124 | challengeData sess d p = do 125 | inp <- runExceptT . asum $ 126 | [ ExceptT $ maybe (Left [fileErr]) Right <$> readFileMaybe _cpInput 127 | , fetchInput 128 | ] 129 | ans <- readFileMaybe _cpAnswer 130 | ts <- foldMap (parseTests . lines) <$> readFileMaybe _cpTests 131 | return $ CD inp ans ts 132 | where 133 | CP{..} = challengePaths d p 134 | fileErr = printf "Input file not found at %s" _cpInput 135 | readFileMaybe :: FilePath -> IO (Maybe String) 136 | readFileMaybe = 137 | (traverse (evaluate . force) . either (const Nothing) Just =<<) 138 | . tryJust (guard . isDoesNotExistError) 139 | . readFile 140 | fetchInput :: ExceptT [String] IO String 141 | fetchInput = do 142 | s <- maybe (throwE ["Session key needed to fetch input"]) return 143 | sess 144 | (cc, r) <- liftIO . withCurlDo . curlGetString _cpDataUrl $ 145 | CurlCookie (printf "session=%s" s) : method_GET 146 | case cc of 147 | CurlOK -> return () 148 | _ -> throwE [ "Error contacting advent of code server to fetch input" 149 | , "Possible invalid session key" 150 | , printf "Url: %s" _cpDataUrl 151 | , printf "Server response: %s" r 152 | ] 153 | liftIO $ writeFile _cpInput r 154 | return r 155 | parseTests :: [String] -> [(String, Maybe String)] 156 | parseTests xs = case break (">>> " `isPrefixOf`) xs of 157 | (inp,[]) 158 | | null (strip (unlines inp)) -> [] 159 | | otherwise -> [(unlines inp, Nothing)] 160 | (inp,(strip.drop 4->ans):rest) 161 | | null (strip (unlines inp)) -> parseTests rest 162 | | otherwise -> 163 | let ans' = ans <$ guard (not (null ans)) 164 | in (unlines inp, ans') : parseTests rest 165 | 166 | data Config = Cfg { _cfgSession :: Maybe String } 167 | deriving (Generic) 168 | 169 | defConfPath :: FilePath 170 | defConfPath = "aoc2017-conf.yaml" 171 | 172 | configFile :: FilePath -> IO Config 173 | configFile fp = do 174 | cfgInp <- tryJust (guard . isDoesNotExistError) 175 | $ BS.readFile fp 176 | case cfgInp of 177 | Left () -> do 178 | Y.encodeFile fp emptyCfg 179 | return emptyCfg 180 | Right b -> do 181 | case Y.decodeEither b of 182 | Left e -> do 183 | printf "Configuration file at %s could not be parsed:\n" fp 184 | print e 185 | return emptyCfg 186 | Right cfg -> return cfg 187 | where 188 | emptyCfg = Cfg Nothing 189 | 190 | session :: FilePath -> IO (Maybe String) 191 | session = fmap _cfgSession . configFile 192 | 193 | configJSON :: A.Options 194 | configJSON = A.defaultOptions 195 | { A.fieldLabelModifier = A.camelTo2 '-' . drop 4 } 196 | 197 | instance A.ToJSON Config where 198 | toJSON = A.genericToJSON configJSON 199 | toEncoding = A.genericToEncoding configJSON 200 | instance A.FromJSON Config where 201 | parseJSON = A.genericParseJSON configJSON 202 | 203 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | Advent of Code 2017 2 | =================== 3 | 4 | For 2016 and 2018 onwards, check out my [Advent of Code Megarepo][megarepo]! 5 | 6 | [megarepo]: https://github.com/mstksg/advent-of-code 7 | 8 | **Warning: Spoilers** 9 | 10 | [Reflections and Benchmarks][RnB] 11 | --------------------------------- 12 | 13 | [RnB]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md 14 | 15 | I try to reflect on every day's puzzle, attempting to describe my thought 16 | processes and how my solutions all work. Benchmarks also included. 17 | 18 | * **[Day 1 Reflections][d1r]** *([code][d1c])* *([benchmarks][d1b])* 19 | * **[Day 2 Reflections][d2r]** *([code][d2c])* *([benchmarks][d2b])* 20 | * **[Day 3 Reflections][d3r]** *([code][d3c])* *([benchmarks][d3b])* 21 | * **[Day 4 Reflections][d4r]** *([code][d4c])* *([benchmarks][d4b])* 22 | * **[Day 5 Reflections][d5r]** *([code][d5c])* *([benchmarks][d5b])* 23 | * **[Day 6 Reflections][d6r]** *([code][d6c])* *([benchmarks][d6b])* 24 | * **[Day 7 Reflections][d7r]** *([code][d7c])* *([benchmarks][d7b])* 25 | * **[Day 8 Reflections][d8r]** *([code][d8c])* *([benchmarks][d8b])* 26 | * **[Day 9 Reflections][d9r]** *([code][d9c])* *([benchmarks][d9b])* *([stream][d9s])* 27 | * **[Day 10 Reflections][d10r]** *([code][d10c])* *([benchmarks][d10b])* *([stream][d10s])* 28 | * **[Day 11 Reflections][d11r]** *([code][d11c])* *([benchmarks][d11b])* 29 | * **[Day 12 Reflections][d12r]** *([code][d12c])* *([benchmarks][d12b])* 30 | * **[Day 13 Reflections][d13r]** *([code][d13c])* *([benchmarks][d13b])* 31 | * **[Day 14 Reflections][d14r]** *([code][d14c])* *([benchmarks][d14b])* 32 | * **[Day 15 Reflections][d15r]** *([code][d15c])* *([benchmarks][d15b])* 33 | * **[Day 16 Reflections][d16r]** *([code][d16c])* *([benchmarks][d16b])* 34 | * **[Day 17 Reflections][d17r]** *([code][d17c])* *([benchmarks][d17b])* 35 | * **Day 18 Reflections** *([code][d18c])* *([benchmarks][d18b])* 36 | * **[Day 19 Reflections][d19r]** *([code][d19c])* *([benchmarks][d19b])* 37 | * **Day 20 Reflections** *([code][d20c])* *([benchmarks][d20b])* 38 | * **Day 21 Reflections** *([code][d21c])* *([benchmarks][d21b])* 39 | * **Day 22 Reflections** *([code][d22c])* *([benchmarks][d22b])* 40 | * **Day 23 Reflections** *([code][d23c])* *([benchmarks][d23b])* 41 | * **Day 24 Reflections** *([code][d24c])* *([benchmarks][d24b])* 42 | * **Day 25 Reflections** *([code][d25c])* *([benchmarks][d25b])* 43 | 44 | [d1r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-1 45 | [d2r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-2 46 | [d3r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-3 47 | [d4r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-4 48 | [d5r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-5 49 | [d6r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-6 50 | [d7r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-7 51 | [d8r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-8 52 | [d9r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-9 53 | [d10r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-10 54 | [d11r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-11 55 | [d12r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-12 56 | [d13r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-13 57 | [d14r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-14 58 | [d15r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-15 59 | [d16r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-16 60 | [d17r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-17 61 | [d18r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-18 62 | [d19r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-19 63 | [d20r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-20 64 | [d21r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-21 65 | [d22r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-22 66 | [d23r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-23 67 | [d24r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-24 68 | [d25r]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-25 69 | 70 | [d1c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day01.hs 71 | [d2c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day02.hs 72 | [d3c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day03.hs 73 | [d4c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day04.hs 74 | [d5c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day05.hs 75 | [d6c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day06.hs 76 | [d7c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day07.hs 77 | [d8c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day08.hs 78 | [d9c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day09.hs 79 | [d10c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day10.hs 80 | [d11c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day11.hs 81 | [d12c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day12.hs 82 | [d13c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day13.hs 83 | [d14c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day14.hs 84 | [d15c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day15.hs 85 | [d16c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day16.hs 86 | [d17c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day17.hs 87 | [d18c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day18.hs 88 | [d19c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day19.hs 89 | [d20c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day20.hs 90 | [d21c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day21.hs 91 | [d22c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day22.hs 92 | [d23c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day23.hs 93 | [d24c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day24.hs 94 | [d25c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day25.hs 95 | 96 | [d1b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-1-benchmarks 97 | [d2b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-2-benchmarks 98 | [d3b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-3-benchmarks 99 | [d4b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-4-benchmarks 100 | [d5b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-5-benchmarks 101 | [d6b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-6-benchmarks 102 | [d7b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-7-benchmarks 103 | [d8b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-8-benchmarks 104 | [d9b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-9-benchmarks 105 | [d10b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-10-benchmarks 106 | [d11b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-11-benchmarks 107 | [d12b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-12-benchmarks 108 | [d13b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-13-benchmarks 109 | [d14b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-14-benchmarks 110 | [d15b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-15-benchmarks 111 | [d16b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-16-benchmarks 112 | [d17b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-17-benchmarks 113 | [d18b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-18-benchmarks 114 | [d19b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-19-benchmarks 115 | [d20b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-20-benchmarks 116 | [d21b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-21-benchmarks 117 | [d22b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-22-benchmarks 118 | [d23b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-23-benchmarks 119 | [d24b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-24-benchmarks 120 | [d25b]: https://github.com/mstksg/advent-of-code-2017/blob/master/reflections.md#day-25-benchmarks 121 | 122 | [d9s]: https://www.twitch.tv/videos/207969022 123 | [d10s]: https://www.twitch.tv/videos/208287550 124 | 125 | Executable 126 | ---------- 127 | 128 | Comes with test examples given in problems. 129 | 130 | You can install using `stack`: 131 | 132 | ```bash 133 | $ git clone https://github.com/mstksg/advent-of-code-2017 134 | $ cd advent-of-code-2017 135 | $ stack setup 136 | $ stack install 137 | ``` 138 | 139 | The executable `aoc2017` includes a testing and benchmark suite 140 | 141 | ``` 142 | $ aoc2017 --help 143 | aoc2017 - Advent of Code 2017 challenge runner 144 | 145 | Usage: aoc2017 DAY [PART] [-t|--tests] [-b|--bench] 146 | Run challenges from Advent of Code 2017 147 | 148 | Available options: 149 | DAY Day of challenge (1 - 25), or "all" 150 | PART Challenge part (a, b, c, etc.) 151 | -t,--tests Run sample tests 152 | -b,--bench Run benchmarks 153 | -h,--help Show this help text 154 | 155 | $ aoc2017 5 b 156 | >> Day 05b 157 | >> [✓] 27720699 158 | ``` 159 | 160 | Benchmarking is implemented using *criterion* 161 | 162 | ``` 163 | $ aoc2017 2 --bench 164 | >> Day 02a 165 | benchmarking... 166 | time 729.1 μs (695.0 μs .. 784.2 μs) 167 | 0.967 R² (0.926 R² .. 0.995 R²) 168 | mean 740.4 μs (711.9 μs .. 783.6 μs) 169 | std dev 116.8 μs (70.44 μs .. 172.8 μs) 170 | variance introduced by outliers: 89% (severely inflated) 171 | 172 | >> Day 02b 173 | benchmarking... 174 | time 782.4 μs (761.3 μs .. 812.9 μs) 175 | 0.983 R² (0.966 R² .. 0.998 R²) 176 | mean 786.7 μs (764.1 μs .. 849.4 μs) 177 | std dev 110.8 μs (42.44 μs .. 228.5 μs) 178 | variance introduced by outliers: 86% (severely inflated) 179 | ``` 180 | 181 | Test suites run the example problems given in the puzzle description, and 182 | outputs are colorized in ANSI terminals. 183 | 184 | ``` 185 | $ aoc2017 1 --tests 186 | [9] [!35732] $ aoc2017 1 --tests 187 | >> Day 01a 188 | [✓] (3) 189 | [✓] (4) 190 | [✓] (0) 191 | [✓] (9) 192 | [✓] Passed 4 out of 4 test(s) 193 | [✓] 1097 194 | >> Day 01b 195 | [✓] (6) 196 | [✓] (0) 197 | [✓] (4) 198 | [✓] (12) 199 | [✓] (4) 200 | [✓] Passed 5 out of 5 test(s) 201 | [✓] 1188 202 | ``` 203 | 204 | This should only work if you're running `aoc2017` in the project directory. 205 | 206 | **To run on actual inputs**, the executable expects inputs to be found in the 207 | folder `data/XX.txt` in the directory you are running in. That is, the input 208 | for Day 7 will be expected at `data/07.txt`. 209 | 210 | *aoc2017 will download missing input files*, but requires a session token. 211 | This can be provided in `aoc2017-conf.yaml`: 212 | 213 | ```yaml 214 | session: [[ session token goes here ]] 215 | ``` 216 | 217 | You can "lock in" your current answers (telling the executable that those are 218 | the correct answers) by passing in `--lock`. This will lock in any final 219 | puzzle solutions encountered as the verified official answers. Later, if you 220 | edit or modify your solutions, they will be checked on the locked-in answers. 221 | 222 | These are store in `data/ans/XXpart.txt`. That is, the target output for Day 7 223 | (Part 2, `b`) will be expected at `data/ans/07b.txt`. You can also manually 224 | edit these files. 225 | 226 | -------------------------------------------------------------------------------- /reflections.md: -------------------------------------------------------------------------------- 1 | Reflections 2 | =========== 3 | 4 | [Table of Contents][] 5 | 6 | [Table of Contents]: https://github.com/mstksg/advent-of-code-2017#reflections-and-benchmarks 7 | 8 | Day 1 9 | ----- 10 | 11 | *([code][d1c])* 12 | 13 | [d1c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day01.hs 14 | 15 | We can generate a list of consecutive items (while looping around) very crudely 16 | using: 17 | 18 | ```haskell 19 | conseqs :: [a] -> [(a,a)] 20 | conseqs (x:xs) = zip (x:xs) (xs ++ [x]) 21 | ``` 22 | 23 | For part 2, we can generate a list of "opposite" items by zipping a bisected 24 | list: 25 | 26 | ```haskell 27 | bisect :: [a] -> ([a], [a]) 28 | bisect xs = splitAt (length xs `div` 2) xs 29 | 30 | uncurry zip . bisect :: [a] -> [(a,a)] 31 | ``` 32 | 33 | From either of these, we can select the ones that are "matching" by filtering 34 | for equal tuples: 35 | 36 | ```haskell 37 | matchings :: Eq a => [(a,a)] -> [a] 38 | matchings = map fst . filter (\(x,y) -> x == y) 39 | ``` 40 | 41 | The result is the sum of all of the "matched" numbers, so in the end, we have: 42 | 43 | ```haskell 44 | day01a :: [Int] -> Int 45 | day01a = sum . matchings . ( conseqs ) 46 | 47 | day01b :: [Int] -> Int 48 | day01b = (*2) . sum . matchings . (uncurry zip . bisect) 49 | ``` 50 | 51 | Note that we do need to "double count" for Part 2. 52 | 53 | We could parse the actual strings into `[Int]` by just using 54 | `map digitToInt :: String -> [Int]` 55 | 56 | ### Day 1 Benchmarks 57 | 58 | ``` 59 | >> Day 01a 60 | benchmarking... 61 | time 59.08 μs (56.52 μs .. 61.98 μs) 62 | 0.981 R² (0.971 R² .. 0.991 R²) 63 | mean 61.41 μs (57.81 μs .. 69.65 μs) 64 | std dev 17.28 μs (7.177 μs .. 28.41 μs) 65 | variance introduced by outliers: 97% (severely inflated) 66 | 67 | >> Day 01b 68 | benchmarking... 69 | time 93.48 μs (88.50 μs .. 98.63 μs) 70 | 0.979 R² (0.969 R² .. 0.992 R²) 71 | mean 90.52 μs (87.72 μs .. 94.51 μs) 72 | std dev 10.30 μs (6.708 μs .. 14.16 μs) 73 | variance introduced by outliers: 86% (severely inflated) 74 | ``` 75 | 76 | Day 2 77 | ----- 78 | 79 | *([code][d2c])* 80 | 81 | [d2c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day02.hs 82 | 83 | Good stream processing demonstration. Both problems just boil down to summing 84 | a function on all lines: 85 | 86 | ```haskell 87 | day02a :: [[Int]] -> Int 88 | day02a = sum . map checkA 89 | 90 | day02b :: [[Int]] -> Int 91 | day02b = sum . map checkB 92 | ``` 93 | 94 | `checkA` is just the maximum minus the minimum: 95 | 96 | ```haskell 97 | checkA :: [Int] -> Int 98 | checkA xs = maximum xs - minimum xs 99 | ``` 100 | 101 | `checkB` requires you to "find" an item subject to several constraints, and 102 | this can be done using the list monad instance (to pretend to be writing 103 | Prolog) or simply a list comprehension. 104 | 105 | ```haskell 106 | checkB :: [Int] -> Int 107 | checkB xs = head $ do 108 | y:ys <- tails (sort xs) 109 | (d, 0) <- (`divMod` y) <$> ys 110 | return d 111 | ``` 112 | 113 | First we list all of our "possibilities" that we want to search -- we consider 114 | all `y : ys`, where `y` is some element in our list, and `ys` is all of items 115 | greater than or equal to `y` in the list. 116 | 117 | Then we consider the `divMod` of any number in `ys` by `y`, but only the ones 118 | that give a `mod` of 0 (the *perfect divisor* of `y` in `ys`). 119 | 120 | Our result is `d`, the result of the perfect division. 121 | 122 | Parsing is pretty straightforward again; we can use `map (map read . words) . 123 | lines :: String -> [[Int]]` to split by lines, then by words, and `read` every 124 | word. 125 | 126 | ### Day 2 Benchmarks 127 | 128 | ``` 129 | >> Day 02a 130 | benchmarking... 131 | time 701.8 μs (671.5 μs .. 741.4 μs) 132 | 0.982 R² (0.961 R² .. 0.996 R²) 133 | mean 687.1 μs (670.0 μs .. 721.0 μs) 134 | std dev 80.53 μs (50.15 μs .. 132.3 μs) 135 | variance introduced by outliers: 81% (severely inflated) 136 | 137 | >> Day 02b 138 | benchmarking... 139 | time 775.4 μs (742.7 μs .. 822.8 μs) 140 | 0.974 R² (0.947 R² .. 0.996 R²) 141 | mean 769.2 μs (746.3 μs .. 818.0 μs) 142 | std dev 107.1 μs (49.91 μs .. 186.3 μs) 143 | variance introduced by outliers: 85% (severely inflated) 144 | ``` 145 | 146 | Day 3 147 | ----- 148 | 149 | *([code][d3c])* 150 | 151 | [d3c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day03.hs 152 | 153 | My Day 3 solution revolves around the `Trail` monoid: 154 | 155 | ```haskell 156 | newtype Trail a = Trail { runTrail :: a -> ([a], a) } 157 | instance Semigroup (Trail a) where 158 | f <> g = Trail $ \x -> let (xs, y) = runTrail f x 159 | (ys, z) = runTrail g y 160 | in (xs ++ ys, z) 161 | instance Monoid (Trail a) where 162 | mempty = Trail ([],) 163 | mappend = (<>) 164 | ``` 165 | 166 | Which describes a function that "leaves a trail" as it is being run. The 167 | `mappend`/`<>` action composes two functions together (one after the other), 168 | and also combines the "trails" that they leave behind. 169 | 170 | In an unrelated monoid usage, we have 171 | 172 | ```haskell 173 | type Pos = (Sum Int, Sum Int) 174 | ``` 175 | 176 | So `p1 <> p2` will be the component-wise addition of two points. 177 | 178 | To start off, we build `ulam :: [Pos]`, an *infinite list* of positions, starting 179 | from the middle of the spiral and moving outwards. `ulam !! 0` would be the 180 | very center (the 1st position), `ulam !! 10` would be the 11th position, etc. 181 | 182 | We build this spiral using `move`, our most basic `Trail`: 183 | 184 | ```haskell 185 | move :: Pos -> Trail Pos 186 | move p = Trail $ \p0 -> ([p0 <> p], p0 <> p) 187 | ``` 188 | 189 | `move (1,0)` would give a `Trail` that *moves* one tile to the right, and 190 | leaves the new position in its trail. 191 | 192 | 193 | We can then build the entire spiral by `<>`ing (using `foldMap`) `Trail`s 194 | forever: 195 | 196 | ```haskell 197 | spiral :: Trail Pos 198 | spiral = move (0,0) 199 | <> foldMap loop [1..] 200 | where 201 | loop :: Int -> Trail Pos 202 | loop n = stimes (2*n-1) (move ( 1, 0)) 203 | <> stimes (2*n-1) (move ( 0, 1)) 204 | <> stimes (2*n ) (move (-1, 0)) 205 | <> stimes (2*n ) (move ( 0,-1)) 206 | ``` 207 | 208 | And for `ulam`, we run the `Trail` from `(0,0)`, and get the trail list (`fst`). 209 | 210 | ```haskell 211 | ulam :: [Pos] 212 | ulam = fst $ runTrail spiral (0,0) 213 | ``` 214 | 215 | ### Part 1 216 | 217 | Part 1 is then just getting the `nth` item in `ulam`, and calculating its 218 | distance from the center: 219 | 220 | ```haskell 221 | day03a :: Int -> Int 222 | day03a i = norm $ ulam !! (i - 1) 223 | where 224 | norm (Sum x, Sum y) = abs x + abs y 225 | ``` 226 | 227 | ### Part 2 228 | 229 | For Part 2, we keep the state of the filled out cells as a `Map Pos Int`, which 230 | stores the number at each position. If the position has not been "reached" 231 | yet, it will not be in the `Map`. 232 | 233 | We can use `State` to compose these functions easily. Here we write a function 234 | that takes a position and fills in that position's value in the `Map` 235 | appropriately, and returns the new value at that position: 236 | 237 | 238 | ```haskell 239 | updateMap :: Pos -> State (M.Map Pos Int) Int 240 | updateMap p = state $ \m0 -> 241 | let newPos = sum . mapMaybe (`M.lookup` m0) $ 242 | [ p <> (Sum x, Sum y) | x <- [-1 .. 1] 243 | , y <- [-1 .. 1] 244 | , x /= 0 || y /= 0 245 | ] 246 | in (newPos, M.insertWith (const id) p newPos m0) 247 | ``` 248 | 249 | We use `M.insertWith (const id)` instead of `M.insert` because we don't want to 250 | overwrite any previous entries. 251 | 252 | Since we wrote `updateMap` using `State`, we can just `traverse` over `ulam` -- 253 | if `updateMap p` updates the map at point `p` and returns the new value at that 254 | position, then `traverse updateMap ulam` updates updates the map at every 255 | position in `ulam`, one-by-one, and returns the new values at each position. 256 | 257 | ```haskell 258 | cellNums :: [Int] 259 | cellNums = flip evalState (M.singleton (0, 0) 1) $ 260 | traverse updateMap ulam 261 | ``` 262 | 263 | And so part 2 is just finding the first item matching some predicate, which is 264 | just `find` from *base*: 265 | 266 | ```haskell 267 | day03b :: Int -> Int 268 | day03b i = fromJust $ find (> i) cellNums 269 | ``` 270 | 271 | ### Day 3 Benchmarks 272 | 273 | ``` 274 | >> Day 03a 275 | benchmarking... 276 | time 2.706 ms (2.640 ms .. 2.751 ms) 277 | 0.997 R² (0.995 R² .. 0.999 R²) 278 | mean 2.186 ms (2.090 ms .. 2.267 ms) 279 | std dev 231.4 μs (198.3 μs .. 267.7 μs) 280 | variance introduced by outliers: 66% (severely inflated) 281 | 282 | >> Day 03b 283 | benchmarking... 284 | time 2.999 μs (2.639 μs .. 3.438 μs) 285 | 0.870 R² (0.831 R² .. 0.935 R²) 286 | mean 3.684 μs (2.945 μs .. 4.457 μs) 287 | std dev 1.629 μs (1.190 μs .. 2.117 μs) 288 | variance introduced by outliers: 99% (severely inflated) 289 | ``` 290 | 291 | Day 4 292 | ----- 293 | 294 | *([code][d4c])* 295 | 296 | [d4c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day04.hs 297 | 298 | Day 4 is very basic stream processing. Just filter for lines that have "all 299 | unique" items, and count how many lines are remaining. 300 | 301 | Part 1 and Part 2 are basically the same, except Part 2 checks for uniqueness 302 | up to ordering of letters. If we sort the letters in each word first, this 303 | normalizes all of the words so we can just use `==`. 304 | 305 | ```haskell 306 | day04a :: [[String]] -> Int 307 | day04a = length . filter uniq 308 | 309 | day04b :: [[String]] -> Int 310 | day04b = length . filter uniq . (map . map) sort 311 | ``` 312 | 313 | All that's left is finding a function to tell us if all of the items in a list 314 | are unique. 315 | 316 | ```haskell 317 | uniq :: Eq a => [a] -> Bool 318 | uniq xs = length xs == length (nub xs) 319 | ``` 320 | 321 | There are definitely ways of doing this that scale better, but given that all 322 | of the lines in my puzzle input are less than a dozen words long, it's really 323 | not worth it to optimize! 324 | 325 | (We can parse the input into a list of list of strings using 326 | `map words . lines :: String -> [[String]]`) 327 | 328 | ### Day 4 Benchmarks 329 | ``` 330 | >> Day 04a 331 | benchmarking... 332 | time 1.786 ms (1.726 ms .. 1.858 ms) 333 | 0.990 R² (0.984 R² .. 0.995 R²) 334 | mean 1.776 ms (1.738 ms .. 1.877 ms) 335 | std dev 193.2 μs (98.00 μs .. 356.9 μs) 336 | variance introduced by outliers: 73% (severely inflated) 337 | 338 | >> Day 04b 339 | benchmarking... 340 | time 3.979 ms (3.431 ms .. 4.421 ms) 341 | 0.912 R² (0.852 R² .. 0.974 R²) 342 | mean 3.499 ms (3.349 ms .. 3.805 ms) 343 | std dev 703.5 μs (475.7 μs .. 1.026 ms) 344 | variance introduced by outliers: 88% (severely inflated) 345 | ``` 346 | 347 | Day 5 348 | ----- 349 | 350 | *([code][d5c])* 351 | 352 | [d5c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day05.hs 353 | 354 | Day 5 centers around the `Tape` zipper: 355 | 356 | ```haskell 357 | data Tape a = Tape { _tLefts :: [a] 358 | , _tFocus :: a 359 | , _tRights :: [a] 360 | } 361 | deriving Show 362 | ``` 363 | 364 | We have the "focus" (the current pointer position), the items to the left of 365 | the focus (in reverse order, starting from the item closest to the focus), and 366 | the items to the right of the focus. 367 | 368 | Tape is neat because moving one step to the left or right is O(1). It's also 369 | "type-safe" in our situation, unlike an `IntMap`, because it enforces a solid 370 | unbroken tape space. 371 | 372 | One fundamental operation on a tape is `move`, which moves the focus on a tape 373 | to the left or right by an `Int` offset. If we ever reach the end of the list, 374 | it's `Nothing`. 375 | 376 | ```haskell 377 | -- | `move n` is O(n) 378 | move :: Int -> Tape Int -> Maybe (Tape Int) 379 | move n (Tape ls x rs) = case compare n 0 of 380 | LT -> case ls of 381 | [] -> Nothing 382 | l:ls' -> move (n + 1) (Tape ls' l (x:rs)) 383 | EQ -> Just (Tape ls x rs) 384 | GT -> case rs of 385 | [] -> Nothing 386 | r:rs' -> move (n - 1) (Tape (x:ls) r rs') 387 | ``` 388 | 389 | Now we just need to simulate the machine in the puzzle: 390 | 391 | ```haskell 392 | step 393 | :: (Int -> Int) -- ^ cell update function 394 | -> Tape Int 395 | -> Maybe (Tape Int) 396 | step f (Tape ls x rs) = move x (Tape ls (f x) rs) 397 | ``` 398 | 399 | At every step, move based on the item at the list focus, and update that item 400 | accordingly. 401 | 402 | We can write a quick utility function to continually apply a `a -> Maybe a` 403 | until we hit a `Nothing`: 404 | 405 | ```haskell 406 | iterateMaybe :: (a -> Maybe a) -> a -> [a] 407 | iterateMaybe f x0 = x0 : unfoldr (fmap dup . f) x0 408 | where 409 | dup x = (x,x) 410 | ``` 411 | 412 | And now we have our solutions. Part 1 and Part 2 are pretty much the same, 413 | except for different updating functions. 414 | 415 | ```haskell 416 | day05a :: Tape Int -> Int 417 | day05a = length . iterateMaybe (step update) 418 | where 419 | update x = x + 1 420 | 421 | day05b :: Tape Int -> Int 422 | day05b = length . iterateMaybe (step update) 423 | where 424 | update x 425 | | x >= 3 = x - 1 426 | | otherwise = x + 1 427 | ``` 428 | 429 | Note that we do have to parse our `Tape` from an input string. We can do this 430 | using something like: 431 | 432 | ```haskell 433 | parse :: String -> Tape Int 434 | parse (map read.lines->x:xs) = Tape [] x xs 435 | parse _ = error "Expected at least one line" 436 | ``` 437 | 438 | Parsing the words in the line, and setting up a `Tape` focused on the far left 439 | item. 440 | 441 | ### Day 5 Benchmarks 442 | 443 | ``` 444 | >> Day 05a 445 | benchmarking... 446 | time 514.3 ms (417.9 ms .. 608.1 ms) 447 | 0.995 R² (0.983 R² .. 1.000 R²) 448 | mean 479.1 ms (451.4 ms .. 496.5 ms) 449 | std dev 26.27 ms (0.0 s .. 30.17 ms) 450 | variance introduced by outliers: 19% (moderately inflated) 451 | 452 | >> Day 05b 453 | benchmarking... 454 | time 1.196 s (1.164 s .. 1.265 s) 455 | 1.000 R² (0.999 R² .. 1.000 R²) 456 | mean 1.211 s (1.197 s .. 1.221 s) 457 | std dev 15.45 ms (0.0 s .. 17.62 ms) 458 | variance introduced by outliers: 19% (moderately inflated) 459 | ``` 460 | 461 | Day 6 462 | ----- 463 | 464 | *([code][d6c])* 465 | 466 | [d6c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day06.hs 467 | 468 | Day 6 is yet another simulation of a virtual machine. There might be an 469 | analytic way to do things, but input size is small enough that you can just 470 | directly simulate the machine in a reasonable time. 471 | 472 | ### Step 473 | 474 | At the most basic level, we need to write a function to advance the simulation 475 | one step in time: 476 | 477 | ```haskell 478 | step :: V.Vector Int -> V.Vector Int 479 | step v = V.accum (+) v' ((,1) <$> indices) 480 | where 481 | maxIx = V.maxIndex v 482 | numBlocks = v V.! maxIx 483 | v' = v V.// [(maxIx, 0)] 484 | indices = (`mod` V.length v) <$> [maxIx + 1 .. maxIx + numBlocks] 485 | ``` 486 | 487 | `V.accum (+) v' ((,1) <$> indices)` will increment all indices in `indices` in 488 | the vector by 1 -- potentially more than once times if it shows up in `indices` 489 | multiple times. For example, if `indices` is `[4,7,1,2,4]` will increment the 490 | numbers at indices 4, 7, 1, 2, and 4 again (so the number at position 4 will be 491 | incremented twice). 492 | 493 | All that's left is generating `indices`. We know we need an entry for every 494 | place we want to "drop a block". We get the starting index using `V.maxIndex`, 495 | and so get the number of blocks to drop using `v V.! maxIx`. Our list of 496 | indices is just `[maxIx + 1 .. maxIx + numBlocks]`, but all `mod`'d by by the 497 | size of `v` so we cycle through the indices. 498 | 499 | We must remember to re-set the starting position's value to `0` before we 500 | start. 501 | 502 | Thanks to [glguy][] for the idea to use `accum`! 503 | 504 | [glguy]: https://twitter.com/glguy 505 | 506 | ### Loop 507 | 508 | We can now just `iterate step :: [V.Vector Int]`, which just contains an 509 | infinite list of steps. We want to now find the loops. 510 | 511 | To do this, we can scan across `iterate step`. We keep track of a `m :: Map a 512 | Int`, which stores all of the previously seen states (as keys), along with *how 513 | long ago* they were seen. We also keep track of the number of steps we have 514 | taken so far (`n`) 515 | 516 | ```haskell 517 | findLoop :: Ord a => [a] -> (Int, Int) 518 | findLoop = go 0 M.empty 519 | where 520 | go _ _ [] = error "We expect an infinite list" 521 | go n m (x:xs) = case M.lookup x m of 522 | Just l -> (n, l) 523 | Nothing -> go (n + 1) (M.insert x 1 m') xs 524 | where 525 | m' = succ <$> m 526 | ``` 527 | 528 | At every step, if the `Map` *does* include the previously seen state as a key, 529 | then we're done. We return the associated value (how long ago it was seen) and 530 | the number of steps we have taken so far. 531 | 532 | Otherwise, insert the new state into the `Map`, update all of the old 533 | "last-time-seen" values (by fmapping `succ`), and move on. 534 | 535 | ### All Together 536 | 537 | We have our whole challenge: 538 | 539 | ```haskell 540 | day06 :: V.Vector Int -> (Int, Int) 541 | day06 = findLoop . iterate step 542 | ``` 543 | 544 | Part 1 is the `fst` of that, and Part 2 is the `snd` of that. 545 | 546 | We can parse the input using `V.fromList . map read . words :: String -> 547 | V.Vector Int`. 548 | 549 | ### Day 6 Benchmarks 550 | 551 | ``` 552 | >> Day 06a 553 | benchmarking... 554 | time 681.9 ms (658.3 ms .. 693.4 ms) 555 | 1.000 R² (1.000 R² .. 1.000 R²) 556 | mean 669.9 ms (665.6 ms .. 672.8 ms) 557 | std dev 4.220 ms (0.0 s .. 4.869 ms) 558 | variance introduced by outliers: 19% (moderately inflated) 559 | 560 | >> Day 06b 561 | benchmarking... 562 | time 688.7 ms (504.2 ms .. 881.2 ms) 563 | 0.990 R² (0.964 R² .. 1.000 R²) 564 | mean 710.2 ms (687.9 ms .. 731.7 ms) 565 | std dev 36.52 ms (0.0 s .. 37.19 ms) 566 | variance introduced by outliers: 19% (moderately inflated) 567 | ``` 568 | 569 | Day 7 570 | ----- 571 | 572 | *([code][d7c])* 573 | 574 | [d7c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day07.hs 575 | 576 | We can just build the tree in Haskell. We have basically a simple rose tree of 577 | `Int`s, so we can use `Tree Int` from `Data.Tree` (from the *containers* 578 | package). 579 | 580 | ### Part 1 581 | 582 | Our input is essentially `M.Map String (Int, S.Set String)`, a map of string 583 | labels to their weights and the labels of their leaves. 584 | 585 | ```haskell 586 | -- | Returns the root label and the tree 587 | buildTree 588 | :: M.Map String (Int, S.Set String) 589 | -> (String, Tree Int) 590 | buildTree m = (root, result) 591 | where 592 | allChildren :: S.Set String 593 | allChildren = S.unions (snd <$> toList m) 594 | root :: String 595 | root = S.findMax $ M.keysSet m `S.difference` allChildren 596 | 597 | result :: Tree Int 598 | result = flip unfoldTree root $ \p -> 599 | let (w, cs) = m M.! p 600 | in (w, toList cs) 601 | 602 | ``` 603 | 604 | Building a tree is pretty simple with `unfoldTree :: (a -> [b] -> (a,[b])) -> b 605 | -> Tree a`. Given an initial seed value, and a way to give a "result" (node 606 | content) and all new seeds, it can unfold out a tree for us. The initial seed 607 | is the root node, and the unfolding process looks up the weights and all of the 608 | children of the given label. 609 | 610 | The only complication now is finding the "root" of the entire tree. This is 611 | simply the only symbol that is not in the union of all children sets. 612 | 613 | We technically don't need the strings in the tree, but we do need it for Part 614 | 1, so we can return it as a second input using a tuple. 615 | 616 | ```haskell 617 | day07a :: M.Map String (Int, S.Set String) -> String 618 | day07a = fst . buildTree 619 | ``` 620 | 621 | One nice thing about using a tree is that we can actually visualize it using 622 | `drawTree :: Tree String -> String` from *containers*! It's kind of big though 623 | so it's difficult to inspect for our actual input, but it's nice for being able 624 | to check the sample input. 625 | 626 | ### Part 2 627 | 628 | Time to find the bad node. 629 | 630 | ```haskell 631 | findBad :: Tree Int -> Maybe Int 632 | findBad t0 = listToMaybe badChildren <|> anomaly 633 | where 634 | badChildren :: [Int] 635 | badChildren = mapMaybe findBad $ subForest t0 636 | weightMap :: M.Map Int [Int] 637 | weightMap = M.fromListWith (++) 638 | . map (\t -> (sum t, [rootLabel t])) 639 | $ subForest t0 640 | anomaly :: Maybe Int 641 | anomaly = case sortOn (length . snd) (M.toList weightMap) of 642 | -- end of the line 643 | [] -> Nothing 644 | -- all weights match 645 | [_] -> Nothing 646 | -- exactly one anomaly 647 | [(wTot1, [w]),(wTot2,_)] -> Just (w + (wTot2 - wTot1)) 648 | -- should not happen 649 | _ -> error "More than one anomaly for node" 650 | ``` 651 | 652 | At the heart of it all, we check if *any of the children* are bad, before 653 | checking if the current node itself is bad. This is because any anomaly on the 654 | level of our current node is not fixable if there are any errors in children 655 | nodes. 656 | 657 | To isolate bad nodes, I built a `Map Int [Int]`, which is a map of unique 658 | "total weight" to a list of all of the immediate child weights that have that 659 | total weight. We can build a total weight by just using `sum :: Tree Int -> 660 | Int`, which adds up all of the weights of all of the child nodes. 661 | 662 | If this map is empty, it means that there are no children. `Nothing`, no 663 | anomaly. 664 | 665 | If this map has one item, it means that there is only one unique total weight 666 | amongst all of the child nodes. `Nothing`, no anomaly. 667 | 668 | If the map has two items, it means that there are two distinct total weights, 669 | and one of those should have exactly *one* corresponding child node. (We can 670 | sort the list to ensure that that anomaly node is the first one in the list) 671 | 672 | From here we can compute what that anomaly node's weight (`w1`) should *really* 673 | be, and return `Just` that. 674 | 675 | Any other cases don't make sense (more than two distinct total weights, or a 676 | situation where there isn't exactly one odd node) 677 | 678 | ```haskell 679 | day07b :: M.Map String (Int, S.Set String) -> Int 680 | day07b = fromJust . findBad . snd . buildTree 681 | ``` 682 | 683 | ### Parsing 684 | 685 | Parsing is straightforward but not trivial. 686 | 687 | ```haskell 688 | parseLine :: String -> (String, (Int, S.Set String)) 689 | parseLine (words->p:w:ws) = 690 | (p, (read w, S.fromList (filter isAlpha <$> drop 1 ws))) 691 | parseLine _ = error "No parse" 692 | 693 | parse :: String -> M.Map String (Int, S.Set String) 694 | parse = M.fromList . map parseLine . lines 695 | ``` 696 | 697 | ### Day 7 Benchmarks 698 | 699 | ``` 700 | >> Day 07a 701 | benchmarking... 702 | time 8.411 ms (7.956 ms .. 8.961 ms) 703 | 0.973 R² (0.954 R² .. 0.989 R²) 704 | mean 8.129 ms (7.939 ms .. 8.447 ms) 705 | std dev 736.6 μs (501.9 μs .. 1.058 ms) 706 | variance introduced by outliers: 50% (moderately inflated) 707 | 708 | >> Day 07b 709 | benchmarking... 710 | time 12.30 ms (11.36 ms .. 14.21 ms) 711 | 0.909 R² (0.815 R² .. 0.993 R²) 712 | mean 12.06 ms (11.55 ms .. 13.00 ms) 713 | std dev 1.799 ms (935.1 μs .. 2.877 ms) 714 | variance introduced by outliers: 69% (severely inflated) 715 | ``` 716 | 717 | Day 8 718 | ----- 719 | 720 | *([code][d8c])* 721 | 722 | [d8c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day08.hs 723 | 724 | Happy to see that Day 8, like day 7, is another problem that is very suitable 725 | for Haskell! :) 726 | 727 | I decided to make an ADT to encode each instruction 728 | 729 | ```haskell 730 | data Instr = Instr { _iRegister :: String 731 | , _iUpdate :: Int 732 | , _iCondReg :: String 733 | , _iPredicate :: Int -> Bool 734 | } 735 | ``` 736 | 737 | It includes a register to update, an update amount, a register to check for a 738 | condition, and a predicate to apply to see whether or not to apply an update. 739 | 740 | So something like 741 | 742 | ``` 743 | b inc 5 if a > 1 744 | ``` 745 | 746 | would be parsed as 747 | 748 | ```haskell 749 | Instr { _iRegister = "b" 750 | , _iUpdate = 5 751 | , _iCondReg = "a" 752 | , _iPredicate = (> 1) 753 | } 754 | ``` 755 | 756 | From this, our updating function `step` is basically following the logic of the 757 | puzzle's update process: 758 | 759 | ```haskell 760 | step :: M.Map String Int -> Instr -> M.Map String Int 761 | step m (Instr r u c p) 762 | | p (M.findWithDefault 0 c m) = M.insertWith (+) r u m 763 | | otherwise = m 764 | ``` 765 | 766 | ### Part 1 767 | 768 | So this makes Part 1 basically a simple `foldl`, to produce the final `Map` of 769 | all the registers. Then we use `maximum :: Ord v => Map k v -> v` to get the 770 | maximum register value. 771 | 772 | ```haskell 773 | day08a :: [Instr] -> Int 774 | day08a = maximum . foldl' step M.empty 775 | ``` 776 | 777 | Note that this might potentially give the wrong answer if all register values 778 | in the `Map` are negative. Then `maximum` of our `Map` would be negative, but 779 | there are still registers that exist with `0` that aren't in our `Map`. 780 | 781 | ### Part 2 782 | 783 | Part 2 is basically a simple `scanl`. 784 | 785 | ```haskell 786 | day08b :: [Instr] -> Int 787 | day08b = maximum . foldMap toList . scanl' step M.empty 788 | ``` 789 | 790 | `foldl` gave us the *final* `Map`, but `scanl` gives us *all the intermediate* 791 | `Map`s that were formed along the way. 792 | 793 | We want the maximum value that was ever seen, so we use `foldMap toList :: [Map 794 | k v] -> [v]` to get a list of all values ever seen, and `maximum` that list. 795 | There are definitely more efficient ways to do this! The same caveat 796 | (situation where all registers are always negative) applies here. 797 | 798 | By the way, isn't it neat that switching between Part 1 and Part 2 is just 799 | switching between `foldl` and `scanl`? (Observation thanks to [cocreature][]) 800 | Higher order functions and purity are the best! 801 | 802 | [cocreature]: https://twitter.com/cocreature 803 | 804 | ### Parsing 805 | 806 | Again, parsing an `Instr` is straightforward but non-trivial. 807 | 808 | ```haskell 809 | parseLine :: String -> Instr 810 | parseLine (words->r:f:u:_:c:o:x:_) = 811 | Instr { _iRegister = r 812 | , _iUpdate = f' (read u) 813 | , _iCondReg = c 814 | , _iPredicate = (`op` read x) 815 | } 816 | where 817 | f' = case f of 818 | "dec" -> negate 819 | _ -> id 820 | op = case o of 821 | ">" -> (>) 822 | ">=" -> (>=) 823 | "<" -> (<) 824 | "<=" -> (<=) 825 | "==" -> (==) 826 | "!=" -> (/=) 827 | _ -> error "Invalid op" 828 | parseLine _ = error "No parse" 829 | ``` 830 | 831 | Care has to be taken to ensure that `dec 5`, for instance, is parsed as an 832 | update of `-5`. 833 | 834 | It is interesting to note that -- as a consequence of laziness -- `read u` and 835 | `f'` might never be evaluated, and `u` and `f` might never be parsed. This is 836 | because if the condition is found to be negative for a line, the `_iUpdate` 837 | field is never used, so we can throw away `u` and `f` without ever evaluating 838 | them! 839 | 840 | ### Day 8 Benchmarks 841 | 842 | ``` 843 | >> Day 08a 844 | benchmarking... 845 | time 8.545 ms (8.085 ms .. 9.007 ms) 846 | 0.984 R² (0.975 R² .. 0.994 R²) 847 | mean 8.609 ms (8.365 ms .. 9.328 ms) 848 | std dev 1.068 ms (432.2 μs .. 2.039 ms) 849 | variance introduced by outliers: 67% (severely inflated) 850 | 851 | >> Day 08b 852 | benchmarking... 853 | time 9.764 ms (9.185 ms .. 10.44 ms) 854 | 0.975 R² (0.955 R² .. 0.993 R²) 855 | mean 9.496 ms (9.233 ms .. 9.816 ms) 856 | std dev 846.1 μs (567.6 μs .. 1.200 ms) 857 | variance introduced by outliers: 50% (moderately inflated) 858 | ``` 859 | 860 | Day 9 861 | ----- 862 | 863 | *([code][d9c])* 864 | 865 | [d9c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day09.hs 866 | 867 | Today I actually decided to [live stream][d9s] my leader board attempt! 868 | Admittedly I was in a new and noisy environment, so adding live streaming to 869 | that only made my attempt a bit more complicated :) 870 | 871 | [d9s]: https://www.twitch.tv/videos/207969022 872 | 873 | Anyway, our solution today involves the AST `Tree`: 874 | 875 | ```haskell 876 | data Tree = Garbage String 877 | | Group [Tree] 878 | ``` 879 | 880 | Getting the score is a simple recursive traversal: 881 | 882 | ```haskell 883 | treeScore :: Tree -> Int 884 | treeScore = go 1 885 | where 886 | go _ (Garbage _ ) = 0 887 | go n (Group ts) = n + sum (go (n + 1) <$> ts) 888 | 889 | ``` 890 | 891 | Getting the total amount of garbage is, as well: 892 | 893 | ```haskell 894 | treeGarbage :: Tree -> Int 895 | treeGarbage (Garbage n ) = length n 896 | treeGarbage (Group ts) = sum (treeGarbage <$> ts) 897 | ``` 898 | 899 | And so that's essentially our entire solution: 900 | 901 | ```haskell 902 | day09a :: Tree -> Int 903 | day09a = treeScore 904 | 905 | day09b :: Tree -> Int 906 | day09b = treeGarbage 907 | ``` 908 | 909 | ### Parsing 910 | 911 | Parsing was simpler than I originally thought it would be. We can use the 912 | *megaparsec* library's parser combinators: 913 | 914 | ```haskell 915 | parseTree :: Parser Tree 916 | parseTree = P.choice [ Group <$> parseGroup 917 | , Garbage <$> parseGarbage 918 | ] 919 | where 920 | parseGroup :: Parser [Tree] 921 | parseGroup = P.between (P.char '{') (P.char '}') $ 922 | parseTree `P.sepBy` P.char ',' 923 | parseGarbage :: Parser String 924 | parseGarbage = P.between (P.char '<') (P.char '>') $ 925 | catMaybes <$> many garbageChar 926 | where 927 | garbageChar :: Parser (Maybe Char) 928 | garbageChar = P.choice 929 | [ Nothing <$ (P.char '!' *> P.anyChar) 930 | , Just <$> P.noneOf ">" 931 | ] 932 | ``` 933 | 934 | Our final `Tree` is either a `Group` (parsed with `parseGroup`) or `Garbage` 935 | (parsed with `parseGarbage`). 936 | 937 | * `parseGroup` parses `Tree`s separated by `,`, between curly brackets. 938 | * `parseGarbage` parses many consecutive valid garbage tokens (Which may or 939 | may not contain a valid garbage character, `Maybe Char`), between angled 940 | brackets. It `catMaybe`s the contents of all of the tokens to get all 941 | actual garbage characters. 942 | 943 | Thanks to [rafl][] for the idea of using `many` and `between` for 944 | `parseGarbage` instead of my original explicitly recursive solution! 945 | 946 | [rafl]: https://github.com/rafl 947 | 948 | And so we have: 949 | 950 | ```haskell 951 | parse :: String -> Tree 952 | parse = either (error . show) id . P.runParser parseTree "" 953 | ``` 954 | 955 | We do need to handle the case where the parser doesn't succeed, since 956 | `runParser` returns an `Either`. 957 | 958 | ### Day 9 Benchmarks 959 | 960 | ``` 961 | >> Day 09a 962 | benchmarking... 963 | time 2.508 ms (2.366 ms .. 2.687 ms) 964 | 0.957 R² (0.910 R² .. 0.990 R²) 965 | mean 2.589 ms (2.477 ms .. 3.009 ms) 966 | std dev 628.2 μs (223.5 μs .. 1.246 ms) 967 | variance introduced by outliers: 94% (severely inflated) 968 | 969 | >> Day 09b 970 | benchmarking... 971 | time 3.354 ms (3.108 ms .. 3.684 ms) 972 | 0.952 R² (0.919 R² .. 0.992 R²) 973 | mean 3.196 ms (3.086 ms .. 3.383 ms) 974 | std dev 411.1 μs (232.5 μs .. 595.1 μs) 975 | variance introduced by outliers: 76% (severely inflated) 976 | ``` 977 | 978 | Day 10 979 | ------ 980 | 981 | *([code][d10c])* *([stream][d10s])* 982 | 983 | [d10c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day10.hs 984 | [d10s]: https://www.twitch.tv/videos/208287550 985 | 986 | I feel like I actually had a shot today, if it weren't for a couple of silly 987 | mistakes! :( First I forgot to add a number, then I had a stray newline in my 988 | input for some reason. For Day 9, I struggled to get an idea of what's going 989 | on, but once I had a clear plan, the rest was easy. For Day 10, the clear idea 990 | was fast, but the many minor lapses along the way were what probably delayed me 991 | the most :) 992 | 993 | Our solution today revolves around this state type: 994 | 995 | ```haskell 996 | data HashState = HS { _hsVec :: V.Vector Int 997 | , _hsPos :: Word8 998 | , _hsSkip :: Word8 999 | } 1000 | ``` 1001 | 1002 | Interesting note -- this `Vector, Int` pairing is actually something that has 1003 | come up *a lot* over the previous Advent of Code puzzles. It's basically a 1004 | vector attached with some "index" (or "focus"). It's actually a manifestation 1005 | of the [*Store* Comonad][store]. Something like this really would have made a 1006 | lot of the previous puzzles really simple, or at least would have been very 1007 | suitable for their implementations. 1008 | 1009 | [store]: http://hackage.haskell.org/package/comonad-5.0.2/docs/Control-Comonad-Store.html 1010 | 1011 | ### Part 1 1012 | 1013 | Anyway, most of the algorithm boils down to a `foldl` with this state on some 1014 | list of inputs: 1015 | 1016 | ```haskell 1017 | step :: HashState -> Word8 -> HashState 1018 | step (HS v0 p0 s0) n = HS v1 p1 s1 1019 | where 1020 | ixes = fromIntegral . (+ p0) <$> init [0 .. n] 1021 | vals = (v0 V.!) <$> ixes 1022 | v1 = v0 V.// zip ixes (reverse vals) 1023 | p1 = p0 + n + s0 1024 | s1 = s0 + 1 1025 | ``` 1026 | 1027 | Our updating function is somewhat of a direct translation of the requirements. 1028 | All of the indices to update are enumerated using `[0 .. n]`. But, we only 1029 | want the first `n` items (we don't want to actually include `n`, just `n - 1`), 1030 | so we can take the `init` of it. We shift their positions by `+ p0`. 1031 | 1032 | The "trick" to the cyclic vector is that `Word8` addition is modular 1033 | arithmetic, so this will actually cause overflows to wrap around like we 1034 | require. For example, `(+ 253) <$> [0..5]` is `[253,254,255,0,1,2]` 1035 | 1036 | We also need the *values* at each of the indices, so we map `(v0 V.!)` over our 1037 | list of indices. 1038 | 1039 | Finally, we use `(//) :: Vector a -> [(Int, a)] -> Vector a` to 1040 | update all of the items necessary. `//` replaces all of the indices in the 1041 | list with the values they are paired up with. For us, we want to put the items 1042 | back in the list in reverse order, so we zip `ixes` and `reverse vals`, so that 1043 | the indices at `ixes` are set to be the values `reverse vals`. 1044 | 1045 | Our new position is `p0 + n + s0` -- the current position plus the length plus 1046 | the skip count. Again, because of `Word8` arithmetic, this wraps around at 1047 | `255`, so it has the behavior we want. 1048 | 1049 | Now we can iterate this using `foldl'` 1050 | 1051 | ```haskell 1052 | process :: [Word8] -> V.Vector Int 1053 | process = _hsVec . foldl' step hs0 1054 | where 1055 | hs0 = HS (V.generate 256 id) 0 0 1056 | ``` 1057 | 1058 | From here, we can write our Part 1: 1059 | 1060 | ```haskell 1061 | day10a :: [Int] -> Int 1062 | day10a = product . V.take 2 . process 1063 | ``` 1064 | 1065 | We can parse our input using `map read . splitOn "," :: String -> [Int]`, 1066 | `splitOn` from the *[split][]* library. 1067 | 1068 | [split]: http://hackage.haskell.org/package/split 1069 | 1070 | ### Part 2 1071 | 1072 | Part 2 is pretty straightforward in that the *logic* is extremely simple, just 1073 | do a series of transformations. 1074 | 1075 | First we can make the "knot hash" itself: 1076 | 1077 | ```haskell 1078 | knothash :: String -> [Word8] 1079 | knothash = map (foldr xor 0) . chunksOf 16 . V.toList . process 1080 | . concat . replicate 64 . (++ salt) 1081 | . map (fromIntegral . ord) 1082 | where 1083 | salt = [17, 31, 73, 47, 23] 1084 | ``` 1085 | 1086 | We: 1087 | 1088 | 1. Append the salt bytes at the end 1089 | 2. `concat . replicate 64 :: [a] -> [a]`, replicate the list of inputs 64 times 1090 | 3. `process` things like how we did in Part 1 1091 | 4. Break into chunks of 16 (using `chunksOf` from the *[split][]* library) 1092 | 5. `foldr` each chunk of 16 using `xor` 1093 | 1094 | And our actual `day10b` is then just applying this and printing this as hex: 1095 | 1096 | ```haskell 1097 | day10b :: [Word8] -> String 1098 | day10b = concatMap (printf "%02x") . knothash 1099 | ``` 1100 | 1101 | We leverage the `printf` formatter from `Text.Printf` to generate the hex, 1102 | being careful to ensure we pad the result. 1103 | 1104 | Not super complicated, it's just that there are so many steps 1105 | described in the puzzle! 1106 | 1107 | ### Day 10 Benchmarks 1108 | 1109 | *Note:* Benchmarks measured with *storable* vectors. 1110 | 1111 | ``` 1112 | >> Day 10a 1113 | benchmarking... 1114 | time 254.6 μs (242.1 μs .. 268.9 μs) 1115 | 0.925 R² (0.851 R² .. 0.976 R²) 1116 | mean 348.8 μs (289.1 μs .. 467.6 μs) 1117 | std dev 265.2 μs (147.4 μs .. 414.0 μs) 1118 | variance introduced by outliers: 99% (severely inflated) 1119 | 1120 | >> Day 10b 1121 | benchmarking... 1122 | time 25.00 ms (21.24 ms .. 27.61 ms) 1123 | 0.936 R² (0.822 R² .. 0.992 R²) 1124 | mean 26.21 ms (24.47 ms .. 33.03 ms) 1125 | std dev 6.425 ms (1.676 ms .. 13.03 ms) 1126 | variance introduced by outliers: 83% (severely inflated) 1127 | ``` 1128 | 1129 | Day 11 1130 | ------ 1131 | 1132 | *([code][d11c])* 1133 | 1134 | [d11c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day11.hs 1135 | 1136 | Nothing too interesting here! Just a straightforward application of the great 1137 | *[grid][]* library. 1138 | 1139 | [grid]: https://hackage.haskell.org/package/grid 1140 | 1141 | 1142 | We barely need to wrap its `neighbor` function (which lets us move in a given 1143 | direction) for our usage: 1144 | 1145 | ```haskell 1146 | step :: (Int, Int) -> HexDirection -> (Int, Int) 1147 | step p = fromJust . neighbour UnboundedHexGrid p 1148 | 1149 | day11a :: [HexDireciton] -> Int 1150 | day11a = distance UnboundedHexGrid (0,0) . foldl' step (0,0) 1151 | ``` 1152 | 1153 | It's just a `foldl` of `neighbor`, and then finding the distance at the final 1154 | point. 1155 | 1156 | And, like day 8's solution, all we need for Part 2 is to switch `foldl'` to 1157 | `scanl`: 1158 | 1159 | ```haskell 1160 | day11a :: [HexDireciton] -> Int 1161 | day11b = maximum . map (distance UnboundedHexGrid (0,0)) . scanl step (0,0) 1162 | ``` 1163 | 1164 | `foldl` gives us the final position, but `scanl` gives us the intermediate 1165 | ones. We just map our distance function onto all of the intermediate positions 1166 | to get a list of intermediate distances, and take the maximum of those. 1167 | 1168 | The most time consuming part was probably writing the parsing function: 1169 | 1170 | ```haskell 1171 | parse :: String -> [HexDirection] 1172 | parse = map (parseDir . filter isAlpha) . splitOn "," 1173 | where 1174 | parseDir = \case 1175 | "nw" -> Northwest 1176 | "n" -> North 1177 | "ne" -> Northeast 1178 | "se" -> Southeast 1179 | "s" -> South 1180 | "sw" -> Southwest 1181 | d -> error $ "Bad direction " ++ d 1182 | ``` 1183 | 1184 | 1185 | Much thanks to [Amy de Buitléir][mhwombat] for the library, which does most of 1186 | the heavy lifting :) 1187 | 1188 | [mhwombat]: https://github.com/mhwombat 1189 | 1190 | ### Day 11 Benchmarks 1191 | 1192 | ``` 1193 | >> Day 11a 1194 | benchmarking... 1195 | time 6.331 ms (5.971 ms .. 6.778 ms) 1196 | 0.960 R² (0.917 R² .. 0.992 R²) 1197 | mean 6.974 ms (6.444 ms .. 8.575 ms) 1198 | std dev 2.855 ms (528.3 μs .. 5.360 ms) 1199 | variance introduced by outliers: 97% (severely inflated) 1200 | 1201 | >> Day 11b 1202 | benchmarking... 1203 | time 7.267 ms (7.017 ms .. 7.503 ms) 1204 | 0.988 R² (0.976 R² .. 0.995 R²) 1205 | mean 7.337 ms (7.172 ms .. 7.586 ms) 1206 | std dev 563.7 μs (392.0 μs .. 794.2 μs) 1207 | variance introduced by outliers: 44% (moderately inflated) 1208 | ``` 1209 | 1210 | Day 12 1211 | ------ 1212 | 1213 | *([code][d12c])* 1214 | 1215 | [d12c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day12.hs 1216 | 1217 | For Day 12, I made a monoid that is collection of disjoint sets, which we use 1218 | to model the set of distinct "groups" in our puzzle. The sets represent things 1219 | that are all interconnected. 1220 | 1221 | ```haskell 1222 | newtype Disjoints = D { getD :: S.Set IS.IntSet } 1223 | instance Monoid Disjoints where 1224 | mempty = D S.empty 1225 | mappend xs ys = foldl' go ys (getD xs) 1226 | where 1227 | go (D zs) z = D (newGroup `S.insert` disjoints) 1228 | where 1229 | overlaps = S.filter (not . IS.null . (`IS.intersection` z)) zs 1230 | disjoints = zs `S.difference` overlaps 1231 | newGroup = IS.unions $ z : S.toList overlaps 1232 | ``` 1233 | 1234 | The mappend action is union, but preserving disjoint connection property. If 1235 | we assume that all items in a set are connected, then the merger of two 1236 | collections of disjoint groups will be a new collection of disjoint groups, 1237 | merging together any of the original sets if it is found out that their items 1238 | have any connections. 1239 | 1240 | For example, merging `DG [[3,5],[8,9],[10,11]]` with `DG [[5,6,8]]` will give 1241 | `DG [[3,5,6,8,9], [10,11]]`. 1242 | 1243 | Now our entire thing is just a `foldMap`. If we treat each of the original 1244 | lines as `IS.IntSet`, a set of connected things: 1245 | 1246 | 1247 | ```haskell 1248 | build :: [IS.IntSet] -> Disjoints 1249 | build = foldMap (D . S.singleton) 1250 | ``` 1251 | 1252 | where `D . S.singleton :: IS.IntSet -> Disjoints`, the "single group" 1253 | `Disjoints`. 1254 | 1255 | From here, querying for the size of the group containing `0`, and the number of 1256 | groups total, is pretty simple: 1257 | 1258 | 1259 | ```haskell 1260 | day12a :: [IS.IntSet] -> Int 1261 | day12a = IS.size . fromJust 1262 | . find (0 `IS.member`) 1263 | . getD . build 1264 | 1265 | day12b :: [IS.IntSet] -> Int 1266 | day12b = S.size . getD . build 1267 | ``` 1268 | 1269 | Part 2 is even simpler than Part 1! 1270 | 1271 | Parsing is again straightforward: 1272 | 1273 | ```haskell 1274 | parseLine :: String -> IS.IntSet 1275 | parseLine (words->n:_:ns) = IS.fromList $ read n 1276 | : map (read . filter isDigit) ns 1277 | parseLine _ = error "No parse" 1278 | 1279 | parse :: String -> [IS.IntSet] 1280 | parse = map parseLine . lines 1281 | ``` 1282 | 1283 | ### Day 12 Benchmarks 1284 | 1285 | ``` 1286 | >> Day 12a 1287 | benchmarking... 1288 | time 53.76 ms (44.69 ms .. 59.42 ms) 1289 | 0.961 R² (0.859 R² .. 0.999 R²) 1290 | mean 58.32 ms (54.25 ms .. 73.01 ms) 1291 | std dev 12.51 ms (1.563 ms .. 21.58 ms) 1292 | variance introduced by outliers: 73% (severely inflated) 1293 | 1294 | >> Day 12b 1295 | benchmarking... 1296 | time 51.23 ms (44.52 ms .. 55.72 ms) 1297 | 0.973 R² (0.925 R² .. 0.998 R²) 1298 | mean 59.26 ms (54.50 ms .. 76.39 ms) 1299 | std dev 15.13 ms (3.328 ms .. 26.23 ms) 1300 | variance introduced by outliers: 82% (severely inflated) 1301 | ``` 1302 | 1303 | Day 13 1304 | ------ 1305 | 1306 | *([code][d13c])* 1307 | 1308 | [d13c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day13.hs 1309 | 1310 | Day 13 is a puzzle that reveals itself nicely after putting in a moment to 1311 | think of some analytic solutions. 1312 | 1313 | The motion of the scanners follows a [Triangle Wave][]. I picked up the 1314 | equation on the wikipedia page: 1315 | 1316 | [Triangle Wave]: https://en.wikipedia.org/wiki/Triangle_wave 1317 | 1318 | ```haskell 1319 | triangle range t = abs ((t - range) `mod` (range * 2) - range) 1320 | ``` 1321 | 1322 | This is a triangle wave starting at zero, that goes from `0` to `range`. 1323 | 1324 | It's probably not the cleanest solution, but it works ok as a direct 1325 | translation! We also don't need the `abs`, since we only care about when 1326 | `triangle range t == 0`, but it doesn't hurt to leave it there for clarity. 1327 | 1328 | Now we can write a function to see if you are caught at a given depth and 1329 | range: 1330 | 1331 | ``` 1332 | caughtAt 1333 | :: Int -- delay 1334 | -> (Int, Int) -- depth, range 1335 | -> Bool 1336 | caughtAt delay (d, r) = triangle (r - 1) (d + delay) == 0 1337 | ``` 1338 | 1339 | Our `range` is actually one less than `triangle`'s expected range (we travel 1340 | from `0` to `r-1`). And, `t` is `depth + delay`. That is, if our initial 1341 | delay is 0, then `t = depth` -- it will take us `depth` picoseconds to get to 1342 | that given depth. In general, it will take us `depth + delay` picoseconds to 1343 | get to a given depth -- a contribution from waiting to start, and a 1344 | contribution from the time it will take to actually reach that depth once we 1345 | start. 1346 | 1347 | ### Day 13 Benchmarks 1348 | 1349 | ``` 1350 | >> Day 13a 1351 | benchmarking... 1352 | time 211.9 μs (202.1 μs .. 222.9 μs) 1353 | 0.976 R² (0.959 R² .. 0.992 R²) 1354 | mean 211.3 μs (204.7 μs .. 222.9 μs) 1355 | std dev 29.80 μs (19.13 μs .. 47.19 μs) 1356 | variance introduced by outliers: 89% (severely inflated) 1357 | 1358 | >> Day 13b 1359 | benchmarking... 1360 | time 192.1 ms (188.2 ms .. 197.3 ms) 1361 | 0.999 R² (0.999 R² .. 1.000 R²) 1362 | mean 197.0 ms (195.0 ms .. 199.7 ms) 1363 | std dev 3.138 ms (1.944 ms .. 4.778 ms) 1364 | variance introduced by outliers: 14% (moderately inflated) 1365 | ``` 1366 | 1367 | Day 14 1368 | ------ 1369 | 1370 | *([code][d14c])* 1371 | 1372 | [d14c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day14.hs 1373 | 1374 | Part 1 is a simple application of the "knot hash" function we wrote: 1375 | different inputs. We can make a row of a grid by running `knothash :: String 1376 | -> [Word8]` on the seed, using `printf` to format things as a binary string, 1377 | and then using `map (== '1')` to convert our binary string into a list of 1378 | `Bool`s. These represent a list of "on" or "off" cells. 1379 | 1380 | ```haskell 1381 | mkRow :: String -> Int -> [Bool] 1382 | mkRow seed n = map (== '1') . concatMap (printf "%08b") . knothash 1383 | $ seed ++ "-" ++ show n 1384 | ``` 1385 | 1386 | Our grid is then just running this function for every row, to get a grid of 1387 | on/off cells: 1388 | 1389 | ```haskell 1390 | mkGrid :: String -> [[Bool]] 1391 | mkGrid seed = map (mkRow seed) [0..127] 1392 | ``` 1393 | 1394 | The actual challenge is then just counting all of the `True`s: 1395 | 1396 | ```haskell 1397 | day14a :: String -> Int 1398 | day14a = length . filter id . concat . mkGrid 1399 | ``` 1400 | 1401 | For Part 2, we can actually re-use the same `Disjoints` monoid that we used for 1402 | Day 12. We'll just add in sets of neighboring lit points, and count how many 1403 | disjoint sets come out at the end. 1404 | 1405 | We're going to leverage `Data.Ix`, to let us enumerate over all cells in a grid 1406 | with `range :: ((Int, Int), (Int, Int)) -> [(Int, Int)]`. `Data.Ix` also gives 1407 | us `index :: (Int, Int) -> Int`, which allows us to "encode" a coordinate as an 1408 | `Int`, so we can use it with the `IntSet` that we wrote earlier. (You could 1409 | just as easily use a `Set (Int, Int)` instead of an `IntSet` under `index`, but 1410 | it's significantly less performant) 1411 | 1412 | ```haskell 1413 | litGroups :: [[Bool]] -> Disjoints 1414 | litGroups grid = foldMap go (range r) 1415 | where 1416 | r = ((0,0),(127,127)) 1417 | isLit (x,y) = grid !! y !! x 1418 | go p | isLit p = D . S.singleton . IS.fromList 1419 | . map (index r) . (p:) . filter isLit 1420 | $ neighbors p 1421 | | otherwise = mempty 1422 | 1423 | neighbors :: (Int, Int) -> [(Int, Int)] 1424 | neighbors (x,y) = [ (x+dx, y+dy) | (dx, dy) <- [(0,1),(0,-1),(1,0),(-1,0)] 1425 | , inBounds (x + dx) && inBounds (y + dy) 1426 | ] 1427 | where 1428 | inBounds z = z >= 0 && z < 128 1429 | ``` 1430 | 1431 | So part 2 is just running `litGroups` and counting the resulting number of 1432 | disjoint groups: 1433 | 1434 | ```haskell 1435 | day14b :: String -> Int 1436 | day14b = S.size . getD . litGroups . mkGrid 1437 | ``` 1438 | 1439 | ### Day 14 Benchmarks 1440 | 1441 | ``` 1442 | >> Day 14a 1443 | benchmarking... 1444 | time 1.085 s (946.8 ms .. 1.171 s) 1445 | 0.998 R² (0.996 R² .. 1.000 R²) 1446 | mean 1.105 s (1.077 s .. 1.119 s) 1447 | std dev 24.32 ms (0.0 s .. 25.04 ms) 1448 | variance introduced by outliers: 19% (moderately inflated) 1449 | 1450 | >> Day 14b 1451 | benchmarking... 1452 | time 1.358 s (1.290 s .. 1.450 s) 1453 | 0.999 R² (0.998 R² .. 1.000 R²) 1454 | mean 1.321 s (1.306 s .. 1.333 s) 1455 | std dev 18.95 ms (0.0 s .. 20.79 ms) 1456 | variance introduced by outliers: 19% (moderately inflated) 1457 | ``` 1458 | 1459 | Day 15 1460 | ------ 1461 | 1462 | *([code][d15c])* 1463 | 1464 | [d15c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day15.hs 1465 | 1466 | This one is a really "easy" one from a Haskell perspective. We can just 1467 | generate the outputs of each stream as an infinite lazily linked list, take the 1468 | number of items we need, and count the pairs that match a specific predicate. 1469 | 1470 | In particular, the predicate we care about is whether or not two items have the 1471 | same final 16 bits. This is the same as checking if two integers have value 1472 | when converted to `Word16`'s (16-bit words). 1473 | 1474 | The generating function, given a "factor" and a "seed", is: 1475 | 1476 | ```haskell 1477 | generate :: Int -> Int -> Int 1478 | generate fac = (`mod` 2147483647) . (* fac) 1479 | ``` 1480 | 1481 | We can then just generate them infinitely (using `iterate` and an initial 1482 | seed), zip the two streams together, take the first 40000000 items, filter for 1483 | the ones where the two items match, and count the length of the resulting list. 1484 | 1485 | ```haskell 1486 | match :: Int -> Int -> Bool 1487 | match = (==) @Word16 `on` fromIntegral 1488 | 1489 | day15a :: Int -> Int -> Int 1490 | day15a seedA seedB = length 1491 | . filter (uncurry match) 1492 | . take 4e7 1493 | $ zip (iterate (generate 16807) seedA) 1494 | (iterate (generate 48271) seedB) 1495 | ``` 1496 | 1497 | Part 2 is pretty much the same thing, except we filter for things that are 1498 | divisible by 4 in the first list, and things that are divisible by 8 in the 1499 | second list. To gain the "asynchronous" behavior that the problem is asking 1500 | for, we have to do this on the lists before they are zipped. That way, all 1501 | `zip` ever sees (and pairs) are the pre-filtered lists. 1502 | 1503 | ```haskell 1504 | divBy :: Int -> Int -> Bool 1505 | x `divBy` b = x `mod` b == 0 1506 | 1507 | day15b :: Int -> Int -> Int 1508 | day15b seedA seedB = length 1509 | . filter (uncurry match) 1510 | . take 5e6 1511 | $ zip (filter (`divBy` 4) . iterate (generate 16807) $ seedA) 1512 | (filter (`divBy` 8) . iterate (generate 48271) $ seedB) 1513 | ``` 1514 | 1515 | All in all a very nice "functional" problem with a functional solution :) 1516 | 1517 | Parsing is basically finding the seeds as the only numeric values on each line: 1518 | 1519 | ``` 1520 | parse :: String -> (Int, Int) 1521 | parse inp = (a, b) 1522 | where 1523 | a:b:_ = read . filter isDigit <$> lines inp 1524 | ``` 1525 | 1526 | ### Day 15 Benchmarks 1527 | 1528 | ``` 1529 | >> Day 15a 1530 | benchmarking... 1531 | time 2.443 s (2.409 s .. 2.506 s) 1532 | 1.000 R² (1.000 R² .. 1.000 R²) 1533 | mean 2.413 s (2.404 s .. 2.422 s) 1534 | std dev 15.09 ms (0.0 s .. 15.61 ms) 1535 | variance introduced by outliers: 19% (moderately inflated) 1536 | 1537 | >> Day 15b 1538 | benchmarking... 1539 | time 952.2 ms (839.4 ms .. 1.054 s) 1540 | 0.998 R² (0.996 R² .. 1.000 R²) 1541 | mean 967.0 ms (944.7 ms .. 984.5 ms) 1542 | std dev 27.27 ms (0.0 s .. 30.41 ms) 1543 | variance introduced by outliers: 19% (moderately inflated) 1544 | ``` 1545 | 1546 | Day 16 1547 | ------ 1548 | 1549 | *([code][d16c])* 1550 | 1551 | [d16c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day16.hs 1552 | 1553 | Day 16 was one of my favorites! It was what prompted this [joyful tweet][group 1554 | theory tweet]: 1555 | 1556 | > Your friends: Group theory is nice but it's it'll never be useful for 1557 | > programming. 1558 | > 1559 | > #adventofcode: "You come upon a very unusual sight; a group of programs here 1560 | > appear to be dancing..." 1561 | 1562 | 1563 | [group theory tweet]: https://twitter.com/mstk/status/942198298672164864 1564 | 1565 | One thing you can notice is that you can basically collect all of the 1566 | swaps/permutations separately, and then all of the renaming separately, and 1567 | then apply them separately. They really exist on different "planes", so to 1568 | speak. 1569 | 1570 | That being said, we can make a data structure that represents a permutation: 1571 | 1572 | ```haskell 1573 | newtype Perm a = P { permMap :: M.Map a a } 1574 | deriving Show 1575 | 1576 | lookupPerm :: Ord a => Perm a -> a -> a 1577 | lookupPerm p k = M.findWithDefault k k (permMap p) 1578 | ``` 1579 | 1580 | Where a `Map` like `M.fromList [(1,3),(3,4),(4,1)]` would turn the list 1581 | `[1,2,3,4,5]` to `[3,2,4,1,5]` ("move `3` to `1`, `4` to `3`, etc."). 1582 | "Following" a permutation is done using `lookupPerm` -- `lookupPerm` for the 1583 | example permutation with `1` would give `3`., on `5` would give `5`, etc. 1584 | 1585 | `Perm` is a Monoid, where `<>` is composing/sequencing permutations, and 1586 | `mempty` is the identity permutation: 1587 | 1588 | ```haskell 1589 | instance Ord a => Semigroup (Perm a) where 1590 | x <> y = P $ (lookupPerm x <$> permMap y) `M.union` permMap x 1591 | instance Ord a => Monoid (Perm a) where 1592 | mappend = (<>) 1593 | mempty = P M.empty 1594 | ``` 1595 | 1596 | A full description of a dance is then just a collection of shufflings and a 1597 | collection of renamings: 1598 | 1599 | ```haskell 1600 | type Dance = (Perm Int, Dual (Perm Char)) 1601 | ``` 1602 | 1603 | We use `Dual (Perm Char)` to describe the renamings because renamings compose 1604 | in the opposite direction of shuffles. `Dual` is a newtype wrapper that gives 1605 | a new `Monoid` instance where `<>` is backwards (`mappend (Dual x) (Dual y) = 1606 | Dual (mappend y x)`) 1607 | 1608 | Because of the `Monoid` instance of tuples, `Dance` is a `Monoid`, where 1609 | composing dances is composing the two permutations. 1610 | 1611 | We can "apply" a Dance: 1612 | 1613 | ```haskell 1614 | runDance :: Dance -> String 1615 | runDance (pI, pN) = lookupPerm (getDual pN) 1616 | . toName 1617 | . lookupPerm pI 1618 | <$> [0..15] 1619 | where 1620 | toName c = chr (c + ord 'a') 1621 | ``` 1622 | 1623 | Which is, for all of the slots in our domain (`[1..15]`), we follow `pI` (the 1624 | shuffles), assign them their proper names (with `toName`), and follow `pN` (the 1625 | renamings). 1626 | 1627 | From here, we can write a function to parse a single dance move: 1628 | 1629 | ```haskell 1630 | parseMove :: String -> Dance 1631 | parseMove = \case 1632 | 's':(read->n) -> (rotator n , mempty ) 1633 | 'x':(map read.splitOn "/"->n:m:_) -> (swapper n m, mempty ) 1634 | 'p':n:_:m:_ -> (mempty , Dual (swapper n m)) 1635 | _ -> error "No parse" 1636 | where 1637 | rotator :: Int -> Perm Int 1638 | rotator n = P $ M.fromList [ (i, (i - n) `mod` 16) | i <- [0..15] ] 1639 | swapper :: Ord a => a -> a -> Perm a 1640 | swapper x y = P $ M.fromList [ (x, y), (y, x) ] 1641 | ``` 1642 | 1643 | And then `foldMap` it on all of the lines: 1644 | 1645 | ```haskell 1646 | parse :: String -> Dance 1647 | parse = foldMap parseMove . splitOn "," 1648 | ``` 1649 | 1650 | `foldMap :: (String -> Dance) -> [String] -> Dance` maps our parsing function 1651 | to create a bunch of `Dance`s, and then folds/composes them all together. 1652 | 1653 | So that's basically just part 1! 1654 | 1655 | ```haskell 1656 | day16a :: String -> String 1657 | day16a = runDance . parse 1658 | ``` 1659 | 1660 | Part 2 we can use `stimes :: Semigroup m => Int -> m -> m`, which does 1661 | *efficient* exponentiation-by-squaring. If we use `stimes 1000000000`, it'll 1662 | compose the same item with itself one billion times by only doing about *30* 1663 | composition operations. This makes Part 2 doable in reasonable time: 1664 | 1665 | ```haskell 1666 | day16b :: String -> String 1667 | day16b = runDance . stimes 1e9 . parse 1668 | ``` 1669 | 1670 | If we naively "ran" the dance over and over again, we'd have to do one billion 1671 | operations. However, using smart exponentiation-by-squaring with `stimes`, we 1672 | do the same thing with only about 30 operations! 1673 | 1674 | ### Day 16 Benchmarks 1675 | 1676 | ``` 1677 | >> Day 16a 1678 | benchmarking... 1679 | time 108.7 ms (103.4 ms .. 113.0 ms) 1680 | 0.993 R² (0.969 R² .. 1.000 R²) 1681 | mean 106.8 ms (104.3 ms .. 111.9 ms) 1682 | std dev 5.427 ms (2.202 ms .. 8.277 ms) 1683 | variance introduced by outliers: 10% (moderately inflated) 1684 | 1685 | >> Day 16b 1686 | benchmarking... 1687 | time 106.4 ms (90.12 ms .. 117.4 ms) 1688 | 0.982 R² (0.961 R² .. 0.999 R²) 1689 | mean 116.3 ms (109.2 ms .. 136.4 ms) 1690 | std dev 17.04 ms (3.190 ms .. 25.59 ms) 1691 | variance introduced by outliers: 48% (moderately inflated) 1692 | ``` 1693 | 1694 | Day 17 1695 | ------ 1696 | 1697 | *([code][d17c])* 1698 | 1699 | [d17c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day17.hs 1700 | 1701 | For Day 17 I used `Tape` again -- for the O(1) insertions. (Even though moving 1702 | around is amortized O(n)). 1703 | 1704 | ```haskell 1705 | data Tape a = Tape { _tLefts :: [a] 1706 | , _tFocus :: a 1707 | , _tRights :: [a] 1708 | } 1709 | deriving Show 1710 | 1711 | unshift :: a -> Tape a -> Tape a 1712 | unshift y (Tape ls x rs) = Tape (x:ls) y rs 1713 | 1714 | moveRight :: Tape a -> Tape a 1715 | moveRight (Tape ls x rs) = case rs of 1716 | [] -> let l :| ls' = NE.reverse (x :| ls) 1717 | in Tape [] l ls' 1718 | r:rs' -> Tape (x:ls) r rs' 1719 | ``` 1720 | 1721 | The only difference between this motion and the previous motion is the periodic 1722 | boundary conditions of tape motion. Before, if we went past the edge of the 1723 | tape, we'd return `Nothing`. Here, however, we want to "cycle" around, so we 1724 | reverse the left-hand list and move our focus to the last item in the list. 1725 | 1726 | With that in mind, we can write our stepping function: 1727 | 1728 | ```haskell 1729 | step :: Int -> Tape a -> a -> Tape a 1730 | step n t0 x = unshift x . moveC n $ t0 1731 | ``` 1732 | 1733 | We expect the number of steps to take, the initial tape, and the item to add. 1734 | This will cycle the tape the given number of steps and then insert the desired 1735 | item. 1736 | 1737 | Part 1 is then just applying this as a `foldl`: 1738 | 1739 | ```haskell 1740 | day17a :: Int -> Int 1741 | day17a n = head . _tRights 1742 | $ foldl' (step n) (Tape [] 0 []) [1 .. 2017] 1743 | ```` 1744 | 1745 | Part 2 can't really be done by iterating this process 50 million times. One 1746 | thing we can leverage is the fact that since 0 is there from the beginning (at 1747 | position 0), we only need to keep track of all the items that are ever inserted 1748 | at position 1: 1749 | 1750 | ```haskell 1751 | day17b :: Int -> Int 1752 | day17b n = last 1753 | . elemIndices @Int 1 1754 | $ scanl jump 0 [1 .. 5e7] 1755 | where 1756 | jump i x = ((i + n) `mod` x) + 1 1757 | ``` 1758 | 1759 | At each step, we "jump" the `n` steps from the current position, being sure to 1760 | `mod` by the current size of the tape. `scanl` then gives us the position of 1761 | the cursor for all points in our process. We then find all of the positions 1762 | where the function jumps to `1` using `elemIndices`, and find the last one. 1763 | 1764 | ### Day 17 Benchmarks 1765 | 1766 | ``` 1767 | >> Day 17a 1768 | benchmarking... 1769 | time 18.38 ms (15.25 ms .. 21.37 ms) 1770 | 0.910 R² (0.855 R² .. 0.972 R²) 1771 | mean 23.24 ms (20.33 ms .. 33.50 ms) 1772 | std dev 11.62 ms (2.391 ms .. 21.67 ms) 1773 | variance introduced by outliers: 95% (severely inflated) 1774 | 1775 | >> Day 17b 1776 | benchmarking... 1777 | time 747.6 ms (694.3 ms .. 881.0 ms) 1778 | 0.996 R² (0.986 R² .. 1.000 R²) 1779 | mean 771.3 ms (749.1 ms .. 809.6 ms) 1780 | std dev 33.29 ms (0.0 s .. 34.91 ms) 1781 | variance introduced by outliers: 19% (moderately inflated) 1782 | ``` 1783 | 1784 | Day 18 1785 | ------ 1786 | 1787 | *([code][d18c])* 1788 | 1789 | [d18c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day18.hs 1790 | 1791 | ### Day 18 Benchmarks 1792 | 1793 | ``` 1794 | >> Day 18a 1795 | benchmarking... 1796 | time 450.8 μs (393.3 μs .. 540.9 μs) 1797 | 0.898 R² (0.849 R² .. 0.992 R²) 1798 | mean 426.0 μs (403.0 μs .. 476.6 μs) 1799 | std dev 102.4 μs (39.56 μs .. 179.0 μs) 1800 | variance introduced by outliers: 95% (severely inflated) 1801 | 1802 | >> Day 18b 1803 | benchmarking... 1804 | time 232.5 ms (208.6 ms .. 252.2 ms) 1805 | 0.991 R² (0.962 R² .. 1.000 R²) 1806 | mean 232.9 ms (224.5 ms .. 240.3 ms) 1807 | std dev 10.83 ms (7.343 ms .. 13.68 ms) 1808 | variance introduced by outliers: 14% (moderately inflated) 1809 | ``` 1810 | 1811 | Day 19 1812 | ------ 1813 | 1814 | *([code][d19c])* 1815 | 1816 | [d19c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day19.hs 1817 | 1818 | Ever since discovering how fun `many` is in Day 18, I felt inspired to abuse it 1819 | again in Day 19. 1820 | 1821 | In Day 19 we can use the search monad, `[]`, and combine it with `StateT` to 1822 | make what I call the "effectful search" monad, `StateT s []`. I go over this a 1823 | bit in an [old blog post][statetlist] of mine. An action in `StateT s []` is 1824 | an exploration down several paths, where each step could modify an internal `s` 1825 | state kept during the search. 1826 | 1827 | [statetlist]: https://blog.jle.im/entry/unique-sample-drawing-searches-with-list-and-statet.html 1828 | 1829 | In our case we are going to be searching through the cells of a grid, and our 1830 | state will be our current position and previous position. 1831 | 1832 | I'm going to be using the *[linear][]* library's `V2 Int` type to represent a 1833 | point, mostly because it gives us a `Num` instance we can use (to add and 1834 | subtract points). 1835 | 1836 | [linear]: http://hackage.haskell.org/package/linear 1837 | 1838 | Any, here is our single search step: 1839 | 1840 | ```haskell 1841 | type Grid = V.Vector (V.Vector Char) 1842 | type Point = L.V2 Int 1843 | 1844 | neighborsOf :: Point -> [Point] 1845 | neighborsOf p0 = (+ p0) <$> [ L.V2 0 1, L.V2 0 (-1), L.V2 1 0, L.V2 (-1) 0 ] 1846 | 1847 | follow :: Grid -> StateT (Point, Point) [] Char 1848 | follow g = get >>= \(p0, p1) -> do -- last position, current position 1849 | Just currChar <- return $ gridAt p1 1850 | p2 <- case currChar of 1851 | '+' -> lift $ neighbors p1 1852 | _ -> return $ p1 + (p1 - p0) 1853 | Just nextChar <- return $ gridAt p2 1854 | guard $ p2 /= p0 1855 | guard $ nextChar /= ' ' 1856 | put (p1, p2) 1857 | return nextChar 1858 | where 1859 | gridAt (L.V2 x y) = (V.!? x) =<< g V.!? y 1860 | ``` 1861 | 1862 | At each step, we: 1863 | 1864 | 1. Get our current position 1865 | 2. Lookup the character at that position, which might fail if the coordinate 1866 | is not in our grid. If it fails, close off this branch. 1867 | 3. If it succeeds, fork into a branch for every potential new point: 1868 | * If the current character is `'+'`, we need to turn! Fork off a new 1869 | branch for every direction/neighbor. 1870 | * If the current character is anything else, we just move in a straight 1871 | line. Continue down one single branch with the new next point, in 1872 | straight-line fashion. (Thanks, [Verlet][]) 1873 | 4. Get the character at the new position. Kill off the fork if the new 1874 | character is out of bounds. 1875 | 4. Now kill off the current fork if: 1876 | * The new point is our previous location. We don't want to go backwards. 1877 | * The new character is a blank line. This means we reached a dead end. 1878 | 5. If we're still alive, update our state. 1879 | 6. Return the new character! 1880 | 1881 | [Verlet]: https://en.wikipedia.org/wiki/Verlet_integration 1882 | 1883 | And that's it! One step! 1884 | 1885 | And now, we can repeat this single step multiple times until we fail, using 1886 | `many :: Alternative f => f a -> f [a]`. `many` will *repeat* the step as many 1887 | times as possible, *collect* all of the results, and *return* them in a list. 1888 | If we `many (follow g)`, we repeat `follow g` until we reach a dead end, and 1889 | then return all of the `Char`s that `follow g` emitted along the way. 1890 | 1891 | ```haskell 1892 | followToTheEnd :: Grid -> StateT (Point, Point) [] String 1893 | followToTheEnd g = ('|':) <$> many (follow g) 1894 | ``` 1895 | 1896 | We add `('|':)` to the beginning of the result so we can account for the first 1897 | position's character. 1898 | 1899 | And that's our full Day 19. We can use `evalStateT :: StateT (Point, Point) [] 1900 | a -> (Point, Point) -> [a]`, to get all of the successful paths (paths that are 1901 | followed to the end, using `many` in our case). We get the first result using 1902 | `head`. The result is a list of all characters emitted by the successful path. 1903 | 1904 | ```haskell 1905 | day19 :: Grid -> [Char] 1906 | day19 g = head . flip evalStateT p0 $ followToTheEnd g 1907 | where 1908 | p0 = (L.V2 x0 (-1), L.V2 x0 0) 1909 | Just x0 = V.elemIndex '|' (g V.! 0) 1910 | ``` 1911 | 1912 | Now all that is left is parsing and extracting the answers. 1913 | 1914 | ```haskell 1915 | day19a :: String -> String 1916 | day19a = filter isAlpha . day19 . parse 1917 | 1918 | day19b :: String -> Int 1919 | day19b = length . day19 . parse 1920 | 1921 | parse :: String -> V.Vector (V.Vector Char) 1922 | parse = V.fromList . map V.fromList . lines 1923 | ``` 1924 | 1925 | ### Day 19 Benchmarks 1926 | 1927 | ``` 1928 | >> Day 19a 1929 | benchmarking... 1930 | time 31.26 ms (30.37 ms .. 31.99 ms) 1931 | 0.993 R² (0.978 R² .. 0.999 R²) 1932 | mean 31.22 ms (30.63 ms .. 32.06 ms) 1933 | std dev 1.569 ms (661.8 μs .. 2.179 ms) 1934 | variance introduced by outliers: 17% (moderately inflated) 1935 | 1936 | >> Day 19b 1937 | benchmarking... 1938 | time 28.87 ms (13.57 ms .. 37.24 ms) 1939 | 0.598 R² (0.127 R² .. 0.898 R²) 1940 | mean 47.90 ms (38.97 ms .. 60.18 ms) 1941 | std dev 19.34 ms (13.19 ms .. 27.93 ms) 1942 | variance introduced by outliers: 92% (severely inflated) 1943 | ``` 1944 | 1945 | Day 20 1946 | ------ 1947 | 1948 | *([code][d20c])* 1949 | 1950 | [d20c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day20.hs 1951 | 1952 | Day 20 starts out as a simple physics simulator/numerical integrator: 1953 | 1954 | ```haskell 1955 | type Point = L.V3 Int 1956 | 1957 | data Particle a = P { _pAcc :: !a 1958 | , _pVel :: !a 1959 | , _pPos :: !a 1960 | } 1961 | deriving (Functor, Foldable, Traversable, Show, Eq, Ord) 1962 | 1963 | type System = [Particle Point] 1964 | ``` 1965 | 1966 | Using the *[linear][]* package again, for `V3`, a 3-vector. It's also 1967 | convenient to decide a `Particle` to contain a description of its acceleration, 1968 | velocity, and position. Our whole system will be a list of `Particle Point`s. 1969 | Note that we parameterize `Particle` so that we can give useful higher-kinded 1970 | instances like `Functor` and `Traversable`. 1971 | 1972 | Stepping the simulation ends up being just stepping every particle. 1973 | Interestingly enough, we can actually use `scanl (+) 0` (for `Traversable`) to 1974 | do the integration step: 1975 | 1976 | ```haskell 1977 | -- | scanl generalized to work on all Traversable 1978 | scanlT :: Traversable t => (b -> a -> b) -> b -> t a -> t b 1979 | scanlT = -- implementatation left as exercise, but I really wish this was 1980 | -- already in base :| 1981 | 1982 | step :: Num a => Particle a -> Particle a 1983 | step = scanlT (+) 0 1984 | ``` 1985 | 1986 | This is because it replaces `_pAcc` with `0 + _pAcc`, and then it replaces 1987 | `_pVel` with `0 + _pAcc + _pVel`, and then finally replaces `_pPos` with `0 + 1988 | _pAcc + _pVel + _pPos` -- just like the problem asks! 1989 | 1990 | For part 1, we can just `map step` a `System` several points, and then find 1991 | closest point: 1992 | 1993 | ```haskell 1994 | norm :: Point -> Int 1995 | norm = sum . fmap abs 1996 | 1997 | day20a :: System -> Int 1998 | day20a = V.minIndex . V.fromList -- hijacking minIndex from Vector 1999 | . map (norm . _pPos) 2000 | . (!! 1000) 2001 | . iterate (map step) 2002 | ``` 2003 | 2004 | However, we are really just looking for the asymptotic behavior. In the long 2005 | run, the distance is dominated by the `|a| t^2` term, so we really just need 2006 | to look for the particle with the highest normed initial acceleration. 2007 | 2008 | ```haskell 2009 | day20a :: System -> Int 2010 | day20a = V.minIndex . V.fromList 2011 | . (map . fmap) norm -- [Particle Point] -> [Particle Int] 2012 | . parse 2013 | ``` 2014 | 2015 | The `Ord` instance of `Particle Int` is such that it sorts first by the `_pAcc` 2016 | field, then the `_pVel` field, then the `_pPos` field. So it'll find first the 2017 | highest normed acceleration, and break ties using the highest normed velocity. 2018 | However, this tie breaking isn't actually sound -- there are situations where 2019 | this won't be true. However, there were no ties in my data set so this method 2020 | was ok :) 2021 | 2022 | For part 2, we can define a function that takes out all "duplicated" points, 2023 | using a frequency map and filtering for frequencies greater than 1: 2024 | 2025 | ```haskell 2026 | collide :: System -> System 2027 | collide s0 = filter ((`S.notMember` collisions) . _pPos) s0 2028 | where 2029 | collisions :: S.Set Point 2030 | collisions = M.keysSet . M.filter @Int (> 1) 2031 | . M.fromListWith (+) 2032 | . map ((,1) . _pPos) 2033 | $ toList s0 2034 | ``` 2035 | 2036 | Now we just iterate `collide . map step`. 2037 | 2038 | We can pick the thousandth element again, like we might have for part 1. 2039 | However, we can be a little smart with a stopping condition: 2040 | 2041 | ```haskell 2042 | day20b :: Challenge 2043 | day20b = show . length . fromJust . find stop 2044 | . iterate (collide . map step) 2045 | . parse 2046 | where 2047 | stop = (> 1000) . minimum . map (norm . _sPos) 2048 | ``` 2049 | 2050 | Here, we iterate until the particle *closest* to the origin is greater than 2051 | a 1000-cube away from the origin. Essentially, this is waiting until all of 2052 | the points clear a 2000-wide cube around the origin. Thinking about the input, 2053 | there will be some particles that start out near the origin and start heading 2054 | *towards* the origin. This condition will wait until the last of those 2055 | particles exits the origin cube, and check for the number of collisions then. 2056 | 2057 | ### Parsing 2058 | 2059 | We can parse into `System` using really silly view patterns :) 2060 | 2061 | ```haskell 2062 | parse :: String -> System 2063 | parse = map parseLine . lines 2064 | where 2065 | parseLine :: String -> Particle Point 2066 | parseLine (map(read.filter num).splitOn","->[pX,pY,pZ,vX,vY,vZ,aX,aY,aZ]) 2067 | = P { _pAcc = L.V3 aX aY aZ 2068 | , _pVel = L.V3 vX vY vZ 2069 | , _pPos = L.V3 pX pY pZ 2070 | } 2071 | parseLine _ = error "No parse" 2072 | num :: Char -> Bool 2073 | num c = isDigit c || c == '-' 2074 | ``` 2075 | 2076 | ### Day 20 Benchmarks 2077 | 2078 | ``` 2079 | >> Day 20a 2080 | benchmarking... 2081 | time 29.87 ms (28.16 ms .. 32.18 ms) 2082 | 0.989 R² (0.979 R² .. 0.997 R²) 2083 | mean 33.94 ms (32.33 ms .. 38.26 ms) 2084 | std dev 5.085 ms (1.678 ms .. 8.683 ms) 2085 | variance introduced by outliers: 61% (severely inflated) 2086 | 2087 | >> Day 20b 2088 | benchmarking... 2089 | time 67.18 ms (64.33 ms .. 72.99 ms) 2090 | 0.990 R² (0.975 R² .. 0.998 R²) 2091 | mean 66.90 ms (64.83 ms .. 68.67 ms) 2092 | std dev 3.437 ms (2.439 ms .. 4.727 ms) 2093 | variance introduced by outliers: 16% (moderately inflated) 2094 | ``` 2095 | 2096 | Day 21 2097 | ------ 2098 | 2099 | *([code][d21c])* 2100 | 2101 | [d21c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day21.hs 2102 | 2103 | ### Day 21 Benchmarks 2104 | 2105 | ``` 2106 | >> Day 21a 2107 | benchmarking... 2108 | time 2.169 ms (2.056 ms .. 2.335 ms) 2109 | 0.911 R² (0.796 R² .. 0.996 R²) 2110 | mean 2.235 ms (2.138 ms .. 2.621 ms) 2111 | std dev 477.3 μs (184.0 μs .. 1.054 ms) 2112 | variance introduced by outliers: 90% (severely inflated) 2113 | 2114 | >> Day 21b 2115 | benchmarking... 2116 | time 3.833 s (3.540 s .. 4.438 s) 2117 | 0.997 R² (0.994 R² .. 1.000 R²) 2118 | mean 3.764 s (3.678 s .. 3.868 s) 2119 | std dev 96.29 ms (0.0 s .. 109.8 ms) 2120 | variance introduced by outliers: 19% (moderately inflated) 2121 | ``` 2122 | 2123 | Day 22 2124 | ------ 2125 | 2126 | *([code][d22c])* 2127 | 2128 | [d22c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day22.hs 2129 | 2130 | ### Day 22 Benchmarks 2131 | 2132 | ``` 2133 | >> Day 22a 2134 | benchmarking... 2135 | time 6.036 ms (5.771 ms .. 6.360 ms) 2136 | 0.975 R² (0.951 R² .. 0.991 R²) 2137 | mean 6.102 ms (5.916 ms .. 6.364 ms) 2138 | std dev 704.9 μs (467.2 μs .. 1.074 ms) 2139 | variance introduced by outliers: 67% (severely inflated) 2140 | 2141 | >> Day 22b 2142 | benchmarking... 2143 | time 7.825 s (7.623 s .. 8.054 s) 2144 | 1.000 R² (1.000 R² .. 1.000 R²) 2145 | mean 7.786 s (7.750 s .. 7.815 s) 2146 | std dev 47.35 ms (0.0 s .. 51.70 ms) 2147 | variance introduced by outliers: 19% (moderately inflated) 2148 | ``` 2149 | 2150 | Day 23 2151 | ------ 2152 | 2153 | *([code][d23c])* 2154 | 2155 | [d23c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day23.hs 2156 | 2157 | ### Day 23 Benchmarks 2158 | 2159 | ``` 2160 | >> Day 23a 2161 | benchmarking... 2162 | time 87.32 ms (81.75 ms .. 92.92 ms) 2163 | 0.991 R² (0.974 R² .. 0.998 R²) 2164 | mean 86.94 ms (84.60 ms .. 90.52 ms) 2165 | std dev 4.436 ms (3.076 ms .. 6.214 ms) 2166 | 2167 | >> Day 23b 2168 | benchmarking... 2169 | time 5.983 ms (5.436 ms .. 6.836 ms) 2170 | 0.897 R² (0.814 R² .. 0.990 R²) 2171 | mean 5.757 ms (5.527 ms .. 6.383 ms) 2172 | std dev 976.3 μs (413.1 μs .. 1.700 ms) 2173 | variance introduced by outliers: 81% (severely inflated) 2174 | ``` 2175 | 2176 | Day 24 2177 | ------ 2178 | 2179 | *([code][d24c])* 2180 | 2181 | [d24c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day24.hs 2182 | 2183 | ### Day 24 Benchmarks 2184 | 2185 | ``` 2186 | >> Day 24a 2187 | benchmarking... 2188 | time 1.681 s (1.570 s .. 1.743 s) 2189 | 0.999 R² (0.999 R² .. 1.000 R²) 2190 | mean 1.673 s (1.653 s .. 1.686 s) 2191 | std dev 19.25 ms (0.0 s .. 22.18 ms) 2192 | variance introduced by outliers: 19% (moderately inflated) 2193 | 2194 | >> Day 24b 2195 | benchmarking... 2196 | time 1.795 s (1.661 s .. NaN s) 2197 | 0.999 R² (0.997 R² .. 1.000 R²) 2198 | mean 1.828 s (1.794 s .. 1.850 s) 2199 | std dev 33.11 ms (0.0 s .. 38.19 ms) 2200 | variance introduced by outliers: 19% (moderately inflated) 2201 | ``` 2202 | 2203 | Day 25 2204 | ------ 2205 | 2206 | *([code][d25c])* 2207 | 2208 | [d25c]: https://github.com/mstksg/advent-of-code-2017/blob/master/src/AOC2017/Day25.hs 2209 | 2210 | ### Day 25 Benchmarks 2211 | 2212 | ``` 2213 | >> Day 25a 2214 | benchmarking... 2215 | time 2.648 s (2.510 s .. 2.834 s) 2216 | 0.999 R² (0.998 R² .. 1.000 R²) 2217 | mean 2.643 s (2.607 s .. 2.668 s) 2218 | std dev 38.04 ms (0.0 s .. 43.77 ms) 2219 | variance introduced by outliers: 19% (moderately inflated) 2220 | ``` 2221 | 2222 | --------------------------------------------------------------------------------