advent13.hs

   1 import Data.List ((\\), nub, sortOn)
   2 import Numeric (showIntAtBase)
   3 import Data.Char (intToDigit)
   4 import Data.Bits (popCount)
   5
   6 import qualified Data.Map.Lazy as Map -- day 4, 5
   7
   8 type Pos = (Int, Int)
   9
  10 seed = 1362
  11
  12 goal1 = (31, 39)
  13
  14 main :: IO ()
  15 main = do
  16     part1
  17     part2
  18
  19
  20 part1 :: IO ()
  21 part1 = print $ length $ tail $ extractJust $ aStar [[(1, 1)]] []
  22
  23 part2 :: IO ()
  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)]] []
  27
  28
  29 extractJust :: Maybe [a] -> [a]
  30 extractJust Nothing = []
  31 extractJust (Just x) = x
  32
  33 isWall :: Int -> Int -> Bool
  34 isWall x y = (popCount n) `mod` 2 == 1
  35     where
  36         n = x*x + 3*x + 2*x*y + y + y*y + seed
  37
  38
  39 showRoom w h = 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) then '#' else '.'
  44
  45 showRoomR w h reached = unlines rows
  46     where
  47         rows = [row x | x <- [0..h]]
  48         row x = [showCell x y | y <- [0..w]]
  49         showCell x y = if (isWall x y)
  50             then '#'
  51             else if (x, y) `elem` reached
  52                 then 'O'
  53                 else '.'
  54
  55
  56 aStar :: [[Pos]] -> [Pos] -> Maybe [Pos]
  57 aStar [] _ = Nothing
  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)
  62     where newAgenda =
  63             sortOn (\a -> trailCost a) $
  64             trails ++ (candidates currentTrail closed)
  65           trailCost t = estimateCost (head t) + length t - 1
  66
  67
  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)
  76
  77 candidates :: [Pos] -> [Pos] -> [[Pos]]
  78 candidates currentTrail closed = newCandidates
  79     where
  80         (candidate:trail) = currentTrail
  81         succs = legalSuccessors $ successors candidate
  82         nonloops = (succs \\ trail) \\ closed
  83         newCandidates = map (\n -> n:candidate:trail) nonloops
  84
  85 isGoal :: Pos -> Bool
  86 isGoal p = p == goal1
  87
  88 isLegal :: Pos -> Bool
  89 isLegal (x, y) =
  90     x >= 0 && y >= 0 && (not $ isWall x y)
  91
  92 successors :: Pos -> [Pos]
  93 successors (x, y) = [(x-1, y), (x+1, y), (x, y-1), (x, y+1)]
  94
  95 legalSuccessors :: [Pos] -> [Pos]
  96 legalSuccessors = filter (isLegal)
  97
  98 estimateCost :: Pos -> Int
  99 estimateCost (x, y) = abs (x - gx) + abs (y - gy)
 100     where (gx, gy) = goal1
 101