Day 18 - replaced Matrix with UArray with great performance improvements!

README.md

@@ -26,10 +26,10 @@ Now located in this repository's wiki.
 | 12  | ~ 1.5       |
 | 13  | ~ 0.5       |
 | 14  |  22.3       |
-| 15  | < 1         |
-| 16  | ~ 15        |
-| 17  | 120         |
-| 18  |             |
+| 15  |             |
+| 16  | ~ 1         |
+| 17  | ~ 15        |
+| 18  | ~ 6         |
 | 19  |             |
 | 20  |             |
 | 21  |             |

package.yaml

@@ -26,6 +26,7 @@ dependencies:
 - extra
 - matrix
 - vector
+- array
 
 library:
   source-dirs: src

src/Day18.hs

@@ -1,47 +1,57 @@
 module Day18 (main) where
 
 import Data.Maybe (catMaybes)
-import Data.Matrix (Matrix, fromLists, nrows, ncols, (!), safeGet, setElem)
+import Data.Foldable (foldl')
+import Data.Ix (range, inRange)
+import Data.Array.Unboxed
 
-type Landscape = Matrix Char
+type Landscape = UArray Coordinate Char
 type Coordinate = (Int, Int) -- row, col
 
-stepCoord :: Landscape -> Coordinate -> Landscape -> Landscape
-stepCoord oldscape (r, c) newscape =
-    let neighbours = catMaybes $ map (flip (uncurry safeGet) oldscape) [(r', c') | r' <- [r-1 .. r+1], c' <- [c-1 .. c+1], (r', c') /= (r, c)]
-        newAcre = case oldscape ! (r, c) of
+parse :: String -> Landscape
+parse str =
+    let nestedList = lines str
+        maxIx = (length nestedList, length $ head nestedList)
+    in  listArray ((1, 1), maxIx) $ concat nestedList
+
+stepCoord :: Landscape -> Landscape -> Coordinate -> Landscape
+stepCoord oldscape newscape coord@(r, c) =
+    let neighbours = catMaybes . map (safeGet oldscape) . filter (/= coord) $ range ((r - 1, c - 1), (r + 1, c + 1))
+        newAcre = case oldscape ! coord of
             '.' -> if (length $ filter (== '|') neighbours) >= 3 then '|' else '.'
             '|' -> if (length $ filter (== '#') neighbours) >= 3 then '#' else '|'
             '#' -> if '|' `elem` neighbours && '#' `elem` neighbours then '#' else '.'
-    in  setElem newAcre (r, c) newscape
+    in  newscape // [(coord, newAcre)]
+    where
+        safeGet :: Landscape -> Coordinate -> Maybe Char
+        safeGet scape coord = if inRange (bounds scape) coord then Just $ scape ! coord else Nothing
 
 stepScape :: Landscape -> Landscape
-stepScape oldscape = foldr (stepCoord oldscape) oldscape [(r, c) | r <- [1 .. nrows oldscape], c <- [1 .. ncols oldscape]]
+stepScape oldscape = foldl' (stepCoord oldscape) oldscape $ indices oldscape
+
+getResVal :: Landscape -> Int
+getResVal scape =
+    let woodedCount     = length . filter (== '|') . elems $ scape
+        lumberyardCount = length . filter (== '#') . elems $ scape
+    in  woodedCount * lumberyardCount
 
 part1 :: Landscape -> Int
-part1 scape =
-    let newscape = iterate stepScape scape !! 10
-        woodedCount     = sum $ fmap (fromEnum . (== '|')) newscape
-        lumberyardCount = sum $ fmap (fromEnum . (== '#')) newscape
-    in  woodedCount * lumberyardCount
+part1 scape = getResVal $ iterate stepScape scape !! 10
 
 part2 :: Landscape -> Int
 part2 scape =
     let resVals = map getResVal $ iterate stepScape scape
-        (i, i') = (461, 489) -- cycleIndices (drop 1 resVals) (drop 2 resVals) 1 2
-        cyclePos = (1000000000 - i) `mod` (i' - i) + i
-    in  getResVal $ iterate stepScape scape !! cyclePos -- resVals !! cyclePos
+        (i1, i2) = tortoiseHare (drop 1 resVals) (drop 2 resVals) 1 2
+        pos = (1000000000 - i1) `mod` (i2 - i1) + i1
+    in  resVals !! pos
     where
-        getResVal scape =
-            let woodedCount     = sum $ fmap (fromEnum . (== '|')) scape
-                lumberyardCount = sum $ fmap (fromEnum . (== '#')) scape
-            in  woodedCount * lumberyardCount
-        -- theoretically this works but it was just faster to print out the first 500 values
-        cycleIndices (t:ts) (h:_:hs) ti hi =
-            if t == h then (ti, hi) else cycleIndices ts hs (ti + 1) (hi + 2)
+        tortoiseHare (t:ts) (h:_:hs) ti hi =
+            if t == h then (ti, nextOcc t ts (ti + 1)) else tortoiseHare ts hs (ti + 1) (hi + 2)
+        nextOcc v (r:rs) n =
+            if v == r then n else nextOcc v rs (n + 1)
 
 main :: IO ()
 main = do
-    input <- fromLists . lines <$> readFile "input/18.txt"
+    input <- parse <$> readFile "input/18.txt"
     print $ part1 input
     print $ part2 input