From 942e1bb64b12468703e7f1b5341d6701f101ae7f Mon Sep 17 00:00:00 2001 From: Neil Smith Date: Sat, 23 Nov 2019 17:53:26 +0000 Subject: [PATCH] Done day 22. --- advent-of-code.cabal | 22 +- problems/day22.html | 435 +++++++++++++++++++++++ src/advent21/advent21-from-megathread.hs | 107 ++++++ src/advent22/advent22.hs | 182 ++++++++++ 4 files changed, 745 insertions(+), 1 deletion(-) create mode 100644 problems/day22.html create mode 100644 src/advent21/advent21-from-megathread.hs create mode 100644 src/advent22/advent22.hs diff --git a/advent-of-code.cabal b/advent-of-code.cabal index 68d29fa..47dfd89 100644 --- a/advent-of-code.cabal +++ b/advent-of-code.cabal @@ -249,4 +249,24 @@ executable advent21 , containers , mtl , text - , megaparsec \ No newline at end of file + , megaparsec + +executable advent21fm + hs-source-dirs: src/advent21 + main-is: advent21-from-megathread.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , containers + , mtl + , text + , megaparsec + , monad-loops + , array + +executable advent22 + hs-source-dirs: src/advent22 + main-is: advent22.hs + default-language: Haskell2010 + build-depends: base >= 4.7 && < 5 + , containers + , pqueue diff --git a/problems/day22.html b/problems/day22.html new file mode 100644 index 0000000..107b467 --- /dev/null +++ b/problems/day22.html @@ -0,0 +1,435 @@ + + + + +Day 22 - Advent of Code 2018 + + + + + + + +

Advent of Code

Neil Smith (AoC++) 44*

  {year=>2018}

+ + + +
+

--- Day 22: Mode Maze ---

This is it, your final stop: the year -483. It's snowing and dark outside; the only light you can see is coming from a small cottage in the distance. You make your way there and knock on the door.

+

A portly man with a large, white beard answers the door and invites you inside. For someone living near the North Pole in -483, he must not get many visitors, but he doesn't act surprised to see you. Instead, he offers you some milk and cookies.

+

After talking for a while, he asks a favor of you. His friend hasn't come back in a few hours, and he's not sure where he is. Scanning the region briefly, you discover one life signal in a cave system nearby; his friend must have taken shelter there. The man asks if you can go there to retrieve his friend.

+

The cave is divided into square regions which are either dominantly rocky, narrow, or wet (called its type). Each region occupies exactly one coordinate in X,Y format where X and Y are integers and zero or greater. (Adjacent regions can be the same type.)

+

The scan (your puzzle input) is not very detailed: it only reveals the depth of the cave system and the coordinates of the target. However, it does not reveal the type of each region. The mouth of the cave is at 0,0.

+

The man explains that due to the unusual geology in the area, there is a method to determine any region's type based on its erosion level. The erosion level of a region can be determined from its geologic index. The geologic index can be determined using the first rule that applies from the list below:

+
    +
  • The region at 0,0 (the mouth of the cave) has a geologic index of 0.
    • +
  • The region at the coordinates of the target has a geologic index of 0.
    • +
  • If the region's Y coordinate is 0, the geologic index is its X coordinate times 16807.
    • +
  • If the region's X coordinate is 0, the geologic index is its Y coordinate times 48271.
    • +
  • Otherwise, the region's geologic index is the result of multiplying the erosion levels of the regions at X-1,Y and X,Y-1.
    • +
+

A region's erosion level is its geologic index plus the cave system's depth, all modulo 20183. Then:

+
    +
  • If the erosion level modulo 3 is 0, the region's type is rocky.
    • +
  • If the erosion level modulo 3 is 1, the region's type is wet.
    • +
  • If the erosion level modulo 3 is 2, the region's type is narrow.
    • +
+

For example, suppose the cave system's depth is 510 and the target's coordinates are 10,10. Using % to represent the modulo operator, the cavern would look as follows:

+
    +
  • At 0,0, the geologic index is 0. The erosion level is (0 + 510) % 20183 = 510. The type is 510 % 3 = 0, rocky.
    • +
  • At 1,0, because the Y coordinate is 0, the geologic index is 1 * 16807 = 16807. The erosion level is (16807 + 510) % 20183 = 17317. The type is 17317 % 3 = 1, wet.
    • +
  • At 0,1, because the X coordinate is 0, the geologic index is 1 * 48271 = 48271. The erosion level is (48271 + 510) % 20183 = 8415. The type is 8415 % 3 = 0, rocky.
    • +
  • At 1,1, neither coordinate is 0 and it is not the coordinate of the target, so the geologic index is the erosion level of 0,1 (8415) times the erosion level of 1,0 (17317), 8415 * 17317 = 145722555. The erosion level is (145722555 + 510) % 20183 = 1805. The type is 1805 % 3 = 2, narrow.
    • +
  • At 10,10, because they are the target's coordinates, the geologic index is 0. The erosion level is (0 + 510) % 20183 = 510. The type is 510 % 3 = 0, rocky.
    • +
+

Drawing this same cave system with rocky as ., wet as =, narrow as |, the mouth as M, the target as T, with 0,0 in the top-left corner, X increasing to the right, and Y increasing downward, the top-left corner of the map looks like this:

+
M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+

Before you go in, you should determine the risk level of the area. For the rectangle that has a top-left corner of region 0,0 and a bottom-right corner of the region containing the target, add up the risk level of each individual region: 0 for rocky regions, 1 for wet regions, and 2 for narrow regions.

+

In the cave system above, because the mouth is at 0,0 and the target is at 10,10, adding up the risk level of all regions with an X coordinate from 0 to 10 and a Y coordinate from 0 to 10, this total is 114.

+

What is the total risk level for the smallest rectangle that includes 0,0 and the target's coordinates?

+
+

Your puzzle answer was 8575.

--- Part Two ---

Okay, it's time to go rescue the man's friend.

+

As you leave, he hands you some tools: a torch and some climbing gear. You can't equip both tools at once, but you can choose to use neither.

+

Tools can only be used in certain regions:

+
    +
  • In rocky regions, you can use the climbing gear or the torch. You cannot use neither (you'll likely slip and fall).
    • +
  • In wet regions, you can use the climbing gear or neither tool. You cannot use the torch (if it gets wet, you won't have a light source).
    • +
  • In narrow regions, you can use the torch or neither tool. You cannot use the climbing gear (it's too bulky to fit).
    • +
+

You start at 0,0 (the mouth of the cave) with the torch equipped and must reach the target coordinates as quickly as possible. The regions with negative X or Y are solid rock and cannot be traversed. The fastest route might involve entering regions beyond the X or Y coordinate of the target.

+

You can move to an adjacent region (up, down, left, or right; never diagonally) if your currently equipped tool allows you to enter that region. Moving to an adjacent region takes one minute. (For example, if you have the torch equipped, you can move between rocky and narrow regions, but cannot enter wet regions.)

+

You can change your currently equipped tool or put both away if your new equipment would be valid for your current region. Switching to using the climbing gear, torch, or neither always takes seven minutes, regardless of which tools you start with. (For example, if you are in a rocky region, you can switch from the torch to the climbing gear, but you cannot switch to neither.)

+

Finally, once you reach the target, you need the torch equipped before you can find him in the dark. The target is always in a rocky region, so if you arrive there with climbing gear equipped, you will need to spend seven minutes switching to your torch.

+

For example, using the same cave system as above, starting in the top left corner (0,0) and moving to the bottom right corner (the target, 10,10) as quickly as possible, one possible route is as follows, with your current position marked X:

+
Initially:
+X=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down:
+M=.|=.|.|=.|=|=.
+X|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right:
+M=.|=.|.|=.|=|=.
+.X=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Switch from using the torch to neither tool:
+M=.|=.|.|=.|=|=.
+.X=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right 3:
+M=.|=.|.|=.|=|=.
+.|=|X|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Switch from using neither tool to the climbing gear:
+M=.|=.|.|=.|=|=.
+.|=|X|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down 7:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..X==..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..=X=..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down 3:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||.X.|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||..X|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Down:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.X..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Right 4:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===T===||
+=|||...|==..|=.|
+=.=|=.=..=X||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Up 2:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===X===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+Switch from using the climbing gear to the torch:
+M=.|=.|.|=.|=|=.
+.|=|=|||..|.=...
+.==|....||=..|==
+=.|....|.==.|==.
+=|..==...=.|==..
+=||.=.=||=|=..|=
+|.=.===|||..=..|
+|..==||=.|==|===
+.=..===..=|.|||.
+.======|||=|=.|=
+.===|=|===X===||
+=|||...|==..|=.|
+=.=|=.=..=.||==|
+||=|=...|==.=|==
+|=.=||===.|||===
+||.|==.|.|.||=||
+
+

This is tied with other routes as the fastest way to reach the target: 45 minutes. In it, 21 minutes are spent switching tools (three times, seven minutes each) and the remaining 24 minutes are spent moving.

+

What is the fewest number of minutes you can take to reach the target?

+
+

Your puzzle answer was 999.

Both parts of this puzzle are complete! They provide two gold stars: **

+

At this point, you should return to your Advent calendar and try another puzzle.

+

If you still want to see it, you can get your puzzle input.

+

You can also this puzzle.

+
+ + + + + + \ No newline at end of file diff --git a/src/advent21/advent21-from-megathread.hs b/src/advent21/advent21-from-megathread.hs new file mode 100644 index 0000000..6a52cf8 --- /dev/null +++ b/src/advent21/advent21-from-megathread.hs @@ -0,0 +1,107 @@ +{-| +Module: Day21 +Description: +-} +{-# LANGUAGE FlexibleContexts, RecordWildCards, TypeApplications #-} +{-# OPTIONS_GHC -Wno-name-shadowing #-} + +import Control.Monad.Cont (callCC, runCont, runContT) +import Control.Monad.Loops (iterateM_) +import Control.Monad.State (evalState, get, put) +import Data.Array.Unboxed (Array, IArray, Ix, UArray, (!), (//), bounds, inRange, listArray) +import Data.Bits (Bits, (.&.), (.|.)) +import Data.Bool (bool) +import qualified Data.IntSet as S (empty, insert, member) +import Data.List (genericLength) +import Text.Megaparsec (MonadParsec, between, choice, parseMaybe, sepEndBy) +import Text.Megaparsec.Char (newline, space, string) +import Text.Megaparsec.Char.Lexer (decimal) + +data Op + = ADDR | ADDI | MULR | MULI | BANR | BANI | BORR | BORI + | SETR | SETI | GTIR | GTRI | GTRR | EQIR | EQRI | EQRR + deriving (Eq) + +data Instruction i = Instruction {op :: Op, a :: i, b :: i, c :: i} + + +main :: IO () +main = do + text <- readFile "data/advent21.txt" + print $ day21a text + print $ day21b text + + +parser :: (IArray a (Instruction i), MonadParsec e String m, Integral i, Ix i) => m (i, a i (Instruction i)) +parser = do + ip <- between (string "#ip" *> space) newline decimal + isns <- flip sepEndBy newline $ do + op <- choice + [ ADDR <$ string "addr", ADDI <$ string "addi" + , MULR <$ string "mulr", MULI <$ string "muli" + , BANR <$ string "banr", BANI <$ string "bani" + , BORR <$ string "borr", BORI <$ string "bori" + , SETR <$ string "setr", SETI <$ string "seti" + , GTIR <$ string "gtir", GTRI <$ string "gtri", GTRR <$ string "gtrr" + , EQIR <$ string "eqir", EQRI <$ string "eqri", EQRR <$ string "eqrr" + ] + Instruction op <$> (space *> decimal) <*> (space *> decimal) <*> (space *> decimal) + return (ip, listArray (0, genericLength isns - 1) isns) + +doOp :: (IArray a i, Bits i, Integral i, Ix i) => a i i -> Op -> i -> i -> i +doOp r ADDR a b = r ! a + r ! b +doOp r ADDI a b = r ! a + b +doOp r MULR a b = r ! a * r ! b +doOp r MULI a b = r ! a * b +doOp r BANR a b = r ! a .&. r ! b +doOp r BANI a b = r ! a .&. b +doOp r BORR a b = r ! a .|. r ! b +doOp r BORI a b = r ! a .|. b +doOp r SETR a _ = r ! a +doOp _ SETI a _ = a +doOp r GTIR a b = bool 0 1 $ a > r ! b +doOp r GTRI a b = bool 0 1 $ r ! a > b +doOp r GTRR a b = bool 0 1 $ r ! a > r ! b +doOp r EQIR a b = bool 0 1 $ a == r ! b +doOp r EQRI a b = bool 0 1 $ r ! a == b +doOp r EQRR a b = bool 0 1 $ r ! a == r ! b + +step :: (Monad m, IArray a1 i, IArray a2 (Instruction i), Bits i, Integral i, Ix i, Show (a1 i i)) => (i -> m ()) -> i -> a2 i (Instruction i) -> a1 i i -> m (a1 i i) +step f ip isns regs + | c == 0 = fail "writing value to register 0" + | op == EQRR, a == 0, c /= ip = regs // [(c, 0), (ip, regs ! ip + 1)] <$ f (regs ! b) + | op == EQRR, b == 0, c /= ip = regs // [(c, 0), (ip, regs ! ip + 1)] <$ f (regs ! a) + | (op /= SETI && a == 0) || (op `elem` [ADDR, MULR, BANR, BORR, GTIR, GTRR, EQIR, EQRR] && b == 0) + = fail "reading from register 0" + | inRange (bounds isns) (base + 8) + , Instruction SETI 0 _ t <- isn, t `notElem` [0, ip] + , Instruction ADDI t' 1 u <- isns ! (base + 1), t == t', u `notElem` [0, ip, t] + , Instruction MULI u' n u'' <- isns ! (base + 2), u == u', n > 0, u == u'' + , Instruction GTRR u' r u'' <- isns ! (base + 3), u == u', r `notElem` [0, ip, t], u == u'' + , Instruction ADDR u' ip' ip'' <- isns ! (base + 4), u == u', ip == ip', ip == ip'' + , Instruction ADDI ip' 1 ip'' <- isns ! (base + 5), ip == ip', ip == ip'' + , Instruction SETI base' _ ip' <- isns ! (base + 6), base + 8 == base', ip == ip' + , Instruction ADDI t' u' t'' <- isns ! (base + 7), t == t', u == u', t == t'' + , Instruction SETI base' _ ip' <- isns ! (base + 8), base == base', ip == ip' + = return $ regs // [(ip, base + 9), (t, max 0 $ regs ! r `div` n), (u, 1)] + | otherwise + = return $ regs // if ip == c then [(ip, result + 1)] else [(ip, regs ! ip + 1), (c, result)] + where base = regs ! ip + isn@Instruction {..} = isns ! base + result = doOp regs op a b + +day21a :: String -> Maybe Int +day21a input = do + (ip, isns) <- parseMaybe @() (parser @Array) input + let regs = listArray @UArray (0, 5) $ repeat 0 + return $ flip runCont id $ callCC $ \f -> iterateM_ (step f ip isns) regs + +day21b :: String -> Maybe Int +day21b input = do + (ip, isns) <- parseMaybe @() (parser @Array) input + let regs = listArray @UArray (0, 5) $ repeat 0 + reportDup f i = do + (seen, prior) <- get + if i `S.member` seen then f prior else put (S.insert i seen, i) + return $ flip evalState (S.empty, undefined) $ flip runContT return $ callCC $ \f -> + iterateM_ (step (reportDup f) ip isns) regs diff --git a/src/advent22/advent22.hs b/src/advent22/advent22.hs new file mode 100644 index 0000000..a8c44f2 --- /dev/null +++ b/src/advent22/advent22.hs @@ -0,0 +1,182 @@ +{-# LANGUAGE NegativeLiterals #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE BangPatterns #-} + +import Debug.Trace + +-- import Prelude hiding ((++)) + +import qualified Data.Map.Strict as M +import Data.Map.Strict ((!)) +import Data.List + +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 Debug.Trace + +type Coord = (Integer, Integer) +type Cave = M.Map Coord Integer + + +data Region = Rocky | Wet | Narrow deriving (Eq, Ord, Show) +data Tool = Rope | Torch | Neither deriving (Eq, Ord, Show) +data Explorer = Explorer { _tool :: Tool + , _coord :: Coord + , _time :: Integer + } deriving (Ord, Show) +type ExploredStates = S.Set Explorer + +type RegionCave = M.Map Coord Region + +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) + + +instance Eq Explorer where + e1 == e2 = (_tool e1 == _tool e2) && (_coord e1 == _coord e2) + + +depth :: Integer +-- depth = 510 +depth = 10689 + +target :: Coord +-- target = (10, 10) +target = (11, 722) + +width :: Integer +width = fst target + +height :: Integer +height = snd target + + +main :: IO () +main = do + print $ part1 + print $ part2 + -- print $ part2 ip instrs + +part1 = cave_risk_level $ erosion_levels width height + +part2 = _time $ _current $ fromJust result + where cave = region_cave $ erosion_levels (width + height + 10) (width + height + 10) + result = aStar (initAgenda) cave S.empty + + + +geologic_index_mouth = 0 +geologic_index_target = 0 +geologic_index_y0 x = x * 16807 +geologic_index_x0 y = y * 48271 +geologic_index l u = l * u + +erosion_level gi = (gi + depth) `mod` 20183 + +risk_level el = el `mod` 3 + +region_type 0 = Rocky +region_type 1 = Wet +region_type 2 = Narrow + +erosion_levels :: Integer -> Integer -> Cave +erosion_levels w h = M.insert (width, height) (erosion_level $ geologic_index_target) cave + where cave0 = M.singleton (0, 0) $ erosion_level $ geologic_index_mouth + cave_top = foldl' (\c x -> M.insert (x, 0) (erosion_level $ geologic_index_y0 x) c) cave0 [1..w] + cave_left = foldl' (\c y -> M.insert (0, y) (erosion_level $ geologic_index_x0 y) c) cave_top [1..h] + cave = foldl' insert_erosion_level + cave_left + [ (xx, yy) | xx <- [1..w], yy <- [1..h] ] + insert_erosion_level c (x, y) = M.insert (x, y) (erosion_level $ geologic_index (c!((x - 1), y)) (c!(x, (y - 1)))) c + +cave_risk_level cave = sum $ map risk_level $ M.elems cave + +region_cave cave = M.map (region_type . risk_level) cave + + +initAgenda :: Agenda +initAgenda = P.singleton (estimateCost explorer) Agendum { _current = explorer, _trail = Q.empty, _cost = estimateCost explorer} + where explorer = Explorer { _coord = (0, 0), _tool = Torch, _time = 0 } + + +aStar :: Agenda -> RegionCave -> ExploredStates -> Maybe Agendum +-- aStar [] _ = Agendum {current=buildingTest, trail=[], cost=0} +aStar agenda cave closed + -- | trace ("Peeping " ++ (show $ fst $ P.findMin agenda) ++ ": " ++ (show reached) ++ " <- " ++ (show $ toList $ Q.take 1 $ _trail $ currentAgendum) ++ " :: " ++ (show newAgenda)) False = undefined + -- | trace ("Peeping " ++ (show $ P.findMin agenda) ) False = undefined + | P.null agenda = Nothing + | otherwise = + if isGoal reached then Just currentAgendum + else if reached `S.member` closed + then aStar (P.deleteMin agenda) cave closed + else aStar newAgenda cave (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 cave closed + + + +candidates :: Agendum -> RegionCave -> ExploredStates -> (Q.Seq Agendum) +candidates agendum cave closed = newCandidates + where + candidate = _current agendum + previous = _trail agendum + succs = legalSuccessors cave $ 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 + (fromIntegral $ _time new) + } + +isGoal :: Explorer -> Bool +isGoal explorer = (_coord explorer) == target && (_tool explorer) == Torch + + +isLegal :: RegionCave -> Explorer -> Bool +isLegal cave explorer = + legalInRegion region tool + where region = cave!(_coord explorer) + tool = _tool explorer + +legalInRegion :: Region -> Tool -> Bool +legalInRegion Rocky Rope = True +legalInRegion Rocky Torch = True +legalInRegion Wet Rope = True +legalInRegion Wet Neither = True +legalInRegion Narrow Torch = True +legalInRegion Narrow Neither = True +legalInRegion _ _ = False + + +successors :: Explorer -> (Q.Seq Explorer) +successors explorer = movingSuccessors >< switchingSuccessors + where time = _time explorer + (x, y) = _coord explorer + tool = _tool explorer + locations = filter (\(x', y') -> x' >= 0 && y' >= 0) + [(x, y + 1), (x, y - 1), (x + 1, y), (x - 1, y)] + tools = [t | t <- [Rope, Torch, Neither] , t /= tool ] + movingSuccessors = fmap (\l -> explorer { _coord = l, _time = time + 1}) $ Q.fromList locations + switchingSuccessors = fmap (\t -> explorer { _tool = t, _time = time + 7}) $ Q.fromList tools + + +legalSuccessors :: RegionCave -> (Q.Seq Explorer) -> (Q.Seq Explorer) +legalSuccessors cave = Q.filter (isLegal cave) + + +estimateCost :: Explorer -> Int +estimateCost explorer = fromIntegral $ (abs (x - width)) + (abs (y - height)) + where (x, y) = _coord explorer + + -- 2.34.1