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