2022/Bfs.hs

@@ -1,16 +0,0 @@
-module Bfs where
-
-import qualified Data.Map as M
-
-type Neighs a = a -> [a]
-
-bfs :: Ord k => Neighs k -> [(k, Int)] -> M.Map k Int -> M.Map k Int
-bfs f [] visited = visited
-bfs f ((q, dist):qs) visited = if new
-    then bfs f queue' visited'
-    else bfs f qs visited 
-    where
-        new = M.notMember q visited 
-        neighs = f q
-        visited' = M.insert q dist visited
-        queue' = qs ++ map(,dist+1) neighs

2022/day12.hs

@@ -4,23 +4,26 @@ import Data.Char (ord)
 import Data.List (findIndex, find)
 import Data.Maybe (isJust, mapMaybe, listToMaybe, fromJust)
 
-import qualified Bfs as B
-
 type Height = Int -- bool identifies if this is our final square
 type Coord = (Int, Int)
 type HeightMap = A.Array Coord Height
 
 
 bfs :: HeightMap -> [(Coord, Int)] -> M.Map Coord Int -> M.Map Coord Int
-bfs heightmap = B.bfs f where
+bfs heightmap [] visited = visited
-    f q@(x,y) = neighs where
+bfs heightmap ((q@(x,y), dist):queue) visited = if usable
-        height = heightmap A.! q
+        then bfs heightmap queue' visited'
+        else bfs heightmap queue visited
+        where
+            current = heightmap A.! q
             inRange (x,y) = let (bx, by) = snd (A.bounds heightmap) in x >= 0 && x <= bx && y >= 0 && y <= by
-        reachable coord = inRange coord && (heightmap A.! coord) >= height - 1
+            reachable coord = inRange coord && (heightmap A.! coord) >= current - 1
             neighs = filter reachable [(x+1, y), (x-1, y), (x, y+1), (x, y-1)]
-
+            usable = case M.lookup q visited of
-
+                                                Nothing -> True
-
+                                                (Just d) -> d > dist
+            visited' = M.insert q dist visited
+            queue' = queue ++ map (,dist+1) neighs
 
 toHeight :: Char -> Int
 toHeight 'S' = toHeight 'a'

2022/day15.hs

@@ -1,17 +1,11 @@
 import Data.List.Split (splitOn)
 import qualified Data.Set as S
-import Data.List (sortOn, sort)
-import qualified Data.Map as M
-import Debug.Trace (traceShowId)
-import GHC.Utils.GlobalVars (global)
 
 type Coord = (Int, Int)
 
 globalY :: Int
 globalY = 2000000
 
-bound = 4000000
-
 parseCoord :: String -> Coord
 parseCoord xs = (read $ init x, read y) where
     [x,y] = map (drop 2) $ splitOn " " xs
@@ -23,86 +17,23 @@ parseLine xs = (sensor, beacon) where
 manhattan :: Coord -> Coord -> Int
 manhattan (a,b) (x,y) = abs (a-x) + abs (b-y)
 
-allWithinRange :: Coord -> Coord -> Int -> [Coord]
+allWithinRange :: Coord -> Coord -> S.Set Coord
-allWithinRange sensor@(a,b) beacon@(x,y) row = filter (\c -> manhattan sensor c <= dist) all where
+allWithinRange sensor@(a,b) beacon@(x,y) = S.fromList $ filter (\c -> manhattan sensor c <= dist) all where
     minx = a - dist
     maxx = a + dist
     miny = b - dist
     maxy = b + dist
     dist = manhattan sensor beacon
-    all = [(x,row) | x <- [minx..maxx]]
+    all = [(x,y) | x <- [minx..maxx], y <- [globalY]]
-
-closest :: Coord -> M.Map Coord Int -> Coord
-closest coord beacons = closest -- manhattan coord closest > beacons M.! closest
-    where
-        closest = head $ sortOn (manhattan coord) (M.keys beacons)
-
-scan :: M.Map Coord Int -> Coord -> Coord
-scan dists progress@(x,y)
-  | outOfRange = progress
-  | x > bound = scan dists $ if y `mod` 1000 == 0 then traceShowId  (0,y+1) else (0, y+1)
-  | y > bound = error "no beacon"
-  | x < fst near = scan dists (fst near + abs xdist, y)
-  | otherwise = scan dists (x+1, y)
-  where
-      near = closest progress dists
-      outOfRange = all (\(sensor, dist) -> manhattan sensor progress > dist) (M.toList dists)
-      xdist = x - fst near
-      next = if x < fst near then (fst near + xdist, y) else (x + 1, y)
-
-bounds :: Coord -> Coord -> Int -> [(Int, Int)]
-bounds sensor@(x,y) coord@(a,b) row = [(x - xdist, x + xdist) | ydist <= dist] where
-    dist = manhattan sensor coord
-    ydist = abs (y-row)
-    xdist = (dist - ydist)
-
-mergeBounds :: [(Int, Int)] -> [(Int, Int)]
-mergeBounds [x] = [x]
-mergeBounds ((a,b):(x,y):xs)
-    | maxL >= minR - 1 = mergeBounds $ (minTot, maxTot):xs
-    | otherwise = [(a,b), (x,y)]
-    where
-    minL = min a b
-    maxL = max a b
-    minR = min x y
-    maxR = max x y
-    minTot = min minL minR
-    maxTot = max maxL maxR
-
-traceCond :: (Int, Int) -> (Int, Int)
-traceCond (x,y) = if x `mod` 1000 == 0 && y `mod` 1000 == 0 then traceShowId (x,y) else (x,y)
-
-scan' :: [(Coord, Coord)] -> M.Map Coord Int -> Coord -> Coord
-scan' input dists progress@(x,y)
-  | length covered == 1 && fst (head covered) <= 0 && snd (head covered) >= bound = scan' input dists $ traceCond (0, y+1)
-  | outOfRange = progress
-  | x > bound = scan' input dists $ traceShowId  (0,y+1)
-  | y > bound = error "no beacon"
-  | otherwise = scan' input dists $ traceCond (x+1, y)
---   | x < fst near = scan' input dists $ traceShowId (fst near + abs xdist, y)
---   | otherwise = scan' input dists $ traceShowId (x+1, y)
-  where
-      covered = mergeBounds $ sort $ concatMap (\(s,b) -> bounds s b y) input
-      near = closest progress dists
-      outOfRange = all (\(sensor, dist) -> manhattan sensor progress > dist) (M.toList dists)
-      xdist = x - fst near
-      next = if x < fst near then (fst near + xdist, y) else (x + 1, y)
-
 
 main :: IO ()
 main = do
     x <- map parseLine . lines <$> getContents
 
     let beacons = S.fromList $ map snd x
-    let reachable = foldr1 S.union $ map (\(a,b) -> S.fromList $ allWithinRange a b globalY) x
+    let reachable = foldr1 S.union $ map (uncurry allWithinRange) x
-
-    let dists = M.fromList $ map (\(s,b) -> (s, manhattan s b)) x
 
     let ys = S.size $ S.filter (\x -> snd x == globalY) (reachable S.\\ beacons)
 
-    -- putStr "part 1: "
+    putStr "part 1: "
-    -- print ys
+    print ys
-
-    putStr "part 2: "
-    let (x',y') = scan' x dists (0,3040754)
-    print $ y' + x'*4000000

2022/day16.hs

@@ -1,101 +0,0 @@
-import qualified Data.Map as M
-import qualified Data.Set as S
-import Data.List.Split (splitOn)
-import Debug.Trace (traceShowId, traceShow, trace)
-import Data.Maybe (fromMaybe)
-
-import Bfs
-import Data.List (maximumBy, permutations, delete)
-import Data.Function (on)
-
-data Valve = V { flow' :: Int, neighs' :: [String] } deriving Show
-type ZMap = M.Map String Valve
-
-data NzValve = NV { flow :: Int, dists :: M.Map String Int} deriving Show
-type NzMap = M.Map String NzValve
-
-parseValve :: String -> (String, Valve)
-parseValve xs = (name, V flow tunnels) where
-    name = words xs !! 1
-    flow = read $ last $ splitOn "=" (head $ splitOn ";" xs)
-    valves = splitOn ", " $ last (splitOn "tunnels lead to valves " xs)
-    singleValve = splitOn "tunnel leads to valve " xs
-    tunnels = if length singleValve == 1 then valves else [last singleValve]
-
-search' :: ZMap -> String -> String -> Int
-search' scan from to = dists M.! to where
-    dists = bfs f [(from,0)] M.empty
-    f x = neighs' (scan M.! x)
-
-
-prepass :: ZMap -> NzMap
-prepass xs = M.fromList $ concatMap f $ M.toList xs where
-    f (name, v@(V flow _)) = [(name, NV flow (M.fromList $ dists name)) | name == "AA" || flow > 0]
-    dists name = map (\target -> (target, search' xs name target)) (filter (/= name) allValves)
-    allValves = map fst . filter (\(name, V flow _) -> name == "AA" || flow > 0) $ M.toList xs
-
-
-
-
-type Memo = M.Map (S.Set String, String, Int) Int
--- search :: Map -> S.Set String -> String -> Int -> Memo -> (Int, Memo)
--- search scan active location n memo 
---     | n <= 0 = (0, M.empty)
---     | otherwise = (releasedPressure + fst best, snd best) where
---         valve = scan M.! location
---         openValve = [(S.insert location active, location, n-1) | S.notMember location active && flow valve > 0]
---         releasedPressure = sum $ map (flow . (scan M.!)) (S.toList active)
---         nop = [(active, location, n-1) | S.size active == M.size scan]
---         move = map (\(name, dist) -> (active, name, n-dist)) (dists $ scan M.! location)
---         actions = openValve ++ move ++ nop
---         trace x = if n>=15 then traceShow (fst x) x else x
---         best = trace $ maximumBy (compare `on` fst) $ map (\(a,l,n) -> search scan a l n memo) actions
---         -- best = maybe best' (\b -> (b,memo)) (M.lookup (active, location, n) memo)
---         -- best' = foldr f (0, memo) actions where
---         --     f (a,l, newN) (i,m) = let (result, memo') = search scan a l newN m; b = max i result in
---         --         trace (b, M.insertWith max (a,l, newN) b $ M.unionWith max m memo')
-
-perms :: Int -> NzMap -> [[String]]
-perms limit m = perms' "AA" limit elems where
-    elems = filter (/= "AA") $ M.keys m
-    perms' :: String -> Int -> [String] -> [[String]]
-    perms' current remaining [] = [[]]
-    perms' current remaining as = do
-        a <- as
-        let distance = dists (m M.! current) M.! a
-        if distance < remaining then do
-            let l = delete a as
-            ls <- perms' a (remaining-distance) l
-            pure $ a:ls
-        else pure [a]
-
-execPerm :: NzMap -> [String] -> Int -> String -> Int -> Int
-execPerm nzmap [] flowrate location remaining = remaining * flowrate
-execPerm nzmap (target:qs) flowrate location remaining
-    | remaining < 0 = 0
-    | distance >= remaining = remaining * flowrate
-    | otherwise = (distance * flowrate) + execPerm nzmap qs flowrate' target (remaining - distance)
-    where
-        valve = nzmap M.! location
-        distance = 1 + dists valve M.! target
-        flowrate' = flowrate + flow (nzmap M.! target)
-
-
-traceMap :: (Show a, Show b) => (a -> a -> Bool) -> (a -> b) -> [a] -> [b]
-traceMap cond f [] = []
-traceMap cond f [x] = [f x]
-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)
-
-main :: IO ()
-main = do
-    x <- prepass . M.fromList . map parseValve . lines <$> getContents
-    mapM_ print x
-
-    let all = perms 30 x
-    let exec p = execPerm x p 0 "AA" 30
-    let result = traceMap (\a b -> take 2 a /= take 2 b) exec all
-    putStr "part 1: "
-    print $ maximum result
-    -- print $ fst $ search x S.empty "AA" 30 M.empty

2022/inputs/day16

@@ -1,56 +0,0 @@
-Valve JI has flow rate=21; tunnels lead to valves WI, XG
-Valve DM has flow rate=3; tunnels lead to valves JX, NG, AW, BY, PF
-Valve AZ has flow rate=0; tunnels lead to valves FJ, VC
-Valve YQ has flow rate=0; tunnels lead to valves TE, OP
-Valve WI has flow rate=0; tunnels lead to valves JI, VC
-Valve NE has flow rate=0; tunnels lead to valves ZK, AA
-Valve FM has flow rate=0; tunnels lead to valves LC, DU
-Valve QI has flow rate=0; tunnels lead to valves TE, JW
-Valve OY has flow rate=0; tunnels lead to valves XS, VF
-Valve XS has flow rate=18; tunnels lead to valves RR, OY, SV, NQ
-Valve NU has flow rate=0; tunnels lead to valves IZ, BD
-Valve JX has flow rate=0; tunnels lead to valves DM, ZK
-Valve WT has flow rate=23; tunnels lead to valves OV, QJ
-Valve KM has flow rate=0; tunnels lead to valves TE, OL
-Valve NG has flow rate=0; tunnels lead to valves II, DM
-Valve FJ has flow rate=0; tunnels lead to valves AZ, II
-Valve QR has flow rate=0; tunnels lead to valves ZK, KI
-Valve KI has flow rate=9; tunnels lead to valves ZZ, DI, TL, AJ, QR
-Valve ON has flow rate=0; tunnels lead to valves LC, QT
-Valve AW has flow rate=0; tunnels lead to valves DM, AA
-Valve HI has flow rate=0; tunnels lead to valves TE, VC
-Valve XG has flow rate=0; tunnels lead to valves II, JI
-Valve II has flow rate=19; tunnels lead to valves LF, NG, OL, FJ, XG
-Valve VC has flow rate=24; tunnels lead to valves WI, HI, AZ
-Valve VJ has flow rate=0; tunnels lead to valves UG, AA
-Valve IZ has flow rate=0; tunnels lead to valves VF, NU
-Valve EJ has flow rate=0; tunnels lead to valves ZK, LC
-Valve DU has flow rate=12; tunnels lead to valves TC, UG, FM
-Valve ZK has flow rate=10; tunnels lead to valves JX, EJ, JW, QR, NE
-Valve XF has flow rate=25; tunnels lead to valves OP, VT
-Valve LC has flow rate=4; tunnels lead to valves FM, EJ, ON, AJ, PF
-Valve SV has flow rate=0; tunnels lead to valves XS, IY
-Valve LF has flow rate=0; tunnels lead to valves II, OV
-Valve DI has flow rate=0; tunnels lead to valves KI, BY
-Valve OP has flow rate=0; tunnels lead to valves YQ, XF
-Valve NQ has flow rate=0; tunnels lead to valves TC, XS
-Valve QJ has flow rate=0; tunnels lead to valves VT, WT
-Valve IY has flow rate=22; tunnel leads to valve SV
-Valve AJ has flow rate=0; tunnels lead to valves LC, KI
-Valve TE has flow rate=11; tunnels lead to valves QI, HI, KM, YQ
-Valve ZZ has flow rate=0; tunnels lead to valves KI, AA
-Valve VT has flow rate=0; tunnels lead to valves XF, QJ
-Valve OL has flow rate=0; tunnels lead to valves KM, II
-Valve TC has flow rate=0; tunnels lead to valves NQ, DU
-Valve TL has flow rate=0; tunnels lead to valves VF, KI
-Valve QT has flow rate=0; tunnels lead to valves AA, ON
-Valve BY has flow rate=0; tunnels lead to valves DM, DI
-Valve OV has flow rate=0; tunnels lead to valves LF, WT
-Valve VN has flow rate=0; tunnels lead to valves RR, BD
-Valve VF has flow rate=13; tunnels lead to valves OY, IZ, TL
-Valve BD has flow rate=17; tunnels lead to valves NU, VN
-Valve UG has flow rate=0; tunnels lead to valves VJ, DU
-Valve PF has flow rate=0; tunnels lead to valves LC, DM
-Valve RR has flow rate=0; tunnels lead to valves XS, VN
-Valve AA has flow rate=0; tunnels lead to valves QT, ZZ, AW, VJ, NE
-Valve JW has flow rate=0; tunnels lead to valves ZK, QI

2022/inputs/day16.test

@@ -1,10 +0,0 @@
-Valve AA has flow rate=0; tunnels lead to valves DD, II, BB
-Valve BB has flow rate=13; tunnels lead to valves CC, AA
-Valve CC has flow rate=2; tunnels lead to valves DD, BB
-Valve DD has flow rate=20; tunnels lead to valves CC, AA, EE
-Valve EE has flow rate=3; tunnels lead to valves FF, DD
-Valve FF has flow rate=0; tunnels lead to valves EE, GG
-Valve GG has flow rate=0; tunnels lead to valves FF, HH
-Valve HH has flow rate=22; tunnel leads to valve GG
-Valve II has flow rate=0; tunnels lead to valves AA, JJ
-Valve JJ has flow rate=21; tunnel leads to valve II