day 12

aoc2022.cabal

@@ -282,9 +282,38 @@ test-suite day10aoctest
   main-is:             AoCTest.hs
   other-modules:       
       Day10Lib
+  build-depends:       base
+                     , HUnit
+                     , split
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010
+
+-- Day 11
+
+test-suite day11aoctest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day11/test, src/day11
+  main-is:             AoCTest.hs
+  other-modules:       
+      Day11Lib
   build-depends:       base
                      , HUnit
                      , parsec
                      , split
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   default-language:    Haskell2010
+
+-- Day 12
+
+test-suite day12aoctest
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      src/day12/test, src/day12
+  main-is:             AoCTest.hs
+  other-modules:       
+      Day12Lib
+  build-depends:       base
+                     , HUnit
+                     , pqueue
+                     , array
+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
+  default-language:    Haskell2010

data/input120.txt

@@ -0,0 +1,5 @@
+Sabqponm
+abcryxxl
+accszExk
+acctuvwj
+abdefghi

data/input121.txt

@@ -0,0 +1,41 @@
+abcccccccccaaaaaaaaaaccccccccccccaaaaaaaaccaaccccccccccccccccccccccccccccccccccccccccccccaaaaaa
+abccccccccccaaaaaaaaaccccccccccccaaaaaaaaaaaacccccccccccaacccacccccccccccccccccccccccccccaaaaaa
+abcccccccccccaaaaaaacccccccccccccaaaaaaaaaaaaaacccccccccaaacaacccccccccaaaccccccccccccccccaaaaa
+abccccccccccaaaaaaccccccccccccccaaaaaaaaaaaaaaaccccccccccaaaaaccccccccccaaacccccccccccccccccaaa
+abccccccccccaaaaaaaccccccccccccaaaaaaaaaaaaaacccccccccccaaaaaacccccccccaaaacccccccccccccccccaac
+abaaccaaccccaaccaaaccccccccaaaaaaaaaaaaaaacaaccccccccccaaaaaaaacccccccccaaalcccccccccccccccaaac
+abaaaaaacccccccccaaccccccccaaaaaacccaaaacccaaccccccccccaaaaaaaaccccccccalllllllcccccccccccccccc
+abaaaaaacccccccaaacccccccccaaaaccccccaaaccccaaaaacccccccccaacccccccaaaakllllllllcccccccaacccccc
+abaaaaaacccccccaaaacccccccccaacccccccaaaccccaaaaacccccccccaacccccccaakkklllpllllccccacaaacccccc
+abaaaaaaaccccccaaaaccccaaccccccccccccccccccaaaaaaccccccccccccccccccckkkkpppppplllcccaaaaaaacccc
+abaaaaaaacaaaccaaaaccaaaaaaccccccccccccccccaaaaaacccccccaaaccccckkkkkkkpppppppplllcddaaaaaacccc
+abcaaaacccaacccccccccaaaaaacccccaaaccccccccaaaaaacccccccaaaaccjkkkkkkkpppppuppplmmdddddaaaccccc
+abccaaaaaaaaaccccccccaaaaaaccccaaaaaacccccccaaacccccccccaaaajjjkkkkkrpppuuuuupppmmmdddddacccccc
+abccccaaaaaaaacccccccaaaaacccccaaaaaacccccccccccccccccccaaacjjjjrrrrrrppuuuuupqqmmmmmddddaccccc
+abccccaaaaaaaaacccccccaaaacccccaaaaaaccccccccccccccccccccccjjjrrrrrrrrpuuuxuvvqqqmmmmmddddccccc
+abccccaaaaaaaaacccccccccccccccccaaaaaccccaacccaccccccccaaccjjjrrrruuuuuuuxxyvvqqqqqmmmmmdddcccc
+abccccaaaaaaaacccccccccaaaccccccaacaaccccaaacaacccaaacaaaccjjjrrrtuuuuuuuxxyvvvqqqqqmmmmdddcccc
+abccaaaaaaaacccccccccccaaaaaccccccccccccccaaaaacccaaaaaaaccjjjrrttttxxxxxxyyvvvvvqqqqmmmmdeeccc
+abccaaaccaaaccccccccaacaaaaacccccccccccccaaaaaacccaaaaaacccjjjrrtttxxxxxxxyyvvvvvvvqqqmmmeeeccc
+abaaaaaaaaaacccaaaccaaaaaaaaaaaccaaaccccaaaaaaaacccaaaaaaaajjjqqrttxxxxxxxyyyyyyvvvqqqnnneeeccc
+SbaaaaaaaaccccaaaaccaaaaaaaaaaaaaaaaacccaaaaaaaaccaaaaaaaaacjjjqqtttxxxxEzzyyyyvvvvqqqnnneeeccc
+abcaaaaaacccccaaaaccccaaaaaaaccaaaaaaccccccaaccccaaaaaaaaaaciiiqqqtttxxxyyyyyyvvvvrrrnnneeecccc
+abcaaaaaacccccaaaacccaaaaaaaaccaaaaaaccccccaaccccaaacaaacccciiiqqqqttxxyyyyyywvvvrrrnnneeeecccc
+abcaaaaaaccccccccccccaaaaaaaaacaaaaacccccccccccccccccaaaccccciiiqqtttxxyyyyyywwrrrrnnnneeeccccc
+abcaaacaacccccaacccccaaaaaaaaacaaaaacccccccccccccccccaaaccccciiiqqttxxxywwyyywwrrrnnnneeecccccc
+abccccccccaaacaaccccccccccacccccccccccccccccccccccccccccccccciiqqqttxxwwwwwwywwrrrnnneeeccccccc
+abccaacccccaaaaaccccccccccccccccccccccccccccccccccccccccaacaaiiqqqttwwwwsswwwwwrrrnnfffeccccccc
+abaaaaccccccaaaaaacccccccccccccccccccccccccccccaaaccccccaaaaaiiqqqttssssssswwwwrrronfffaccccccc
+abaaaaaacccaaaaaaacccccccccccccccccccccccccccaaaaaacccccaaaaaiiqqqssssssssssswrrrooofffaaaacccc
+abaaaaaaccaaaaaacccccccccccccccccccccccccccccaaaaaacccccaaaaaiiqqqppssspppssssrrrooofffaaaacccc
+abaaaaaaccaacaaacccccccccccccccccccccccccccccaaaaaacccccaaaaaiihpppppppppppossrrooofffaaaaacccc
+abaaaaccccccccaacccccccccccccccccccccccccccccaaaaaccccccccaaahhhhppppppppppoooooooofffaaaaccccc
+abaaaaccccccccccaacccccccccccccccccaaacccccccaaaaacccccccccccchhhhhhhhhhggpoooooooffffaaaaccccc
+abccaacccccccacaaaccccccccccccccccaaaaacccccccccccccccccccccccchhhhhhhhhggggoooooffffaacaaacccc
+abccccccccccaaaaacaaccccccccccccccaaaaaccccccccccccccccccccccccchhhhhhhhggggggggggffcaacccccccc
+abccccccccccaaaaaaaaccccccccccccccaaaacccaacccccccccccaccccccccccccccaaaaaggggggggfcccccccccccc
+abccccccccccccaaaaaccccaacccccccccaaaacaaaaccccccccaaaaccccccccccccccaaaacaaagggggcccccccccaccc
+abcccccccccccaaaaacccccaacccccccccaaaaaaaaaccccccccaaaaaaccccccccccccaaaccaaaacccccccccccccaaac
+abcccccccccccaacaaccaaaaaaaacccaaaaaaaaaaaccccccccccaaaaccccccccccccccaccccaaacccccccccccccaaaa
+abccccccccccccccaaccaaaaaaaaccaaaaaaaaaaaccccccccccaaaaacccccccccccccccccccccacccccccccccccaaaa
+abccccccccccccccccccccaaaaacccaaaaaaaaaaaacccccccccaacaacccccccccccccccccccccccccccccccccaaaaaa

src/day12/Day12Lib.hs

@@ -0,0 +1,77 @@
+module Day12Lib
+  ( --
+    processInput1,
+    processInput2,
+  )
+where
+
+import Data.Array
+import Data.Char
+import Data.PQueue.Prio.Min
+    ( MinPQueue, fromList, singleton, union, deleteFindMin )
+import Debug.Trace
+
+bfs :: Array (Int, Int) Int -> Array (Int, Int) Bool -> MinPQueue Int [(Int, Int)] -> (Int -> Int -> Bool) -> ((Int, Int) -> Bool) -> Int
+bfs mp visited queue isValidNeighbor isEnd =
+  let ((_, p@(x, y) : path), queueTail) = deleteFindMin queue
+      neigh = generateNeighbors mp visited p (isValidNeighbor (mp ! p))
+   in if or [isEnd n | n <- neigh]
+        then length path + 1
+        else
+          bfs
+            mp
+            (visited // [(n, True) | n <- neigh])
+            (queueTail `union` fromList [(length path + 2, x : p : path) | x <- neigh])
+            isValidNeighbor
+            isEnd
+
+inBounds :: (Ord a1, Ord a2) => (a1, a2) -> ((a1, a2), (a1, a2)) -> Bool
+inBounds (x, y) ((xmin, ymin), (xmax, ymax)) = x >= xmin && x <= xmax && y >= ymin && y <= ymax
+
+neighborCoordinates :: (Num a1, Num a2) => (a1, a2) -> [(a1, a2)]
+neighborCoordinates (x, y) = [(x - 1, y), (x + 1, y), (x, y - 1), (x, y + 1)]
+
+generateNeighbors :: Array (Int, Int) Int -> Array (Int, Int) Bool -> (Int, Int) -> (Int -> Bool) -> [(Int, Int)]
+generateNeighbors mp visited p@(x, y) isValidNeighbor =
+  [ n | n <- neighborCoordinates p, n `inBounds` bounds mp
+                                      && not (visited ! n)
+                                      && isValidNeighbor (mp ! n)
+  ]
+
+elevation :: Char -> Int
+elevation 'S' = 0
+elevation 'E' = ord 'z' - ord 'a'
+elevation c = ord c - ord 'a'
+
+-- ####################
+
+processInput1 :: String -> Int
+processInput1 input =
+  let l = lines input
+      h = length l
+      w = length (head l)
+      mp = listArray ((0, 0), (h - 1, w - 1)) (concat l)
+      p = head [i | (i, e) <- assocs mp, e == 'S']
+      e = head [i | (i, e) <- assocs mp, e == 'E']
+      ele = array (bounds mp) [(i, elevation e) | (i, e) <- assocs mp]
+   in bfs
+        ele
+        (listArray ((0, 0), (h - 1, w - 1)) [(i, j) == p | i <- [0 .. h - 1], j <- [0 .. w - 1]])
+        (singleton 1 [p])
+        (\x y -> y - x <= 1)
+        (== e)
+
+processInput2 :: String -> Int
+processInput2 input =
+  let l = lines input
+      h = length l
+      w = length (head l)
+      mp = listArray ((0, 0), (h - 1, w - 1)) (concat l)
+      e = head [i | (i, e) <- assocs mp, e == 'E']
+      ele = array (bounds mp) [(i, elevation e) | (i, e) <- assocs mp]
+   in bfs
+        ele
+        (listArray ((0, 0), (h - 1, w - 1)) [(i, j) == e | i <- [0 .. h - 1], j <- [0 .. w - 1]])
+        (singleton 1 [e])
+        (\x y -> x - y <= 1)
+        (\p -> ele ! p == 0)

src/day12/test/AoCTest.hs

@@ -0,0 +1,41 @@
+import Day12Lib (processInput1, processInput2)
+import System.IO
+import Test.HUnit
+
+testCases1 =
+  [ ("data/input120.txt", 31),
+    ("data/input121.txt", 420)
+  ]
+
+testCase1 (file, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual "input test" result $ processInput1 contents
+    )
+
+testCases2 =
+  [ ("data/input120.txt", 29),
+    ("data/input121.txt", 414)
+  ]
+
+testCase2 (file, result) = do
+  withFile
+    file
+    ReadMode
+    ( \handle -> do
+        contents <- hGetContents handle
+        assertEqual ("input test: " ++ file) result $ processInput2 contents
+    )
+
+tests =
+  TestList $
+    [TestCase (testCase1 c) | c <- testCases1]
+      ++ [TestCase (testCase2 c) | c <- testCases2]
+
+main :: IO ()
+main = do
+  runTestTT tests
+  return ()