Improves interval tree solution 3
parent
534271d1bd
commit
3b10150e08
29
3/3.hs
29
3/3.hs
|
@ -6,7 +6,7 @@ import Data.Bits (Bits(shift))
|
||||||
import Data.Function (on)
|
import Data.Function (on)
|
||||||
import qualified Data.Set as Set
|
import qualified Data.Set as Set
|
||||||
import qualified Data.Tree as T
|
import qualified Data.Tree as T
|
||||||
import Data.List (maximumBy, foldl', sort)
|
import Data.List (maximumBy, foldl', sort, sortOn)
|
||||||
import Data.Ord (comparing)
|
import Data.Ord (comparing)
|
||||||
import Text.Parsec hiding (Empty)
|
import Text.Parsec hiding (Empty)
|
||||||
|
|
||||||
|
@ -80,6 +80,7 @@ instance Show a => Show (Interval a) where
|
||||||
data IntervalTree a b = Node { itLeft :: IntervalTree a b
|
data IntervalTree a b = Node { itLeft :: IntervalTree a b
|
||||||
, itCenter :: a
|
, itCenter :: a
|
||||||
, itIntervals :: [(Interval a, b)]
|
, itIntervals :: [(Interval a, b)]
|
||||||
|
, itEndSortedIntervals:: [Interval a]
|
||||||
, itRight :: IntervalTree a b
|
, itRight :: IntervalTree a b
|
||||||
}
|
}
|
||||||
| Empty a a deriving (Show, Eq)
|
| Empty a a deriving (Show, Eq)
|
||||||
|
@ -91,14 +92,14 @@ leftOf (Interval (_, end)) x = end <= x
|
||||||
insert :: (Ord a, Ord b, Bits a, Num a) => (Interval a, b) -> IntervalTree a b -> IntervalTree a b
|
insert :: (Ord a, Ord b, Bits a, Num a) => (Interval a, b) -> IntervalTree a b -> IntervalTree a b
|
||||||
insert o@(interval, _) tree = case tree of
|
insert o@(interval, _) tree = case tree of
|
||||||
Empty start end -> go start end (start + half (end - start))
|
Empty start end -> go start end (start + half (end - start))
|
||||||
Node l center is r | interval `leftOf` center -> Node (insert o l) center is r
|
Node l center is es r | interval `leftOf` center -> Node (insert o l) center is es r
|
||||||
Node l center is r | interval `rightOf` center -> Node l center is (insert o r)
|
Node l center is es r | interval `rightOf` center -> Node l center is es (insert o r)
|
||||||
Node l center is r -> Node l center (sort (o:is)) r
|
Node l center is es r -> Node l center (sort (o:is)) (sortOn (negate . snd . unInterval) (interval:es)) r
|
||||||
where
|
where
|
||||||
go start end center
|
go start end center
|
||||||
| interval `leftOf` center = Node (insert o (Empty start center)) center [] (Empty center end)
|
| interval `leftOf` center = Node (insert o (Empty start center)) center [] [] (Empty center end)
|
||||||
| interval `rightOf` center = Node (Empty start center) center [] (insert o (Empty center end))
|
| interval `rightOf` center = Node (Empty start center) center [] [] (insert o (Empty center end))
|
||||||
| otherwise = Node (Empty start center) center [o] (Empty center end)
|
| otherwise = Node (Empty start center) center [o] [interval] (Empty center end)
|
||||||
|
|
||||||
half = flip shift (-1)
|
half = flip shift (-1)
|
||||||
|
|
||||||
|
@ -108,13 +109,15 @@ overlappingIntervals f interval = go []
|
||||||
where
|
where
|
||||||
go acc t = case t of
|
go acc t = case t of
|
||||||
Empty _ _ -> acc
|
Empty _ _ -> acc
|
||||||
Node l _ is _ | not (null is) && interval `leftOf` leftmostStart is -> go acc l
|
Node l _ is _ _ | not (null is) && interval `leftOf` leftmostStart is -> go acc l
|
||||||
Node l center is _ | interval `leftOf` center -> go (acc' is acc) l
|
Node _ _ _ es r | not (null es) && interval `rightOf` rightmostEnd es -> go acc r
|
||||||
Node _ center is r | interval `rightOf` center -> go (acc' is acc) r
|
Node l center is _ _ | interval `leftOf` center -> go (acc' is acc) l
|
||||||
Node l _ is r -> go (go (acc' is acc) l) r
|
Node _ center is _ r | interval `rightOf` center -> go (acc' is acc) r
|
||||||
|
Node l _ is _ r -> go (go (acc' is acc) l) r
|
||||||
where
|
where
|
||||||
acc' is acc = filter (\(i,_) -> i `f` interval) is ++ acc
|
acc' is acc = filter (\(i,_) -> i `f` interval) is ++ acc
|
||||||
leftmostStart = fst . unInterval . fst . head
|
leftmostStart = fst . unInterval . fst . head
|
||||||
|
rightmostEnd = snd . unInterval . head
|
||||||
|
|
||||||
includingIntervals :: Ord a => Interval a -> IntervalTree a b -> [(Interval a, b)]
|
includingIntervals :: Ord a => Interval a -> IntervalTree a b -> [(Interval a, b)]
|
||||||
includingIntervals =
|
includingIntervals =
|
||||||
|
@ -141,7 +144,7 @@ rectIntervalTrees rects =
|
||||||
|
|
||||||
toTree :: (Show a, Show b) => IntervalTree a b -> T.Tree String
|
toTree :: (Show a, Show b) => IntervalTree a b -> T.Tree String
|
||||||
toTree (Empty start end) = T.Node (show ("E", start, end)) []
|
toTree (Empty start end) = T.Node (show ("E", start, end)) []
|
||||||
toTree (Node l c is r) = T.Node (show ("N", c, is)) [toTree l, toTree r]
|
toTree (Node l c is _ r) = T.Node (show ("N", c, is)) [toTree l, toTree r]
|
||||||
|
|
||||||
intervalTreeSolve :: [Rect] -> (Int, [Rect])
|
intervalTreeSolve :: [Rect] -> (Int, [Rect])
|
||||||
intervalTreeSolve rects =
|
intervalTreeSolve rects =
|
||||||
|
@ -167,6 +170,6 @@ intervalTreeSolve rects =
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = do
|
main = do
|
||||||
rects <- readInput . lines <$> getContents
|
rects <- readInput . lines <$> getContents
|
||||||
let (overlapArea, noOverlapRects) = bruteForceSolve rects
|
let (overlapArea, noOverlapRects) = intervalTreeSolve rects
|
||||||
putStrLn $ "Overlap Area = " ++ show overlapArea
|
putStrLn $ "Overlap Area = " ++ show overlapArea
|
||||||
putStrLn $ "No overlap rects = " ++ show noOverlapRects
|
putStrLn $ "No overlap rects = " ++ show noOverlapRects
|
Loading…
Reference in New Issue