start cleaning up 10

solutions/src/2023/08.hs

@@ -12,10 +12,10 @@ Maintainer  : emertens@gmail.com
 module Main (main) where
 
 import Advent (format, stageTH)
+import Control.Monad (unless)
+import Data.List (findIndex)
 import Data.Map qualified as Map
 import Data.Maybe (fromJust)
-import Data.List (findIndex)
-import Control.Monad (unless)
 
 data D = DL | DR
 

solutions/src/2023/10.hs

@@ -1,4 +1,4 @@
-{-# Language QuasiQuotes, ImportQualifiedPost #-}
+{-# Language LambdaCase, ImportQualifiedPost, TransformListComp #-}
 {-|
 Module      : Main
 Description : Day 10 solution
@@ -11,12 +11,13 @@ Maintainer  : emertens@gmail.com
 -}
 module Main (main) where
 
-import Advent
+import Advent (getInputMap)
+import Advent.Coord (cardinal, invert, invert', south, turnLeft, Coord)
+import Advent.Search (dfsN, dfsOn)
 import Data.Map (Map)
 import Data.Map qualified as Map
+import Data.Set (Set)
 import Data.Set qualified as Set
-import Advent.Search (bfsN, bfsOnN)
-import Advent.Coord (Coord, cardinal, north, south, east, west, above, below, right, left)
 
 -- | Parse the input and print out answers to both parts.
 --
@@ -26,51 +27,40 @@ import Advent.Coord (Coord, cardinal, north, south, east, west, above, below, ri
 main :: IO ()
 main =
  do input <- getInputMap 2023 10
-    let start = head [k | (k,'S') <- Map.assocs input]
-    let coords = [(here,dir) | d <- [south], (_,dir,here) <- bfsOnN pick (step input) [(1,d,d+start)]]
+    let start = head [k | (k, 'S') <- Map.assocs input]
+    let dir0 = south -- XXX: hardcoded
+    let route = [(here,dir) | (dir,here) <- dfsOn snd (step input) (dir0, dir0+start)]
 
-    let pipe = Set.fromList (map fst coords)
-    let candidates = Set.fromList (concatMap (rightof input) coords) `Set.difference` pipe
-    let contained = Set.fromList (bfsN (openNeighbors input pipe) (Set.toList candidates))
-    print (length coords `quot` 2)
+    let pipe = Set.fromList (map fst route)
+    let containable = Map.keysSet input `Set.difference` pipe
+    let candidates = Set.fromList (concatMap (rightof input) route) `Set.difference` pipe
+    let contained = Set.fromList (dfsN (openNeighbors containable) (Set.toList candidates))
+
+    print (length route `quot` 2)
     print (Set.size contained)
 
-pick :: (a, b, c) -> c
-pick (_,_,here)=here
+openNeighbors :: Set Coord -> Coord -> [Coord]
+openNeighbors input x = [y | y <- cardinal x, Set.member y input]
 
-openNeighbors :: Map Coord a -> Set.Set Coord -> Coord -> [Coord]
-openNeighbors input pipe x = [ y  | y <- cardinal x, Map.member y input , Set.notMember y pipe]
-
-step :: Map Coord Char -> (Int, Coord, Coord) -> [(Int, Coord, Coord)]
-step inp (n, dir, here) =
- do dir' <- next dir (Map.findWithDefault '.' here inp)
-    let here1 = here + dir'
-    pure (n+1, dir', here1)
+step :: Map Coord Char -> (Coord, Coord) -> [(Coord, Coord)]
+step inp (dir, here) =
+  [(dir', here + dir') | let dir' = pipeEffect (inp Map.! here) dir]
 
 rightof :: Map Coord Char -> (Coord, Coord) -> [Coord]
-rightof input (x,dir) =
-  case input Map.! x of
-    '-' | dir == east -> [below x]
-    '-' | dir == west -> [above x]
-    '|' | dir == north -> [right x]
-    '|' | dir == south -> [left x]
-    'F' | dir == west -> [above x, left x]
-    'J' | dir == east -> [below x, right x]
-    '7' | dir == north -> [right x, above x]
-    'L' | dir == south -> [left x, below x]
-    _ -> []
+rightof input (here, dir) =
+  [ here + d
+  | let pipe = pipeEffect (input Map.! here)
+  , d <- iterate turnLeft (-dir)
+  , then drop 1
+  , then takeWhile by dir /= pipe d]
 
-next :: Coord -> Char -> [Coord]
-next dir '-' | dir == east = [east]
-next dir '-' | dir == west = [west]
-next dir '|' | dir == north = [north]
-next dir '|' | dir == south = [south]
-next dir 'J' | dir == south = [west]
-next dir 'J' | dir == east = [north]
-next dir '7' | dir == east = [south]
-next dir '7' | dir == north = [west]
-next dir 'F' | dir == west = [south]
-next dir 'F' | dir == north = [east]
-next dir 'L' | dir == south = [east]
-next dir 'L' | dir == west = [north]
-next _ _ = []
+pipeEffect :: Char -> Coord -> Coord
+pipeEffect = \case
+  'S' -> id
+  '-' -> id
+  '|' -> id
+  '7' -> invert
+  'J' -> invert'
+  'L' -> invert
+  'F' -> invert'
+  _   -> error "bad pipe character"