Day 20 -- really slow...
This commit is contained in:
parent
04c021ff22
commit
d2924d7265
|
@ -31,7 +31,7 @@ Now located in this repository's wiki.
|
||||||
| 17 | ~ 15 |
|
| 17 | ~ 15 |
|
||||||
| 18 | ~ 6 |
|
| 18 | ~ 6 |
|
||||||
| 19 | ~ 3 |
|
| 19 | ~ 3 |
|
||||||
| 20 | |
|
| 20 | ~ 40 |
|
||||||
| 21 | |
|
| 21 | |
|
||||||
| 22 | |
|
| 22 | |
|
||||||
| 23 | |
|
| 23 | |
|
||||||
|
|
|
@ -30,4 +30,4 @@ import qualified Day24
|
||||||
import qualified Day25
|
import qualified Day25
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = Day19.main
|
main = Day20.main
|
||||||
|
|
File diff suppressed because one or more lines are too long
|
@ -27,6 +27,7 @@ dependencies:
|
||||||
- matrix
|
- matrix
|
||||||
- vector
|
- vector
|
||||||
- array
|
- array
|
||||||
|
- parsec
|
||||||
|
|
||||||
library:
|
library:
|
||||||
source-dirs: src
|
source-dirs: src
|
||||||
|
|
74
src/Day20.hs
74
src/Day20.hs
|
@ -1,6 +1,78 @@
|
||||||
module Day20 (main) where
|
module Day20 (main) where
|
||||||
|
|
||||||
|
import Prelude hiding (null, sum)
|
||||||
|
import Data.Foldable (foldl', toList, sum)
|
||||||
|
import Control.Applicative ((<*))
|
||||||
|
import Text.Parsec (Parsec, eof, try, choice, many1, sepBy1, (<|>))
|
||||||
|
import qualified Text.Parsec as P (parse)
|
||||||
|
import Text.Parsec.Token (makeTokenParser, parens)
|
||||||
|
import Text.Parsec.Char (char, endOfLine , oneOf)
|
||||||
|
import Text.Parsec.Language (emptyDef)
|
||||||
|
import Data.Map.Strict (Map, empty, unionWith, unionsWith, fromList, insert, filterWithKey, (!))
|
||||||
|
import Data.Set (Set, singleton, null, union, unions, size, (\\))
|
||||||
|
import qualified Data.Set as S (fromList)
|
||||||
|
|
||||||
|
type Parser = Parsec String ()
|
||||||
|
data AndPath = Simple String | OrPath [Path]
|
||||||
|
type Path = [AndPath]
|
||||||
|
type Graph = Map Coordinate (Set Coordinate)
|
||||||
|
type Coordinate = (Int, Int)
|
||||||
|
|
||||||
|
(//) = div
|
||||||
|
dirs = many1 $ oneOf "NEWS"
|
||||||
|
pars = parens $ makeTokenParser emptyDef
|
||||||
|
|
||||||
|
parser1 :: Parser Int
|
||||||
|
parser1 = char '^' >> parserRec <* char '$' <* endOfLine <* eof
|
||||||
|
where
|
||||||
|
parserRec = sum <$> (many1 $ choice [length <$> dirs, pars maxSubexp])
|
||||||
|
maxSubexp = do
|
||||||
|
lengths <- sepBy1 (try parserRec <|> return 0) (char '|')
|
||||||
|
return $ if any (== 0) lengths then 0 else maximum lengths
|
||||||
|
|
||||||
|
parser2 :: Parser Path
|
||||||
|
parser2 = char '^' >> parserRec <* char '$' <* endOfLine <* eof
|
||||||
|
where
|
||||||
|
parserRec = many1 $ choice [Simple <$> dirs, pars subexp]
|
||||||
|
subexp = OrPath <$> sepBy1 (try parserRec <|> (return $ [Simple ""])) (char '|')
|
||||||
|
|
||||||
|
parse :: String -> Parser a -> a
|
||||||
|
parse input parser = case P.parse parser "" input of
|
||||||
|
Left e -> error $ show e
|
||||||
|
Right r -> r
|
||||||
|
|
||||||
|
pathToGraph :: (Coordinate, Graph) -> Path -> (Coordinate, Graph)
|
||||||
|
pathToGraph cg [] = cg
|
||||||
|
pathToGraph cg ((Simple str):rest) = pathToGraph (foldl' addEdge cg str) rest
|
||||||
|
where
|
||||||
|
addEdge (coord, graph) dir =
|
||||||
|
let newCoord = step coord dir
|
||||||
|
newGraph = unionWith union (fromList [(coord, singleton newCoord), (newCoord, singleton coord)]) graph
|
||||||
|
in (newCoord, newGraph)
|
||||||
|
step (x, y) 'N' = (x, y + 1)
|
||||||
|
step (x, y) 'E' = (x + 1, y)
|
||||||
|
step (x, y) 'S' = (x, y - 1)
|
||||||
|
step (x, y) 'W' = (x - 1, y)
|
||||||
|
pathToGraph cg@(coord, graph) ((OrPath paths):rest) =
|
||||||
|
let newGraph = unionsWith union $ map (snd . pathToGraph cg) paths
|
||||||
|
in pathToGraph (coord, newGraph) rest
|
||||||
|
|
||||||
|
-- bfs :: graph -> map from distances to rooms with that minimum distance
|
||||||
|
bfs :: Graph -> Map Int (Set Coordinate)
|
||||||
|
bfs graph = bfsRec (fmap (\\ initialRoom) graph) 1 initialRoom (fromList [(0, initialRoom)])
|
||||||
|
where
|
||||||
|
initialRoom = S.fromList [(0, 0)]
|
||||||
|
bfsRec graph n coords distances = if null coords then distances else
|
||||||
|
let coordsReachable = unions . map (graph !) $ toList coords
|
||||||
|
newDistances = insert n coordsReachable distances
|
||||||
|
newGraph = fmap (\\ coordsReachable) graph
|
||||||
|
in bfsRec newGraph (n + 1) coordsReachable newDistances
|
||||||
|
|
||||||
|
part2 :: Path -> Int
|
||||||
|
part2 = sum . fmap size . filterWithKey (\k v -> k >= 1000) . bfs . snd . pathToGraph ((0, 0), empty)
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
input <- readFile "input/20.txt"
|
input <- readFile "input/20.txt"
|
||||||
print input
|
print $ parse input parser1
|
||||||
|
print . part2 $ parse input parser2
|
||||||
|
|
Loading…
Reference in New Issue