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