advent11/src/advent11naive.hs

   1 -- import Debug.Trace
   2
   3 import Prelude hiding (Left, Right)
   4
   5 import qualified Data.Map as M
   6 import Data.Map ((!))
   7 import qualified Data.Set as S
   8 -- import Data.Sort
   9 import Data.List
  10
  11 type Position = (Int, Int)
  12 data Seat = Floor | Empty | Occupied deriving (Eq, Ord)
  13 data Direction = Up | UpRight | Right | DownRight | Down | DownLeft | Left | UpLeft
  14   deriving (Eq, Ord, Show, Enum)
  15 type Seats = M.Map Position Seat
  16
  17 instance Show Seat where
  18   show Floor = "."
  19   show Empty = "L"
  20   show Occupied = "#"
  21
  22
  23 main :: IO ()
  24 main =
  25   do  text <- readFile "data/advent11.txt"
  26       let (seats, maxCorner) = readGrid text
  27       print $ M.size seats
  28       print maxCorner
  29       print $ part1 seats
  30       print $ part2 seats
  31       -- print $ part2 trees maxCorner
  32
  33
  34 part1 seats = M.size $ M.filter (== Occupied) $ runUntilSame ruleA seats
  35 part2 seats = M.size $ M.filter (== Occupied) $ runUntilSame ruleB seats
  36
  37 step rule seats = M.mapWithKey (rule seats) seats
  38
  39 runSteps rule seats = iterate (step rule) seats
  40
  41 seatDifferences rule seats = zip (runSteps rule seats) (tail $ runSteps rule seats)
  42
  43 runUntilSame rule seats = fst $ head $ dropWhile (uncurry (/=)) $ seatDifferences rule seats
  44
  45
  46 ruleA seats here thisSeat
  47   | thisSeat == Empty && nOccs == 0 = Occupied
  48   | thisSeat == Occupied && nOccs >= 4 = Empty
  49   | otherwise = thisSeat
  50   where nOccs = M.size $ occupiedNeighbours seats here
  51
  52 ruleB seats here thisSeat
  53   | thisSeat == Empty && nOccs == 0 = Occupied
  54   | thisSeat == Occupied && nOccs >= 5 = Empty
  55   | otherwise = thisSeat
  56   where nOccs = M.size $ occupiedInSight seats here
  57
  58
  59 neighbours (r, c) = S.delete (r, c) $ S.fromList [(r + dr, c + dc) | dr <- [-1, 0, 1], dc <- [-1, 0, 1]]
  60
  61 neighbourhood seats here = M.restrictKeys seats (neighbours here)
  62 occupiedNeighbours seats here = M.filter (== Occupied) $ neighbourhood seats here
  63
  64
  65 onSightLine :: Position -> Direction -> Position -> Bool
  66 onSightLine (r0, c0) Down      (r, c) = (c0 == c) && (r > r0)
  67 onSightLine (r0, c0) Up        (r, c) = (c0 == c) && (r < r0)
  68 onSightLine (r0, c0) Right     (r, c) = (r0 == r) && (c > c0)
  69 onSightLine (r0, c0) Left      (r, c) = (r0 == r) && (c < c0)
  70 onSightLine (r0, c0) DownRight (r, c) = ((r - r0) > 0) && ((r - r0) == (c - c0))
  71 onSightLine (r0, c0) UpLeft    (r, c) = ((r - r0) < 0) && ((r - r0) == (c - c0))
  72 onSightLine (r0, c0) DownLeft  (r, c) = ((r - r0) > 0) && ((r - r0) == (c0 - c))
  73 onSightLine (r0, c0) UpRight   (r, c) = ((r - r0) < 0) && ((r - r0) == (c0 - c))
  74
  75 manhattan (r1, c1) (r2, c2) = abs (r1 - r2) + abs (c1 - c2)
  76
  77 closestInDirection seats here direction = take 1 sortedSeats
  78   -- where seatsInDirection = M.keys $ M.filterWithKey (\o _ -> onSightLine here direction o) seats
  79   where seatsInDirection = filter (onSightLine here direction) $ M.keys seats
  80         sortedSeats = sortOn (manhattan here) seatsInDirection
  81
  82 closestInSight :: Seats -> Position -> (S.Set Position)
  83 closestInSight seats here = S.fromList $ concatMap (closestInDirection seats here) [d | d <- [Up .. UpLeft]]
  84
  85 occupiedInSight :: Seats -> Position -> Seats
  86 occupiedInSight seats here = M.filter (== Occupied) $ M.restrictKeys seats $ closestInSight seats here
  87
  88
  89 readGrid :: String -> (Seats, Position)
  90 readGrid input = (seats, (maxR, maxC))
  91   where seats = M.fromList $ concat
  92                   [ [((r, c), Empty) | (t, c) <- zip row [0..], t == 'L']
  93                   | (row, r) <- zip rows [0..] ]
  94         rows = lines input
  95         maxC = (length $ head rows) - 1
  96         maxR = (length rows) - 1
  97
  98 showGrid seats (maxR, maxC) =
  99   unlines $ [ concat [showSeat (r, c) | c <- [0..maxC] ] | r <- [0..maxR]]
 100   where showSeat here = show $ M.findWithDefault Floor here seats
 101