Solve day 8 part 1
This commit is contained in:
parent
f12e7b6e36
commit
b0a191edb9
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -44,6 +44,7 @@ executable aoc
|
||||
containers,
|
||||
deepseq,
|
||||
directory,
|
||||
disjoint-containers,
|
||||
exceptions,
|
||||
extra,
|
||||
filepath,
|
||||
|
||||
1
outputs/real/8/1
Normal file
1
outputs/real/8/1
Normal file
@ -0,0 +1 @@
|
||||
66640
|
||||
Loading…
x
Reference in New Issue
Block a user