{-
%------------------------------------------------------------------------------
% Copyright (C) 1997, 1998, 2008 Joern Dinkla, www.dinkla.net
%------------------------------------------------------------------------------
%
% see
%     Joern Dinkla, Geometrische Algorithmen in Haskell, Diploma Thesis,
%     University of Bonn, Germany, 1998. 
%
-}

-- | The mergehull algorithm.

module GeomAlg.ConvexHull.MergeHull ( 
         mergeHull, incrementalMergeHull, bottomupMergeHull, 
		 insert, merge, lowerBridge, upperBridge
       )
where

import GeomAlg.Point2    ( P2, Point2, equalIth, leftOrBelow,
		   below, lexic2, compareIth,
		   leftest, rightest, 
		   isLeftTurn, isRightTurn, clockwise3 )
import GeomAlg.Polygon   ( Polygon (PolygonCW), Polygon2, inConvex, deleteCollinear )
import List      ( groupBy )
import GeomAlg.Divide    ( SplitTree (..), splitTree, reduce )
import GeomAlg.External.Utilities ( rotateTo, extremaBy, Rel3, sublist )
import GeomAlg.External.Sorting   ( sortBy )

-- |siehe \cite[K. 5.1]{chen96:cg}, \cite[K. 3.8]{orourke94:cg}

-- | Als Abk�rzungen definieren wir

filterAndSort	              :: (Ord a, Num a) => [P2 a] -> [[P2 a]]
filterAndSort		      = map (extremaBy below) . groupBy (equalIth 1) 
			      . sortBy leftOrBelow

-- | Merge hull
mergeHull                     :: (Ord a, Num a) => [P2 a] -> Polygon2 a
mergeHull                     = PolygonCW . deleteCollinear
			      . reduce (extremaBy below) merge
			      . splitTree lexic2 (compareIth 1)

merge                         :: (Ord a, Num a) => [P2 a] -> [P2 a] -> [P2 a]
merge ls rs                   = sublist ur lr rs ++ sublist ll ul ls
  where (ul, ur)	      = upperBridge ls rs
        (ll, lr)	      = lowerBridge ls rs

upperBridge, lowerBridge      :: (Ord a, Num a) => [P2 a] -> [P2 a] -> (P2 a,P2 a)
upperBridge ls rs             = bridge isLeftTurn (reverse ls) rs
lowerBridge ls rs             = bridge isRightTurn ls (reverse rs)

bridge                        :: (Ord a, Num a)=> Rel3 (P2 a) -> [P2 a] -> [P2 a] -> (P2 a, P2 a)
bridge turn ls rs             = find (rotate rightest ls) (rotate leftest rs)
  where rotate f xs	      = cycle (rotateTo (f xs) xs)
        find xs@(l:xxs@(m:_)) ys@(r:yys@(n:_))
           | turn l r m       = find xxs ys
           | turn l r n       = find xs yys
           | otherwise        = (l, r)

-- | Mit der Funktion |merge| l��t sich ein inkrementeller Algorithmus mit Laufzeit $O(n^2)$ entwerfen.

insert                        :: (Fractional a, Ord a) => [P2 a] -> P2 a -> [P2 a]
insert [] p                   = [p]
insert ch p                
  | p `inConvex` (PolygonCW ch) = ch
  | otherwise                 = merge ch [p]

incrementalMergeHull          :: (Fractional a, Ord a) => [P2 a] -> Polygon2 a
incrementalMergeHull          = PolygonCW . deleteCollinear 
			      . foldl insert [] 
			      . concat . filterAndSort

-- | Auch eine bottomup-Version l��t sich schreiben.

bottomupMergeHull             :: (Num a, Ord a) => [P2 a] -> Polygon2 a
bottomupMergeHull             = PolygonCW . deleteCollinear . head 
			      . merges . initial . filterAndSort

merges			      :: (Ord a, Num a) => [[P2 a]] -> [[P2 a]]
merges []		      = []
merges [x]		      = [x]
merges (x:y:ys)		      = merges (merge x y : merges ys)

initial			      :: (Ord a, Num a) => [[P2 a]] -> [[P2 a]]
initial []		      = []
initial [p]		      = [p]
initial ([p]:[q]:xs)	      = initial ([p,q]:xs)
initial ([p,q]:[r]:xs)	      = clockwise3 [p,q,r] : initial xs
initial ([p]:[q,r]:xs)	      = clockwise3 [p,q,r] : initial xs
initial ([p,q]:[r,s]:xs)      = [p,q] : initial ([r,s]:xs)