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