Solve day 8 part 1

This commit is contained in:
George Thomas 2025-12-08 21:58:47 +00:00
parent f12e7b6e36
commit b0a191edb9
4 changed files with 28 additions and 4 deletions

View File

@ -57,7 +57,7 @@ import Data.Char
import Data.Foldable hiding (foldl1, foldr1, maximum, maximumBy, minimum, minimumBy)
import Data.Foldable1
import Data.Functor
import Data.List (sortOn, transpose)
import Data.List (sortOn, tails, transpose)
import Data.List.Extra (dropEnd, enumerate)
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1)
import Data.Maybe

View File

@ -2,14 +2,36 @@ module Puzzles.Day8 (puzzle) where
import Pre
import Data.DisjointSet qualified as DS
import Data.Text.Lazy qualified as TL
import Linear.Metric
import Linear.V3
puzzle :: Puzzle
puzzle =
Puzzle
{ number = 8
, parser = pure ()
, parser = (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
, parts =
[ \() ->
"TODO"
[ TL.show
. product
. take 3
. sortOn Down
. map length
. DS.toLists
. snd
. \boxes ->
-- TODO more principled way of distinguishing example and real
(!! ((if length boxes == 20 then 10 else if length boxes == 1000 then 1000 else undefined))) $
connectBoxes boxes
]
, extraTests = mempty
}
connectBoxes :: [V3 Int] -> [((V3 Int, V3 Int), DS.DisjointSet (V3 Int))]
connectBoxes boxes = zip allPairs $ scanl (flip $ uncurry DS.union) (foldMap DS.singleton boxes) allPairs
where
allPairs = sortOn (quadrance . uncurry (-)) $ filter (uncurry (/=)) $ allUnorderedPairs boxes
allUnorderedPairs :: [a] -> [(a, a)]
allUnorderedPairs = concat . join (zipWith (flip $ map . (,)) . tails)

View File

@ -44,6 +44,7 @@ executable aoc
containers,
deepseq,
directory,
disjoint-containers,
exceptions,
extra,
filepath,

1
outputs/real/8/1 Normal file
View File

@ -0,0 +1 @@
66640