Tidying

diff --git a/adventofcode1624/app/advent24.hs b/adventofcode1624/app/advent24.hs
index fc97d167ea098ebce349592ea8743beda9505c34..efd99ac48e70876e4ee26515d0140de0e890e453 100644 (file)
--- a/adventofcode1624/app/advent24.hs
+++ b/adventofcode1624/app/advent24.hs
@@ -3,16 +3,12 @@
 module Main(main) where
 
 import GHC.Generics (Generic)
-import Data.Maybe (catMaybes, fromJust)
+import Data.Maybe (catMaybes)
 import Data.List 
 import Data.Char (isDigit)
 import qualified Data.Map.Strict as M
 import Data.Map.Strict ((!))
-import qualified Data.HashSet as S
-import Data.Graph.AStar
 import Data.Hashable
-import qualified Data.HashSet
-import Debug.Trace
 
 type Point = (Int, Int) -- row, column, both zero based.
 type Grid = M.Map Point Char
@@ -22,13 +18,9 @@ data Path = Path { from :: Point
                  , path :: Int
                  } deriving (Eq, Generic)
 instance Hashable Path
--- instance Eq Path where
---     p1 == p2 = (joins p1) == (joins p2) 
 instance Show Path where
     show p = "Path { " ++ show (from p) ++ " -> " ++ show (to p) ++ ", " ++ show (path p) ++ " }"
 
-type PathSet = S.HashSet Path
-
 -- Grid search state
 data Gss = Gss { origin :: Point
                , current :: Point
@@ -41,9 +33,6 @@ instance Ord Gss where
 instance Show Gss where
     show gss = "Gss { " ++ show (origin gss) ++ " -> " ++ show (current gss) ++ " -> " ++ show (goal gss) ++ " }"
 
-data Tour = Tour {at :: Point, tour :: [Path]} deriving (Show, Eq)
-
-
 littleGrid = "\
 \###########\n\
 \#0.1.....2#\n\
@@ -61,49 +50,18 @@ main = do
     let start = head $ M.keys $ M.filter (=='0') mp
     let aStarSearch s g = asG [startGss s g] mp []
     let paths = map (fromGss) $ catMaybes $ [aStarSearch st gl | st <- (M.keys goals), gl <- (M.keys goals), st /= gl]
-
-    -- part0 mp
     part1 start (M.keys goals) paths
     part2 start (M.keys goals) paths
 
-part0 mp = print (length allPaths, allPaths)
-    where goals = M.filter (isDigit) mp
-          start = head $ M.keys $ M.filter (=='0') mp
-          -- goal = head $ M.keys goals
-          goal = head $ M.keys $ M.filter (=='2') mp
-          -- aStarSearch s g = aStar (successorsG mp) costG heuristicG isGoalG (startGss s g)
-          aStarSearch s g = asG [startGss s g] mp []
-          traceSearch s g = trace ("Trace " ++ (show s) ++ " -> " ++ (show g)) (aStarSearch s g)
-          paths = S.fromList $ map (fromGss) $ catMaybes $ map (\gl -> aStarSearch start gl) $ M.keys goals
-          path = aStarSearch start goal
-          allPaths = map (fromGss) $ catMaybes $ [traceSearch st gl | st <- (M.keys goals), gl <- (M.keys goals), st /= gl]
-
 fromGss :: Gss -> Path
 fromGss g = Path {from = origin g, to = goal g, path = (length (gssPath g)) - 1}
 
 part1 :: Point -> [Point] -> [Path] ->  IO ()
 part1 start points paths = print $ shortestTour start points paths
 
-    -- where goals = M.filter (isDigit) mp
-    --       start = head $ M.keys $ M.filter (=='0') mp
-    --       aStarSearch s g = asG [startGss s g] mp []
-    --       paths = nub $ map (fromGss) $ catMaybes $ [aStarSearch st gl | st <- (M.keys goals), gl <- (M.keys goals), st /= gl]
-
 part2 :: Point -> [Point] -> [Path] ->  IO ()
 part2 start points paths = print $ shortestReturningTour start points paths
 
--- bfsG :: [Gss] -> Grid -> [Path] -> [Point] -> [Path]
--- -- bfsG ps _ paths closed | trace ((show ps) ++ " :: " ++ (show paths) ++ " X " ++ (show closed)) False = undefined
--- bfsG [] _ paths _ = paths
--- bfsG (p:ps) g paths closed = 
---     if current p /= origin p && isDigit currentCell
---         then bfsG ps g (newPath:paths) ((current p):closed)
---         else bfsG (ps ++ extraAgenda) g paths ((current p):closed)
---     where currentCell = (g!(current p))
---           newPath = Path {joins = S.fromList [current p, origin p], path = gssPath p}
---           nextPoints = filter (\np -> np `notElem` ((gssPath p) ++ closed)) $ gridNeighbours g $ current p
---           extraAgenda = map (\n -> Gss {origin = origin p, goal = goal p, current = n, gssPath = (n:(gssPath p))}) nextPoints
-
 asG :: [Gss] -> Grid -> [Point] -> Maybe Gss
 -- asG ps _ closed | trace ((show ps) ++ " :: " ++ (show paths) ++ " X " ++ (show closed)) False = undefined
 asG [] _ _ = Nothing
@@ -113,9 +71,7 @@ asG (p:ps) g closed =
         else if (head $ gssPath p) `elem` closed
                 then asG ps g closed
                 else asG newAgenda g ((current p):closed)
-    where -- currentCell = (g!(current p))
-          -- newPath = Path {joins = S.fromList [current p, origin p], path = gssPath p}
-          nextPoints = filter (\np -> np `notElem` ((gssPath p) ++ closed)) $ gridNeighbours g $ current p
+    where nextPoints = filter (\np -> np `notElem` ((gssPath p) ++ closed)) $ gridNeighbours g $ current p
           extraAgenda = map (\n -> Gss {origin = origin p, goal = goal p, current = n, gssPath = (n:(gssPath p))}) nextPoints
           newAgenda = sort (ps ++ extraAgenda)
 
@@ -123,7 +79,6 @@ asG (p:ps) g closed =
 startGss :: Point -> Point -> Gss
 startGss p g = Gss {origin = p, goal = g, current = p, gssPath = [p]}
 
-
 gridNeighbours :: Grid -> Point -> [Point]
 gridNeighbours g p@(r, c) = filter (\n -> (g!n) /= '#') ns
     where ns = [(r-1, c), (r+1, c), (r, c-1), (r, c+1)]
@@ -133,20 +88,6 @@ heuristicG gss = abs (rg - rc) + abs (cg - cc)
     where (rg, cg) = goal gss
           (rc, cc) = current gss
 
--- isGoalG :: Gss -> Bool
--- isGoalG st = current st == goal st
-
--- successorsG :: Grid -> Gss -> Data.HashSet.HashSet Gss
--- successorsG grid st = Data.HashSet.fromList extraAgenda
---     where nextPoints = gridNeighbours grid $ current st
---           -- nextPoints = filter (\np -> np `notElem` (gssPath st)) $ gridNeighbours grid $ current st
---           extraAgenda = map (\n -> Gss {origin = origin st, goal = goal st, current = n, gssPath = (n:(gssPath st))}) nextPoints
-
--- costG :: a -> b -> Int
--- costG = const $ const 1
-
-
-
 shortestTour :: Point -> [Point] -> [Path] -> Int
 shortestTour p0 points paths = minimum $ map (\p -> pathLength p paths) startRight
     where pointPerms = permutations points