e85429629f
Now that it's in the prelude, the desire to remove diagonals is less obvious than it was.
44 lines
1.4 KiB
Haskell
44 lines
1.4 KiB
Haskell
module Puzzles.Day8 (puzzle) where
|
|
|
|
import Pre
|
|
|
|
import Control.Lens
|
|
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 = \isRealData ->
|
|
(if isRealData then 1000 else 10,)
|
|
<$> (V3 <$> decimal <* single ',' <*> decimal <* single ',' <*> decimal) `sepEndBy` newline
|
|
, parts =
|
|
[ uncurry \n ->
|
|
TL.show
|
|
. product
|
|
. take 3
|
|
. sortOn Down
|
|
. map length
|
|
. DS.toLists
|
|
. maybe (error "not enough boxes") snd
|
|
. listIndex n
|
|
. connectBoxes
|
|
, uncurry . const $
|
|
TL.show
|
|
. uncurry ((*) `on` view _x)
|
|
. maybe (error "sets never unified") fst
|
|
. lastMay
|
|
. takeWhile ((> 1) . DS.sets . snd)
|
|
. connectBoxes
|
|
]
|
|
, 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 (-)) $ allUnorderedPairs False boxes
|