Minor refactor

This commit is contained in:
George Thomas 2025-12-09 00:26:22 +00:00
parent 1e3ed16971
commit 02fbb8c0be
2 changed files with 6 additions and 4 deletions

View File

@ -64,9 +64,9 @@ import Data.Foldable hiding (foldl1, foldr1, maximum, maximumBy, minimum, minimu
import Data.Foldable1 import Data.Foldable1
import Data.Function import Data.Function
import Data.Functor import Data.Functor
import Data.List (sortOn, tails, transpose) import Data.List (sortOn, transpose)
import Data.List.Extra (dropEnd, enumerate, notNull, splitOn) import Data.List.Extra (dropEnd, enumerate, notNull, splitOn)
import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1) import Data.List.NonEmpty (NonEmpty ((:|)), nonEmpty, some1, tail, tails)
import Data.Maybe import Data.Maybe
import Data.Ord import Data.Ord
import Data.Sequence (Seq) import Data.Sequence (Seq)

View File

@ -8,6 +8,8 @@ import Data.Text.Lazy qualified as TL
import Linear.Metric import Linear.Metric
import Linear.V3 import Linear.V3
import Prelude hiding (tail)
puzzle :: Puzzle puzzle :: Puzzle
puzzle = puzzle =
Puzzle Puzzle
@ -40,7 +42,7 @@ puzzle =
connectBoxes :: [V3 Int] -> [((V3 Int, V3 Int), DS.DisjointSet (V3 Int))] 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 connectBoxes boxes = zip allPairs $ scanl (flip $ uncurry DS.union) (foldMap DS.singleton boxes) allPairs
where where
allPairs = sortOn (quadrance . uncurry (-)) $ filter (uncurry (/=)) $ allUnorderedPairs boxes allPairs = sortOn (quadrance . uncurry (-)) $ allUnorderedPairs boxes
allUnorderedPairs :: [a] -> [(a, a)] allUnorderedPairs :: [a] -> [(a, a)]
allUnorderedPairs = concat . join (zipWith (flip $ map . (,)) . tails) allUnorderedPairs = concat . join (zipWith (flip $ map . (,)) . tail . tails)