AoC2019/day10.hs

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