-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Set.AVL
-- Copyright   :  (c) Adrian Hey 2005,2006
-- License     :  BSD3
--
-- Maintainer  :  http://homepages.nildram.co.uk/~ahey/em.png
-- Stability   :  provisional
-- Portability :  portable
--
-- This module provides an AVL tree based clone of the base package Data.Set.
--
-- There are some differences though..
--
-- * 'size' is O(n), not O(1)
--
-- * The showTree and showTreeWith functions are not implemented.
--
-- * The complexities of 'isSubsetOf','isProperSubsetOf','union','intersection','difference'
-- are unknown (because my maths isn't good enough to figure it out),
-- but are probably no worse than the originals.
--
-- * Conversion functions 'toTree', 'unsafeFromTree', 'toStdSet', 'fromStdSet'.
-- have been added. 
-----------------------------------------------------------------------------

-- TODO: rename conversion functions: with unsafe prefix

module Data.Set.AVL  ( 
            -- * Set type
            Set

            -- * Operators
            , (\\)

            -- * Query
            , null
            , size
            , member
            , isSubsetOf
            , isProperSubsetOf
            
            -- * Construction
            , empty
            , singleton
            , insert
            , delete
            
            -- * Combine
            , union, unions
            , difference
            , intersection
            
            -- * Filter
            , filter
            , partition
            , split
            , splitMember

            -- * Map
	    , map
	    , mapMonotonic

            -- * Fold
            , fold

            -- * Min\/Max
            , findMin
            , findMax
            , deleteMin
            , deleteMax
            , deleteFindMin
            , deleteFindMax

            -- * Conversion

            -- ** List
            , elems
            , toList
            , fromList
            
            -- ** Ordered list
            , toAscList
            , fromAscList
            , fromDistinctAscList

            -- ** To\/From Data.Set.Set
            , toStdSet
            , fromStdSet

            -- ** To\/From raw AVL trees.
            -- | These conversions allow you to use the functions provided by Data.Tree.AVL.
            , toTree
            , unsafeFromTree
                        
            -- * Debugging
--            , showTree
--            , showTreeWith
            , valid

	-- * Old interface, DEPRECATED
	,emptySet,       -- :: Set a
	mkSet,          -- :: Ord a => [a]  -> Set a
	setToList,      -- :: Set a -> [a] 
	unitSet,        -- :: a -> Set a
	elementOf,      -- :: Ord a => a -> Set a -> Bool
	isEmptySet,     -- :: Set a -> Bool
	cardinality,    -- :: Set a -> Int
	unionManySets,  -- :: Ord a => [Set a] -> Set a
	minusSet,       -- :: Ord a => Set a -> Set a -> Set a
	mapSet,         -- :: Ord a => (b -> a) -> Set b -> Set a
	intersect,      -- :: Ord a => Set a -> Set a -> Set a
	addToSet,      	-- :: Ord a => Set a -> a -> Set a
	delFromSet,    	-- :: Ord a => Set a -> a -> Set a
            ) where

import Prelude hiding (filter,foldr,null,map)
import qualified Data.List  as List
import qualified Data.Maybe as Maybe
import qualified Data.Set
import Data.Monoid

import qualified Data.COrdering           as COrdering
import qualified Data.Tree.AVL            as AVL
import qualified Data.Tree.AVL.Test.Utils as AVL

#ifdef __GLASGOW_HASKELL__
import Data.Generics.Basics -- re-exports Data.Typeable
#else
import Data.Typeable
#endif

-- | A set of values @a@.
newtype Set a = Set (AVL.AVL a)

instance Eq a => Eq (Set a) where
  t1 == t2  = (size t1 == size t2) && (toAscList t1 == toAscList t2)

instance Ord a => Ord (Set a) where
    compare s1 s2 = compare (toAscList s1) (toAscList s2) 

instance Show a => Show (Set a) where
  showsPrec _ s  = showSet (toAscList s)

showSet :: (Show a) => [a] -> ShowS
showSet []     
  = showString "{}" 
showSet (x:xs) 
  = showChar '{' . shows x . showTail xs
  where
    showTail []       = showChar '}'
    showTail (x':xs') = showChar ',' . shows x' . showTail xs'

instance Ord a => Monoid (Set a) where
    mempty  = empty
    mappend = union
    mconcat = unions


#include "Typeable.h"
INSTANCE_TYPEABLE1(Set,theTc,"Data.Set.AVL")


#ifdef __GLASGOW_HASKELL__
-- This instance preserves data abstraction at the cost of inefficiency.
-- We omit reflection services for the sake of data abstraction.
instance (Data a, Ord a) => Data (Set a) where
  gfoldl f z set = z fromList `f` (toList set)
  toConstr _     = error "toConstr"
  gunfold _ _    = error "gunfold"
  dataTypeOf _   = mkNorepType "Data.Set.AVL.Set"
#endif

-- | /O(1)/. The empty set.
empty  :: Set a
empty = Set (AVL.empty)

-- | /O(1)/. Create a singleton set.
singleton :: a -> Set a
singleton a = Set (AVL.singleton a) 

-- | /O(1)/. Is this the empty set?
null :: Set a -> Bool
null (Set t) = AVL.isEmpty t

-- | /O(n)/. The number of elements in the set.
size :: Set a -> Int
size (Set t) = AVL.size t

-- | /O(log n)/. Is the element in the set?
member :: Ord a => a -> Set a -> Bool
member a (Set t) = AVL.genContains t (compare a)

-- | /O(?)/. Is this a subset?
-- @(s1 `isSubsetOf` s2)@ tells whether @s1@ is a subset of @s2@.
isSubsetOf :: Ord a => Set a -> Set a -> Bool
isSubsetOf (Set t1) (Set t2) = AVL.genIsSubsetOf compare t1 t2

-- | /O(?)/. Is this a proper subset? (ie. a subset but not equal).
isProperSubsetOf :: Ord a => Set a -> Set a -> Bool
isProperSubsetOf (Set t1) (Set t2) = (AVL.size t1 < AVL.size t2) && (AVL.genIsSubsetOf compare t1 t2)

-- | /O(?)/. The union of two sets, preferring the first set when
-- equal elements are encountered. 
union :: Ord a => Set a -> Set a -> Set a
union (Set t1) (Set t2) = Set (AVL.genUnion COrdering.fstCC t1 t2)

-- | The union of a list of sets: (@'unions' == 'foldl'' 'union' 'empty'@).
unions :: Ord a => [Set a] -> Set a
unions ts = List.foldl' union empty ts

infixl 9 \\ --
-- | /O(?)/. See 'difference'.
(\\) :: Ord a => Set a -> Set a -> Set a
m1 \\ m2 = difference m1 m2

-- | /O(?)/. Difference of two sets. 
difference :: Ord a => Set a -> Set a -> Set a
difference (Set t1) (Set t2) = Set (AVL.genDifference compare t1 t2)

-- | /O(?)/. The intersection of two sets.
intersection :: Ord a => Set a -> Set a -> Set a
intersection (Set t1) (Set t2) = Set (AVL.genIntersection COrdering.fstCC t1 t2)

-- | /O(log n)/. Insert an element in a set.
-- If the set already contains an element equal to the given value,
-- it is replaced with the new value.
insert :: Ord a => a -> Set a -> Set a
insert a (Set t) = Set (AVL.genPush (COrdering.fstCC a) a t)

-- | /O(log n)/. Delete an element from a set.
delete :: Ord a => a -> Set a -> Set a
delete a (Set t) = Set (AVL.genDel (compare a) t)

-- | /O(n)/. Build a set from an ascending list in linear time.
-- /The precondition (input list is ascending) is not checked./
fromAscList :: Eq a => [a] -> Set a 
fromAscList as
  = fromDistinctAscList (combineEq as)
  where
  -- [combineEq xs] combines equal elements with [const] in an ordered list [xs]
  combineEq xs
    = case xs of
        []     -> []
        [x]    -> [x]
        (x:xx) -> combineEq' x xx
  combineEq' z [] = [z]
  combineEq' z (x:xs)
    | z==x      = combineEq' z xs
    | otherwise = z:combineEq' x xs

-- | /O(n)/. Build a set from an ascending list of distinct elements in linear time.
-- /The precondition (input list is strictly ascending) is not checked./
fromDistinctAscList :: [a] -> Set a 
fromDistinctAscList as = Set (AVL.asTreeL as)

-- | /O(n*log n)/. Create a set from a list of elements.
fromList :: Ord a => [a] -> Set a 
fromList as = Set (AVL.genAsTree COrdering.fstCC as)

-- | /O(n)/. The elements of a set.
elems :: Set a -> [a]
elems s = toAscList s

-- | /O(n)/. Convert the set to a list of elements.
toList :: Set a -> [a]
toList s = toAscList s

-- | /O(n)/. Convert the set to an ascending list of elements.
toAscList :: Set a -> [a]
toAscList (Set t) = AVL.asListL t

-- | /O(n)/. Filter all elements that satisfy the predicate.
filter :: Ord a => (a -> Bool) -> Set a -> Set a
filter p (Set t) = Set (AVL.filterViaList p t)

-- | /O(n)/. Partition the set into two sets, one with all elements that satisfy
-- the predicate and one with all elements that don't satisfy the predicate.
-- See also 'split'.
partition :: Ord a => (a -> Bool) -> Set a -> (Set a,Set a)
partition p (Set t) = (Set trueT, Set falseT)
 where (trueT,falseT) = AVL.partitionAVL p t 

-- | /O(log n)/. The expression (@'split' x set@) is a pair @(set1,set2)@
-- where all elements in @set1@ are lower than @x@ and all elements in
-- @set2@ larger than @x@. @x@ is not found in neither @set1@ nor @set2@.
split :: Ord a => a -> Set a -> (Set a,Set a)
split a (Set t) = (Set lessT, Set greaterT)
 where (lessT, _, greaterT) = AVL.genFork (COrdering.unitCC a) t

-- | /O(log n)/. Performs a 'split' but also returns whether the pivot
-- element was found in the original set.
splitMember :: Ord a => a -> Set a -> (Set a,Bool,Set a)
splitMember a (Set t) = (Set lessT, Maybe.isJust mbUnit, Set greaterT)
 where (lessT, mbUnit, greaterT) = AVL.genFork (COrdering.unitCC a) t

-- | /O(n*log n)/. 
-- @'map' f s@ is the set obtained by applying @f@ to each element of @s@.
-- 
-- It's worth noting that the size of the result may be smaller if,
-- for some @(x,y)@, @x \/= y && f x == f y@
map :: (Ord a, Ord b) => (a->b) -> Set a -> Set b
map f = fromList . List.map f . toList

-- | /O(n)/. The identity
--
-- @'mapMonotonic' f s == 'map' f s@, works only when @f@ is monotonic.
-- /The precondition is not checked./
-- Semi-formally, we have:
-- 
-- > and [x < y ==> f x < f y | x <- ls, y <- ls] 
-- >                     ==> mapMonotonic f s == map f s
-- >     where ls = toList s
mapMonotonic :: (a->b) -> Set a -> Set b
mapMonotonic f (Set t) = Set (AVL.mapAVL f t)

-- | /O(n)/. Fold over the elements of a set in an unspecified order.
fold :: (a -> b -> b) -> b -> Set a -> b
fold f b (Set t) = AVL.foldrAVL f b t 

-- | /O(log n)/. The minimal element of a set.
findMin :: Set a -> a
findMin (Set t) = case AVL.tryReadL t of
                  Just a  -> a
                  Nothing -> error "Set.findMin: empty set has no minimal element"

-- | /O(log n)/. The maximal element of a set.
findMax :: Set a -> a
findMax (Set t) = case AVL.tryReadR t of
                  Just a  -> a
                  Nothing -> error "Set.findMax: empty set has no maximal element"

-- | /O(log n)/. Delete the minimal element.
deleteMin :: Set a -> Set a
deleteMin (Set t) = Set (case AVL.tryDelL t of
                         Just t' -> t'
                         Nothing -> t -- empty
                        )

-- | /O(log n)/. Delete the maximal element.
deleteMax :: Set a -> Set a
deleteMax (Set t) = Set (case AVL.tryDelR t of
                         Just t' -> t'
                         Nothing -> t -- empty
                        )

-- | /O(log n)/. Delete and find the minimal element.
-- 
-- > deleteFindMin set = (findMin set, deleteMin set)
deleteFindMin :: Set a -> (a,Set a)
deleteFindMin (Set t) =
 case AVL.tryPopL t of
 Just (a,t') -> (a, Set t')
 Nothing     -> (error "Set.deleteFindMin: can not return the minimal element of an empty set", empty)

-- | /O(log n)/. Delete and find the maximal element.
-- 
-- > deleteFindMax set = (findMax set, deleteMax set)
deleteFindMax :: Set a -> (a,Set a)
deleteFindMax (Set t) =
 case AVL.tryPopR t of
 Just (t',a) -> (a, Set t')
 Nothing     -> (error "Set.deleteFindMax: can not return the maximal element of an empty set", empty)

-- | /O(n)/. Test if the internal set structure is valid.
valid :: Ord a => Set a -> Bool
valid (Set t) = AVL.isSortedOK compare t

-- | /O(n)/. Convert a Data.Set.Set to an AVL tree based Set (as provided by this module).
fromStdSet :: Data.Set.Set a -> Set a
fromStdSet s = Set (AVL.set2AVL s)

-- | /O(n)/. Convert an AVL tree based Set (as provided by this module) to a Data.Set.Set.
toStdSet :: Set a -> Data.Set.Set a
toStdSet (Set t) = AVL.avl2Set t

-- | /O(1)/. Convert a /sorted/ AVL tree to an AVL tree based Set (as provided by this module).
-- This function does not check the input AVL tree is sorted.
{-# INLINE unsafeFromTree #-}
unsafeFromTree :: AVL.AVL a -> Set a
unsafeFromTree t = Set t

-- | /O(1)/. Convert an AVL tree based Set (as provided by this module) to a sorted AVL tree.
{-# INLINE toTree #-}
toTree :: Set a -> AVL.AVL a
toTree (Set t) = t

{--------------------------------------------------------------------
  Old Data.Set compatibility interface
--------------------------------------------------------------------}

{-# DEPRECATED emptySet "Use empty instead" #-}
-- | Obsolete equivalent of 'empty'.
emptySet :: Set a
emptySet = empty

{-# DEPRECATED mkSet "Use fromList instead" #-}
-- | Obsolete equivalent of 'fromList'.
mkSet :: Ord a => [a]  -> Set a
mkSet = fromList

{-# DEPRECATED setToList "Use elems instead." #-}
-- | Obsolete equivalent of 'elems'.
setToList :: Set a -> [a] 
setToList = elems

{-# DEPRECATED unitSet "Use singleton instead." #-}
-- | Obsolete equivalent of 'singleton'.
unitSet :: a -> Set a
unitSet = singleton

{-# DEPRECATED elementOf "Use member instead." #-}
-- | Obsolete equivalent of 'member'.
elementOf :: Ord a => a -> Set a -> Bool
elementOf = member

{-# DEPRECATED isEmptySet "Use null instead." #-}
-- | Obsolete equivalent of 'null'.
isEmptySet :: Set a -> Bool
isEmptySet = null

{-# DEPRECATED cardinality "Use size instead." #-}
-- | Obsolete equivalent of 'size'.
cardinality :: Set a -> Int
cardinality = size

{-# DEPRECATED unionManySets "Use unions instead." #-}
-- | Obsolete equivalent of 'unions'.
unionManySets :: Ord a => [Set a] -> Set a
unionManySets = unions

{-# DEPRECATED minusSet "Use difference instead." #-}
-- | Obsolete equivalent of 'difference'.
minusSet :: Ord a => Set a -> Set a -> Set a
minusSet = difference

{-# DEPRECATED mapSet "Use map instead." #-}
-- | Obsolete equivalent of 'map'.
mapSet :: (Ord a, Ord b) => (b -> a) -> Set b -> Set a
mapSet = map

{-# DEPRECATED intersect "Use intersection instead." #-}
-- | Obsolete equivalent of 'intersection'.
intersect :: Ord a => Set a -> Set a -> Set a
intersect = intersection

{-# DEPRECATED addToSet "Use 'flip insert' instead." #-}
-- | Obsolete equivalent of @'flip' 'insert'@.
addToSet :: Ord a => Set a -> a -> Set a
addToSet = flip insert

{-# DEPRECATED delFromSet "Use `flip delete' instead." #-}
-- | Obsolete equivalent of @'flip' 'delete'@.
delFromSet :: Ord a => Set a -> a -> Set a
delFromSet = flip delete