Skip to content

Commit 9221f72

Browse files
mstksgmstksg
committed
clean up and reflection
1 parent 1b16e88 commit 9221f72

File tree

3 files changed

+81
-38
lines changed

3 files changed

+81
-38
lines changed

‎2025/AOC2025/Day07.hs‎

Lines changed: 14 additions & 38 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,3 @@
1-
{-# OPTIONS_GHC -Wno-unused-imports #-}
2-
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
3-
41
-- |
52
-- Module : AOC2025.Day07
63
-- License : BSD3
@@ -9,45 +6,24 @@
96
-- Portability : non-portable
107
--
118
-- Day 7. See "AOC.Solver" for the types used in this module!
12-
--
13-
-- After completing the challenge, it is recommended to:
14-
--
15-
-- * Replace "AOC.Prelude" imports to specific modules (with explicit
16-
-- imports) for readability.
17-
-- * Remove the @-Wno-unused-imports@ and @-Wno-unused-top-binds@
18-
-- pragmas.
19-
-- * Replace the partial type signatures underscores in the solution
20-
-- types @_ :~> _@ with the actual types of inputs and outputs of the
21-
-- solution. You can delete the type signatures completely and GHC
22-
-- will recommend what should go in place of the underscores.
239
module AOC2025.Day07 (
2410
day07a,
2511
day07b,
2612
)
2713
where
2814

29-
import AOC.Prelude
30-
import qualified Data.Graph.Inductive as G
31-
import qualified Data.IntMap as IM
32-
import qualified Data.IntMap.NonEmpty as NEIM
33-
import qualified Data.IntSet as IS
34-
import qualified Data.IntSet.NonEmpty as NEIS
35-
import qualified Data.List.NonEmpty as NE
36-
import qualified Data.List.PointedList as PL
37-
import qualified Data.List.PointedList.Circular as PLC
15+
import AOC.Common (countTrue, firstJust)
16+
import AOC.Common.Point (Point, parseAsciiMap)
17+
import AOC.Solver (noFail, (:~>) (..))
18+
import Control.Lens (view)
19+
import Data.Foldable (toList)
3820
import qualified Data.Map as M
21+
import Data.Map.NonEmpty (NEMap)
3922
import qualified Data.Map.NonEmpty as NEM
40-
import qualified Data.OrdPSQ as PSQ
41-
import qualified Data.Sequence as Seq
42-
import qualified Data.Sequence.NonEmpty as NESeq
43-
import qualified Data.Set as S
23+
import Data.Maybe (fromMaybe)
24+
import Data.Set.NonEmpty (NESet)
4425
import qualified Data.Set.NonEmpty as NES
45-
import qualified Data.Text as T
46-
import qualified Data.Vector as V
47-
import qualified Linear as L
48-
import qualified Text.Megaparsec as P
49-
import qualified Text.Megaparsec.Char as P
50-
import qualified Text.Megaparsec.Char.Lexer as PP
26+
import Linear.V2 (V2 (..), _y)
5127

5228
parseMap :: String -> Maybe (Point, NESet Point)
5329
parseMap =
@@ -57,7 +33,7 @@ parseMap =
5733
where
5834
reshape (startPos, rest) = (,) . fst <$> M.lookupMin startPos <*> NES.nonEmptySet (M.keysSet rest)
5935

60-
day07a :: _ :~> _
36+
day07a :: (Point, NESet Point) :~> Int
6137
day07a =
6238
MkSol
6339
{ sParse = parseMap
@@ -66,22 +42,22 @@ day07a =
6642
noFail $ \(startPos, splitters) ->
6743
let pathsTo :: NEMap Point Bool
6844
pathsTo = flip NEM.fromSet splitters \(V2 x y0) ->
69-
let cands = takeWhile ((`NES.notMember` splitters) . V2 x) [y0 - 1, y0 - 2 .. 0]
45+
let cands = takeWhile ((`NES.notMember` splitters) . V2 x) [y0 - 2, y0 - 4 .. 0]
7046
in flip any cands \y ->
7147
V2 x y == startPos
7248
|| NEM.findWithDefault False (V2 (x - 1) y) pathsTo
7349
|| NEM.findWithDefault False (V2 (x + 1) y) pathsTo
7450
in countTrue id pathsTo
7551
}
7652

77-
day07b :: _ :~> _
53+
day07b :: (Point, NESet Point) :~> Int
7854
day07b =
7955
MkSol
8056
{ sParse = parseMap
8157
, sShow = show
8258
, sSolve = \(startPos, splitters) -> do
83-
let maxY = maximum $ NES.map (view _y) splitters
84-
downFrom (V2 x y0) = fromMaybe 1 $ flip firstJust [y0 .. maxY] \y ->
59+
let maxY = maximum . map (view _y) $ toList splitters
60+
downFrom (V2 x y0) = fromMaybe 1 $ flip firstJust [y0, y0 + 2 .. maxY] \y ->
8561
NEM.lookup (V2 x y) pathsFrom
8662
pathsFrom :: NEMap Point Int
8763
pathsFrom = flip NEM.fromSet splitters \p ->

‎bench-results/2025/day07.txt‎

Lines changed: 19 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,19 @@
1+
>> Day 07a
2+
benchmarking...
3+
time 294.4 μs (290.3 μs .. 297.8 μs)
4+
0.998 R² (0.996 R² .. 0.999 R²)
5+
mean 292.1 μs (288.4 μs .. 300.8 μs)
6+
std dev 17.52 μs (9.509 μs .. 26.57 μs)
7+
variance introduced by outliers: 56% (severely inflated)
8+
9+
* parsing and formatting times excluded
10+
11+
>> Day 07b
12+
benchmarking...
13+
time 343.3 μs (342.8 μs .. 343.9 μs)
14+
1.000 R² (1.000 R² .. 1.000 R²)
15+
mean 343.1 μs (342.7 μs .. 343.6 μs)
16+
std dev 1.471 μs (1.172 μs .. 1.847 μs)
17+
18+
* parsing and formatting times excluded
19+

‎reflections/2025/day07.md‎

Lines changed: 48 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,48 @@
1+
Both of these can be done with knot-tying -- part 1 tying the knot upwards from
2+
bottom to top to check if a given splitter received any light, and part 2 tying
3+
the knot downwards to add up the number of paths under both paths of a
4+
splitter. Assuming you have your splitter as a `Set Point`:
5+
6+
```haskell
7+
type Point = V2 Int
8+
9+
part1 :: Point -> Set Point -> Int
10+
part1 sourcePos splitters = M.size $ M.filter id reached
11+
where
12+
reached :: Map Point Bool
13+
reached = flip M.fromSet splitters \(V2 x y0) ->
14+
let cands = takeWhile ((`S.notMember` splitters) . V2 x) [y0 - 2, y0 - 4 .. 0]
15+
in flip any cands \y ->
16+
V2 x y == sourcePos
17+
|| NEM.findWithDefault False (V2 (x - 1) y) reached
18+
|| NEM.findWithDefault False (V2 (x + 1) y) reached
19+
```
20+
21+
`cands` climbs all the way up until it hits a splitter, which effectively
22+
blocks the beam. So, along the way, we either hit the source (`V2 x y ==
23+
sourcePos`) or hit the output of a splitter, in which case our result is if
24+
that splitter itself got any light.
25+
26+
```haskell
27+
part2 :: Point -> Set Point -> Int
28+
part2 sourcePos splitters = pathsFrom M.! (sourcePos + V2 0 2)
29+
where
30+
maxY = maximum $ S.map (view _y) $ map splitters
31+
downFrom (V2 x y0) = fromMaybe 1 $ listToMaybe
32+
[ n
33+
| Just n <- M.lookup . V2 x <$> [y0, y0 + 2 .. maxY]
34+
]
35+
pathsFrom :: Map Point Int
36+
pathsFrom = flip M.fromSet splitters \p ->
37+
downFrom (p + V2 1 2) + downFrom (p + V2 (-1) 2)
38+
```
39+
40+
`downFrom` drops downwards until we leave the map (returning 1), or until we
41+
hit a splitter, in which case the number of paths is the number of paths from
42+
the splitter we hit.
43+
44+
Overall by only memoizing/knot-tying against the splitter set, we save a lot of
45+
time from constructing the memo table for the entire grid.
46+
47+
I really want to unite both of these into a single function and swap out `+`
48+
for `||` somehow, but I can't quite seem to massage them...

0 commit comments

Comments
 (0)