From fbf84930783a435e67f823085f646be0ab8ffd6d Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Fri, 30 Dec 2016 11:28:57 +0000 Subject: [PATCH] Trying out different data structures for day 11, seeing if any improve matters --- README.html | 24 ++- README.md | 52 +++++- adventofcode1611/adventofcode1611.cabal | 24 +++ adventofcode1611/app/advent11ps.hs | 32 +++- adventofcode1611/app/advent11psm.hs | 194 +++++++++++++++++++++++ adventofcode1611/app/advent11psmh.hs | 202 ++++++++++++++++++++++++ stack.yaml | 2 +- 7 files changed, 511 insertions(+), 19 deletions(-) create mode 100644 adventofcode1611/app/advent11psm.hs create mode 100644 adventofcode1611/app/advent11psmh.hs diff --git a/README.html b/README.html index a85b3e3..2525fa5 100644 --- a/README.html +++ b/README.html @@ -14,9 +14,27 @@

Code to solve the Advent of Code puzzles. This year, I'm trying to use the puzzles as a prompt to learn Haskell.

Learn you a Haskell, Introduction to Haskell 98, and Hackage are good resources.

-

I'm using the basic Haskell Platform installation (install with

-
$ sudo aptitude install haskell-platform
+

Toolchain

+

I'm using the basic Haskell Platform installation, togeher with Stack to manage the packages and dependencies (install with

+
$ sudo aptitude install haskell-platform haskell-stack

).

+

I have one package for each day, to save time waiting for Stack to check every executable before compiling what's changed. Each package needs a separate directory tree and a separate .cabal file.

+

Compile with

+
stack build
+

or

+
stack build adventofcode1601
+

Run with

+
stack exec advent01
+

Run interactively with

+
stack ghci adventofcode1601:exe:advent01
+

To profile, use

+
stack build --executable-profiling --library-profiling -ghc-options="-fprof-auto -rtsopts" adventofcode1601
+

then run with

+
stack exec -- advent01 +RTS -p -hy
+

Readme

+

Build this readme file wth

+
pandoc -s README.md > README.html
+

Earlier instructions, for compiling before use of Stack

I'm also using some extra libraries. Before installing, run cabal update then set library-profiling: True in ~/.cabal/config . Then install the packages with

$ cabal install MissingH
 $ cabal install parsec-numbers
@@ -30,8 +48,6 @@ $ cabal install pqueue
ghc -O2 --make advent01.hs -prof -auto-all -caf-all -fforce-recomp -rstopts
 time ./advent01 +RTS -p -hy

and create the profile picture with h2ps advent01.hp .

-

Build this readme file wth

-
pandoc -s README.md > README.html

(Using the Modest style.)

diff --git a/README.md b/README.md index 2e4886c..78f7849 100644 --- a/README.md +++ b/README.md @@ -7,12 +7,53 @@ Code to solve the [Advent of Code](http://adventofcode.com/2016/) puzzles. This [Learn you a Haskell](http://learnyouahaskell.com/chapters), [Introduction to Haskell 98](https://www.haskell.org/tutorial/index.html), and [Hackage](https://hackage.haskell.org/) are good resources. -I'm using the basic Haskell Platform installation (install with +# Toolchain + +I'm using the basic Haskell Platform installation, togeher with `Stack` to manage the packages and dependencies (install with ``` -$ sudo aptitude install haskell-platform +$ sudo aptitude install haskell-platform haskell-stack ``` ). +I have one package for each day, to save time waiting for Stack to check every executable before compiling what's changed. Each package needs a separate directory tree and a separate `.cabal` file. + +Compile with +``` +stack build +``` +or +``` +stack build adventofcode1601 +``` + +Run with +``` +stack exec advent01 +``` + +Run interactively with +``` +stack ghci adventofcode1601:exe:advent01 +``` + +To profile, use +``` +stack build --executable-profiling --library-profiling -ghc-options="-fprof-auto -rtsopts" adventofcode1601 +``` +then run with +``` +stack exec -- advent01 +RTS -p -hy +``` + +# Readme + +Build this readme file wth +``` +pandoc -s README.md > README.html +``` + +### Earlier instructions, for compiling before use of Stack + I'm also using some extra libraries. Before installing, run `cabal update` then set `library-profiling: True` in `~/.cabal/config` . Then install the packages with ``` $ cabal install MissingH @@ -39,9 +80,4 @@ time ./advent01 +RTS -p -hy and create the profile picture with `h2ps advent01.hp` . -Build this readme file wth -``` -pandoc -s README.md > README.html -``` - -(Using the [Modest style](https://github.com/markdowncss/modest).) \ No newline at end of file +(Using the [Modest style](https://github.com/markdowncss/modest).) diff --git a/adventofcode1611/adventofcode1611.cabal b/adventofcode1611/adventofcode1611.cabal index 19ce815..d6b3810 100644 --- a/adventofcode1611/adventofcode1611.cabal +++ b/adventofcode1611/adventofcode1611.cabal @@ -63,6 +63,30 @@ executable advent11ps , unordered-containers default-language: Haskell2010 +executable advent11psm + hs-source-dirs: app + main-is: advent11psm.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode16 + , pqueue + , hashable + , containers + , unordered-containers + default-language: Haskell2010 + +executable advent11psmh + hs-source-dirs: app + main-is: advent11psmh.hs + ghc-options: -O2 -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , adventofcode16 + , pqueue + , hashable + , containers + , unordered-containers + default-language: Haskell2010 + test-suite adventofcode1611-test type: exitcode-stdio-1.0 hs-source-dirs: test diff --git a/adventofcode1611/app/advent11ps.hs b/adventofcode1611/app/advent11ps.hs index 349c8a5..cccf02f 100644 --- a/adventofcode1611/app/advent11ps.hs +++ b/adventofcode1611/app/advent11ps.hs @@ -12,7 +12,7 @@ module Main(main) where import GHC.Generics (Generic) -- import Prelude hiding (length, take, drop) -import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices) +import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices, intercalate) import Data.Ord (comparing) import Data.Char (isDigit) import Data.Maybe (fromMaybe) @@ -22,19 +22,25 @@ import qualified Data.HashSet as S import qualified Data.Sequence as Q import Data.Sequence ((<|), (|>), (><)) import Data.Foldable (toList, foldr') +import Debug.Trace -data Item = Generator String | Microchip String deriving (Show, Eq, Generic) +data Item = Generator String | Microchip String deriving (Eq, Generic) instance Hashable Item type Floor = [Item] -data Building = Building Int [Floor] deriving (Show, Eq, Generic) +data Building = Building Int [Floor] deriving (Eq, Ord, Generic) instance Hashable Building data CBuilding = CBuilding Int Integer deriving (Show, Eq, Generic) instance Hashable CBuilding +-- instance Hashable CBuilding where +-- hashWithSalt s (CBuilding f fs) = +-- s `hashWithSalt` +-- f `hashWithSalt` fs + type CBuildings = S.HashSet CBuilding data Agendum = Agendum {current :: Building, trail :: Q.Seq CBuilding, cost :: Int} deriving (Show, Eq) type Agenda = P.MinPQueue Int Agendum -type Candidates = S.HashSet (Int, Agendum) +-- type Candidates = S.HashSet (Int, Agendum) instance Ord Item where compare (Generator a) (Generator b) = compare a b @@ -42,8 +48,17 @@ instance Ord Item where compare (Generator _) (Microchip _) = LT compare (Microchip _) (Generator _) = GT -instance Ord Building where - compare b1 b2 = comparing estimateCost b1 b2 +instance Show Item where + show (Generator a) = "G" ++ take 2 a + show (Microchip a) = "M" ++ take 2 a + +-- instance Ord Building where +-- compare b1 b2 = comparing estimateCost b1 b2 + +instance Show Building where + show (Building f floors) = (show f) ++ "<* " ++ (intercalate "; " $ map (showFloor) floors) + where showFloor fl = intercalate ", " $ map (show) fl + building1 = Building 0 [ (sort [Generator "polonium", Generator "thulium", @@ -94,9 +109,13 @@ canonical (Building f floors) = CBuilding f (read $ filter (isDigit) $ show $ so main :: IO () main = do + -- part0 part1 part2 +part0 :: IO () +part0 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda buildingTest) S.empty + part1 :: IO () part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) S.empty @@ -109,6 +128,7 @@ initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail = Q.empt aStar :: Agenda -> CBuildings -> Maybe Agendum -- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} aStar agenda closed + -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " :: " ++ (show newAgenda)) False = undefined | P.null agenda = Nothing | otherwise = if isGoal reached then Just currentAgendum diff --git a/adventofcode1611/app/advent11psm.hs b/adventofcode1611/app/advent11psm.hs new file mode 100644 index 0000000..5a29bf1 --- /dev/null +++ b/adventofcode1611/app/advent11psm.hs @@ -0,0 +1,194 @@ +-- Using the idea of canonical representation of buildings from +-- https://andars.github.io/aoc_day11.html by Andrew Foote, +-- plus my extension of represening the pairs as an integer. + +-- This version is A* search, using a priority queue for the agenda, +-- Sets for various collecions, and a Map to store the floors in the +-- building. + +{-# LANGUAGE DeriveGeneric #-} + +module Main(main) where + +import GHC.Generics (Generic) + +-- import Prelude hiding (length, take, drop) +import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices, intercalate) +import Data.Ord (comparing) +import Data.Char (isDigit) +import Data.Maybe (fromMaybe, fromJust) +import qualified Data.PQueue.Prio.Min as P +import qualified Data.Set as S +import qualified Data.Sequence as Q +import qualified Data.Map.Strict as M +import Data.Hashable +import Data.Sequence ((<|), (|>), (><)) +import Data.Foldable (toList, foldr', foldl', all) +import Debug.Trace + +data Item = Generator String | Microchip String deriving (Eq, Generic) +type Floor = S.Set Item +type Floors = M.Map Int Floor +data Building = Building Int Floors deriving (Eq, Ord, Generic) +type Buildings = S.Set Building +-- data CBuilding = CBuilding Int Integer deriving (Show, Eq, Generic) +-- instance Hashable CBuilding +-- type CBuildings = S.HashSet CBuilding +data Agendum = Agendum {current :: Building, trail :: Q.Seq Building, cost :: Int} deriving (Show, Eq) +type Agenda = P.MinPQueue Int Agendum +type Candidates = S.Set (Int, Agendum) + +instance Show Item where + show (Generator a) = "G" ++ take 2 a + show (Microchip a) = "M" ++ take 2 a + +instance Ord Item where + compare (Generator a) (Generator b) = compare a b + compare (Microchip a) (Microchip b) = compare a b + compare (Generator _) (Microchip _) = LT + compare (Microchip _) (Generator _) = GT + +-- instance Ord Building where +-- compare b1 b2 = comparing estimateCost b1 b2 + +instance Show Building where + show (Building f floors) = (show f) ++ "<* " ++ (intercalate "; " $ toList $ M.map (showFloor) floors) + where showFloor fl = intercalate ", " $ toList $ S.map (show) fl + + +-- building1 = Building 0 [ +-- (sort [Generator "polonium", Generator "thulium", +-- Microchip "thulium", Generator "promethium", Generator "ruthenium", +-- Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]), +-- (sort [Microchip "polonium", Microchip "promethium"]), +-- [], +-- [] +-- ] + +building1 = Building 0 (M.fromList + [ (0, S.fromList [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]) + , (1, S.fromList [Microchip "polonium", Microchip "promethium"]) + , (2, S.empty ) + , (3, S.empty ) + ]) + + + +building0 = Building 0 (M.fromList + [ (0, S.fromList [Generator "polonium", Generator "thulium", Microchip "thulium", Generator "promethium"]) + , (1, S.fromList [Microchip "polonium", Microchip "promethium"]) + , (2, S.empty ) + , (3, S.empty ) + ]) + +building2 = Building 0 (M.fromList + [ (0, S.fromList [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt", + Generator "dilithium", Microchip "dilithium"]) + , (1, S.fromList [Microchip "polonium", Microchip "promethium"]) + , (2, S.empty ) + , (3, S.empty ) + ]) + +buildingTest = Building 0 (M.fromList + [ (0, S.fromList [Microchip "hydrogen", Microchip "lithium"]) + , (1, S.fromList [Generator "hydrogen"]) + , (2, S.fromList [Generator "lithium"]) + , (3, S.empty ) + ]) + + +main :: IO () +main = do + -- part0 + part1 + part2 + +part0 :: IO () +part0 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda buildingTest) S.empty + +part1 :: IO () +part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) S.empty + +part2 :: IO () +part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) S.empty + + +initAgenda :: Building -> Agenda +initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail = Q.empty, cost = estimateCost b} + + +aStar :: Agenda -> Buildings -> 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 + | P.null agenda = Nothing + | otherwise = + if isGoal reached then Just currentAgendum + else if reached `S.member` closed + then aStar (P.deleteMin agenda) closed + else aStar newAgenda (S.insert reached closed) + where + (_, currentAgendum) = P.findMin agenda + reached = current currentAgendum + newAgenda = foldl' (\q a -> P.insert (cost a) a q) (P.deleteMin agenda) $ candidates currentAgendum closed + + + +candidates :: Agendum -> Buildings -> Q.Seq Agendum +candidates agendum closed = newCandidates + where + candidate = current agendum + previous = trail agendum + succs = legalSuccessors $ successors candidate + nonloops = Q.filter (\s -> not $ s `S.member` closed) succs + newCandidates = fmap (\n -> makeAgendum n) nonloops + makeAgendum new = Agendum {current = new, + trail = candidate <| previous, + cost = estimateCost new + length previous + 1} + +isGoal :: Building -> Bool +isGoal (Building f floors) = + f+1 == height && (all (S.null) $ M.filterWithKey (\k _ -> k < f) floors) + where height = M.size floors + +isLegal :: Building -> Bool +isLegal (Building f floors) = + null floor + || + not (any (isGenerator) floor) + || + any (safePair) pairs + where floor = fromJust $ M.lookup f floors + pairs = [(i, j) | i <- (S.toList floor), j <- (S.toList floor), isGenerator i] + safePair (Generator e, Microchip f) = e == f + safePair (Generator _, Generator _) = False + +isGenerator :: Item -> Bool +isGenerator (Generator _) = True +isGenerator (Microchip _) = False + +successors :: Building -> (Q.Seq Building) +successors b@(Building f floors) = Q.fromList [updateBuilding b nf is | nf <- nextFloors, is <- items] + where + floor = fromJust $ M.lookup f floors + items = map (S.fromList) $ filter (\is -> length is == 1 || length is == 2) $ subsequences $ toList floor + nextFloors = if f == 0 then [1] + else if f+1 == length floors then [f-1] + else [f+1, f-1] + +legalSuccessors :: (Q.Seq Building) -> (Q.Seq Building) +legalSuccessors = Q.filter (isLegal) + +updateBuilding :: Building -> Int -> Floor -> Building +updateBuilding (Building oldF oldFloors) newF items = Building newF newFloors + where newFloors = M.adjust (\f -> f `S.union` items) newF $ M.adjust (\f -> f `S.difference` items) oldF oldFloors + + +estimateCost :: Building -> Int +estimateCost (Building _ floors) = + sum $ map (\(c, f) -> c * S.size f) $ zip [0..] $ reverse $ M.elems floors + diff --git a/adventofcode1611/app/advent11psmh.hs b/adventofcode1611/app/advent11psmh.hs new file mode 100644 index 0000000..e2427a8 --- /dev/null +++ b/adventofcode1611/app/advent11psmh.hs @@ -0,0 +1,202 @@ +-- Using the idea of canonical representation of buildings from +-- https://andars.github.io/aoc_day11.html by Andrew Foote, +-- plus my extension of represening the pairs as an integer. + +-- This version is A* search, using a priority queue for the agenda, +-- Sets for various collecions, and a Map to store the floors in the +-- building. + +{-# LANGUAGE DeriveGeneric #-} + +module Main(main) where + +import GHC.Generics (Generic) + +-- import Prelude hiding (length, take, drop) +import Data.List (subsequences, (\\), sort, sortOn, nub, findIndices, intercalate) +import Data.Ord (comparing) +import Data.Char (isDigit) +import Data.Maybe (fromMaybe, fromJust) +import qualified Data.PQueue.Prio.Min as P +import qualified Data.HashSet as S +import qualified Data.Sequence as Q +import qualified Data.HashMap.Strict as M +import Data.Hashable +import Data.Sequence ((<|), (|>), (><)) +import Data.Foldable (toList, foldr', foldl', all) +import Debug.Trace + +data Item = Generator String | Microchip String deriving (Eq, Generic) +instance Hashable Item +data Floor = Floor (S.HashSet Item) deriving (Eq, Generic) +instance Hashable Floor +unFloor :: Floor -> S.HashSet Item +unFloor (Floor f) = f +data Floors = Floors (M.HashMap Int Floor) deriving (Eq, Generic) +instance Hashable Floors +data Building = Building Int Floors deriving (Eq, Generic) +instance Hashable Building +type Buildings = S.HashSet Building +-- data CBuilding = CBuilding Int Integer deriving (Show, Eq, Generic) +-- instance Hashable CBuilding +-- type CBuildings = S.HashSet CBuilding +data Agendum = Agendum {current :: Building, trail :: Q.Seq Building, cost :: Int} deriving (Show, Eq) +type Agenda = P.MinPQueue Int Agendum +type Candidates = S.HashSet (Int, Agendum) + +instance Show Item where + show (Generator a) = "G" ++ take 2 a + show (Microchip a) = "M" ++ take 2 a + +instance Ord Item where + compare (Generator a) (Generator b) = compare a b + compare (Microchip a) (Microchip b) = compare a b + compare (Generator _) (Microchip _) = LT + compare (Microchip _) (Generator _) = GT + +-- instance Ord Building where +-- compare b1 b2 = comparing estimateCost b1 b2 + +instance Show Building where + show (Building f (Floors floors)) = (show f) ++ "<* " ++ (intercalate "; " $ toList $ M.map (showFloor. unFloor) floors) + where showFloor fl = intercalate ", " $ toList $ S.map (show) fl + + +-- building1 = Building 0 [ +-- (sort [Generator "polonium", Generator "thulium", +-- Microchip "thulium", Generator "promethium", Generator "ruthenium", +-- Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]), +-- (sort [Microchip "polonium", Microchip "promethium"]), +-- [], +-- [] +-- ] + +building1 = Building 0 (Floors $ M.fromList + [ (0, Floor $ S.fromList [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt"]) + , (1, Floor $ S.fromList [Microchip "polonium", Microchip "promethium"]) + , (2, Floor $ S.empty ) + , (3, Floor $ S.empty ) + ]) + + + +building0 = Building 0 (Floors $ M.fromList + [ (0, Floor $ S.fromList [Generator "polonium", Generator "thulium", Microchip "thulium", Generator "promethium"]) + , (1, Floor $ S.fromList [Microchip "polonium", Microchip "promethium"]) + , (2, Floor $ S.empty ) + , (3, Floor $ S.empty ) + ]) + +building2 = Building 0 (Floors $ M.fromList + [ (0, Floor $ S.fromList [Generator "polonium", Generator "thulium", + Microchip "thulium", Generator "promethium", Generator "ruthenium", + Microchip "ruthenium", Generator "cobalt", Microchip "cobalt", + Generator "dilithium", Microchip "dilithium"]) + , (1, Floor $ S.fromList [Microchip "polonium", Microchip "promethium"]) + , (2, Floor $ S.empty ) + , (3, Floor $ S.empty ) + ]) + +buildingTest = Building 0 (Floors $ M.fromList + [ (0, Floor $ S.fromList [Microchip "hydrogen", Microchip "lithium"]) + , (1, Floor $ S.fromList [Generator "hydrogen"]) + , (2, Floor $ S.fromList [Generator "lithium"]) + , (3, Floor $ S.empty ) + ]) + + +main :: IO () +main = do + -- part0 + part1 + part2 + +part0 :: IO () +part0 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda buildingTest) S.empty + +part1 :: IO () +part1 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building1) S.empty + +part2 :: IO () +part2 = print $ length $ trail $ fromMaybe (snd $ P.findMin $ initAgenda buildingTest) $ aStar (initAgenda building2) S.empty + + +initAgenda :: Building -> Agenda +initAgenda b = P.singleton (estimateCost b) Agendum {current = b, trail = Q.empty, cost = estimateCost b} + + +aStar :: Agenda -> Buildings -> 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 + | P.null agenda = Nothing + | otherwise = + if isGoal reached then Just currentAgendum + else if reached `S.member` closed + then aStar (P.deleteMin agenda) closed + else aStar newAgenda (S.insert reached closed) + where + (_, currentAgendum) = P.findMin agenda + reached = current currentAgendum + newAgenda = foldl' (\q a -> P.insert (cost a) a q) (P.deleteMin agenda) $ candidates currentAgendum closed + + + +candidates :: Agendum -> Buildings -> Q.Seq Agendum +candidates agendum closed = newCandidates + where + candidate = current agendum + previous = trail agendum + succs = legalSuccessors $ successors candidate + nonloops = Q.filter (\s -> not $ s `S.member` closed) succs + newCandidates = fmap (\n -> makeAgendum n) nonloops + makeAgendum new = Agendum {current = new, + trail = candidate <| previous, + cost = estimateCost new + length previous + 1} + +isGoal :: Building -> Bool +isGoal (Building f (Floors floors)) = + f+1 == height && (all (\fl -> S.null $ unFloor fl) $ M.filterWithKey (\k _ -> k < f) floors) + where height = M.size floors + +isLegal :: Building -> Bool +isLegal (Building f (Floors floors)) = + null floor + || + not (any (isGenerator) floor) + || + any (safePair) pairs + where floor = unFloor $ fromJust $ M.lookup f floors + pairs = [(i, j) | i <- (S.toList floor), j <- (S.toList floor), isGenerator i] + safePair (Generator e, Microchip f) = e == f + safePair (Generator _, Generator _) = False + +isGenerator :: Item -> Bool +isGenerator (Generator _) = True +isGenerator (Microchip _) = False + +successors :: Building -> (Q.Seq Building) +successors b@(Building f (Floors floors)) = Q.fromList [updateBuilding b nf is | nf <- nextFloors, is <- items] + where + floor = unFloor $ fromJust $ M.lookup f floors + items = map (S.fromList) $ filter (\is -> length is == 1 || length is == 2) $ subsequences $ toList floor + nextFloors = if f == 0 then [1] + else if f+1 == length floors then [f-1] + else [f+1, f-1] + +legalSuccessors :: (Q.Seq Building) -> (Q.Seq Building) +legalSuccessors = Q.filter (isLegal) + +updateBuilding :: Building -> Int -> S.HashSet Item -> Building +updateBuilding (Building oldF (Floors oldFloors)) newF items = Building newF (Floors newFloors) + where oldFloorsE = fmap (unFloor) oldFloors + newFloorsE = M.adjust (\f -> f `S.union` items) newF $ M.adjust (\f -> f `S.difference` items) oldF oldFloorsE + newFloors = fmap (Floor) newFloorsE + + +estimateCost :: Building -> Int +estimateCost (Building _ (Floors floors)) = + sum $ map (\(c, f) -> c * S.size f) $ zip [0..] $ reverse $ M.elems $ fmap (unFloor) floors + diff --git a/stack.yaml b/stack.yaml index d3fc849..bc4f778 100644 --- a/stack.yaml +++ b/stack.yaml @@ -32,4 +32,4 @@ extra-deps: - astar-0.3.0.0 - parsec-numbers-0.1.0 - pqueue-1.3.2 -resolver: lts-6.25 +resolver: lts-6.27 -- 2.34.1