Skip to content

Commit e6f8cea

Browse files
glguyglguy
committed
Clean up 2025-08 a bit
1 parent 1931f9d commit e6f8cea

File tree

3 files changed

+77
-35
lines changed

3 files changed

+77
-35
lines changed

‎common/src/Advent/DisjointSet.hs‎

Lines changed: 11 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -52,15 +52,20 @@ setSize ds x =
5252
do (size, _) <- findRoot ds x
5353
pure size
5454

55-
unifySets :: Ix a => DisjointSet a -> a -> a -> IO ()
55+
-- | Unify two sets into one. Returns True when the unification
56+
-- successfully unified two sets. Returns False when the sets
57+
-- were already unified.
58+
unifySets :: Ix a => DisjointSet a -> a -> a -> IO Bool
5659
unifySets (DS arr) x y =
5760
do (sizeX, x') <- findRoot (DS arr) x
5861
(sizeY, y') <- findRoot (DS arr) y
59-
60-
when (x' /= y')
61-
if sizeX < sizeY
62-
then writeArray arr x' (0,y') >> writeArray arr y' (sizeX + sizeY, y')
63-
else writeArray arr y' (0,x') >> writeArray arr x' (sizeX + sizeY, x')
62+
let success = x' /= y'
63+
success <$ when success
64+
if sizeX < sizeY
65+
then do writeArray arr x' (0, y')
66+
writeArray arr y' (sizeX + sizeY, y')
67+
else do writeArray arr y' (0, x')
68+
writeArray arr x' (sizeX + sizeY, x')
6469

6570
inSameSet :: Ix a => DisjointSet a -> a -> a -> IO Bool
6671
inSameSet ds x y =

‎solutions/src/2024/18.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,7 @@ import Control.Monad (when)
1919
import Data.Array.IO (IOUArray, Ix(range, inRange), readArray, writeArray, newArray)
2020
import Data.Array.Unboxed (UArray, accumArray)
2121
import Data.Foldable (for_, traverse_)
22+
import Data.Functor (void)
2223
import Data.Maybe (listToMaybe)
2324

2425
-- | >>> :main
@@ -56,7 +57,7 @@ part2 cs =
5657
let link x y =
5758
when (inRange b y)
5859
do o <- readArray open y
59-
when o (unifySets ds x y)
60+
when o (void (unifySets ds x y))
6061

6162
-- Connect all the adjacent, initially open spaces
6263
for_ (range b) \c ->

‎solutions/src/2025/08.hs‎

Lines changed: 64 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -8,38 +8,65 @@ Maintainer : [email protected]
88
99
<https://adventofcode.com/2025/day/8>
1010
11+
>>> :{
12+
:main +
13+
"prefix=10
14+
162,817,812
15+
57,618,57
16+
906,360,560
17+
592,479,940
18+
352,342,300
19+
466,668,158
20+
542,29,236
21+
431,825,988
22+
739,650,466
23+
52,470,668
24+
216,146,977
25+
819,987,18
26+
117,168,530
27+
805,96,715
28+
346,949,466
29+
970,615,88
30+
941,993,340
31+
862,61,35
32+
984,92,344
33+
425,690,689
34+
"
35+
:}
36+
40
37+
25272
38+
1139
-}
1240
module Main (main) where
1341

1442
import Advent (format)
1543
import Advent.Coord3 ( Coord3(C3) )
1644
import Advent.DisjointSet (newDisjointSet, setRepresentative, setSize, unifySets, DisjointSet)
17-
import Data.List ( sort, sortOn, tails )
18-
import Data.Maybe ( catMaybes )
45+
import Data.List ( sort, sortOn, tails, sortBy )
46+
import Data.Maybe ( catMaybes, fromMaybe )
1947

2048
-- | >>> :main
2149
-- 244188
2250
-- 8361881885
2351
main :: IO ()
2452
main =
25-
do input <- [format|2025 8 (%u,%u,%u%n)*|]
53+
do (mbPrefixLen, input) <- [format|2025 8 (prefix=%u%n|)(%u,%u,%u%n)*|]
54+
let prefixLen = fromMaybe 1000 mbPrefixLen
2655
let n = length input
2756

28-
-- Pairs of junction identifiers and coordinates
29-
let pairs = [ (i, j, C3 x1 x2 x3, C3 y1 y2 y3)
57+
-- Pairs of junction identifiers and coordinates sorted by distance
58+
let pairs = sortOn dist2
59+
[ (i, j, C3 x1 x2 x3, C3 y1 y2 y3)
3060
| (i, (x1, x2, x3)) : xs <- tails (zip [1..] input)
3161
, (j, (y1, y2, y3)) <- xs]
3262

33-
-- Pairs sorted by straight line distance
34-
let pairs' = sortOn dist2 pairs
35-
3663
ds <- newDisjointSet (1, n)
37-
let (p1, p2) = splitAt 1000 pairs'
38-
39-
-- Do the first 1000 connections and compute the part 1 answer
64+
let (p1, p2) = splitAt prefixLen pairs
65+
66+
-- Do the first 1000 (unless overridden) connections and compute the part 1 answer
4067
n1 <- loop (length input) ds p1
4168
print =<< part1Answer ds n
42-
69+
4370
-- Keep going and compute the part 2 answer
4471
loop n1 ds p2
4572
pure ()
@@ -51,28 +78,37 @@ loop ::
5178
IO Int {- ^ number of disjoint circuits remaining -}
5279
loop n ds [] = pure n
5380
loop n ds ((i, j, x, y):xs) =
54-
do i' <- setRepresentative ds i
55-
j' <- setRepresentative ds j
56-
if i' == j' then loop n ds xs
57-
else do
58-
unifySets ds i' j'
59-
if n == 2 then 1 <$ print (part2Answer x y)
60-
else loop (n-1) ds xs
81+
do success <- unifySets ds i j
82+
if success then
83+
if n == 2 then
84+
1 <$ print (part2Answer x y)
85+
else
86+
loop (n-1) ds xs
87+
else
88+
loop n ds xs
6189

6290
-- | Distance-squared between the two points
6391
dist2 :: (a, b, Coord3, Coord3) -> Int
64-
dist2 (_, _, C3 x1 x2 x3, C3 y1 y2 y3) = sq (x1-y1) + sq (x2-y2) + sq (x3-y3)
65-
where sq x = x*x
92+
dist2 (_, _, x, y) = sq a + sq b + sq c
93+
where
94+
C3 a b c = x - y
95+
sq a = a * a
96+
97+
-- | Returns the size of each connected set.
98+
setSizes :: DisjointSet Int -> Int -> IO [Int]
99+
setSizes ds n = catMaybes <$> mapM rootSize [1 .. n]
100+
where
101+
rootSize x =
102+
do x' <- setRepresentative ds x
103+
if x' == x then
104+
Just <$> setSize ds x'
105+
else
106+
pure Nothing
66107

67108
part1Answer :: DisjointSet Int -> Int -> IO Int
68109
part1Answer ds n =
69-
do sizes <- mapM (\x -> do
70-
x' <- setRepresentative ds x
71-
if x' == x then do
72-
n <- setSize ds x'
73-
pure (Just n)
74-
else pure Nothing) [1 .. n]
75-
pure (product (take 3 (reverse (sort (catMaybes sizes)))))
110+
do sizes <- setSizes ds n
111+
pure (product (take 3 (sortBy (flip compare) sizes)))
76112

77113
-- | Product of the x-coordinates of the last connection needed.
78114
part2Answer :: Coord3 -> Coord3 -> Int

0 commit comments

Comments
 (0)