AoC/2019/day10/day10.hs
2019-12-11 02:20:24 +01:00

98 lines
2.6 KiB
Haskell

{-# 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]
]