Day 23

day23/Part1.hs

@@ -0,0 +1,31 @@
+module Part1 where
+
+import Commons
+import Data.Array (Ix (inRange), bounds, (!))
+
+
+cleanNext :: Trails -> [(Int, Int)] -> [((Int, Int), Direction)] -> [((Int, Int), Direction)]
+cleanNext tr hist [] = []
+cleanNext tr hist ((ch, dh): t) =
+  if inRange (bounds tr) ch && (tr ! ch == Slope dh || tr ! ch == Empty) && notElem ch hist
+  then (ch, dh): cleanNext tr hist t else cleanNext tr hist t
+
+getNext :: Trails -> [(Int, Int)] -> Direction -> [((Int, Int), Direction)]
+getNext tr ((y, x): t) North = cleanNext tr t [((y - 1, x), North), ((y, x - 1), West), ((y, x + 1), East)]
+getNext tr ((y, x): t) East = cleanNext tr t [((y - 1, x), North), ((y, x + 1), East), ((y + 1, x), South)]
+getNext tr ((y, x): t) South = cleanNext tr t [((y + 1, x), South), ((y, x - 1), West), ((y, x + 1), East)]
+getNext tr ((y, x): t) West = cleanNext tr t [((y - 1, x), North), ((y, x - 1), West), ((y + 1, x), South)]
+
+getNextTrails' :: Trails -> (Int, Int) -> (Int, Int) -> [(Int, Int)] -> [((Int, Int), Direction)] -> [[(Int, Int)]]
+getNextTrails' _ _ _ _ [] = []
+getNextTrails' tr f s hist ((ch, dh): t)
+  | ch == f   = hist: getNextTrails' tr f ch hist t
+  | otherwise = getNextTrails tr f ch (ch: hist) dh ++ getNextTrails' tr f ch hist t
+
+getNextTrails :: Trails -> (Int, Int) -> (Int, Int) -> [(Int, Int)] -> Direction -> [[(Int, Int)]]
+getNextTrails tr f s hist d = let next = getNext tr hist d
+                              in getNextTrails' tr f s hist next
+
+getAllTrails :: Trails -> [[(Int, Int)]]
+getAllTrails tr = let ((yMin, xMin), (yMax, xMax)) = bounds tr
+                  in getNextTrails tr (yMax, xMax - 1) (yMin, xMin + 1) [(yMin, xMin + 1)] South