c/aoc-2022
1
Fork 0
Code Issues Releases Activity

Day 23

Browse Source 
Sadly too slow
This commit is contained in:
Christian
2024-11-29 09:07:09 +01:00
parent dee243860b
commit e4eb5a2b9b
6 changed files with 203 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
Y2022.cabal
View File

@@ -56,6 +56,7 @@ library
Days.D19
Days.D20
Days.D21
Days.D23
Days.D24
Days.D25
build-depends:

72
app/Main.hs
View File

@@ -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

2
bench/Bench.hs
View File

@@ -29,7 +29,7 @@ paths =
, "./data/20.in"
, "./data/21.in"
, ""
, ""
, "./data/23.in"
, "./data/24.in"
, "./data/25.in"
]

75
data/23.in Normal file
View File

@@ -0,0 +1,75 @@
.#..###.##..##.####.#.....##.##.#..#.##.#..#.#.#.####..#####.#......#...#..
###...#.#..##...#.##...#.###.###....##..##..######.#.#..#.#...#.##...#.#.#.
.......#.###.....#.##.....##..#.#...##..#####.###.##......#.###.##.#####.##
##.##...##..####.##.........#.##.#.#..####.##....#.#####.####.####..##..##.
#..#.###...###...#..#..#..#.#.##.######.###..##########.#..#.##.#.#.##....#
.#..#..##..#.#.......#.#....#######..#.##.##..##.#.#.#..#.##....#..##.#####
.#.##..##.##...#.##.##..##.##.##..##...###..###.#...##..##....#.##....#####
.###.###.#.##.###....#..###..###..##.#.#.#.#....#####.###.######...###.###.
#...####.###.....#.....###...#..##.##...########.#.#.######...#..#.###....#
..###.#.###..#.#.........#....#.#.#####.#.#.#....###.##..###...####.#.#...#
###.#.######.##.#.##....##.##..##.#.#..#.#..##..#..##.###..##.########.#.#.
.#...##.....###...##..###.#.##.....#.##..#.#.#..##.#...#.#.#.###.#....#.##.
..####.#.#.###....###.#.....##...#.##.#...#..#.#..#####...######....#..##.#
.##.#..##.###.###..#.#.#####.#.###......###..#.#..#..###..###..#.....#..##.
#.#.#####..##.##...#...#...#..#...#.#.#..#........######.##.#...#..#.#..##.
.#.####....#.#..##.##..#...##.##...##.....###.###.###..#.#....#.#.####.#..#
##.#..#.###..###........#...##.#..##...####.##..#..#.##.#....##..##..#####.
...#..##.#..##.####..###...#.#.#.......#####..######....###..#.#..###.###..
.#.##...#.#.#........##..#.#####.#####...##......#.##.....#..####..#####...
.#.#..#..#.#.#.####.#...###.###.#..###...###.##..##...##..####.#.....#.#.##
##...#.#...##..##..##..##.####..######...##..#...##..##.##....##...#.#.....
..####.#####..##.####...#...#...#.#.#..##.##..#...###.#..#...#...#.#...#.##
..###.#....#.########...##....#..#.#.#..#.##..#...#.##.....#.###..#..#..#.#
#.##....###.#..##.#.##..####..###......####.###.##..###....#..#.#.#...####.
.######.#....#....#####...#..#..###.#..#...#.###.#.##..#.###..#..###......#
#..##.#.#####.#.#.##.#..###.#..#..#.#..#.#..#.#.....##########.#..#..#..#.#
###.##....#...####.###..##..#....#.#......#.#.#......#..##.#..####...#..#.#
..#.###..#.###.##.#..#....#..#####.#.#.####.#...#....#.##.#.#..###.########
..#.#.....##.##...#..##...#.#..##.####.###.#.#..#..####...#..##..##..#.###.
.###..#.###....#.####.#..#...###.#....#...#....###.#.######.####..#.#..###.
.#.##.##.....#.###.#...#..#.#.##.##..#.#..###.##..#.##....##....#.#...#.##.
#.##.#..#.#.#....##...####.#..#.###..######.###.#..##.#.#.#####...##..#.##.
#.###.##.#..#...#..##..#.##.....#...#....#...##....#..#..##..##.##....##.##
..###..#...#.#..##.##..#####.#..#.#..#...#...##.#.#..#..#.###....#.####.###
###.###...####..###..#..#.##..#.#.#.....#....#.#####.#..###.#..####....##.#
#.###.#.#.##.###.##.........###.#..#######.####..........#.#.###..#.#.##.#.
####.##.#####.##.#.#.##......#...#.#.##..###..#...#...###..###.#####..##...
.##...#####.##########.#....##.......#.#.#.#.###..#####....#..#.####..#####
####..#..####.###..###..#####.###....#.#.#.....#.####..#..###.#..##.##..##.
###.#.#....##..#.##.#.....##..##.##..##.###.##.#.#...####...#.##..####..##.
#..#..##.#....###..##.#..#...#.#.#.#.######.##..#...##.#.#.....####..##.##.
....####..###.#.##..#...#..##..#####.....##.##..#.##..##...#####.....##..#.
.##...##...######..##..#.##..##.#.#..##.##..###.#.####...#######..##....#..
.###.##.#......###....#####.#.#.##...#####..#..##.###...##...###.#.##...##.
.#....####..#..#..##...##....#.##...###..##.#..#.#.#.#.####.....###...#.###
##.###..#....##....#.##..#.#.....#...###..##..###....#.....###...##.....###
##......#.##.#.###...##..###.....#.##.#..#.###..###.#.##...#####..###..#.##
##.##.#####........#..##........#..##..##......#.###.#.#..##.######.#....##
##.....#.##...#.####.####...#.###.#....#.######.#....#.#.##....#...##..##.#
#.##.....#####.###.###.##.#.#.#..#....#.....#.#..###.####.#####...#.......#
...#######......###.##.#.#.#.....######.#.##.#.#...#..#.#....#.#.#.##..###.
#.###..#.##.#####..#.#...##.####.###.#####..#.....#...#.#..##.#.####.##.#..
.##..##...##....#####.#...####..#....#..##.#...#####.#.##...#.####.###...##
..####.###...##.##.#..#.###.##..#....#.#....###.#..##.#.....#.###....##.#..
#.##.#...#..##.####.######.##..#.#......#.###...#..##.#..##..###.#..#.#.#.#
..##.##..#..#.####.###.#...##.###.###.##..##.###....##...##.#..##.###...##.
.####..#....#####..#..##....#.#.##.#####.#####..#.....###.#..###.####......
##...#.#.#..##..##....##.###...#.##..#..#....###....#####.##..##.....####.#
#..####...####..##..#..#..#.#.....##.#..#####..#.#.###.#..###.....#.#.###.#
.##..####.####...#.#....##..#####..#...#...#..###..##......#...#..#.##.###.
#..##..###.###.#.#..##..#.#.###....##..##.###.#..#....#.#.#..#..##.#..####.
#.####..##....#...#.#...###..#..##...##.#.#.#.#...#..#...##...#...#.#....#.
#..###.###...###.#.###.#....#..##....#.#.#..#.##.###.#####..##.###...#.#...
.#..###.#.#..#.#.#...####.#.#.##.###.#..##.##.......#.#.#.#.#...#..#.#...##
######.....###...#..#..###.#.#...#...##..##.##.#..#.#...###.##.##....#.#...
#..##...#...##...###..#....#...###.#.###.###..#..##.##..####..#.###.##....#
..##...#..#.#.#######..#.###..#.#.#.#.##.#..#.....#.##.###.#####.#.######..
#.#.#..##.#.###.#....#..#..######.#....##.#..###.####.#......#..##.##.##.##
######....##......#..#...####..###..######.#.#.##....#...##.#.#..#.#.#.##..
###.####.###.#####.....######..#...#.##.#....##.#.##..#.#.##.#.##..###..###
..######....####..###..##..##.##...#.###..#.##..#.#...#.##.##.....#..#..###
.##..##..#.##....#...##.###.##..#...##..##.##.#.#..###...##....#.#.#..#...#
..#..##.########.##..#####.#....#..##.##.##.#...#.##..##.#..#..###...#.#.##
#.##....#..#.#..##.#......#.#..##.#.............#.##.#...##.#..#...##.#.###
#..#..###.#.##.#..#....##..#..#..##.##..#.##...###.......#..###..####...##.

87
src/Days/D23.hs Normal file
View File

@@ -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)
)

3
src/Lib.hs
View File

@@ -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]
]