@@ 20,14 20,10 @@ import qualified Data.Set as Set
type Name = String
-indexed :: [a] -> [(Int, a)]
-indexed = go 0
- where go _ [] = []
- go i (x:xs) = (i,x):go (succ i) xs
-
data Survey = Survey { rates :: Array Int Int
, distances :: Map (Int,Int) Int
- , initiallyClosedValves :: [ Int ]
+ , initiallyClosedValves :: Set Int
+ , totalRate :: Int
}
deriving (Show, Eq)
@@ 44,70 40,106 @@ parser = mk <$> many valve
newline
return $ (v, r, ds)
-mk vs = Survey { rates, distances, initiallyClosedValves }
- where is = indexed vs
+mk vs = Survey { rates, distances, initiallyClosedValves, totalRate }
+ where is = enumerate vs
n = length is
r = (0, pred $ length is)
names = Array.array r $ flip fmap is $ \(i, (n, _, _)) -> (i,n)
tunnels = Array.array r $ flip fmap is $ \(i, (_, _, ds)) -> (i, g 0 <$> ds)
rates = Array.array r $ flip fmap is $ \(i, (_, r, ds)) -> (i,r)
- initiallyClosedValves = Maybe.mapMaybe (\(i, (_, r, _)) -> if r > 0 then Just i else Nothing) is
+ initiallyClosedValves = Set.fromList $ Maybe.mapMaybe (\(i, (_, r, _)) -> if r > 0 then Just i else Nothing) is
+ totalRate = Set.foldl (\r i -> r + rates ! i) 0 initiallyClosedValves
g i d | d == names ! i = i
g i d | otherwise = g (succ i) d
- distances = Map.fromList [ ((i, j), d i j) | i <- 0:initiallyClosedValves, j <- initiallyClosedValves, i /= j ]
+ distances = Map.fromList [ ((i, j), d i j) | i <- 0:(Set.toList initiallyClosedValves), j <- (Set.toList initiallyClosedValves), i /= j ]
ns = Set.fromList $ Array.range r
d i j = dijkstra i j ns (\k -> fmap (flip (,) 1) (tunnels ! k))
-data Action = Noop | Move Int | Open
+data Action = Move Int Int | Open Int
deriving ( Show, Eq )
-data St = St { loc :: Int
+data St = St { action :: [ Action ]
, pressure :: Int
- , openValves :: [ Int ]
- , closedValves :: [ Int ]
+ , rate :: Int
+ , closedValves :: Set Int
, time :: Int
}
deriving ( Show, Eq )
-initSt s = St { loc = 0
- , pressure = 0
- , openValves = []
- , closedValves = initiallyClosedValves s
- , time = 0
- }
-
-releasePressure s@(Survey { rates }) (St { openValves }) t = sum $ fmap (\i -> t * rates ! i) openValves
-
-move s i st = st { time = time st + d
- , loc = i
- , pressure = pressure st + releasePressure s st d
- }
- where d = (Map.!) (distances s) (loc st, i)
-
-open s i st = st { time = time st + 1
- , pressure = pressure st + releasePressure s st 1
- , closedValves = List.delete i $ closedValves st
- , openValves = i:openValves st
- }
-
-next s st@(St { loc, pressure, time, closedValves }) = Maybe.mapMaybe f closedValves
- where f i = let d = (Map.!) (distances s) (loc, i) in
- if 30 - time > d + 1 then Just (open s i $ move s i st) else Nothing
-
-partA s = go 0 [ initSt s ]
+initSt n s = St { action = take n $ repeat $ Move 0 0
+ , pressure = 0
+ , rate = 0
+ , closedValves = initiallyClosedValves s
+ , time = 0
+ }
+
+releasePressure s st = st { pressure = pressure st + rate st }
+
+runOutTheClock n s st = st { time = n
+ , pressure = pressure st + (n - time st) * rate st
+ }
+
+potential n s st = pressure st + (n - time st) * (totalRate s)
+
+takeTime st = st { time = time st + 1 }
+
+doOpen s i st | Set.member i (closedValves st) = st { closedValves = Set.delete i (closedValves st)
+ , rate = rate st + (rates s ! i)
+ }
+doOpen _ i st | otherwise = st
+
+whatsNext :: Int -> Survey -> St -> Action -> [ Action ]
+whatsNext n _ st _ | time st == n = []
+whatsNext _ s st a | otherwise = case a of
+ Move 0 l -> if Set.member l (closedValves st) then open l else walk l
+ Move d l -> [ Move (pred d) l ]
+ Open l -> walk l
+ where walk l = f l <$> Set.toList (closedValves st)
+ f l i = Move (pred $ (Map.!) (distances s) (l, i)) i
+ open l = [ Open l ]
+
+next :: Survey -> St -> St
+next s st = releasePressure s . takeTime . cardinal1R foldl' (\st a -> act a st) (action st) $ st
+ where act (Open loc) st = doOpen s loc st
+ act (Move _ loc) st = st
+
+partA :: Survey -> Int
+partA s = go 0 [ initSt 1 s ]
where go !m [] = m
- go !m (st:acc) = case next s st of
- [] -> let m' = runOutTheClock st in
+ go !m (st:acc) = let st' = next s st in
+ case whatsNext 30 s st' (head $ action st') of
+ [] -> let m' = pressure $ runOutTheClock 30 s st' in
go (max m m') acc
- sts -> go m (sts `combine` acc)
- runOutTheClock st@(St { pressure, time }) = pressure + releasePressure s st (30 - time)
+ as -> let sts = fmap (\a -> st' { action = a:[] }) as in
+ go m (sts `combine` acc)
---partB :: Parse -> Parse
---partB = id
+partB :: Survey -> Int
+partB s = go 0 [ initSt 2 s ]
+ where go !m [] = m
+ go !m (st:acc) = let st' = next s st in
+ if potential 26 s st' <= m then go m acc else
+ case action st' of
+ a:[] ->
+ case whatsNext 26 s st' a of
+ [] -> let m' = pressure $ runOutTheClock 26 s st' in
+ go (max m m') acc
+ as -> let sts = fmap (\a -> st' { action = a:[] }) as in
+ go m (sts `combine` acc)
+ a:b:[] ->
+ let a:b:[] = action st' in
+ case (whatsNext 26 s st' a, whatsNext 26 s st' b) of
+ ([], []) -> let m' = pressure $ runOutTheClock 26 s st' in
+ go (max m m') acc
+ (as, []) -> let sts = fmap (\a -> st' { action = a:[] }) as in
+ go m (sts `combine` acc)
+ ([], bs) -> let sts = fmap (\a -> st' { action = b:[] }) bs in
+ go m (sts `combine` acc)
+ (as, bs) -> let sts = [ st' { action = a:b:[] } | a<-as, b<-bs, a /= b ] in
+ go m (sts `combine` acc)
main :: IO ()
main = with parser $ do
run' "16.example" "a example" partA 1651
run' "16.input" "a input" partA 1896
- --run "16.example" "b example" partB
- --run "16.input" "b input" partB
+ run' "16.example" "b example" partB 1707
+ run' "16.input" "b input" partB 2576
@@ 27,10 27,12 @@ module Qulude ( module Prelude
, count
, distinct
, combine
+ , enumerate
, thrush
, warbler
, cardinal
+ , cardinal1R
, Parser
, parseFile
@@ 128,6 130,11 @@ count = go 0
distinct :: Ord a => [a] -> [a]
distinct = Set.toList . Set.fromList
+enumerate :: [a] -> [(Int, a)]
+enumerate = go 0
+ where go _ [] = []
+ go i (x:xs) = (i,x):go (succ i) xs
+
combine :: [a] -> [a] -> [a]
combine [] bs = bs
combine (a:as) bs = a:(combine as bs)
@@ 155,6 162,10 @@ warbler f a = f a a
cardinal :: (a -> b -> c) -> b -> a -> c
cardinal = flip
+-- Cardinal Once Removed: labcd.abdc
+cardinal1R :: (b -> c -> d -> e) -> b -> d -> c -> e
+cardinal1R a b d c = a b c d
+
parseFile :: Parser a -> String -> IO (Maybe a)
parseFile parser fn = doesFileExist fn >>= \case
False -> return Nothing