Day 3

app/Main.hs

@@ -34,11 +34,11 @@ main = do
     print (sum fs + (sum . fmap calculateFuelOfFuel) fs)
     r_day2 <- readFile "./app/input_day2"
     let instructions = day2_instructions r_day2
-    putStr "[Day 2-1] Result:"
+    putStr "[Day 2-1] Result: "
     print $ day2 (12,2) instructions
-    putStr "[Day 2-2] Result:"
+    putStr "[Day 2-2] Result: "
     print $ day2_look instructions
     r_day3 <- readFile "./app/input_day3"
-    putStr "[Day 3-1] Result: "
+    putStr "[Day 3] Result: "
-    print $ getNumber r_day3
+    print $ getDistanceAndSteps r_day3
-    
+

src/Day3.hs

@@ -1,13 +1,14 @@
 module Day3
     (
-        module Day3
+        getDistanceAndSteps
     ) where
 
 import Numeric.Natural
 import Text.ParserCombinators.ReadP
 import Data.Char
 import Control.Applicative
-import Data.Set as S
+import Data.Map as M
+import Data.List
 
 data Instruction = R Natural
                  | L Natural
@@ -32,47 +33,56 @@ readInstruction = do
         _ -> error "fail instruction"
 
 type Coord = (Integer, Integer)
+type MyMap = M.Map Coord Natural
 
 executeInstruction :: Coord
+                   -> Natural
                    -> Instruction
-                   -> S.Set Coord
+                   -> MyMap
-                   -> (S.Set Coord, Coord)
+                   -> (MyMap, Coord, Natural)
-executeInstruction (x,y) (R n) s = (go (fromIntegral n) s, (x,y + fromIntegral n))
+executeInstruction (x,y) steps (R n) s = (go 1 s, (x + fromIntegral n, y), steps + n)
-    where go 0  s' = s'
+    where go n' s'
-          go n' s'  = S.insert (x,y + n') (go (n' - 1) s')
+            | n' == fromIntegral n + 1 = s'
-executeInstruction (x,y) (L n) s = (go (fromIntegral n) s, (x,y - fromIntegral n))
+            | otherwise = M.insertWith min (x + n', y) (steps + fromInteger n') (go (n'+ 1) s')
-    where go 0  s' = s'
+executeInstruction (x,y) steps (L n) s = (go 1 s, (x - fromIntegral n,y), steps + n)
-          go n' s'  = S.insert (x,y - n') (go (n' - 1) s')
+    where go n' s'
-executeInstruction (x,y) (U n) s = (go (fromIntegral n) s, (x + fromIntegral n,y))
+            | n' == fromIntegral n + 1 = s'
-    where go 0  s' = s'
+            | otherwise = M.insertWith min (x - n', y) (steps + fromInteger n') (go (n'+ 1) s')
-          go n' s'  = S.insert (x + n',y) (go (n' - 1) s')
+executeInstruction (x,y) steps (U n) s = (go 1 s, (x,y + fromIntegral n), steps + n)
-executeInstruction (x,y) (D n) s = (go (fromIntegral n) s, (x - fromIntegral n,y))
+    where go n' s'
-    where go 0  s' = s'
+            | n' == fromIntegral n + 1 = s'
-          go n' s'  = S.insert (x - n',y) (go (n' - 1) s')
+            | otherwise = M.insertWith min (x, y + n') (steps + fromInteger n') (go (n'+ 1) s')
+executeInstruction (x,y) steps (D n) s = (go 1 s, (x,y - fromIntegral n), steps + n)
+    where go n' s'
+            | n' == fromIntegral n + 1 = s'
+            | otherwise = M.insertWith min (x, y - n') (steps + fromInteger n') (go (n'+ 1) s')
 
-executeAllInstructions :: Line -> Coord -> S.Set Coord
+executeAllInstructions :: Line -> Coord -> Natural -> MyMap
-executeAllInstructions [] _ = S.empty
+executeAllInstructions [] _ _ = M.empty
-executeAllInstructions (x:xs) c =
+executeAllInstructions (x:xs) c steps =
-    let (s, c') = executeInstruction c x S.empty in
+    let (s, c', steps') = executeInstruction c steps x M.empty in
-        union s (executeAllInstructions xs c')
+        M.unionWith min s (executeAllInstructions xs c' steps')
 
-executeForAllLines :: [Line] -> Coord -> [S.Set Coord]
+executeForAllLines :: [Line] -> Coord -> Natural -> [MyMap]
-executeForAllLines [] _ = []
+executeForAllLines [] _ _ = []
-executeForAllLines (x:xs) c =
+executeForAllLines (x:xs) c steps =
-    executeAllInstructions x c : executeForAllLines xs c
+    executeAllInstructions x c steps : executeForAllLines xs c steps
 
-getIntersection :: [S.Set Coord] -> S.Set Coord
+getIntersection :: [MyMap] -> M.Map Coord [Natural]
-getIntersection [] = S.empty
+getIntersection [] = M.empty
-getIntersection (x:xs) = Prelude.foldr S.intersection x xs
+getIntersection (x:xs) = Prelude.foldr (M.intersectionWith (:)) (M.map (:[]) x) xs
 
 getDistance :: Coord -> Integer
 getDistance (x,y) = abs x + abs y
 
-getSmallest :: S.Set Coord -> Integer
+getSmallest :: M.Map Coord [Natural] -> Integer
-getSmallest = S.findMin . S.map getDistance
+getSmallest = fst . M.findMin . M.mapKeys getDistance
 
-getNumber :: String -> Integer
+getSmallest' :: M.Map Coord [Natural] -> Integer
-getNumber s = getSmallest c
+getSmallest' m = let m' = M.map (fromIntegral . sum) m in minimum m'
+
+getDistanceAndSteps :: String -> (Integer, Integer)
+getDistanceAndSteps s = (getSmallest c, getSmallest' c)
     where c = getIntersection cs
-          cs = executeForAllLines ls (0,0)
+          cs = executeForAllLines ls (0,0) 0
           ls = fst . last . readP_to_S readInstructions <$> lines s