From cf9be993787582089b71f86c25f9de2dbebf790c Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Thu, 21 Nov 2019 10:06:30 +0000 Subject: [PATCH] Day 20a working, but space leak means it doesn't complete --- README.md | 6 +- advent-of-code.cabal | 2 + data/advent20a.txt | 1 + data/advent20b.txt | 1 + data/advent20c.txt | 1 + data/advent20d.txt | 1 + data/advent20e.txt | 1 + src/advent20/advent20.hs | 117 ++++++++++++++++++--------------------- 8 files changed, 67 insertions(+), 63 deletions(-) create mode 100644 data/advent20a.txt create mode 100644 data/advent20b.txt create mode 100644 data/advent20c.txt create mode 100644 data/advent20d.txt create mode 100644 data/advent20e.txt diff --git a/README.md b/README.md index e268bd4..f9bb2e1 100644 --- 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 7a9d811..dd2f207 100644 --- 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 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 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 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 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 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 96ff894..7f24c4b 100644 --- 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 -- 2.34.1