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