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)
12 type Bounds = (Int, Int)
13 type Position = V2 Int
14 type Delta = V2 (Ratio Int)
16 type Asteroids = S.Set Position
18 type TargetInfo = (Float, Float)
19 type Targets = M.Map TargetInfo Position
23 text <- readFile "data/advent10.txt"
24 let (asteroids, bounds) = successfulParse text
26 let (monitor, visCount) = bestVisible bounds asteroids
27 print visCount -- part 1
28 let targets = makeTargets monitor (S.delete monitor asteroids)
33 part2 targets = 100 * x + y
34 where V2 x y = (targetSequence targets)!!199
37 bestVisible :: Bounds -> Asteroids -> (Position, Int)
38 bestVisible bounds asteroids = maximumBy (comparing snd) $ S.toList $ S.map (visibleCount bounds asteroids) asteroids
40 visibleCount :: Bounds -> Asteroids -> Position -> (Position, Int)
41 visibleCount bounds asteroids origin = (origin, S.size $ visible bounds origin asteroids)
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
47 allScreenings :: Bounds -> Position -> Asteroids -> Asteroids
48 allScreenings bounds origin asteroids = S.foldl' (screenings bounds origin) S.empty asteroids
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
64 inBounds :: Bounds -> Delta -> Bool
65 inBounds (maxX, maxY) (V2 x y) = (x >= 0) && (x <= (maxX % 1)) && (y >= 0) && (y <= (maxY % 1))
67 integerVec :: Delta -> Position
68 integerVec (V2 x y) = V2 (numerator x) (numerator y)
70 isIntegral :: Delta -> Bool
71 isIntegral (V2 x y) = (denominator x == 1) && (denominator y == 1)
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
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))
85 possibleTargets :: Float -> Targets -> Targets
86 possibleTargets angle targets = M.filterWithKey (\(a, _) _ -> a > angle) targets
88 firstTarget :: Targets -> (TargetInfo, Position)
89 firstTarget targets = M.findMin targets
91 targetSequence targets = targetNext ((- pi / 2) - 0.001) targets
93 targetNext :: Float -> Targets -> [Position]
94 targetNext angle 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
104 successfulParse :: String -> (Asteroids, Bounds)
105 successfulParse input = ( S.fromList [(V2 x y) | x <- [0..maxX], y <- [0..maxY]
110 where grid = lines input
111 maxX = (length $ head grid) - 1
112 maxY = (length grid) - 1
113 isAsteroid x y = (grid!!y)!!x == '#'
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 '.'