Starting branch for A-star search in day 11
[advent-of-code-16.git] / advent13.hs
1 import Data.List ((\\), nub, sortOn)
2 import Data.Bits (popCount)
3 import Data.Maybe (fromMaybe)
4
5 type Pos = (Int, Int)
6
7 seed = 1362
8
9 goal1 = (31, 39)
10
11 main :: IO ()
12 main = do
13 part1
14 part2
15
16
17 part1 :: IO ()
18 part1 = print $ length $ tail $ fromMaybe [] $ aStar [[(1, 1)]] []
19
20 part2 :: IO ()
21 part2 = do print $ length $ tail $ edl 50 [[(1, 1)]] []
22 putStrLn $ showRoomR 30 25 $ edl 50 [[(1, 1)]] []
23
24
25 -- extractJust :: Maybe [a] -> [a]
26 -- extractJust Nothing = []
27 -- extractJust (Just x) = x
28
29 isWall :: Int -> Int -> Bool
30 isWall x y = odd $ popCount n
31 where
32 n = x*x + 3*x + 2*x*y + y + y*y + seed
33
34
35 showRoom w h = showRoomR w h []
36
37 showRoomR w h reached = unlines rows
38 where
39 rows = [row x | x <- [0..h]]
40 row x = [showCell x y | y <- [0..w]]
41 showCell x y = if (isWall x y)
42 then '#'
43 else if (x, y) `elem` reached
44 then 'O'
45 else '.'
46
47
48 aStar :: [[Pos]] -> [Pos] -> Maybe [Pos]
49 aStar [] _ = Nothing
50 aStar (currentTrail:trails) closed =
51 if isGoal (head currentTrail) then Just currentTrail
52 else if (head currentTrail) `elem` closed then aStar trails closed
53 else aStar newAgenda ((head currentTrail): closed)
54 where newAgenda =
55 sortOn (\a -> trailCost a) $
56 trails ++ (candidates currentTrail closed)
57 trailCost t = estimateCost (head t) + length t - 1
58
59
60 -- exhaustive depth-limited
61 edl :: Int -> [[Pos]] -> [Pos] -> [Pos]
62 edl _ [] closed = nub closed
63 edl limit (currentTrail:trails) closed =
64 if (length currentTrail) > (limit+1) then edl limit trails ((head currentTrail):closed)
65 else if (head currentTrail) `elem` closed then edl limit trails closed
66 else edl limit newAgenda ((head currentTrail):closed)
67 where newAgenda = trails ++ (candidates currentTrail closed)
68
69 candidates :: [Pos] -> [Pos] -> [[Pos]]
70 candidates currentTrail closed = newCandidates
71 where
72 (candidate:trail) = currentTrail
73 succs = legalSuccessors $ successors candidate
74 nonloops = (succs \\ trail) \\ closed
75 newCandidates = map (\n -> n:candidate:trail) nonloops
76
77 isGoal :: Pos -> Bool
78 isGoal p = p == goal1
79
80 isLegal :: Pos -> Bool
81 isLegal (x, y) =
82 x >= 0 && y >= 0 && (not $ isWall x y)
83
84 successors :: Pos -> [Pos]
85 successors (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
86
87 legalSuccessors :: [Pos] -> [Pos]
88 legalSuccessors = filter (isLegal)
89
90 estimateCost :: Pos -> Int
91 estimateCost (x, y) = abs (x - gx) + abs (y - gy)
92 where (gx, gy) = goal1
93