65 lines
2.7 KiB
Haskell
65 lines
2.7 KiB
Haskell
module Day15 where
|
|
import Data.Array
|
|
import Data.Char (digitToInt)
|
|
import Debug.Trace (trace, traceShow)
|
|
import Data.Maybe (fromJust, mapMaybe)
|
|
import Data.List (nub, sort)
|
|
|
|
type Cavern = [[Int]]
|
|
|
|
neighs :: Int -> Int -> Int -> Int -> [(Int,Int)]
|
|
neighs max_x max_y x y = filter (\(x,y) -> x >= 0 && x <= max_x && y >= 0 && y <= max_y) [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
|
|
|
|
mapInd :: (Int -> a -> b) -> [a] -> [b]
|
|
mapInd f = zipWith f [0..]
|
|
|
|
minMaybe :: [Maybe Int] -> Maybe Int
|
|
minMaybe = foldr go Nothing where
|
|
go Nothing state = state
|
|
go (Just x) Nothing = Just x
|
|
go (Just x) (Just y) = Just (min x y)
|
|
|
|
searchStep :: Array (Int,Int) Int -> Array (Int,Int) (Maybe Int) -> [(Int,Int)] -> (Array (Int,Int) (Maybe Int), [(Int,Int)])
|
|
searchStep costs so_far active = (so_far // updates, map fst updates) where
|
|
updates = mapMaybe (\(x,y) -> let cur = so_far ! (x,y); new = minMaybe (cur:neigh_costs x y); in if cur /= new then Just ((x,y), new) else Nothing) new_active
|
|
new_active = nub $ sort $ concatMap (uncurry n) active
|
|
n = uncurry neighs (snd $ bounds costs)
|
|
neigh_costs x y = map (\(x',y') -> fmap (+ (costs ! (x,y))) (so_far !(x',y')) ) (n x y)
|
|
|
|
search :: [[Int]] -> Int
|
|
search cavern = fromJust $ final_iter ! snd (bounds final_iter) where
|
|
iters = iterate (\(i,(s,a)) -> trace ("step " ++ show i ++ show (s ! snd (bounds s))) (i+1, searchStep cavern_array s a)) (0,(init_array, [(0,0)]))
|
|
final_iter = fst $ snd $ iters !! (10 + length cavern + length (head cavern))
|
|
-- search' :: [[Int]] -> [[Maybe Int]] -> Int
|
|
-- search' cavern step = iterate (searchStep cavern) init
|
|
-- search' cavern step = case last $ last s of
|
|
-- Nothing -> trace "Nothing yet.." $ search' cavern s
|
|
-- Just x -> if Just x <= last (last $ searchStep cavern s) then x else trace ("test; " ++ show x ++ " > " ++ show (last(last $ searchStep cavern s))) $ search' cavern s
|
|
-- where s = searchStep cavern step
|
|
toArray = Data.Array.listArray ((0,0), (length cavern - 1, length (head cavern) - 1))
|
|
cavern_array = toArray $ concat cavern
|
|
firstLine = Just 0: replicate (length cavern - 1) Nothing
|
|
init = firstLine : map (map (const Nothing)) (tail cavern)
|
|
init_array = toArray $ concat init
|
|
|
|
fullMap :: [[Int]] -> [[Int]]
|
|
fullMap cavern = full where
|
|
increment 9 = 1
|
|
increment x = x + 1
|
|
first_row = map (concat . take 5 . iterate (map increment)) cavern
|
|
full = concat $ take 5 $ iterate (map (map increment)) first_row
|
|
|
|
|
|
|
|
main :: IO ()
|
|
main = do
|
|
cavern <- map (map digitToInt) . lines <$> getContents
|
|
putStr "part 1: "
|
|
print $ search cavern
|
|
|
|
putStr "part 2: "
|
|
-- print cavern
|
|
-- mapM_ print $ fullMap cavern
|
|
print $ search $ fullMap cavern
|
|
|
|
print "bye" |