2019-12-10 21:21:20 +01:00
{- # LANGUAGE LambdaCase # -}
{- # LANGUAGE BangPatterns # -}
{- # LANGUAGE ParallelListComp # -}
import Data.List as L
import Data.Maybe
2019-12-11 02:20:24 +01:00
import Data.Ord
import Data.Ratio
import qualified Data.Vector as V
type Asteroid_old = ( Int , Int )
2019-12-10 21:21:20 +01:00
2019-12-11 02:20:24 +01:00
data Asteroid =
Asteroid Int Int
deriving ( Show )
2019-12-10 21:21:20 +01:00
instance Eq Asteroid where
2019-12-11 02:20:24 +01:00
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
2019-12-10 21:21:20 +01:00
instance Ord Asteroid where
2019-12-11 02:20:24 +01:00
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
2019-12-10 21:21:20 +01:00
( +| ) :: Asteroid -> Asteroid -> Asteroid
2019-12-11 02:20:24 +01:00
( +| ) ( Asteroid a b ) ( Asteroid c d ) = Asteroid ( a + c ) ( b + d )
2019-12-10 21:21:20 +01:00
( -| ) :: Asteroid -> Asteroid -> Asteroid
2019-12-11 02:20:24 +01:00
( -| ) ( Asteroid a b ) ( Asteroid c d ) = Asteroid ( a - c ) ( b - d )
2019-12-10 21:21:20 +01:00
neg :: Asteroid -> Asteroid
neg ( Asteroid a b ) = Asteroid ( - a ) ( - b )
2019-12-11 02:20:24 +01:00
2019-12-10 21:21:20 +01:00
dist :: Asteroid -> Int
dist ( Asteroid x y ) = abs x + abs y
main = do
2019-12-11 02:20:24 +01:00
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
2019-12-10 21:21:20 +01:00
listCycle :: [ Maybe Asteroid ] -> [ Maybe Asteroid ]
listCycle [] = []
listCycle xs = nub xs ++ listCycle ( xs \\ nub xs )
parse :: [ String ] -> [ Maybe Asteroid ]
2019-12-11 02:20:24 +01:00
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 ] )
2019-12-10 21:21:20 +01:00
maxInSight :: [ Maybe Asteroid ] -> ( Asteroid , Int )
2019-12-11 02:20:24 +01:00
maxInSight xs =
maximumBy ( comparing snd ) $ map ( f . transformCoordinates xs ) ( catMaybes xs )
where
f ( x , y ) = ( x , pred . length . nub $ y )
2019-12-10 21:21:20 +01:00
asts :: [ String ] -> [ Maybe Asteroid_old ]
2019-12-11 02:20:24 +01:00
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 ]
]