{-# LANGUAGE LambdaCase #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ParallelListComp #-} import Data.List as L import Data.Maybe import Data.Ord import Data.Ratio import qualified Data.Vector as V type Asteroid_old = (Int, Int) data Asteroid = Asteroid Int Int deriving (Show) instance Eq Asteroid where Asteroid a b == Asteroid c d = reduce a b == reduce c d where reduce x y | y == 0 && x == 0 = (0, 0) | x == 0 = (0, signum y) | y == 0 = (signum x, 0) | otherwise = (signum x * (abs $numerator z), signum y * (abs $denominator z)) where z = x %y instance Ord Asteroid where Asteroid a b `compare` Asteroid c d = (phi a b) `compare` (phi c d) where phi x y = phi' (fromIntegral x) (fromIntegral y) phi' :: Double -> Double -> Double phi' x y | x >= 0 = atan2 x (-y) | otherwise = 2 * pi + atan2 (-x) y (+|) :: Asteroid -> Asteroid -> Asteroid (+|) (Asteroid a b) (Asteroid c d) = Asteroid (a + c) (b + d) (-|) :: Asteroid -> Asteroid -> Asteroid (-|) (Asteroid a b) (Asteroid c d) = Asteroid (a - c) (b - d) neg :: Asteroid -> Asteroid neg (Asteroid a b) = Asteroid (-a) (-b) dist :: Asteroid -> Int dist (Asteroid x y) = abs x + abs y main = do content <- lines <$> readFile "input" print $ parse content let aMax = fst $ maxInSight $ parse content print aMax let newlist = listCycle $ sort $ sortOn (dist . fromJust) $ snd $ transformCoordinates (parse content) aMax let newnewlist = snd $ transformCoordinates newlist (neg aMax) print $ newnewlist !! 199 listCycle :: [Maybe Asteroid] -> [Maybe Asteroid] listCycle [] = [] listCycle xs = nub xs ++ listCycle (xs \\ nub xs) parse :: [String] -> [Maybe Asteroid] parse = concat . V.toList . V.map V.toList . toAsteroids . V.map V.fromList . V.fromList where toAsteroids = V.imap g g x = V.imap (f x) f i j a = case a of '.' -> Nothing _ -> Just $ Asteroid j i transformCoordinates :: [Maybe Asteroid] -> Asteroid -> (Asteroid, [Maybe Asteroid]) transformCoordinates xs a = (a, [Just $ x -| a | Just x <- xs, x /= a]) maxInSight :: [Maybe Asteroid] -> (Asteroid, Int) maxInSight xs = maximumBy (comparing snd) $ map (f . transformCoordinates xs) (catMaybes xs) where f (x, y) = (x, pred . length . nub $ y) asts :: [String] -> [Maybe Asteroid_old] asts xxs = L.nub [ if (xxs !! y) !! (x) == '.' then Nothing else Just (x, y) | y <- [0 .. (L.length $ L.head xxs) - 1] , x <- [0 .. L.length xxs - 1] ]