advent10/src/advent10.hs

   1 import Data.Ratio
   2 import qualified Data.Set as S
   3 import qualified Data.Map.Strict as M
   4 import Linear (V2(..), (^+^), (*^))
   5 import Linear.Metric (norm)
   6
   7 import Data.List
   8 import Data.Ord
   9
  10 type Bounds = (Integer, Integer)
  11 type Position = V2 Rational
  12
  13 type Asteroids = S.Set Position
  14
  15 type TargetInfo = (Double, Double)
  16 type Targets = M.Map TargetInfo Position
  17
  18 main :: IO ()
  19 main = do
  20         text <- readFile "data/advent10.txt"
  21         let (asteroids, bounds) = successfulParse text
  22         -- print asteroids
  23         let (monitor, visCount) = bestVisible bounds asteroids
  24         print visCount -- part 1
  25         let targets = makeTargets monitor (S.delete monitor asteroids)
  26         -- print targets
  27         print $ part2 targets
  28
  29
  30 part2 targets = numerator $ 100 * x + y
  31     where V2 x y = (targetSequence targets)!!199
  32
  33
  34 bestVisible :: Bounds -> Asteroids -> (Position, Int)
  35 bestVisible bounds asteroids = maximumBy (comparing snd)
  36                                 $ S.toList
  37                                 $ S.map (visibleCount bounds asteroids) asteroids
  38
  39 visibleCount :: Bounds -> Asteroids -> Position -> (Position, Int)
  40 visibleCount bounds asteroids origin = (origin, S.size $ visible bounds origin asteroids)
  41
  42 visible :: Bounds -> Position -> Asteroids -> Asteroids
  43 visible bounds origin asteroids = S.delete origin $ S.difference asteroids screened
  44     where screened = allScreenings bounds origin asteroids
  45
  46 allScreenings :: Bounds -> Position -> Asteroids -> Asteroids
  47 allScreenings bounds origin asteroids = S.foldl' (screenings bounds origin) S.empty asteroids
  48
  49
  50 screenings :: Bounds -> Position -> Asteroids -> Position -> Asteroids
  51 screenings bounds origin@(V2 ox oy) screened0 target@(V2 tx ty)
  52     | origin == target = screened0
  53     | otherwise        = S.union screened0 screened
  54     where maxComponent = max (abs (tx - ox)) (abs (ty - oy))
  55           delta = V2 ((tx - ox) / maxComponent) ((ty - oy) / maxComponent)
  56           rawScreens = takeWhile (inBounds bounds) [target ^+^ n *^ delta | n <- [1..]]
  57           screened = S.fromList rawScreens
  58
  59 inBounds :: Bounds -> Position -> Bool
  60 inBounds (maxX, maxY) (V2 x y) = (x >= 0) && (x <= (maxX % 1)) && (y >= 0) && (y <= (maxY % 1))
  61
  62
  63
  64 makeTargets :: Position -> Asteroids -> Targets
  65 makeTargets origin asteroids = S.foldl' addTarget M.empty asteroids
  66     where addTarget m t = M.insert (targetInfo origin t) t m
  67
  68 targetInfo :: Position -> Position -> TargetInfo
  69 targetInfo origin target = (angle, range)
  70     where V2 dx dy = target - origin
  71           angle = atan2 (fromRational dy) (fromRational dx)
  72           -- recipRange = 1 / (norm (V2 (fromIntegral dy) (fromIntegral dx)))
  73           range = norm (V2 (fromRational dy) (fromRational dx))
  74
  75
  76 targetSequence :: Targets -> [Position]
  77 targetSequence targets = targetNext ((- pi / 2) - 0.001) targets
  78
  79 targetNext :: Double -> Targets -> [Position]
  80 targetNext angle targets
  81     | M.null targets = []
  82     | M.null possibles = targetNext (- pi) targets
  83     | otherwise = (target:(targetNext angle' targets'))
  84     where possibles = possibleTargets angle targets
  85           ((targetAngle, targetRange), target) = firstTarget possibles
  86           targets' = M.delete (targetAngle, targetRange) targets
  87           angle' = targetAngle
  88
  89 possibleTargets :: Double -> Targets -> Targets
  90 possibleTargets angle targets = M.filterWithKey (\(a, _) _ -> a > angle) targets
  91
  92 firstTarget :: Targets -> (TargetInfo, Position)
  93 firstTarget targets = M.findMin targets
  94
  95
  96 successfulParse :: String -> (Asteroids, Bounds)
  97 successfulParse input = ( S.fromList [(V2 (fromIntegral x % 1) (fromIntegral y % 1)) | x <- [0..maxX], y <- [0..maxY]
  98                                                , isAsteroid x y
  99                                                ]
 100                         , (fromIntegral maxX, fromIntegral maxY)
 101                         )
 102     where grid = lines input
 103           maxX = (length $ head grid) - 1
 104           maxY = (length grid) - 1
 105           isAsteroid x y = (grid!!y)!!x == '#'
 106
 107
 108 showPattern (maxX, maxY) asteroids = unlines rows
 109     where rows = [[cell x y | x <- [0..maxX]] | y <- [0..maxY] ]
 110           cell x y = if S.member (V2 x y) asteroids then '#' else '.'
 111
 112