Tweaking and tidying

diff --git a/advent14/Main.hs b/advent14/Main.hs
index d3b0c621feaeedc80e070b07b2237d36aa7fbe5b..e7e8d5b53173018faff8bde55d43e6a625d30c2a 100644 (file)
--- a/advent14/Main.hs
+++ b/advent14/Main.hs
@@ -2,29 +2,22 @@
 
 import AoC
 import Data.List
-import qualified Data.Map.Strict as Map
+import qualified Data.Map.Strict as M
 import qualified Data.Array.Unboxed as U
-import qualified Data.Array.ST as M
+import qualified Data.Array.ST as A
 import Data.STRef
 import Control.Monad.ST
 import Control.Monad
 import Data.Ix
-
-
 import Linear (V2(..), (^+^))
 import qualified Data.Sequence as Q
 import Data.Sequence (Seq( (:|>), (:<|) ) ) 
 
-data Element = Empty | Cube | Round deriving (Show, Eq, Ord)
-
 type Position = V2 Int
 type Grid = U.UArray Position Bool
-type MGrid s = M.STUArray s Position Bool
-
+type MGrid s = A.STUArray s Position Bool
 type Gaps s = STRef s (Q.Seq Position)
-
-type Cache = Map.Map Grid Int
-
+type Cache = M.Map Grid Int
 
 main :: IO ()
 main = 
@@ -44,21 +37,20 @@ main =
       print $ part2 rGrid cGrid
       
 
-part1 :: Grid -> Grid -> Int
+part1, part2 :: Grid -> Grid -> Int
 part1 rGrid cGrid = getLoad $ rollNorth rGrid cGrid 
-
 part2 rGrid cGrid = getLoad finalGrid
   where (grid', cache, repeatEnd) = findRepeat rGrid cGrid
-        repeatStart = cache Map.! grid'
+        repeatStart = cache M.! grid'
         repeatLen = repeatEnd - repeatStart
         finalIndex = ((1e9 - repeatStart) `mod` repeatLen) + repeatStart
-        (finalGrid, _) = Map.findMin $ Map.filter (== finalIndex) cache
+        (finalGrid, _) = M.findMin $ M.filter (== finalIndex) cache
 
 
 findRepeat :: Grid -> Grid -> (Grid, Cache, Int)
-findRepeat rGrid cGrid = head $ dropWhile test $ iterate go (rGrid, Map.empty, 0)
-  where test (g, c, _) = g `Map.notMember` c
-        go (g, c, i) = (rollCycle g cGrid, Map.insert g i c, (i + 1))
+findRepeat rGrid cGrid = head $ dropWhile test $ iterate go (rGrid, M.empty, 0)
+  where test (g, c, _) = g `M.notMember` c
+        go (g, c, i) = (rollCycle g cGrid, M.insert g i c, (i + 1))
 
 rollNorth, rollCycle :: Grid -> Grid -> Grid
 rollNorth rGrid cGrid = roll (V2 0 0) (V2 0 1) (V2 1 0) cGrid rGrid
@@ -74,25 +66,25 @@ rollCycle rGrid cGrid = foldl' go rGrid [ (V2 0 0, V2 0 1, V2 1 0)
 
 roll :: Position -> Position -> Position -> Grid -> Grid -> Grid
 roll start majorStep minorStep cGrid rGrid =
-  M.runSTUArray $ 
-    do grid <- M.thaw rGrid 
+  A.runSTUArray $ 
+    do grid <- A.thaw rGrid 
        holes <- newSTRef Q.Empty
        forM_ (takeWhile (inBounds rGrid) $ iterate (^+^ majorStep) start) $ \maj ->
          do writeSTRef holes Q.Empty
             forM_ (takeWhile (inBounds rGrid) $ iterate (^+^ minorStep) maj) $ \here ->
-              do rollPosition grid cGrid holes here
+              rollPosition grid cGrid holes here
        return grid
 
 rollPosition :: (MGrid s) -> Grid -> (Gaps s) -> Position -> ST s ()
 rollPosition grid cGrid holes here
   | cGrid U.! here = writeSTRef holes Q.Empty
-  | otherwise = do roundHere <- M.readArray grid here
+  | otherwise = do roundHere <- A.readArray grid here
                    holesVal <- readSTRef holes
                    if roundHere then
                      case holesVal of
                        Q.Empty -> return ()
-                       (h :<| hs) -> do M.writeArray grid h True
-                                        M.writeArray grid here False
+                       (h :<| hs) -> do A.writeArray grid h True
+                                        A.writeArray grid here False
                                         writeSTRef holes (hs :|> here)
                    else modifySTRef holes (:|> here)
 
@@ -110,13 +102,13 @@ readGrids text = (rGrid, cGrid)
   where rows = lines text
         r = length rows - 1
         c = (length $ head rows) - 1
-        rGrid = U.listArray ((V2 0 0), (V2 r c)) $ map ((== Round) . readElem) $ concat rows
-        cGrid = U.listArray ((V2 0 0), (V2 r c)) $ map ((== Cube ) . readElem) $ concat rows
+        rGrid = U.listArray ((V2 0 0), (V2 r c)) $ fmap (== 'O') $ concat rows
+        cGrid = U.listArray ((V2 0 0), (V2 r c)) $ fmap (== '#') $ concat rows
 
-readElem :: Char -> Element
-readElem '.' = Empty
-readElem '#' = Cube
-readElem 'O' = Round
+-- readElem :: Char -> Element
+-- readElem '.' = Empty
+-- readElem '#' = Cube
+-- readElem 'O' = Round
 
 showGrid :: Grid -> Grid -> String
 showGrid rGrid cGrid = unlines rows