Skyline.hs

{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}

module SkyLine where

import Data.List (groupBy, sort)

{-
  input:
  [left,right,height]
  buildings = [[2,9,10],[3,7,15],[5,12,12],[15,20,10],[19,24,8]]
  output:
  [[2,10],[3,15],[7,12],[12,0],[15,10],[20,8],[24,0]]
  this problem wants the 'new' result after a change
  except it wants the previous coord on a "downstroke"
  the problem explicitly says "left endpoint of some horizontal segment"
  so I could pull out the segments and get the first value of those?
  that means end of one segment and begin of next segment will overlap, hm
  so, get the max of all the explicit coords, then build the segments?
  oops, I forgot to add explicit zeros where's nothing exists!
-}
prob1 :: [[Int]]
prob1 = [[2, 9, 10], [3, 7, 15], [5, 12, 12], [15, 20, 10], [19, 24, 8]]

prob2 :: [[Int]]
prob2 = [[0, 2, 3], [2, 5, 3]]

prob3 :: [[Int]]
prob3 = [[2, 9, 10], [3, 7, 15], [11, 2, 0], [5, 12, 12], [15, 20, 10], [19, 24, 8]]

-- this gives the correct result:
-- >>> finalSolution prob1
-- [(2,10),(3,15),(7,12),(12,0),(15,10),(20,8),(24,0)]
finalSolution :: Foldable t => t [Int] -> [(Int, Int)]
finalSolution bs = concat $ zipWith change clean (tail clean)
  where
    clean = addEdges . addMissing . explicitCoords $ bs

buildingToCoords :: Enum a => (a, a, b) -> [(a, b)]
buildingToCoords (l, r, h) = zip [l .. r] (repeat h)

listToTuple :: [c] -> (c, c, c)
listToTuple [x, y, z] = (x, y, z)
listToTuple _ = error "bad input"

explicitCoords :: (Foldable t, Enum b, Ord b) => t [b] -> [(b, b)]
explicitCoords = largestByX
  where
    explicitSortedCoords = sort . concatMap (buildingToCoords . listToTuple)
    groupedByX = groupBy (\x y -> fst x == fst y) . explicitSortedCoords
    largestByX = (maximum <$>) . groupedByX

-- cheesy hack because I didn't make genuine segments
change :: Ord a1 => (a2, a1) -> (a2, a1) -> [(a2, a1)]
change (oldx, oldy) new@(_, newy)
    | oldy < newy = [new]
    | oldy > newy = [(oldx, newy)]
    | otherwise = []

addEdges :: [(Int, Int)] -> [(Int, Int)]
addEdges coords = getBegin (head coords) : coords <> [getEnd (last coords)]

getBegin :: (Int, Int) -> (Int, Int)
getBegin (x, _) = (x - 1, 0)
getEnd :: (Int, Int) -> (Int, Int)
getEnd (x, _) = (x + 1, 0)

addMissing :: [(Int, Int)] -> [(Int, Int)]
addMissing coords =
    sort $ coords <> [(x, 0) | x <- [fst $ minimum coords .. fst $ maximum coords], x `notElem` (fst <$> coords)]