import Data.List as List import Debug.Trace as Trace main = do content <- getContents let layers = lines content let indexlayers = map(\x-> mapInd(\x y -> (y,x)) x ) layers let points = concat (mapInd(\x y->map(\x->((fst x,y),snd x))x) $ indexlayers) let asteroids = (Trace.traceShowId(map fst (filter(\(x,y) -> y == '#' ) points))) let changedAsteroids = changeCoordinate asteroids (2,2) --let sortedAsteroids = sortBy sortDistance asteroids --let view = length (getViews (asteroids) (3,4)) --let result = List.maximum(map(\x-> length(getViews (asteroids) x)) (asteroids)) let views = (getViews asteroids (2,2)) let lines = map reduce(map(\(x,y)-> ((x-2),(y-2))) (getBorder (2,2) 4)) let order = destroyOrders changedAsteroids lines (2,2) [] --let destroyed = destroyOrder views lines [] --mapM putStrLn (map(\(x,y)->(show x ) ++(show y)) asteroids) --mapM putStrLn (map(\(x,y)->(show x ) ++(show y)) sortedAsteroids) -- putStrLn ( show result) --mapM putStrLn ( map show views) mapM putStrLn ( map show order) --mapM putStrLn (map show (layers)) --mapM putStrLn ( map show destroyed) destroyOrders :: [(Int,Int)] ->[(Int,Int)] -> (Int,Int) -> [(Int,Int)] -> [(Int,Int)] destroyOrders ast laser station out |length ast > 0 = do let views = foldl getView [] ast let destroyed = (Trace.traceShowId(destroyOrder views laser [])) let newout = out ++ destroyed let newast = (Trace.traceShowId(ast \\ destroyed)) destroyOrders newast laser station newout |otherwise = out mapInd :: (a -> Int -> b) -> [a] -> [b] mapInd f l = zipWith f l [0..] sortDistance ((a,b),c) ((a2,b2),c2) | a + b > a2 + b2 = GT | a + b < a2 + b2 = LT | a + b == a2 + b2 = EQ getViews :: [(Int,Int)] -> (Int,Int) -> [(Int,Int)] getViews xs (a,b) = foldl getView [](delete (0,0)( (map(\(x,y) -> ((x-a),(y-b)))xs))) changeCoordinate :: [(Int, Int)] -> (Int,Int) -> [(Int,Int)] changeCoordinate xs (a,b) = (delete (0,0)( (map(\(x,y) -> ((x-a),(y-b)))xs))) getView :: [(Int,Int)] -> (Int,Int) -> [(Int,Int)] getView xs y |notElem (reduce y) (map reduce xs) = xs ++ [y] |otherwise = xs reduce :: (Int,Int) -> (Int,Int) reduce (a,b) = ((div a (gcd a b)),(div b (gcd a b))) destroyOrder :: [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)] -> [(Int,Int)] destroyOrder ast (x:xs) out | length xs > 0 = do let asteroid = getLineAst ast x if length asteroid /= 0 then do let newast = delete (head asteroid) ast let newout = out ++ asteroid destroyOrder newast xs newout else destroyOrder ast xs out | length xs == 0 = do let asteroid = getLineAst ast x if length asteroid /= 0 then out ++ asteroid else out getLineAst :: [(Int,Int)] -> (Int,Int) -> [(Int,Int)] getLineAst xs r = filter(\x->reduce(x) == r) xs getBorder :: (Int,Int) -> Int -> [(Int,Int)] getBorder (a,b) l = do let p1 = [(i,0) | i <- [a..l]] let p2 = [(l,j) | j <- [1..l]] let p3 = [(i,l) | i <- reverse [0..(l-1)]] let p4 = [(l,j) | j <- [(l-1)..0]] let p5 = [(0,j) | j <- reverse [0..(l-1)]] let p6 = [(i,0) | i <- [0..(a-1)]] p1 ++ p2 ++ p3 ++ p4 ++ p5 ++ p6