-----------------------------------------------------------------------------
-- |
-- 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
            , clipSize
            , 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

#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(min n c)/ where n is the 'Set' size and c is clip value.
--
-- Returns the exact 'Set' size in the form @('Just' n)@ if this is less than or
-- equal to the input clip value. Returns @'Nothing'@ if the size is greater than
-- the clip value.
clipSize ::  Int -> Set a -> Maybe Int
clipSize c (Set t) = AVL.clipSize c 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' == 'List.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.filterAVL 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