better 09

code/aoc2021-programs.cabal

@@ -71,5 +71,5 @@ executable aoc2021-09
    main-is: Main.hs
    ghc-options: -O2 -Wall
    hs-source-dirs: src/09
-   build-depends: base
+   build-depends: base, containers
    default-language: Haskell2010

code/src/09/09-input.txt

@@ -5,7 +5,7 @@
 5301988631079966546689877892397898799899876567677678989876545689989897234999943239898985432987654265
 6212987432367897656899756789456789989943987878998789878987659792196976546899865498767994321398754376
 5429876543456789897998767896569898978932198989949896569999798943235989756798976987656789520999866789
-653498965467889899923987898769898756789323999682398769889987894476799868987897896547897639898997894
+6534989654678898999239878987698987567893239996823987698898987894476799868987897896547897639898997894
 7676798798799967894345989399897696457894547895612998987657896789987897979986789987535679798767989923
 8787899999895459965456895499987545348987656954109899996532345996598965499765678996547899987955679434
 9898998798986578977567896989876432167899767963298789987831234897679879987654567987698929896434598945
@@ -97,4 +97,4 @@
 3236989876676789543997634678943459869877997689367899854323459854346965939876784569789867997998767567
 2135678987798994312498545689642399759866859789245699978754667965457899845989765679679878956999543458
 3446889398919865324987656796530987649754349890134589989765778976579998756799897789545989349898742455
-45879932091019654356987878954212984321012459323756789998768999876789998678999989964321912987654312348
+4587993209101965435698787895421298432101245932375678999876899987678999867899998996432191298765431234

code/src/09/Main.hs

@@ -1,53 +1,65 @@
 module Main where
 
--- this runs really badly
--- mostly because i was too lazy to use a map
-
 import Data.List
+import Debug.Trace
+import qualified Data.Map as M
 
-main :: IO ()
-main = do
-  raw <- getContents
-  let input = map (map (read . (:[]))) $ lines raw
-    in do
-      putStrLn $ "day8a: " ++ (show $ solveA input)
-      putStrLn $ "day8b: " ++ (show $ solveB input)
-
-solveA :: [[Int]] -> Int
-solveA db' = sum $ map ((+ 1) . snd) $ filter (isLow db) db
+mkAdjList :: Int -> Int -> AdjList
+mkAdjList w h = M.fromList $
+  map (\p -> (,) p (mkDeltas w h p)) $
+  [ (x,y) | x <- xr, y <- yr ]
   where
-    db = toMap db'
+    xr = [0..(w-1)]
+    yr = [0..(h-1)]
 
-solveB :: [[Int]] -> Int
-solveB db' = product $ take 3 $ reverse $ sort
-  $ map (length . (findBasin (filter (\((_,_),v) -> v /= 9) db))) lps
-  where
-    lps = filter (isLow db) db
-    db = toMap db'
-
-findBasin :: [((Int,Int),Int)] -> ((Int,Int),Int) -> [((Int,Int),Int)]
-findBasin db p = nub $ p : concat (map (findBasin db) $ filter isNb db)
-  where
-    isNb (c,v) = c `elem` (deltas (fst p)) && v > (snd p)
-
-toMap :: [[Int]] -> [((Int,Int),Int)]
-toMap [] = []
-toMap rows = concat $ map f $ zip [0..] rows
+mkValList :: [[Int]] -> ValList
+mkValList [] = M.empty
+mkValList rows = M.fromList $ concat $ map f $ zip [0..] rows
   where
     f (i,v) = map (g i) $ zip [0..] v
-    g i (j,v) = ((i,j), v)
+    g i (j,v) = ((j,i), v)
 
-deltas :: (Int,Int) -> [(Int,Int)]
-deltas (x,y) =
+mkDeltas :: Int -> Int -> (Int,Int) -> [(Int,Int)]
+mkDeltas w h (x,y) = filter
+  (\(i,j) -> (i >= 0 && i < w && j >= 0 && j < h))
   [ ((x-1),y)
   , ((x+1),y)
   , (x,(y-1))
   , (x,(y+1))
   ]
 
-isLow :: [((Int,Int),Int)] -> ((Int,Int),Int) -> Bool
-isLow db ((x,y),v) = all (> v) nbs
-  where
-    mbs = map (\p -> lookup p db) (deltas (x,y))
-    nbs = [ x | Just x <- mbs ]
+main :: IO ()
+main = do
+  raw <- getContents
+  let input = map (map (read . (:[]))) $ lines raw
+      al = mkAdjList (length (head input)) (length input)
+      vl = mkValList input
+    in do
+      putStrLn $ "day9a: " ++ (show $ solveA al vl)
+      putStrLn $ "day9b: " ++ (show $ solveB al vl)
 
+type AdjList = M.Map (Int,Int) [(Int,Int)]
+type ValList = M.Map (Int,Int) Int
+
+solveA :: AdjList -> ValList -> Int
+solveA al vl = sum $ map (1 +) $ (findVals vl) (findMinima al vl)
+
+solveB :: AdjList -> ValList -> Int
+solveB al vl = product $ take 3 $ (reverse . sort) $ map (length . nub) $
+  map (findConnected al vl) $ (findMinima al vl)
+
+findConnected :: AdjList -> ValList -> (Int,Int) -> [(Int,Int)]
+findConnected al vl p = (:) p $ concat (map (findConnected al vl) $ (filter f (al M.! p)))
+  where
+    f q = (vl M.! p) < (vl M.! q) && (vl M.! q) /= 9
+
+mlookup :: Ord k => M.Map k a -> k -> Maybe a
+mlookup = flip M.lookup
+
+findMinima :: AdjList -> ValList -> [(Int,Int)]
+findMinima al vl = filter f $ M.keys vl
+  where
+    f p = all (> (vl M.! p)) $ map (vl M.!) $ al M.! p
+
+findVals :: ValList -> [(Int,Int)] -> [Int]
+findVals vl cs = [ x | Just x <- map (mlookup vl) cs ]

code/src/09/Main2.hs

@@ -0,0 +1,65 @@
+module Main where
+
+import Data.List
+import Debug.Trace
+import qualified Data.Map as M
+
+mkAdjList :: Int -> Int -> AdjList
+mkAdjList w h = M.fromList $
+  map (\p -> (,) p (mkDeltas w h p)) $
+  [ (x,y) | x <- xr, y <- yr ]
+  where
+    xr = [0..(w-1)]
+    yr = [0..(h-1)]
+
+mkValList :: [[Int]] -> ValList
+mkValList [] = M.empty
+mkValList rows = M.fromList $ concat $ map f $ zip [0..] rows
+  where
+    f (i,v) = map (g i) $ zip [0..] v
+    g i (j,v) = ((j,i), v)
+
+mkDeltas :: Int -> Int -> (Int,Int) -> [(Int,Int)]
+mkDeltas w h (x,y) = filter
+  (\(i,j) -> (i >= 0 && i < w && j >= 0 && j < h))
+  [ ((x-1),y)
+  , ((x+1),y)
+  , (x,(y-1))
+  , (x,(y+1))
+  ]
+
+main :: IO ()
+main = do
+  raw <- getContents
+  let input = map (map (read . (:[]))) $ lines raw
+      al = mkAdjList (length (head input)) (length input)
+      vl = mkValList input
+    in do
+      putStrLn $ "day8a: " ++ (show $ solveA al vl)
+      putStrLn $ "day8b: " ++ (show $ solveB al vl)
+
+type AdjList = M.Map (Int,Int) [(Int,Int)]
+type ValList = M.Map (Int,Int) Int
+
+solveA :: AdjList -> ValList -> Int
+solveA al vl = sum $ map (1 +) $ (findVals vl) (findMinima al vl)
+
+solveB :: AdjList -> ValList -> Int
+solveB al vl = product $ take 3 $ (reverse . sort) $ map (length . nub) $
+  map (findConnected al vl) $ (findMinima al vl)
+
+findConnected :: AdjList -> ValList -> (Int,Int) -> [(Int,Int)]
+findConnected al vl p = (:) p $ concat (map (findConnected al vl) $ (filter f (al M.! p)))
+  where
+    f q = (vl M.! p) < (vl M.! q) && (vl M.! q) /= 9
+
+mlookup :: Ord k => M.Map k a -> k -> Maybe a
+mlookup = flip M.lookup
+
+findMinima :: AdjList -> ValList -> [(Int,Int)]
+findMinima al vl = filter f $ M.keys vl
+  where
+    f p = all (> (vl M.! p)) $ map (vl M.!) $ al M.! p
+
+findVals :: ValList -> [(Int,Int)] -> [Int]
+findVals vl cs = [ x | Just x <- map (mlookup vl) cs ]

code/src/09/test.txt

@@ -1,5 +0,0 @@
-2199943210
-3987894921
-9856789892
-8767896789
-9899965678