Day 20a working, but space leak means it doesn't complete

diff --git a/README.md b/README.md
index e268bd46b85f1e577b1d36ced9fb41b2f849d011..f9bb2e14caf06d504c1f1419b65b627af40164cb 100644 (file)
--- a/README.md
+++ b/README.md
@@ -55,12 +55,16 @@ stack ghci advent-of-code:exe:advent01
 
 To profile, use 
 ```
-stack build --executable-profiling --library-profiling --ghc-options="-fprof-auto -rtsopts" adventofcode1601
+stack build --executable-profiling --library-profiling --ghc-options="-fprof-auto -rtsopts"
 ```
 then run with
 ```
 stack exec -- advent01 +RTS -p -hy
 ```
+Generate the profile graph with
+```
+stack exec hp2ps advent01.hp
+```
 
 # Packages
 

diff --git a/advent-of-code.cabal b/advent-of-code.cabal
index 7a9d811a6619a6fbfd2dc7f6e9f02c079689c0c6..dd2f20754ba2f713b5b9c3bd1fa882c22d0b439b 100644 (file)
--- a/advent-of-code.cabal
+++ b/advent-of-code.cabal
@@ -235,6 +235,8 @@ executable advent20
   build-depends:       base >= 4.7 && < 5
                      , containers
                      , mtl
+                     , transformers
+                     , extra
                      , text
                      , megaparsec 
                      , linear

diff --git a/data/advent20a.txt b/data/advent20a.txt
new file mode 100644 (file)
index 0000000..94b3dad
--- /dev/null
+++ b/data/advent20a.txt
@@ -0,0 +1 @@
+^WNE$

diff --git a/data/advent20b.txt b/data/advent20b.txt
new file mode 100644 (file)
index 0000000..25ab237
--- /dev/null
+++ b/data/advent20b.txt
@@ -0,0 +1 @@
+^ENWWW(NEEE|SSE(EE|N))$

diff --git a/data/advent20c.txt b/data/advent20c.txt
new file mode 100644 (file)
index 0000000..273d2d8
--- /dev/null
+++ b/data/advent20c.txt
@@ -0,0 +1 @@
+^ENNWSWW(NEWS|)SSSEEN(WNSE|)EE(SWEN|)NNN$

diff --git a/data/advent20d.txt b/data/advent20d.txt
new file mode 100644 (file)
index 0000000..402c3bb
--- /dev/null
+++ b/data/advent20d.txt
@@ -0,0 +1 @@
+^ESSWWN(E|NNENN(EESS(WNSE|)SSS|WWWSSSSE(SW|NNNE)))$

diff --git a/data/advent20e.txt b/data/advent20e.txt
new file mode 100644 (file)
index 0000000..6107601
--- /dev/null
+++ b/data/advent20e.txt
@@ -0,0 +1 @@
+^WSSEESWWWNW(S|NENNEEEENN(ESSSSW(NWSW|SSEN)|WSWWN(E|WWS(E|SS))))$

diff --git a/src/advent20/advent20.hs b/src/advent20/advent20.hs
index 96ff8944698d04a8f1fa3fc60b4300345755efd2..7f24c4beb9acc7c9c5b0e8172ad99e0a34802e75 100644 (file)
--- a/src/advent20/advent20.hs
+++ b/src/advent20/advent20.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE NegativeLiterals #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE BangPatterns #-}
 
 
 -- import Debug.Trace
@@ -21,42 +22,70 @@ import qualified Data.Set as S
 
 import Linear (V2(..))
 
-import Control.Monad.State.Lazy
+-- import Control.Monad.State.Lazy
+import Control.Monad.State.Strict
+import Control.Monad.Extra (concatMapM)
+-- import Control.Monad.Trans.List
 
 type Coord = V2 Integer -- x, y, with north and east incresing values (origin a bottom left)
 data Door = Door Coord Coord deriving (Show, Eq, Ord)
 type Doors = S.Set Door
 
-makeDoor :: Coord -> Coord -> Door
-makeDoor a b 
-    | a < b = Door a b
-    | otherwise = Door b a
+data MazeSection = Path [Coord] | Junction [Maze] deriving (Show, Eq)
+type Maze = [MazeSection]
 
 
+type Mapper = State Doors [Coord]
 
 
+makeDoor :: Coord -> Coord -> Door
+makeDoor !a !b 
+    | a < b = Door a b
+    | otherwise = Door b a
+
 main :: IO ()
 main = do 
         text <- TIO.readFile "data/advent20.txt"
+        let maze = successfulParse text
         print $ T.length text
-        -- let (ip, instrs) = successfulParse text
-        -- print (ip, instrs)
-        -- -- print $ part1 ip instrs
-        -- print $ sum [i | i <- [1..1032], 1032 `mod` i == 0]
-        -- -- print $ part2 ip instrs
-        -- print $ sum [i | i <- [1..10551432], 10551432 `mod` i == 0]
+        -- print maze
+        part1 maze
+
+
+emptyMap = S.empty
 
+part1 maze = 
+    do 
+        let start = V2 0 0
+        let doors = execState (mapMaze [start] maze) emptyMap
+        print $ length doors
 
 
--- type Parser = Parsec Void Text
-type Parser = ParsecT Void Text (StateT [Coord] [])
+mapMaze :: [Coord] -> Maze -> Mapper
+mapMaze !starts !sections =
+    foldM (\heres section -> mapMazeSection heres section) starts sections
 
+mapMazeSection :: [Coord] -> MazeSection -> Mapper
+mapMazeSection !starts (Junction mazes) = 
+    concatMapM (\maze -> mapMaze starts maze) mazes
+mapMazeSection !starts (Path steps) = 
+    mapM mapPath starts
+    where mapPath start = foldM (\here step -> includeDoor here step) start steps
+
+includeDoor :: Coord -> Coord -> State Doors Coord
+includeDoor !here !step = 
+    do let there = (here + step)
+       let door = there `seq` makeDoor here there
+       modify' (door `seq` S.insert door)
+       return there
+
+
+type Parser = Parsec Void Text
 
 sc :: Parser ()
 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 
-lexeme  = L.lexeme sc
--- integer = lexeme L.decimal
+-- lexeme  = L.lexeme sc
 symb = L.symbol sc
 branchSepP = symb "|"
 openBranchP = symb "("
@@ -71,57 +100,21 @@ sP = (symb "S" *> pure (V2  0 -1))
 eP = (symb "E" *> pure (V2  1  0))
 wP = (symb "W" *> pure (V2 -1  0))
 
--- instructionFileP = (startP `between` endP) branchesP
-
--- branchesP :: MyParser Doors
--- branchesP = fmap S.unions . many $ choiceP <|> pathP
-
--- choiceP :: MyParser Doors
--- choiceP = (openBranchP `between` closeBranchP)  $ do
---     here <- get
---     return fmap S.unions (`sepBy` branchSepP) $ do
---         put here
---         return branchesP
-
-
-
--- pathP :: MyParser Doors
--- pathP = S.fromList <$> many stepP
-pathP = many stepP
-
--- stepP :: MyParser Door
-stepP = do
-    heres <- get
-    delta <- doorP
-    let theres = map (+delta) heres 
-    put theres
-    return (map (\h -> makeDoor h (h + delta)) heres)
+pathP = Path <$> some doorP
 
--- choiceP :: MyParser [Door]
--- choiceP = (openBranchP `between` closeBranchP) $ do
---     heres <- get
---     do 
---         here <- heres
---         put [here]
---         branch <- (pathP `sepBy` branchSepP)
---         return branch
+junctionP = Junction <$> (openBranchP `between` closeBranchP) manyMazesP
 
-    -- fmap concat $ (`sepBy` branchSepP) $ do
-    --     here <- heres 
-    --     pathP
+manyMazesP = mazeP `sepBy` branchSepP
 
+mazeSectionP = pathP <|> junctionP
 
-{-    heres <- get
-    choices <- (`sepBy` branchSepP) $ do
-        put heres
-        pathP
-    return $ concat choices -- (S.unions choices)-}
+mazeP = many mazeSectionP
 
--- choiceOrPathP = many (choiceP <|> pathP)
+wholeMazeP = (startP `between` endP) mazeP
 
 
--- successfulParse :: Text -> (Integer, [Instruction])
--- successfulParse input = 
---         case parse instructionsP "input" input of
---                 Left  _error -> (0, []) -- TIO.putStr $ T.pack $ parseErrorPretty err
---                 Right instructions  -> instructions
\ No newline at end of file
+successfulParse :: Text -> Maze
+successfulParse input = 
+        case parse wholeMazeP "input" input of
+                Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+                Right maze   -> maze