70 lines
1.8 KiB
Haskell
70 lines
1.8 KiB
Haskell
import Data.List as L
|
|
import Data.Maybe
|
|
import Data.Ord
|
|
import qualified Data.Vector as V
|
|
|
|
data Asteroid =
|
|
Asteroid Int Int
|
|
deriving (Show)
|
|
|
|
instance Eq Asteroid where
|
|
Asteroid a b == Asteroid c d = phi a b == phi c d
|
|
|
|
instance Ord Asteroid where
|
|
Asteroid a b `compare` Asteroid c d = phi a b `compare` phi c d
|
|
|
|
phi :: Int -> Int -> Double
|
|
phi xi yi
|
|
| x >= 0 = atan2 x (-y)
|
|
| otherwise = 2 * pi + atan2 (-x) y
|
|
where x = fromIntegral xi
|
|
y = fromIntegral yi
|
|
|
|
(-|) :: 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 :: IO ()
|
|
main = do
|
|
content <- lines <$> readFile "input"
|
|
let (aMax,sMax) = maxInSight $ parse content
|
|
print sMax
|
|
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, length . nub $ y)
|