diff --git a/Y2022.cabal b/Y2022.cabal index d408b26..c9cbf01 100644 --- a/Y2022.cabal +++ b/Y2022.cabal @@ -56,6 +56,7 @@ library Days.D19 Days.D20 Days.D21 + Days.D23 Days.D24 Days.D25 build-depends: diff --git a/app/Main.hs b/app/Main.hs index 027d422..1a1effb 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,40 +2,39 @@ module Main where -import Lib - -import System.Environment (getArgs) import Data.List (uncons) import Data.Maybe (mapMaybe) +import Lib +import System.Environment (getArgs) paths :: [FilePath] paths = - [ "./data/01.in" - , "./data/02.in" - , "./data/03.in" - , "./data/04.in" - , "./data/05.in" - , "./data/06.in" - , "./data/07.in" - , "./data/08.in" - , "./data/09.in" - , "./data/10.in" - , "./data/11.in" - , "./data/12.in" - , "./data/13.in" - , "./data/14.in" - , "./data/15.in" - , "./data/16.in" - , "./data/17.in" - , "./data/18.in" - , "./data/19.in" - , "./data/20.in" - , "./data/21.in" - , "" - , "" - , "./data/24.in" - , "./data/25.in" - ] + [ "./data/01.in", + "./data/02.in", + "./data/03.in", + "./data/04.in", + "./data/05.in", + "./data/06.in", + "./data/07.in", + "./data/08.in", + "./data/09.in", + "./data/10.in", + "./data/11.in", + "./data/12.in", + "./data/13.in", + "./data/14.in", + "./data/15.in", + "./data/16.in", + "./data/17.in", + "./data/18.in", + "./data/19.in", + "./data/20.in", + "./data/21.in", + "", + "./data/23.in", + "./data/24.in", + "./data/25.in" + ] solutions :: [(Int, Day, FilePath)] solutions = @@ -51,12 +50,15 @@ runAll = mapM_ (\(dayNum, day, path) -> run day path >>= printDR dayNum) usage :: IO () usage = putStrLn "./Main" - main :: IO () main = - printHeader - >> getArgs - >>= (\case + printHeader + >> getArgs + >>= ( \case ["all"] -> runAll solutions - _ -> runAll [last solutions]) - >> printFooter + ("day" : dayNumStrs) -> + let dayNums = map read dayNumStrs + in runAll (filter (\(a, _, _) -> a `elem` dayNums) solutions) + _ -> runAll [last solutions] + ) + >> printFooter diff --git a/bench/Bench.hs b/bench/Bench.hs index dee4d2d..c5f7796 100644 --- a/bench/Bench.hs +++ b/bench/Bench.hs @@ -29,7 +29,7 @@ paths = , "./data/20.in" , "./data/21.in" , "" - , "" + , "./data/23.in" , "./data/24.in" , "./data/25.in" ] diff --git a/data/23.in b/data/23.in new file mode 100644 index 0000000..d506938 --- /dev/null +++ b/data/23.in @@ -0,0 +1,75 @@ +.#..###.##..##.####.#.....##.##.#..#.##.#..#.#.#.####..#####.#......#...#.. +###...#.#..##...#.##...#.###.###....##..##..######.#.#..#.#...#.##...#.#.#. +.......#.###.....#.##.....##..#.#...##..#####.###.##......#.###.##.#####.## +##.##...##..####.##.........#.##.#.#..####.##....#.#####.####.####..##..##. +#..#.###...###...#..#..#..#.#.##.######.###..##########.#..#.##.#.#.##....# +.#..#..##..#.#.......#.#....#######..#.##.##..##.#.#.#..#.##....#..##.##### +.#.##..##.##...#.##.##..##.##.##..##...###..###.#...##..##....#.##....##### +.###.###.#.##.###....#..###..###..##.#.#.#.#....#####.###.######...###.###. +#...####.###.....#.....###...#..##.##...########.#.#.######...#..#.###....# +..###.#.###..#.#.........#....#.#.#####.#.#.#....###.##..###...####.#.#...# +###.#.######.##.#.##....##.##..##.#.#..#.#..##..#..##.###..##.########.#.#. +.#...##.....###...##..###.#.##.....#.##..#.#.#..##.#...#.#.#.###.#....#.##. +..####.#.#.###....###.#.....##...#.##.#...#..#.#..#####...######....#..##.# +.##.#..##.###.###..#.#.#####.#.###......###..#.#..#..###..###..#.....#..##. +#.#.#####..##.##...#...#...#..#...#.#.#..#........######.##.#...#..#.#..##. +.#.####....#.#..##.##..#...##.##...##.....###.###.###..#.#....#.#.####.#..# +##.#..#.###..###........#...##.#..##...####.##..#..#.##.#....##..##..#####. +...#..##.#..##.####..###...#.#.#.......#####..######....###..#.#..###.###.. +.#.##...#.#.#........##..#.#####.#####...##......#.##.....#..####..#####... +.#.#..#..#.#.#.####.#...###.###.#..###...###.##..##...##..####.#.....#.#.## +##...#.#...##..##..##..##.####..######...##..#...##..##.##....##...#.#..... +..####.#####..##.####...#...#...#.#.#..##.##..#...###.#..#...#...#.#...#.## +..###.#....#.########...##....#..#.#.#..#.##..#...#.##.....#.###..#..#..#.# +#.##....###.#..##.#.##..####..###......####.###.##..###....#..#.#.#...####. +.######.#....#....#####...#..#..###.#..#...#.###.#.##..#.###..#..###......# +#..##.#.#####.#.#.##.#..###.#..#..#.#..#.#..#.#.....##########.#..#..#..#.# +###.##....#...####.###..##..#....#.#......#.#.#......#..##.#..####...#..#.# +..#.###..#.###.##.#..#....#..#####.#.#.####.#...#....#.##.#.#..###.######## +..#.#.....##.##...#..##...#.#..##.####.###.#.#..#..####...#..##..##..#.###. +.###..#.###....#.####.#..#...###.#....#...#....###.#.######.####..#.#..###. +.#.##.##.....#.###.#...#..#.#.##.##..#.#..###.##..#.##....##....#.#...#.##. +#.##.#..#.#.#....##...####.#..#.###..######.###.#..##.#.#.#####...##..#.##. +#.###.##.#..#...#..##..#.##.....#...#....#...##....#..#..##..##.##....##.## +..###..#...#.#..##.##..#####.#..#.#..#...#...##.#.#..#..#.###....#.####.### +###.###...####..###..#..#.##..#.#.#.....#....#.#####.#..###.#..####....##.# +#.###.#.#.##.###.##.........###.#..#######.####..........#.#.###..#.#.##.#. +####.##.#####.##.#.#.##......#...#.#.##..###..#...#...###..###.#####..##... +.##...#####.##########.#....##.......#.#.#.#.###..#####....#..#.####..##### +####..#..####.###..###..#####.###....#.#.#.....#.####..#..###.#..##.##..##. +###.#.#....##..#.##.#.....##..##.##..##.###.##.#.#...####...#.##..####..##. +#..#..##.#....###..##.#..#...#.#.#.#.######.##..#...##.#.#.....####..##.##. +....####..###.#.##..#...#..##..#####.....##.##..#.##..##...#####.....##..#. +.##...##...######..##..#.##..##.#.#..##.##..###.#.####...#######..##....#.. +.###.##.#......###....#####.#.#.##...#####..#..##.###...##...###.#.##...##. +.#....####..#..#..##...##....#.##...###..##.#..#.#.#.#.####.....###...#.### +##.###..#....##....#.##..#.#.....#...###..##..###....#.....###...##.....### +##......#.##.#.###...##..###.....#.##.#..#.###..###.#.##...#####..###..#.## +##.##.#####........#..##........#..##..##......#.###.#.#..##.######.#....## +##.....#.##...#.####.####...#.###.#....#.######.#....#.#.##....#...##..##.# +#.##.....#####.###.###.##.#.#.#..#....#.....#.#..###.####.#####...#.......# +...#######......###.##.#.#.#.....######.#.##.#.#...#..#.#....#.#.#.##..###. +#.###..#.##.#####..#.#...##.####.###.#####..#.....#...#.#..##.#.####.##.#.. +.##..##...##....#####.#...####..#....#..##.#...#####.#.##...#.####.###...## +..####.###...##.##.#..#.###.##..#....#.#....###.#..##.#.....#.###....##.#.. +#.##.#...#..##.####.######.##..#.#......#.###...#..##.#..##..###.#..#.#.#.# +..##.##..#..#.####.###.#...##.###.###.##..##.###....##...##.#..##.###...##. +.####..#....#####..#..##....#.#.##.#####.#####..#.....###.#..###.####...... +##...#.#.#..##..##....##.###...#.##..#..#....###....#####.##..##.....####.# +#..####...####..##..#..#..#.#.....##.#..#####..#.#.###.#..###.....#.#.###.# +.##..####.####...#.#....##..#####..#...#...#..###..##......#...#..#.##.###. +#..##..###.###.#.#..##..#.#.###....##..##.###.#..#....#.#.#..#..##.#..####. +#.####..##....#...#.#...###..#..##...##.#.#.#.#...#..#...##...#...#.#....#. +#..###.###...###.#.###.#....#..##....#.#.#..#.##.###.#####..##.###...#.#... +.#..###.#.#..#.#.#...####.#.#.##.###.#..##.##.......#.#.#.#.#...#..#.#...## +######.....###...#..#..###.#.#...#...##..##.##.#..#.#...###.##.##....#.#... +#..##...#...##...###..#....#...###.#.###.###..#..##.##..####..#.###.##....# +..##...#..#.#.#######..#.###..#.#.#.#.##.#..#.....#.##.###.#####.#.######.. +#.#.#..##.#.###.#....#..#..######.#....##.#..###.####.#......#..##.##.##.## +######....##......#..#...####..###..######.#.#.##....#...##.#.#..#.#.#.##.. +###.####.###.#####.....######..#...#.##.#....##.#.##..#.#.##.#.##..###..### +..######....####..###..##..##.##...#.###..#.##..#.#...#.##.##.....#..#..### +.##..##..#.##....#...##.###.##..#...##..##.##.#.#..###...##....#.#.#..#...# +..#..##.########.##..#####.#....#..##.##.##.#...#.##..##.#..#..###...#.#.## +#.##....#..#.#..##.#......#.#..##.#.............#.##.#...##.#..#...##.#.### +#..#..###.#.##.#..#....##..#..#..##.##..#.##...###.......#..###..####...##. diff --git a/src/Days/D23.hs b/src/Days/D23.hs new file mode 100644 index 0000000..2478ed9 --- /dev/null +++ b/src/Days/D23.hs @@ -0,0 +1,87 @@ +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} +{-# OPTIONS_GHC -Wno-incomplete-patterns #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Days.D23 where + +import Common +import Control.Monad (zipWithM) +import Control.Monad.ST.Strict (runST) +import Data.Functor ((<&>)) +import Data.HashTable.Class qualified as HT +import Data.HashTable.ST.Basic qualified as HTB +import Data.List (tails) +import Data.List.Extra (scanl') +import Data.Maybe (fromMaybe, isJust) + +type V2 = (Int, Int) + +preprocess :: String -> [V2] +preprocess = + concatMap (\(row, line) -> [(row, col) | (col, ch) <- zip [0 ..] line, ch == '#']) + . zip [0 ..] + . lines + +data Direction = N | S | E | W + +dance :: [Direction] -> [V2] -> [V2] +dance directions pts = + runST $ do + proposals <- HTB.newSized (length pts) + elfSet <- HT.fromList $ map (,()) pts + dsts <- + mapM + ( \(x, y) -> do + neighbours <- sequence [isJust <$> HTB.lookup elfSet (x + xd, y + yd) | xd <- [-1 .. 1], yd <- [-1 .. 1], not (xd == 0 && yd == 0)] + let [nw, n, ne, w, e, sw, s, se] = neighbours + + ( if or neighbours + then + ( let move dirs = + case dirs of + [] -> (x, y) + (dir : rest) -> case dir of + N -> if nw || n || ne then move rest else (x - 1, y) + S -> if sw || s || se then move rest else (x + 1, y) + W -> if nw || w || sw then move rest else (x, y - 1) + E -> if ne || e || se then move rest else (x, y + 1) + dst = move directions + in HT.mutate proposals dst (\old -> (Just . ((1 :: Int) +) . fromMaybe 0 $ old, dst)) + ) + else return (x, y) + ) + ) + pts + + let update old new = HT.lookup proposals new <&> (\case Nothing -> new; Just n -> if n > 1 then old else new) + zipWithM update pts dsts + +procession :: [V2] -> [[V2]] +procession initial = + let choreo = map (take 4) . tails . cycle $ [N, S, W, E] + in scanl' (flip dance) initial choreo + +part2 :: [V2] -> Int +part2 = findDup 1 . procession + where + findDup :: (Eq a) => Int -> [a] -> Int + findDup acc (x : y : xs) = if x == y then acc else findDup (acc + 1) (y : xs) + +part1 :: [V2] -> Int +part1 = score . (!! 10) . procession + where + score pts = + let (fsts, snds) = (map fst pts, map snd pts) + (fmin, fmax) = (minimum fsts, maximum fsts) + (smin, smax) = (minimum snds, maximum snds) + in (fmax - fmin + 1) * (smax - smin + 1) - length pts + +day :: Day +day = + StringDay + ( \string -> + let input = preprocess string + in Right (definitive $ part1 input, definitive $ part2 input) + ) diff --git a/src/Lib.hs b/src/Lib.hs index aebad73..6a648d7 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -33,6 +33,7 @@ import Days.D18 qualified as D18 import Days.D19 qualified as D19 import Days.D20 qualified as D20 import Days.D21 qualified as D21 +import Days.D23 qualified as D23 import Days.D24 qualified as D24 import Days.D25 qualified as D25 @@ -69,7 +70,7 @@ days = , [D20.day] , [D21.day] , [] - , [] + , [D23.day] , [D24.day] , [D25.day] ]