1 import Data.List ((\\), nub, sortOn)
2 import Numeric (showIntAtBase)
3 import Data.Char (intToDigit)
4 import Data.Bits (popCount)
6 import qualified Data.Map.Lazy as Map -- day 4, 5
21 part1 = print $ length $ tail $ extractJust $ aStar [[(1, 1)]] []
24 part2 = do print $ length $ tail $ edl 50 [[(1, 1)]] []
25 putStrLn $ showRoomR 30 25 $ edl 50 [[(1, 1)]] []
26 -- part2 = print $ length $ tail $ edl 50 [[(1, 1)]] []
29 extractJust :: Maybe [a] -> [a]
30 extractJust Nothing = []
31 extractJust (Just x) = x
33 isWall :: Int -> Int -> Bool
34 isWall x y = (popCount n) `mod` 2 == 1
36 n = x*x + 3*x + 2*x*y + y + y*y + seed
39 showRoom w h = unlines rows
41 rows = [row x | x <- [0..h]]
42 row x = [showCell x y | y <- [0..w]]
43 showCell x y = if (isWall x y) then '#' else '.'
45 showRoomR w h reached = unlines rows
47 rows = [row x | x <- [0..h]]
48 row x = [showCell x y | y <- [0..w]]
49 showCell x y = if (isWall x y)
51 else if (x, y) `elem` reached
56 aStar :: [[Pos]] -> [Pos] -> Maybe [Pos]
58 aStar (currentTrail:trails) closed =
59 if isGoal (head currentTrail) then Just currentTrail
60 else if (head currentTrail) `elem` closed then aStar trails closed
61 else aStar newAgenda ((head currentTrail): closed)
63 sortOn (\a -> trailCost a) $
64 trails ++ (candidates currentTrail closed)
65 trailCost t = estimateCost (head t) + length t - 1
68 -- exhaustive depth-limited
69 edl :: Int -> [[Pos]] -> [Pos] -> [Pos]
70 edl _ [] closed = nub closed
71 edl limit (currentTrail:trails) closed =
72 if (length currentTrail) > (limit+1) then edl limit trails ((head currentTrail):closed)
73 else if (head currentTrail) `elem` closed then edl limit trails closed
74 else edl limit newAgenda ((head currentTrail):closed)
75 where newAgenda = trails ++ (candidates currentTrail closed)
77 candidates :: [Pos] -> [Pos] -> [[Pos]]
78 candidates currentTrail closed = newCandidates
80 (candidate:trail) = currentTrail
81 succs = legalSuccessors $ successors candidate
82 nonloops = (succs \\ trail) \\ closed
83 newCandidates = map (\n -> n:candidate:trail) nonloops
88 isLegal :: Pos -> Bool
90 x >= 0 && y >= 0 && (not $ isWall x y)
92 successors :: Pos -> [Pos]
93 successors (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
95 legalSuccessors :: [Pos] -> [Pos]
96 legalSuccessors = filter (isLegal)
98 estimateCost :: Pos -> Int
99 estimateCost (x, y) = abs (x - gx) + abs (y - gy)
100 where (gx, gy) = goal1