2022/day16.hs

@@ -5,9 +5,8 @@ import Debug.Trace (traceShowId, traceShow, trace)
 import Data.Maybe (fromMaybe)
 
 import Bfs
-import Data.List (maximumBy, permutations, delete, singleton)
+import Data.List (maximumBy, permutations, delete)
 import Data.Function (on)
-import Control.Monad.Trans.State (State, get, put, evalState)
 
 data Valve = V { flow' :: Int, neighs' :: [String] } deriving Show
 type ZMap = M.Map String Valve
@@ -64,7 +63,7 @@ perms limit m = perms' "AA" limit elems where
     perms' current remaining as = do
         a <- as
         let distance = dists (m M.! current) M.! a
-        [a] : if distance < remaining then do
+        if distance < remaining then do
             let l = delete a as
             ls <- perms' a (remaining-distance) l
             pure $ a:ls
@@ -89,54 +88,14 @@ traceMap cond f (x:y:xs)
     | cond x y = let result = f x in traceShow (result, x) (result: traceMap cond f (y:xs))
     | otherwise = f x : traceMap cond f (y:xs)
 
-type EleMemo = M.Map (S.Set String) Int
-eleLookup :: NzMap -> S.Set String -> State EleMemo Int
-eleLookup nzmap permutation = do
-    mmap <- get
-    case M.lookup permutation mmap of
-        Just x -> pure x
-        Nothing -> do
-            let valves = M.fromList $ filter (\(name, valve) -> S.notMember name permutation) (M.toList nzmap)
-            let elePerms = traceShow ("elephant", permutation) $ perms 26 valves
-            let exec p = execPerm nzmap p 0 "AA" 26
-            let flow = maximum $ map exec elePerms
-            put $ M.insert permutation flow mmap
-            pure flow
-
-part2 :: NzMap -> [String] -> State EleMemo Int
-part2 nzmap permutation = do
-    let me = execPerm nzmap permutation 0 "AA" 26
-    elephant <- eleLookup nzmap (S.fromList permutation)
-    pure $ me + elephant
-    -- case elephant of
-    --     Just ele -> pure $ me + ele
-    --     Nothing -> do
-    --         let valves = M.fromList $ filter (\(name, valve) -> S.notMember name permset) (M.toList nzmap)
-    --         let elePerms = traceShow ("elephant", permutation) $ perms 26 valves
-    --         let exec p = execPerm nzmap p 0 "AA" 26
-    --         let ele = maximum $ map exec elePerms
-    --         put $ M.insert permset ele state
-    --         pure $ me + ele
-
 main :: IO ()
 main = do
     x <- prepass . M.fromList . map parseValve . lines <$> getContents
     mapM_ print x
 
-    -- let all = perms 30 x
+    let all = perms 30 x
-    -- let exec p = execPerm x p 0 "AA" 30
+    let exec p = execPerm x p 0 "AA" 30
-    -- let result = traceMap (\a b -> take 2 a /= take 2 b) exec all
+    let result = traceMap (\a b -> take 2 a /= take 2 b) exec all
-    -- putStr "part 1: "
+    putStr "part 1: "
-    -- print $ maximum result
-    -- print $ fst $ search x S.empty "AA" 30 M.empty
-
-    putStr "part 2: "
-    -- let initialEle = maximumBy (compare `on` fst) $ map (\p -> (execPerm x p 0 "AA" 26, [S.fromList p])) (perms 26 x)
-    -- print initialEle
-
-
-    let all = perms 26 x
-    let action = mapM (part2 x) all
-    let result = evalState action M.empty
     print $ maximum result
-    pure ()
+    -- print $ fst $ search x S.empty "AA" 30 M.empty

2022/day17.hs

@@ -1,98 +0,0 @@
-import qualified Data.Set as S
-import Debug.Trace (traceShow)
-
-type Coord = (Integer, Integer)
-type Rock = [Coord]
-
-rockFix :: Rock -> Rock
-rockFix xs = let maxy = maximum (map snd xs) in map (\(x,y) -> (x+2, y-maxy)) xs
-
-rocks :: [Rock]
-rocks = map rockFix
-  [ [(0,0), (1,0), (2,0), (3,0)]
-  , [(1,0), (0,1), (1,1), (2,1), (1,2)]
-  , [(2,0), (2,1), (0,2), (1,2), (2,2)]
-  , [(0,0), (0,1), (0,2), (0,3)]
-  , [(0,0), (0,1), (1,0), (1,1)]
-  ]
-
-simulate :: [Rock] -> Maybe Rock -> String -> S.Set Coord -> Integer -> S.Set Coord
-simulate [] _ _ _ _ = error "finite stream of rocks"
-simulate (r:rs) Nothing jets occupied 0 = occupied
-simulate (r:rs) Nothing jets occupied n = simulate rs (Just next) jets occupied (n-1) where
-    height = minimum (1 : map snd (S.toList occupied)) - 4
-    next = map (\(x,y) -> (x, y+height)) r
-simulate (r:rs) (Just rock) (j:js) occupied remaining = if valid dropped
-    then simulate (r:rs) (Just dropped) js occupied remaining
-    else simulate (r:rs) Nothing js occupied' remaining
-    where
-        pushF = case j of
-            '>' -> \(x,y) -> (x+1, y)
-            '<' -> \(x,y) -> (x-1, y)
-            _ -> error ("invalid char" ++ show j)
-        dropF (x,y) = (x, y+1)
-        valid = all (\c@(x,y) -> c `S.notMember` occupied
-                              && x >= 0 && x < 7 && y <= 0)
-        pushed = if valid (map pushF rock) then map pushF rock else rock
-        dropped = map dropF pushed
-        occupied' = foldr S.insert occupied pushed
-
-
--- simulate2 :: [Rock] -> String -> [Rock] -> Maybe Rock -> String -> S.Set Coord -> Integer -> Integer -> Integer
--- simulate2 origR origJ [] _ _ _ _ _ = error "finite stream of rocks"
--- simulate2 origR origJ (r:rs) Nothing jets occupied 0 iters = undefined
--- simulate2 origR origJ (r:rs) Nothing jets occupied n iters = if iters > 0 && matchesR && matchesJ
---     then let h = minimum (map snd (S.toList occupied)) in
---          let repetitions = n `div` iters in
---          let addedHeight = h * repetitions in addedHeight + simulate2 origR origJ (r:rs) Nothing jets occupied (n `mod` iters) 0
---     else simulate2 origR origJ rs (Just next) jets occupied (n-1) (iters+1) where
---         height = minimum (1 : map snd (S.toList occupied)) - 4
---         next = map (\(x,y) -> (x, y+height)) r
---         matchesR = origR == take (length origR) (r:rs)
---         matchesJ = origJ == take (length origJ) jets
--- simulate2 origR origJ (r:rs) (Just rock) (j:js) occupied remaining iters = if valid dropped
---     then simulate2 origR origJ (r:rs) (Just dropped) js occupied remaining iters
---     else simulate2 origR origJ (r:rs) Nothing js occupied' remaining iters
---     where
---         pushF = case j of
---             '>' -> \(x,y) -> (x+1, y)
---             '<' -> \(x,y) -> (x-1, y)
---             _ -> error ("invalid char" ++ show j)
---         dropF (x,y) = (x, y+1)
---         valid = all (\c@(x,y) -> c `S.notMember` occupied
---                               && x >= 0 && x < 7 && y <= 0)
---         pushed = if valid (map pushF rock) then map pushF rock else rock
---         dropped = map dropF pushed
---         occupied' = foldr S.insert occupied pushed
-
-
-main :: IO ()
-main = do
-    jets <- head . lines <$> getContents
-    let height set = -(minimum $ map snd (S.toList set)) + 1
-
-    putStr "part 1: "
-    let tower = simulate (cycle rocks) Nothing (cycle jets) S.empty 2022
-    print (height tower)
-
-    -- part 2
-    let repIters = lcm (fromIntegral $ length jets) (fromIntegral $ length rocks) :: Integer
-    putStr "repeated: " >> print repIters
-
-    let initial = simulate (cycle rocks) Nothing (cycle jets) S.empty repIters
-    let repeated = simulate (cycle rocks) Nothing (cycle jets) S.empty (2*repIters)
-
-    let diff ls = zipWith (-) (tail ls) ls
-    print $ diff $ map (\i -> height $ simulate (cycle rocks) Nothing (cycle jets) S.empty (i*repIters)) [1..20]
-
-    let initHeight = height initial
-    let repHeight = height repeated - initHeight
-    putStr "repeated structure height: " >> print (initHeight, repHeight)
-    let remIters = 1000000000000 `mod` repIters
-    let remaining = simulate (cycle rocks) Nothing (cycle jets) S.empty remIters
-    let remHeight = if remIters > 0 then -(minimum $ map snd (S.toList remaining)) + 1 else 0
-    -- let tower = simulate2 rocks jets (cycle rocks) Nothing (cycle jets) S.empty 2022 0
-
-    putStr "part 2: "
-    let repNum = 1000000000000 `div` repIters
-    print $ (repNum * repHeight) + remHeight

2022/inputs/day17.test

@@ -1 +0,0 @@
->>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>