refaco(2024/Day16)

Author: goblivend

2024/Day16/Day16.hs

@@ -1,9 +1,6 @@
 module Main where
 
-import Data.Bits
 import Data.List
-import Data.List.Split
-import Data.List.Unique
 import Data.Map (Map)
 import Data.Map qualified as M
 import Data.Matrix (Matrix, (!))
@@ -13,7 +10,6 @@ import Data.Set qualified as S
 import Data.Tuple.Extra
 import Debug.Trace
 import System.Environment
-import Text.Regex.TDFA ((=~))
 -- TODO: Cleanup imports after day done
 
 type Input = (Matrix Char, (Int, Int))
@@ -42,41 +38,31 @@ turn90 RIGHT = [UP, DOWN]
 
 pathFind ::Matrix Char -> Map ((Int, Int), Dir) Int -> Int -> Dir -> (Int, Int) -> (Bool, Map ((Int, Int), Dir) Int, Int, Set (Int, Int))
 pathFind maze seen score dir pos
-  -- | rightPos && trace ("At " ++ show pos) (False ) = (False, seen, -1, S.empty)
-  | (pos, dir) `M.member` seen && seen M.! (pos, dir) < score = (False, seen, -1, S.empty) -- Lower score ok
-  -- | rightPos && trace ("At " ++ show pos ++ " has better score") (False ) = (False, seen, -1, S.empty)
-  | maze ! pos == 'E' = (True, seen, score, S.singleton pos)
-  -- | rightPos && trace ("At " ++ show pos ++ " not at end") (False ) = (False, seen, -1, S.empty)
-  | maze ! pos == '#' = (False, seen, -1, S.empty)
-  -- | rightPos && trace ("At " ++ show pos ++ " not at wall" ++ show bestSols) (False ) = (False, seen, -1, S.empty)
+  | {-# SCC alreadyBeen #-} (pos, dir) `M.member` seen && seen M.! (pos, dir) < score = (False, seen, -1, S.empty) -- Lower score ok
+  | {-# SCC isEnd #-} maze ! pos == 'E' = (True, seen, score, S.singleton pos)
+  | {-# SCC isWall #-} maze ! pos == '#' = (False, seen, -1, S.empty)
   | length bestSols /= 0 = bestSol
   | otherwise = (False, s2seen, -1, S.empty)
     where
-      rightPos = (pos == (5, 4) || (pos == (4, 4) && dir == UP))
-
-
-
       currSeen = (M.insert (pos, dir) score seen)
-      (fbool, fseen, fscore, fseats) = pathFind maze currSeen (score + 1) dir (move pos dir)
+      (fbool, fseen, fscore, fseats) = {-# SCC findForward #-} pathFind maze currSeen (score + 1) dir (move pos dir)
       [d1, d2] = turn90 dir
-      (s1bool, s1seen, s1score, s1seats) = pathFind maze fseen (score + 1001) d1 (move pos d1)
-      (s2bool, s2seen, s2score, s2seats) = pathFind maze s1seen (score + 1001) d2 (move pos d2)
+      (s1bool, s1seen, s1score, s1seats) = {-# SCC findSide1 #-} pathFind maze fseen (score + 1001) d1 (move pos d1)
+      (s2bool, s2seen, s2score, s2seats) = {-# SCC findSide2 #-} pathFind maze s1seen (score + 1001) d2 (move pos d2)
 
       bestSols :: [[(Bool, Set (Int, Int), Int)]]
-      bestSols = groupBy (\a b -> thd3 a == thd3 b) . sortOn thd3 $ filter (fst3) [(fbool, fseats, fscore), (s1bool, s1seats, s1score), (s2bool, s2seats, s2score)]
+      bestSols = {-# SCC sortBest #-} groupBy (\a b -> thd3 a == thd3 b) . sortOn thd3 $ filter (fst3) [(fbool, fseats, fscore), (s1bool, s1seats, s1score), (s2bool, s2seats, s2score)]
 
-      seats = S.unions $ map snd3 $ head bestSols
+      seats = {-# SCC union #-} S.unions $ map snd3 $ head bestSols
 
       bestSol = (True, s2seen, thd3 . head $ head bestSols, S.insert pos seats)
 
-part :: Input -> (Output, Output)
-part (maze, pos) = (\(_,_,p1,p2) -> (p1, S.size p2)) $ pathFind maze M.empty 0 RIGHT pos
+solve :: Input -> (Output, Output)
+solve (maze, pos) = (\(_,_,p1,p2) -> (p1, {-# SCC sizeCalculation #-} S.size p2)) $ pathFind maze M.empty 0 RIGHT pos
 
 showMaze :: Matrix Char -> Set (Int, Int) -> [String]
 showMaze maze path = map (map (\yx -> if yx `S.member` path then 'O' else maze ! yx)) [[(y, x) | x<-[1..Mat.ncols maze]] | y<-[1..Mat.nrows maze]]
 
-
-
 main :: IO ()
 main = do
   args  <- getArgs
@@ -85,9 +71,9 @@ main = do
 
   -- print $ first Mat.toLists input
 
-  let (part1, part2) = part input
+  let (part1, part2) = solve input
 
-  print $ (== 85480) $ part1
-  print $ (== 518) $ part2
+  print $ part1
+  print $ part2
 
   -- putStrLn $ unlines . showMaze (fst input) $ (\(_,_,_,e) -> e) $ pathFind (fst input) M.empty 0 RIGHT (snd input)

2024/README.md

@@ -204,3 +204,37 @@ Nice and interesting puzzle today
 Basically a simple path finding but with a few twists that make it fun
 
 Will try to optimize solution
+
+Edit: Haven't found any easy optimization
+
+I know a way to optimize : Have another Map containing this time the set of valid spots => if already been on a position no need to do it again even from another good path.
+
+For example
+```
+#######
+#....E#
+#.#.###
+#S..###
+#######
+```
+
+The first path explored will be this one
+```
+#######
+#..OOE#
+#.#O###
+#SOO###
+#######
+```
+
+But then at the moment when I reach the last intersection I need to go back up to the end
+
+```
+#######
+#OOXXE#
+#O#.###
+#S..###
+#######
+```
+
+The optimization would allow me to skip this last part represented with `X`