From 7d62744864f29867c8410ec6f2bbbfd8a2c7e043 Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Tue, 24 Dec 2019 22:40:58 +0000 Subject: [PATCH] Done part 1 --- advent18/package.yaml | 61 ++++++++++++ advent18/src/advent18.hs | 195 +++++++++++++++++++++++++++++++++++++++ data/advent18.txt | 81 ++++++++++++++++ data/advent18a.txt | 3 + data/advent18b.txt | 5 + data/advent18c.txt | 5 + stack.yaml | 1 + 7 files changed, 351 insertions(+) create mode 100644 advent18/package.yaml create mode 100644 advent18/src/advent18.hs create mode 100644 data/advent18.txt create mode 100644 data/advent18a.txt create mode 100644 data/advent18b.txt create mode 100644 data/advent18c.txt diff --git a/advent18/package.yaml b/advent18/package.yaml new file mode 100644 index 0000000..84dc748 --- /dev/null +++ b/advent18/package.yaml @@ -0,0 +1,61 @@ +# This YAML file describes your package. Stack will automatically generate a +# Cabal file when you run `stack build`. See the hpack website for help with +# this file: . + +name: advent18 +synopsis: Advent of Code +version: '0.0.1' + +default-extensions: +- AllowAmbiguousTypes +- ApplicativeDo +- BangPatterns +- BlockArguments +- DataKinds +- DeriveFoldable +- DeriveFunctor +- DeriveGeneric +- DeriveTraversable +- EmptyCase +- FlexibleContexts +- FlexibleInstances +- FunctionalDependencies +- GADTs +- GeneralizedNewtypeDeriving +- ImplicitParams +- KindSignatures +- LambdaCase +- MonadComprehensions +- MonoLocalBinds +- MultiParamTypeClasses +- MultiWayIf +- NegativeLiterals +- NumDecimals +- OverloadedLists +- OverloadedStrings +- PartialTypeSignatures +- PatternGuards +- PatternSynonyms +- PolyKinds +- RankNTypes +- RecordWildCards +- ScopedTypeVariables +- TemplateHaskell +- TransformListComp +- TupleSections +- TypeApplications +- TypeInType +- TypeOperators +- ViewPatterns + + +executables: + advent18: + main: advent18.hs + source-dirs: src + dependencies: + - base >= 2 && < 6 + - text + - containers + - pqueue + - mtl diff --git a/advent18/src/advent18.hs b/advent18/src/advent18.hs new file mode 100644 index 0000000..a31c17a --- /dev/null +++ b/advent18/src/advent18.hs @@ -0,0 +1,195 @@ +import Debug.Trace + +-- import qualified Data.Text.IO as TIO + +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) +import qualified Data.PQueue.Prio.Min as P +import qualified Data.Set as S +import qualified Data.Sequence as Q +import Data.Sequence ((<|), (|>), (><)) +import Data.Foldable (toList, foldr', foldl', all) +import Data.Maybe (fromJust) +import Data.List +import Data.Char +import Control.Monad.Reader + + +type Position = (Integer, Integer) -- r, c + +type Keys = S.Set Char +type PointOfInterest = M.Map Position Char + + +data Explorer = Explorer { _position :: Position + , _keysHeld :: Keys + } deriving (Eq, Ord, Show) +type ExploredStates = S.Set Explorer + +type Cave = S.Set Position +data CaveComplex = CaveComplex { _cave :: Cave + , _keys :: PointOfInterest + , _doors :: PointOfInterest + } deriving (Eq, Ord, Show) +type CaveContext = Reader CaveComplex + +data Agendum = Agendum { _current :: Explorer + , _trail :: Q.Seq Explorer + , _cost :: Int} deriving (Show, Eq) +type Agenda = P.MinPQueue Int Agendum +type Candidates = S.Set (Int, Agendum) + + + + +main :: IO () +main = do + text <- readFile "data/advent18.txt" + let (cc, explorer) = buildCaveComplex text + -- print cc + -- print explorer + print $ part1 cc explorer + +part1 :: CaveComplex -> Explorer -> Int +part1 cave explorer = maybe 0 (( + 1) . _cost ) result + where result = runReader (searchCave explorer) cave + +-- -- part1 :: CaveComplex -> Explorer -> Maybe Agendum +-- part1 cave explorer = keySeq (fromJust result) +-- where result = runReader (searchCave explorer) cave + + +keySeq :: Agendum -> Q.Seq Keys +keySeq agendum = Q.filter (not . S.null) kdiff + where keyss = fmap _keysHeld $ _trail agendum + kdiff = fmap (uncurry S.difference) $ Q.zip ((_keysHeld $ _current agendum) <| keyss) keyss + + +searchCave :: Explorer -> CaveContext (Maybe Agendum) +searchCave explorer = + do agenda <- initAgenda explorer + aStar agenda S.empty + + +buildCaveComplex text = foldl' buildCaveRow (cc0, explorer0) $ zip [0..] rows + where cc0 = CaveComplex {_cave = S.empty, _keys = M.empty, _doors = M.empty} + explorer0 = Explorer { _position = (0, 0), _keysHeld = S.empty } + rows = lines text + +buildCaveRow (cc, explorer) (r, row) = foldl' (buildCaveCell r) (cc, explorer) $ zip [0..] row + +buildCaveCell r (cc, explorer) (c, char) + | char == '.' = (cc', explorer) + | char == '@' = (cc', explorer { _position = here }) + | isLower char = (cc' { _keys = M.insert here char $ _keys cc'}, explorer) + | isUpper char = (cc' { _doors = M.insert here char $ _doors cc'}, explorer) + | otherwise = (cc, explorer) + where cc' = cc { _cave = S.insert here $ _cave cc } + here = (r, c) + + + + +initAgenda :: Explorer -> CaveContext Agenda +initAgenda explorer = + do cost <- estimateCost explorer + return $ P.singleton cost Agendum { _current = explorer, _trail = Q.empty, _cost = cost} + + +aStar :: Agenda -> ExploredStates -> CaveContext (Maybe Agendum) +-- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} +aStar agenda closed + -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ toList $ Q.take 1 $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined + -- | trace ("Peeping " ++ (show $ _current $ snd $ P.findMin agenda) ) False = undefined + | P.null agenda = return Nothing + | otherwise = + do let (_, currentAgendum) = P.findMin agenda + let reached = _current currentAgendum + nexts <- candidates currentAgendum closed + let newAgenda = foldl' (\q a -> P.insert (_cost a) a q) (P.deleteMin agenda) nexts + reachedGoal <- isGoal reached + if reachedGoal + then return (Just currentAgendum) + else if reached `S.member` closed + then aStar (P.deleteMin agenda) closed + else aStar newAgenda (S.insert reached closed) + + +isGoal :: Explorer -> CaveContext Bool +isGoal explorer = + do keys <- asks (S.fromList . M.elems . _keys) + return $ keys == _keysHeld explorer + + +candidates :: Agendum -> ExploredStates -> CaveContext (Q.Seq Agendum) +candidates agendum closed = + do let candidate = _current agendum + let previous = _trail agendum + succs <- successors candidate + let nonloops = Q.filter (\s -> not $ s `S.member` closed) succs + mapM (makeAgendum candidate previous) nonloops + +makeAgendum :: Explorer -> (Q.Seq Explorer) -> Explorer -> CaveContext Agendum +makeAgendum candidate previous new = + do cost <- estimateCost new + return Agendum { _current = new + , _trail = candidate <| previous + , _cost = cost + (Q.length previous) + } + +successors :: Explorer -> CaveContext (Q.Seq Explorer) +successors explorer = + do let here = _position explorer + let locations0 = possibleNeighbours here + cave <- asks _cave + keys <- asks _keys + doors <- asks _doors + let keysHeld = _keysHeld explorer + let locations1 = Q.filter (`S.member` cave) locations0 + let locations2 = Q.filter (hasKeyFor doors keysHeld) locations1 + return $ fmap (\l -> explorer { _position = l, _keysHeld = pickupKey keys keysHeld l}) locations2 + + +hasKeyFor :: PointOfInterest -> Keys -> Position -> Bool +-- hasKeyFor doors keys here | trace ("hkf: " ++ (intercalate " " [show doors, show keys, show here, show (maybe True (`S.member` keys) $ M.lookup here doors)])) False = undefined +hasKeyFor doors keys here = maybe True keyForDoor $ M.lookup here doors + where keyForDoor d = (toLower d) `S.member` keys + -- if location `M.member` doors + -- then (doors!location) `S.elem` keys + -- else True + + +pickupKey :: PointOfInterest -> Keys -> Position -> Keys +pickupKey keys held here = maybe held (`S.insert` held) $ M.lookup here keys + -- if here `M.member` keys + -- then S.insert (keys!here) held + -- else held + + +estimateCost :: Explorer -> CaveContext Int +estimateCost explorer = -- return 0 + do keys <- asks _keys + let (r, c) = _position explorer + let unfoundKeys = M.filter (`S.notMember` (_keysHeld explorer)) keys + let minR = minimum $ map fst $ M.keys unfoundKeys + let minC = minimum $ map snd $ M.keys unfoundKeys + let maxR = maximum $ map fst $ M.keys unfoundKeys + let maxC = maximum $ map snd $ M.keys unfoundKeys + let spanR = spanV r minR maxR + let spanC = spanV c minC maxC + if M.null unfoundKeys + then return 0 + else return $ fromIntegral (spanR + spanC) + -- return $ sum $ map (manhattan here) $ M.keys unfoundKeys + +spanV this minV maxV + | this < minV = maxV - this + | this > maxV = this - minV + -- | this > minV && this < maxV = (this - minV) + (maxV - this) + | otherwise = (this - minV) + (maxV - this) + +manhattan :: Position -> Position -> Int +manhattan (r1, c1) (r2, c2) = fromIntegral $ abs (r1 - r2) + abs (c1 - c2) + +possibleNeighbours :: Position -> Q.Seq Position +possibleNeighbours (r, c) = [(r + 1, c), (r - 1, c), (r, c + 1), (r, c - 1)] diff --git a/data/advent18.txt b/data/advent18.txt new file mode 100644 index 0000000..b3b7bb9 --- /dev/null +++ b/data/advent18.txt @@ -0,0 +1,81 @@ +################################################################################# +#...........#.....#.#...........#.....#.#...#...#...........#...........#......u# +###.#######.#.###.#.#.###.#######.###.#.#.#.###.#.#######.###.#####.###.###.###.# +#...#.....#.#.#.#.#.....#.#.......#...#.#.#...#.#.#.....#.........#...#...#...#.# +#.#####I#.#.#.#.#.#######.#.#######.###.#.###.#.#.#####.#############.###.#####.# +#.....#.#.#.#.#...........#.....#.#.....#...#.#.#.......#.....#.....#...#...#...# +#.###.#.#.#.#.#################.#.#####.#.#.#.#J#######.#.#.#.#.###.###.###.#.#.# +#...#.#.#.....#.....#...........#.#.....#.#.#.#...#.....#.#.#.#.#.....#.#...Y.#.# +#####.#########.###.#.###########.#.#######.#.#.#.#.#####.#H#.#.#####.#.#######.# +#...#...#.......#...#...#...#.....#.....#...#...#.#...#.#.#.#.#...#...#.....#...# +#.#.###.#.#######.#####.#.#.#.###.#####.#.#######.###.#.#.#.#####.###.###.#.##### +#.#.....#.#..k#..z......#.#.#...#.....#.#.....#.....#.#...#.#...#...#...#.#.....# +#.#####.#.#.#.###########.#####.#.#####.#.###.#######.#.###.#.#.###.###.#######.# +#.....#l#.R.#.....#.......#.....#...#...#...#.....#...#.#...#.#.....#...........# +#.###.#.#######.#.###.#.###.#######.#.#####.#####.#.#####.###.###.#############.# +#.#.#.#...#...#.#...#.#...#.#.....#.#...#.#.#.#...#...#...#...#...#...#.....#...# +#.#.#.###.#.#.#####.#.###.#.#.#.###.###.#.#.#.#.#####.#.###.#.#####.#.#.###.#.### +#...#.#...#.#.......#...#...#.#d..#.#...#..q..#...#...#...#.#.#.....#...Z.#r#.#.# +###.#.###.#V###########.#####.###.#.#.###########O#.#####.#.###.###########.#.#.# +#...#...#.#........f..#.#.....#...#.#.#.#.......#.#.#.....#.........#.......#...# +#######.#############.#.#######.###.#.#.#.#####.#.#.#.###.#########.#.#########.# +#.......#...........#.#.......#...#...#.#...#.#.#.#...#.#...#...#...#...#.#..e..# +#.#######.###.#.#############.###.#####.###.#.#.#.#####.###.###.###.###.#.#.##### +#p........#.#.#.#.......#...#...#.....#.#...#.#.#.#.......#...#.F.#...#.#...#.K.# +#.#########.#.###.#.###.#.#.###.###.#.#.#.###.#.#.#N#####.###.###.#####.#####.#.# +#...#.......#.....#...#.#.#.....#...#...#.#.......#.#...#...#...#.....#.......#.# +###.#.###.###########.###.#######.#####.#.#########.#.#####.###.#####.#####.###.# +#.#.#...#...........#.#...#.....#...S.#.#.#...#.......#...#...#.....#.....#...#.# +#.#.###########.###.#.#.###.###.#####.#.#.#.#.#.#######.#.###.#####.#####.###.#.# +#...#.........#.#...#...#...#.#.......#.#...#...#...#...#...#..x..#.#...#...#.#.# +#.###.#######.#.#########.#.#.#########.#.#######.#.#.#####.###.###.#.#####.###.# +#.....#.....#.#.......#...#.#.#.......#.#.#.......#.#.#.......#.#...#.#...#...#.# +#########.###.#.###.###.###.#.#.#####.#.#.#######.#.#.#######.#.#.###.#.#.###.#.# +#.....#...#...#.#.#.#...#...#...#..t#...#...#.....#.#.....#.....#...#...#...#..v# +#.###.#.###.###.#.#.#.###.###.#####.#######.#.#####.#####.###.#####.#####.####### +#.#.....#...#.....#.....#.#...........#.#...#.#...#.#...#...#.#...#.....#.......# +#.#######.#######.#####.#.###########.#.#.###.#.###.#.#.###.###.#.#####.#####.#.# +#.......#.#.....#.#...#.#.......#.#...#.#.....#...#...#...#.....#.....#.#...#.#.# +#.#####.#.#X###.###.#.#########.#.#.###.#######.#.#######.###########.#.#.#P###.# +#.....#.....#.......#...........#...............#.........T....g....#.....#.....# +#######################################.@.####################################### +#..y#...#.................#...#...................#.....#.........#.....#...#...# +#.###.#.#.#########.#.#####E#.#####.#.#.#.###.#####.###.###.#.###.###.#.#.#.#.#.# +#.#...#...#...#.#.U.#.#.....#.#...#.#.#.#.#.#...#...#.#...#.#...#.#...#.#.#.#.#.# +#.#.#######.#.#.#.#####.#####.#.#.###.#.#.#.###.#.###.###.#####.#.#.###.#A#.#.#.# +#.#...#...C.#...#.........#..a#.#...#.#.#.....#...#.#...#.#.....#.#.#...#.#b..#.# +#.###.#.#######.###########.###.###.#.#.#####.#####.#.#.#.#.#####.#.#.###.#####.# +#.....#.#.......#.#...B...#.#...#.#...#.#.#...#...#...#.#.#.#...#...#...#.#.....# +#.#####.#.#######.#.#####.#.#.#.#.#####.#.#.###.#.#####.#.#.#.#.#######.#.#.##### +#.W.....#.#...#...#...#...#.#.#.#.....#.#.#.....#.......#.#...#.#.....#...#...#.# +#########.#.#.###.###.#.###.#.#.#.#.###.#.#############.#.###.#.###.#.#.#####.#.# +#.......#...#...#.#...#.#...#.#.#.#.....#.....#.......#.#...#.#...#.#.#.#...#...# +#####.#.#######.#.#.###.###.#.#.#.#######.#####.#.#####.###.#.###.###.#.#.#.###.# +#.....#.......#.#.#.#...#...#.#.#.....#.#.....#.#.........#.#.#.#...#...#.#c#...# +#.#########.###.#.#.###.#.#####.#####.#.#.###.#.###########.#.#.###.#.###.#.##### +#.#.....#...#...#.#...#...#.G.#.#...#.#.#...#...#...#...#...#...#.#.#...#.#.....# +#.#.#####.###.###.###.#####.#.#.#.#.#.#.###.#####.###.#.#.#####.#.#.#####.#####.# +#.#.....#...#.#.....#.#.....#...#.#.#.#.#.#...#.....#.#...#...#...#..w......#.#.# +#.#.###.###.#.###.###.###.#########.#.#.#.###.#.###.#.###.#.#.###.#########.#.#.# +#.#...#...#.#...#.#...#...#.........#.#.#...#.#.#.#.#.#...#.#...#.#...#...#...#.# +#.#######.#.###.#.#.###.#######.#####.#.#.#.#.#.#.#.#.#####.###.###.#.#.#.#####.# +#.......#.#.#...#.#...#.#.......#.....#.#.#.#.#...#.#...#...#.#.....#...#...#...# +#.#####.#.#.#.###.#####.###.#.###.#####.#.#.#.#####.###.#.###.#######.#####.#.#.# +#.#...#.#...#.#...#.....#...#.#...#.....#.#.#.....#...#...#...#.....#.....#.#.#.# +#.#.#.#.#####.#.#.#.#####.###.#.#####.#.#.#######.###.#####.###.###.#######.#.### +#.#.#...#.....#.#...#...#...#.#....s..#.#.....#...#.....#...#...#.........#.#...# +#.#.###.#.#####.#####.#.#.#.#.#########.#.###.#.###.###.#.###.#.#########.#.###.# +#.#..m#.#.....#...#...#...#.#.#.......#.#.#.#.#.#...#...#...#.#.#...#...#...#..i# +#.###.#######.#.#.#.#######.#.#####.#.#.#.#.#.#.#.###.#####.#.###.#.#.#######.#.# +#...#.........#.#.#.......#.#...#...#.#.#.#.#...#.#...#...#.#.....#.#.......#.#.# +###.#############.#######.#.###.#.#.###.#.#.#####.#.###.#.#.#.#####Q###.###M#.### +#...#.....#.......#..j#...#.#.....#.#...#...#.....#...#.#.#.#.#.....#...#...#...# +#.#####.#.###.#######.#.###.#########.#####.#.#.#####.#.#.#.###.#####.###.###.#.# +#...#...#.....#.....#...#.#.......#...#.#...#.#.#...#.#.#.#.....#.....#.#.#...#.# +###.#.#########.###.#.###.#######.#.###.#.#####.#.#.#.#.###########.###.#.#####.# +#.#.#.............#.#.#.....#....o#.#...#.......#.#.#.#...#.......#.#..h#...#...# +#.#.###############.#.#####.#.###.#.###.###########.#.#.#.#.###.#.#.#.#.###.#.### +#.#...#.........#...#.......#.#...#.D...#...#.......#.#.#...#...#...#.#...#.#...# +#.###.#.#######.#.#########.#.#########.#.#.#.###.###.#######.#######.#.###.###L# +#.......#.........#.........#..........n#.#.....#.............#.......#.........# +################################################################################# diff --git a/data/advent18a.txt b/data/advent18a.txt new file mode 100644 index 0000000..33802e1 --- /dev/null +++ b/data/advent18a.txt @@ -0,0 +1,3 @@ +######### +#b.A.@.a# +######### diff --git a/data/advent18b.txt b/data/advent18b.txt new file mode 100644 index 0000000..af485bc --- /dev/null +++ b/data/advent18b.txt @@ -0,0 +1,5 @@ +######################## +#f.D.E.e.C.b.A.@.a.B.c.# +######################.# +#d.....................# +######################## diff --git a/data/advent18c.txt b/data/advent18c.txt new file mode 100644 index 0000000..b650235 --- /dev/null +++ b/data/advent18c.txt @@ -0,0 +1,5 @@ +######################## +#...............b.C.D.f# +#.###################### +#.....@.a.B.c.d.A.e.F.g# +######################## diff --git a/stack.yaml b/stack.yaml index de5b5af..f4b4817 100644 --- a/stack.yaml +++ b/stack.yaml @@ -55,6 +55,7 @@ packages: - advent15 - advent16 - advent17 +- advent18 # Dependency packages to be pulled from upstream that are not in the resolver. -- 2.34.1