trunk
HeNine 2 years ago
parent b7367da63b
commit 1bb65f20b4

@ -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

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

@ -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

@ -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)

@ -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 ()
Loading…
Cancel
Save