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