Portability | portable |
---|---|
Stability | stable |
Maintainer | http://homepages.nildram.co.uk/~ahey/em.png |
- Types.
- Simple AVL related utilities.
- Reading from AVL trees
- Writing to AVL trees
- "Pushing" new elements into AVL trees
- Deleting elements from AVL trees
- "Popping" elements from AVL trees
- Set operations
- The AVL Zipper
- Joining AVL trees
- List related utilities for AVL trees
- Some analogues of common List functions
- Some clones of common List functions
- "Flattening" AVL trees
- Splitting AVL trees
- AVL tree size utilities.
- AVL tree height utilities.
- Low level Binary Path utilities.
- Correctness checking.
- Tree parameter utilities.
- Deprecated
Many of the functions defined by this package make use of generalised comparison functions
which return a variant of the Prelude Ordering
data type: Data.COrdering.COrdering
. These
are refered to as "combining comparisons". (This is because they combine "equal"
values in some manner defined by the user.)
The idea is that using this simple mechanism you can define many practical and
useful variations of tree (or general set) operations from a few generic primitives,
something that would not be so easy using plain Ordering
comparisons
(overloaded or otherwise).
Functions which involve searching a tree really only require a single argument
function which takes the current tree element value as argument and returns
an Ordering
or Data.COrdering.COrdering
to direct the next stage of the search down
the left or right sub-trees (or stop at the current element). For documentation
purposes, these functions are called "selectors" throughout this library.
Typically a selector will be obtained by partially applying the appropriate
combining comparison with the value or key being searched for. For example..
mySelector :: Int -> Ordering Tree elements are Ints or.. mySelector :: (key,val) -> COrdering val Tree elements are (key,val) pairs
- data AVL e
- empty :: AVL e
- isEmpty :: AVL e -> Bool
- isNonEmpty :: AVL e -> Bool
- singleton :: e -> AVL e
- pair :: e -> e -> AVL e
- tryGetSingleton :: AVL e -> Maybe e
- assertReadL :: AVL e -> e
- tryReadL :: AVL e -> Maybe e
- assertReadR :: AVL e -> e
- tryReadR :: AVL e -> Maybe e
- assertRead :: AVL e -> (e -> COrdering a) -> a
- tryRead :: AVL e -> (e -> COrdering a) -> Maybe a
- tryReadMaybe :: AVL e -> (e -> COrdering (Maybe a)) -> Maybe a
- defaultRead :: a -> AVL e -> (e -> COrdering a) -> a
- contains :: AVL e -> (e -> Ordering) -> Bool
- writeL :: e -> AVL e -> AVL e
- tryWriteL :: e -> AVL e -> Maybe (AVL e)
- writeR :: AVL e -> e -> AVL e
- tryWriteR :: AVL e -> e -> Maybe (AVL e)
- write :: (e -> COrdering e) -> AVL e -> AVL e
- writeFast :: (e -> COrdering e) -> AVL e -> AVL e
- tryWrite :: (e -> COrdering e) -> AVL e -> Maybe (AVL e)
- writeMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
- tryWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> Maybe (AVL e)
- pushL :: e -> AVL e -> AVL e
- pushR :: AVL e -> e -> AVL e
- push :: (e -> COrdering e) -> e -> AVL e -> AVL e
- push' :: (e -> COrdering e) -> e -> AVL e -> AVL e
- pushMaybe :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
- pushMaybe' :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
- delL :: AVL e -> AVL e
- delR :: AVL e -> AVL e
- assertDelL :: AVL e -> AVL e
- assertDelR :: AVL e -> AVL e
- tryDelL :: AVL e -> Maybe (AVL e)
- tryDelR :: AVL e -> Maybe (AVL e)
- delete :: (e -> Ordering) -> AVL e -> AVL e
- deleteFast :: (e -> Ordering) -> AVL e -> AVL e
- deleteIf :: (e -> COrdering Bool) -> AVL e -> AVL e
- deleteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
- assertPopL :: AVL e -> (e, AVL e)
- assertPopR :: AVL e -> (AVL e, e)
- tryPopL :: AVL e -> Maybe (e, AVL e)
- tryPopR :: AVL e -> Maybe (AVL e, e)
- assertPop :: (e -> COrdering a) -> AVL e -> (a, AVL e)
- tryPop :: (e -> COrdering a) -> AVL e -> Maybe (a, AVL e)
- assertPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> (a, AVL e)
- tryPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> Maybe (a, AVL e)
- assertPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> (a, AVL e)
- tryPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> Maybe (a, AVL e)
- union :: (e -> e -> COrdering e) -> AVL e -> AVL e -> AVL e
- unionMaybe :: (e -> e -> COrdering (Maybe e)) -> AVL e -> AVL e -> AVL e
- disjointUnion :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
- unions :: (e -> e -> COrdering e) -> [AVL e] -> AVL e
- difference :: (a -> b -> Ordering) -> AVL a -> AVL b -> AVL a
- differenceMaybe :: (a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL a
- symDifference :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
- intersection :: (a -> b -> COrdering c) -> AVL a -> AVL b -> AVL c
- intersectionMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL c
- intersectionToList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]
- intersectionAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]
- intersectionMaybeToList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]
- intersectionMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]
- venn :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
- vennMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
- vennToList :: (a -> b -> COrdering c) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- vennAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- vennMaybeToList :: (a -> b -> COrdering (Maybe c)) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- vennMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- isSubsetOf :: (a -> b -> Ordering) -> AVL a -> AVL b -> Bool
- isSubsetOfBy :: (a -> b -> COrdering Bool) -> AVL a -> AVL b -> Bool
- data ZAVL e
- data PAVL e
- assertOpenL :: AVL e -> ZAVL e
- assertOpenR :: AVL e -> ZAVL e
- tryOpenL :: AVL e -> Maybe (ZAVL e)
- tryOpenR :: AVL e -> Maybe (ZAVL e)
- assertOpen :: (e -> Ordering) -> AVL e -> ZAVL e
- tryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
- tryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
- tryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
- openEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)
- close :: ZAVL e -> AVL e
- fillClose :: e -> PAVL e -> AVL e
- getCurrent :: ZAVL e -> e
- putCurrent :: e -> ZAVL e -> ZAVL e
- applyCurrent :: (e -> e) -> ZAVL e -> ZAVL e
- applyCurrent' :: (e -> e) -> ZAVL e -> ZAVL e
- assertMoveL :: ZAVL e -> ZAVL e
- assertMoveR :: ZAVL e -> ZAVL e
- tryMoveL :: ZAVL e -> Maybe (ZAVL e)
- tryMoveR :: ZAVL e -> Maybe (ZAVL e)
- insertL :: e -> ZAVL e -> ZAVL e
- insertR :: ZAVL e -> e -> ZAVL e
- insertMoveL :: e -> ZAVL e -> ZAVL e
- insertMoveR :: ZAVL e -> e -> ZAVL e
- fill :: e -> PAVL e -> ZAVL e
- delClose :: ZAVL e -> AVL e
- assertDelMoveL :: ZAVL e -> ZAVL e
- assertDelMoveR :: ZAVL e -> ZAVL e
- tryDelMoveR :: ZAVL e -> Maybe (ZAVL e)
- tryDelMoveL :: ZAVL e -> Maybe (ZAVL e)
- delAllL :: ZAVL e -> ZAVL e
- delAllR :: ZAVL e -> ZAVL e
- delAllCloseL :: ZAVL e -> AVL e
- delAllCloseR :: ZAVL e -> AVL e
- delAllIncCloseL :: ZAVL e -> AVL e
- delAllIncCloseR :: ZAVL e -> AVL e
- insertTreeL :: AVL e -> ZAVL e -> ZAVL e
- insertTreeR :: ZAVL e -> AVL e -> ZAVL e
- isLeftmost :: ZAVL e -> Bool
- isRightmost :: ZAVL e -> Bool
- sizeL :: ZAVL e -> Int
- sizeR :: ZAVL e -> Int
- sizeZAVL :: ZAVL e -> Int
- data BAVL e
- openBAVL :: (e -> Ordering) -> AVL e -> BAVL e
- closeBAVL :: BAVL e -> AVL e
- fullBAVL :: BAVL e -> Bool
- emptyBAVL :: BAVL e -> Bool
- tryReadBAVL :: BAVL e -> Maybe e
- readFullBAVL :: BAVL e -> e
- pushBAVL :: e -> BAVL e -> AVL e
- deleteBAVL :: BAVL e -> AVL e
- fullBAVLtoZAVL :: BAVL e -> ZAVL e
- emptyBAVLtoPAVL :: BAVL e -> PAVL e
- anyBAVLtoEither :: BAVL e -> Either (PAVL e) (ZAVL e)
- join :: AVL e -> AVL e -> AVL e
- concatAVL :: [AVL e] -> AVL e
- flatConcat :: [AVL e] -> AVL e
- asListL :: AVL e -> [e]
- toListL :: AVL e -> [e] -> [e]
- asListR :: AVL e -> [e]
- toListR :: AVL e -> [e] -> [e]
- asTreeLenL :: Int -> [e] -> AVL e
- asTreeL :: [e] -> AVL e
- asTreeLenR :: Int -> [e] -> AVL e
- asTreeR :: [e] -> AVL e
- asTree :: (e -> e -> COrdering e) -> [e] -> AVL e
- pushList :: (e -> e -> COrdering e) -> AVL e -> [e] -> AVL e
- reverse :: AVL e -> AVL e
- map :: (a -> b) -> AVL a -> AVL b
- map' :: (a -> b) -> AVL a -> AVL b
- mapAccumL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumR :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumR' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- replicate :: Int -> e -> AVL e
- filter :: (e -> Bool) -> AVL e -> AVL e
- mapMaybe :: (a -> Maybe b) -> AVL a -> AVL b
- filterViaList :: (e -> Bool) -> AVL e -> AVL e
- mapMaybeViaList :: (a -> Maybe b) -> AVL a -> AVL b
- partition :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
- traverseAVL :: Applicative f => (a -> f b) -> AVL a -> f (AVL b)
- foldr :: (e -> a -> a) -> a -> AVL e -> a
- foldr' :: (e -> a -> a) -> a -> AVL e -> a
- foldr1 :: (e -> e -> e) -> AVL e -> e
- foldr1' :: (e -> e -> e) -> AVL e -> e
- foldr2 :: (e -> a -> a) -> (e -> a) -> AVL e -> a
- foldr2' :: (e -> a -> a) -> (e -> a) -> AVL e -> a
- foldl :: (a -> e -> a) -> a -> AVL e -> a
- foldl' :: (a -> e -> a) -> a -> AVL e -> a
- foldl1 :: (e -> e -> e) -> AVL e -> e
- foldl1' :: (e -> e -> e) -> AVL e -> e
- foldl2 :: (a -> e -> a) -> (e -> a) -> AVL e -> a
- foldl2' :: (a -> e -> a) -> (e -> a) -> AVL e -> a
- mapAccumL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)
- mapAccumR'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)
- foldrInt# :: (e -> Int# -> Int#) -> Int# -> AVL e -> Int#
- nub :: Ord a => [a] -> [a]
- nubBy :: (a -> a -> Ordering) -> [a] -> [a]
- flatten :: AVL e -> AVL e
- flatReverse :: AVL e -> AVL e
- flatMap :: (a -> b) -> AVL a -> AVL b
- flatMap' :: (a -> b) -> AVL a -> AVL b
- splitAtL :: Int -> AVL e -> Either Int (AVL e, AVL e)
- splitAtR :: Int -> AVL e -> Either Int (AVL e, AVL e)
- takeL :: Int -> AVL e -> Either Int (AVL e)
- takeR :: Int -> AVL e -> Either Int (AVL e)
- dropL :: Int -> AVL e -> Either Int (AVL e)
- dropR :: Int -> AVL e -> Either Int (AVL e)
- rotateL :: AVL e -> AVL e
- rotateR :: AVL e -> AVL e
- popRotateL :: AVL e -> (e, AVL e)
- popRotateR :: AVL e -> (AVL e, e)
- rotateByL :: AVL e -> Int -> AVL e
- rotateByR :: AVL e -> Int -> AVL e
- spanL :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
- spanR :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
- takeWhileL :: (e -> Bool) -> AVL e -> AVL e
- dropWhileL :: (e -> Bool) -> AVL e -> AVL e
- takeWhileR :: (e -> Bool) -> AVL e -> AVL e
- dropWhileR :: (e -> Bool) -> AVL e -> AVL e
- forkL :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)
- forkR :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)
- fork :: (e -> COrdering a) -> AVL e -> (AVL e, Maybe a, AVL e)
- takeLE :: (e -> Ordering) -> AVL e -> AVL e
- dropGT :: (e -> Ordering) -> AVL e -> AVL e
- takeLT :: (e -> Ordering) -> AVL e -> AVL e
- dropGE :: (e -> Ordering) -> AVL e -> AVL e
- takeGT :: (e -> Ordering) -> AVL e -> AVL e
- dropLE :: (e -> Ordering) -> AVL e -> AVL e
- takeGE :: (e -> Ordering) -> AVL e -> AVL e
- dropLT :: (e -> Ordering) -> AVL e -> AVL e
- size :: AVL e -> Int
- addSize :: Int -> AVL e -> Int
- clipSize :: Int -> AVL e -> Maybe Int
- addSize# :: Int# -> AVL e -> Int#
- size# :: AVL e -> Int#
- height :: AVL e -> Int#
- addHeight :: Int# -> AVL e -> Int#
- compareHeight :: AVL a -> AVL b -> Ordering
- data BinPath a
- findFullPath :: (e -> Ordering) -> AVL e -> Int#
- findEmptyPath :: (e -> Ordering) -> AVL e -> Int#
- openPath :: (e -> Ordering) -> AVL e -> BinPath e
- openPathWith :: (e -> COrdering a) -> AVL e -> BinPath a
- readPath :: Int# -> AVL e -> e
- writePath :: Int# -> e -> AVL e -> AVL e
- insertPath :: Int# -> e -> AVL e -> AVL e
- deletePath :: Int# -> AVL e -> AVL e
- isBalanced :: AVL e -> Bool
- isSorted :: (e -> e -> Ordering) -> AVL e -> Bool
- isSortedOK :: (e -> e -> Ordering) -> AVL e -> Bool
- minElements :: Int -> Integer
- maxElements :: Int -> Integer
- genUnion :: (e -> e -> COrdering e) -> AVL e -> AVL e -> AVL e
- genUnionMaybe :: (e -> e -> COrdering (Maybe e)) -> AVL e -> AVL e -> AVL e
- genDisjointUnion :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
- genUnions :: (e -> e -> COrdering e) -> [AVL e] -> AVL e
- genDifference :: (a -> b -> Ordering) -> AVL a -> AVL b -> AVL a
- genDifferenceMaybe :: (a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL a
- genSymDifference :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL e
- genIntersection :: (a -> b -> COrdering c) -> AVL a -> AVL b -> AVL c
- genIntersectionMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL c
- genIntersectionToListL :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]
- genIntersectionAsListL :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]
- genIntersectionMaybeToListL :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]
- genIntersectionMaybeAsListL :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]
- genVenn :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
- genVennMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)
- genVennToList :: (a -> b -> COrdering c) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- genVennAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- genVennMaybeToList :: (a -> b -> COrdering (Maybe c)) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- genVennMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, [c], AVL b)
- genIsSubsetOf :: (a -> b -> Ordering) -> AVL a -> AVL b -> Bool
- genIsSubsetOfBy :: (a -> b -> COrdering Bool) -> AVL a -> AVL b -> Bool
- genAssertRead :: AVL e -> (e -> COrdering a) -> a
- genTryRead :: AVL e -> (e -> COrdering a) -> Maybe a
- genTryReadMaybe :: AVL e -> (e -> COrdering (Maybe a)) -> Maybe a
- genDefaultRead :: a -> AVL e -> (e -> COrdering a) -> a
- genContains :: AVL e -> (e -> Ordering) -> Bool
- genWrite :: (e -> COrdering e) -> AVL e -> AVL e
- genWriteFast :: (e -> COrdering e) -> AVL e -> AVL e
- genTryWrite :: (e -> COrdering e) -> AVL e -> Maybe (AVL e)
- genWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
- genTryWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> Maybe (AVL e)
- genDel :: (e -> Ordering) -> AVL e -> AVL e
- genDelFast :: (e -> Ordering) -> AVL e -> AVL e
- genDelIf :: (e -> COrdering Bool) -> AVL e -> AVL e
- genDelMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL e
- genAssertPop :: (e -> COrdering a) -> AVL e -> (a, AVL e)
- genTryPop :: (e -> COrdering a) -> AVL e -> Maybe (a, AVL e)
- genAssertPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> (a, AVL e)
- genTryPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> Maybe (a, AVL e)
- genAssertPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> (a, AVL e)
- genTryPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> Maybe (a, AVL e)
- genPush :: (e -> COrdering e) -> e -> AVL e -> AVL e
- genPush' :: (e -> COrdering e) -> e -> AVL e -> AVL e
- genPushMaybe :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
- genPushMaybe' :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL e
- genAsTree :: (e -> e -> COrdering e) -> [e] -> AVL e
- genForkL :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)
- genForkR :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)
- genFork :: (e -> COrdering a) -> AVL e -> (AVL e, Maybe a, AVL e)
- genTakeLE :: (e -> Ordering) -> AVL e -> AVL e
- genDropGT :: (e -> Ordering) -> AVL e -> AVL e
- genTakeLT :: (e -> Ordering) -> AVL e -> AVL e
- genDropGE :: (e -> Ordering) -> AVL e -> AVL e
- genTakeGT :: (e -> Ordering) -> AVL e -> AVL e
- genDropLE :: (e -> Ordering) -> AVL e -> AVL e
- genTakeGE :: (e -> Ordering) -> AVL e -> AVL e
- genDropLT :: (e -> Ordering) -> AVL e -> AVL e
- genAssertOpen :: (e -> Ordering) -> AVL e -> ZAVL e
- genTryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
- genTryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
- genTryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)
- genOpenEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)
- genOpenBAVL :: (e -> Ordering) -> AVL e -> BAVL e
- genFindPath :: (e -> Ordering) -> AVL e -> Int#
- genOpenPath :: (e -> Ordering) -> AVL e -> BinPath e
- genOpenPathWith :: (e -> COrdering a) -> AVL e -> BinPath a
- fastAddSize :: Int# -> AVL e -> Int#
- reverseAVL :: AVL e -> AVL e
- mapAVL :: (a -> b) -> AVL a -> AVL b
- mapAVL' :: (a -> b) -> AVL a -> AVL b
- mapAccumLAVL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumRAVL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumLAVL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumRAVL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)
- mapAccumLAVL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)
- mapAccumRAVL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)
- replicateAVL :: Int -> e -> AVL e
- filterAVL :: (e -> Bool) -> AVL e -> AVL e
- mapMaybeAVL :: (a -> Maybe b) -> AVL a -> AVL b
- partitionAVL :: (e -> Bool) -> AVL e -> (AVL e, AVL e)
- foldrAVL :: (e -> a -> a) -> a -> AVL e -> a
- foldrAVL' :: (e -> a -> a) -> a -> AVL e -> a
- foldr1AVL :: (e -> e -> e) -> AVL e -> e
- foldr1AVL' :: (e -> e -> e) -> AVL e -> e
- foldr2AVL :: (e -> a -> a) -> (e -> a) -> AVL e -> a
- foldr2AVL' :: (e -> a -> a) -> (e -> a) -> AVL e -> a
- foldlAVL :: (a -> e -> a) -> a -> AVL e -> a
- foldlAVL' :: (a -> e -> a) -> a -> AVL e -> a
- foldl1AVL :: (e -> e -> e) -> AVL e -> e
- foldl1AVL' :: (e -> e -> e) -> AVL e -> e
- foldl2AVL :: (a -> e -> a) -> (e -> a) -> AVL e -> a
- foldl2AVL' :: (a -> e -> a) -> (e -> a) -> AVL e -> a
- foldrAVL_UINT :: (e -> Int# -> Int#) -> Int# -> AVL e -> Int#
- findPath :: (e -> Ordering) -> AVL e -> Int#
Types.
AVL tree data type.
The balance factor (BF) of an AVL
tree node is defined as the difference between the height of
the left and right sub-trees. An AVL
tree is ALWAYS height balanced, such that |BF| <= 1.
The functions in this library (Data.Tree.AVL) are designed so that they never construct
an unbalanced tree (well that's assuming they're not broken). The AVL
tree type defined here
has the BF encoded the constructors.
Some functions in this library return AVL
trees that are also "flat", which (in the context
of this library) means that the sizes of left and right sub-trees differ by at most one and
are also flat. Flat sorted trees should give slightly shorter searches than sorted trees which
are merely height balanced. Whether or not flattening is worth the effort depends on the number
of times the tree will be searched and the cost of element comparison.
In cases where the tree elements are sorted, all the relevant AVL
functions follow the
convention that the leftmost tree element is least and the rightmost tree element is
the greatest. Bear this in mind when defining general comparison functions. It should
also be noted that all functions in this library for sorted trees require that the tree
does not contain multiple elements which are "equal" (according to whatever criterion
has been used to sort the elements).
It is important to be consistent about argument ordering when defining general purpose comparison functions (or selectors) for searching a sorted tree, such as ..
myComp :: (k -> e -> Ordering) -- or.. myCComp :: (k -> e -> COrdering a)
In these cases the first argument is the search key and the second argument is an element of
the AVL
tree. For example..
key `myCComp` element -> Lt implies key < element, proceed down the left sub-tree key `myCComp` element -> Gt implies key > element, proceed down the right sub-tree
This convention is same as that used by the overloaded compare
method from Ord
class.
Controlling Strictness.
The AVL
tree data type is declared as non-strict in all it's fields,
but all the functions in this library behave as though it is strict in its
recursive fields (left and right sub-trees). Strictness in the element field is
controlled either by using the strict variants of functions (defined in this library
where appropriate), or using strict variants of the combinators defined in Data.COrdering,
or using seq
etc. in your own code (in any combining comparisons you define, for example).
Begining with version 3.0 these are now derived, and hence are defined in terms of strict structural equality, rather than observational equivalence. The reason for this change is that the observational equivalence abstraction was technically breakable with the exposed API. But since this change, some functions which were previously considered unsafe have become safe to expose (those that measure tree height, for example).
Begining with version 4.0 these are now derived to ensure consistency with Eq
instance.
(Show now reveals the exact tree structure).
Simple AVL related utilities.
isNonEmpty :: AVL e -> BoolSource
Returns True
if an AVL tree is non-empty.
Complexity: O(1)
Create an AVL tree of two elements, occuring in same order as the arguments.
tryGetSingleton :: AVL e -> Maybe eSource
If the AVL tree is a singleton (has only one element e
) then this function returns (
.
Otherwise it returns Nothing.
Just
e)
Complexity: O(1)
Reading from AVL trees
Reading from extreme left or right
assertReadL :: AVL e -> eSource
Read the leftmost element from a non-empty tree. Raises an error if the tree is empty. If the tree is sorted this will return the least element.
Complexity: O(log n)
tryReadL :: AVL e -> Maybe eSource
Similar to assertReadL
but returns Nothing
if the tree is empty.
Complexity: O(log n)
assertReadR :: AVL e -> eSource
Read the rightmost element from a non-empty tree. Raises an error if the tree is empty. If the tree is sorted this will return the greatest element.
Complexity: O(log n)
tryReadR :: AVL e -> Maybe eSource
Similar to assertReadR
but returns Nothing
if the tree is empty.
Complexity: O(log n)
Reading from sorted AVL trees
assertRead :: AVL e -> (e -> COrdering a) -> aSource
General purpose function to perform a search of a sorted tree, using the supplied selector. This function raises a error if the search fails.
Complexity: O(log n)
tryRead :: AVL e -> (e -> COrdering a) -> Maybe aSource
General purpose function to perform a search of a sorted tree, using the supplied selector.
This function is similar to assertRead
, but returns Nothing
if the search failed.
Complexity: O(log n)
defaultRead :: a -> AVL e -> (e -> COrdering a) -> aSource
General purpose function to perform a search of a sorted tree, using the supplied selector.
This function is similar to assertRead
, but returns a the default value (first argument) if
the search fails.
Complexity: O(log n)
Simple searches of sorted AVL trees
contains :: AVL e -> (e -> Ordering) -> BoolSource
General purpose function to perform a search of a sorted tree, using the supplied selector. Returns True if matching element is found.
Complexity: O(log n)
Writing to AVL trees
These functions alter the content of a tree (values of tree elements) but not the structure of a tree.
Writing to extreme left or right
I'm not sure these are likely to be much use in practice, but they're simple enough to implement so are included for the sake of completeness.
writeL :: e -> AVL e -> AVL eSource
Replace the left most element of a tree with the supplied new element. This function raises an error if applied to an empty tree.
Complexity: O(log n)
writeR :: AVL e -> e -> AVL eSource
Replace the right most element of a tree with the supplied new element. This function raises an error if applied to an empty tree.
Complexity: O(log n)
Writing to sorted trees
write :: (e -> COrdering e) -> AVL e -> AVL eSource
A general purpose function to perform a search of a tree, using the supplied selector.
If the search succeeds the found element is replaced by the value (e
) of the (
constructor returned by the selector. If the search fails this function returns the original tree.
Eq
e)
Complexity: O(log n)
writeFast :: (e -> COrdering e) -> AVL e -> AVL eSource
Functionally identical to write
, but returns an identical tree (one with all the nodes on
the path duplicated) if the search fails. This should probably only be used if you know the
search will succeed and will return an element which is different from that already present.
Complexity: O(log n)
"Pushing" new elements into AVL trees
"Pushing" is another word for insertion. (c.f "Popping".)
Pushing on extreme left or right
pushL :: e -> AVL e -> AVL eSource
Push a new element in the leftmost position of an AVL tree. No comparison or searching is involved.
Complexity: O(log n)
pushR :: AVL e -> e -> AVL eSource
Push a new element in the rightmost position of an AVL tree. No comparison or searching is involved.
Complexity: O(log n)
Pushing on sorted AVL trees
push :: (e -> COrdering e) -> e -> AVL e -> AVL eSource
General push. This function searches the AVL tree using the supplied selector. If a matching element
is found it's replaced by the value (e
) returned in the (
constructor returned by the selector.
If no match is found then the default element value is added at in the appropriate position in the tree.
Eq
e)
Note that for this to work properly requires that the selector behave as if it were comparing the (potentially) new default element with existing tree elements, even if it isn't.
Note also that this function is non-strict in it's second argument (the default value which
is inserted if the search fails or is discarded if the search succeeds). If you want
to force evaluation, but only if it's actually incorprated in the tree, then use push'
Complexity: O(log n)
push' :: (e -> COrdering e) -> e -> AVL e -> AVL eSource
Almost identical to push
, but this version forces evaluation of the default new element
(second argument) if no matching element is found. Note that it does not do this if
a matching element is found, because in this case the default new element is discarded
anyway. Note also that it does not force evaluation of any replacement value provided by the
selector (if it returns Eq). (You have to do that yourself if that's what you want.)
Complexity: O(log n)
pushMaybe :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL eSource
Similar to push
, but returns the original tree if the combining comparison returns
(
. So this function can be used reduce heap burn rate by avoiding duplication
of nodes on the insertion path. But it may also be marginally slower otherwise.
Eq
Nothing
)
Note that this function is non-strict in it's second argument (the default value which
is inserted in the search fails or is discarded if the search succeeds). If you want
to force evaluation, but only if it's actually incorprated in the tree, then use pushMaybe'
Complexity: O(log n)
pushMaybe' :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL eSource
Almost identical to pushMaybe
, but this version forces evaluation of the default new element
(second argument) if no matching element is found. Note that it does not do this if
a matching element is found, because in this case the default new element is discarded
anyway.
Complexity: O(log n)
Deleting elements from AVL trees
Deleting from extreme left or right
Delete the left-most element of an AVL tree. If the tree is sorted this will be the least element. This function returns an empty tree if it's argument is an empty tree.
Complexity: O(log n)
Delete the right-most element of an AVL tree. If the tree is sorted this will be the greatest element. This function returns an empty tree if it's argument is an empty tree.
Complexity: O(log n)
assertDelL :: AVL e -> AVL eSource
Delete the left-most element of a non-empty AVL tree. If the tree is sorted this will be the least element. This function raises an error if it's argument is an empty tree.
Complexity: O(log n)
assertDelR :: AVL e -> AVL eSource
Delete the right-most element of a non-empty AVL tree. If the tree is sorted this will be the greatest element. This function raises an error if it's argument is an empty tree.
Complexity: O(log n)
tryDelL :: AVL e -> Maybe (AVL e)Source
Try to delete the left-most element of a non-empty AVL tree. If the tree is sorted this will be the
least element. This function returns Nothing
if it's argument is an empty tree.
Complexity: O(log n)
tryDelR :: AVL e -> Maybe (AVL e)Source
Try to delete the right-most element of a non-empty AVL tree. If the tree is sorted this will be the
greatest element. This function returns Nothing
if it's argument is an empty tree.
Complexity: O(log n)
Deleting from sorted trees
delete :: (e -> Ordering) -> AVL e -> AVL eSource
General purpose function for deletion of elements from a sorted AVL tree. If a matching element is not found then this function returns the original tree.
Complexity: O(log n)
deleteFast :: (e -> Ordering) -> AVL e -> AVL eSource
Functionally identical to delete
, but returns an identical tree (one with all the nodes on
the path duplicated) if the search fails. This should probably only be used if you know the
search will succeed.
Complexity: O(log n)
"Popping" elements from AVL trees
"Popping" means reading and deleting a tree element in a single operation.
Popping from extreme left or right
assertPopL :: AVL e -> (e, AVL e)Source
Pop the left-most element from a non-empty AVL tree, returning the popped element and the modified AVL tree. If the tree is sorted this will be the least element. This function raises an error if it's argument is an empty tree.
Complexity: O(log n)
assertPopR :: AVL e -> (AVL e, e)Source
Pop the right-most element from a non-empty AVL tree, returning the popped element and the modified AVL tree. If the tree is sorted this will be the greatest element. This function raises an error if it's argument is an empty tree.
Complexity: O(log n)
tryPopL :: AVL e -> Maybe (e, AVL e)Source
Same as assertPopL
, except this version returns Nothing
if it's argument is an empty tree.
Complexity: O(log n)
tryPopR :: AVL e -> Maybe (AVL e, e)Source
Same as assertPopR
, except this version returns Nothing
if it's argument is an empty tree.
Complexity: O(log n)
Popping from sorted trees
assertPop :: (e -> COrdering a) -> AVL e -> (a, AVL e)Source
General purpose function for popping elements from a sorted AVL tree. An error is raised if a matching element is not found. The pair returned by this function consists of the popped value and the modified tree.
Complexity: O(log n)
tryPop :: (e -> COrdering a) -> AVL e -> Maybe (a, AVL e)Source
Similar to genPop
, but this function returns Nothing
if the search fails.
Complexity: O(log n)
assertPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> (a, AVL e)Source
In this case the selector returns two values if a search succeeds.
If the second is (
then the new value (Just
e)e
) is substituted in the same place in the tree.
If the second is Nothing
then the corresponding tree element is deleted.
This function raises an error if the search fails.
Complexity: O(log n)
tryPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> Maybe (a, AVL e)Source
Similar to assertPopMaybe
, but returns Nothing
if the search fails.
Complexity: O(log n)
assertPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> (a, AVL e)Source
A simpler version of assertPopMaybe
. The corresponding element is deleted if the second value
returned by the selector is True
. If it's False
, the original tree is returned.
This function raises an error if the search fails.
Complexity: O(log n)
tryPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> Maybe (a, AVL e)Source
Similar to genPopIf
, but returns Nothing
if the search fails.
Complexity: O(log n)
Set operations
Functions for manipulating AVL trees which represent ordered sets (I.E. sorted trees). Note that although many of these functions work with a variety of different element types they all require that elements are sorted according to the same criterion (such as a field value in a record).
Union
union :: (e -> e -> COrdering e) -> AVL e -> AVL e -> AVL eSource
Uses the supplied combining comparison to evaluate the union of two sets represented as sorted AVL trees. Whenever the combining comparison is applied, the first comparison argument is an element of the first tree and the second comparison argument is an element of the second tree.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
unionMaybe :: (e -> e -> COrdering (Maybe e)) -> AVL e -> AVL e -> AVL eSource
Similar to union
, but the resulting tree does not include elements in cases where
the supplied combining comparison returns (Eq Nothing)
.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
disjointUnion :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL eSource
Uses the supplied comparison to evaluate the union of two disjoint sets represented as
sorted AVL trees. It will be slightly faster than union
but will raise an error if the
two sets intersect. Typically this would be used to re-combine the "post-munge" results
from one of the "venn" operations.
Complexity: Not sure, but I'd appreciate it if someone could figure it out. (Faster than Hedge union from Data.Set at any rate).
unions :: (e -> e -> COrdering e) -> [AVL e] -> AVL eSource
Uses the supplied combining comparison to evaluate the union of all sets in a list of sets represented as sorted AVL trees. Behaves as if defined..
unions ccmp avls = foldl' (union
ccmp) empty avls
Difference
difference :: (a -> b -> Ordering) -> AVL a -> AVL b -> AVL aSource
Uses the supplied comparison to evaluate the difference between two sets represented as sorted AVL trees. The expression..
difference cmp setA setB
.. is a set containing all those elements of setA
which do not appear in setB
.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
differenceMaybe :: (a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL aSource
Similar to difference
, but the resulting tree also includes those elements a' for which the
combining comparison returns (Eq (Just a'))
.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
symDifference :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL eSource
The symmetric difference is the set of elements which occur in one set or the other but not both.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
Intersection
intersection :: (a -> b -> COrdering c) -> AVL a -> AVL b -> AVL cSource
Uses the supplied combining comparison to evaluate the intersection of two sets represented as sorted AVL trees.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
intersectionMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL cSource
Similar to intersection
, but the resulting tree does not include elements in cases where
the supplied combining comparison returns (Eq Nothing)
.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
Intersection with the result as a list
Sometimes you don't want intersection to give a tree, particularly if the resulting elements are not orderered or sorted according to whatever criterion was used to sort the elements of the input sets.
The reason these variants are provided for intersection only (and not the other set functions) is that the (tree returning) intersections always construct an entirely new tree, whereas with the others the resulting tree will typically share sub-trees with one or both of the originals. (Of course the results of the others can easily be converted to a list too if required.)
intersectionToList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]Source
Similar to intersection
, but prepends the result to the supplied list in
ascending order. This is a (++) free function which behaves as if defined:
intersectionToList c setA setB cs = asListL (intersection c setA setB) ++ cs
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
intersectionAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]Source
Applies intersectionToList
to the empty list.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
intersectionMaybeToList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]Source
Similar to intersectionToList
, but the result does not include elements in cases where
the supplied combining comparison returns (Eq Nothing)
.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
intersectionMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]Source
Applies intersectionMaybeToList
to the empty list.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
'Venn diagram' operations
Given two sets A and B represented as sorted AVL trees, the venn operations evaluate
components A-B
, A.B
and B-A
. The intersection part may be obtained as a List
rather than AVL tree if required.
Note that in all cases the three resulting sets are disjoint and can safely be re-combined
after most "munging" operations using disjointUnion
.
venn :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)Source
Given two Sets A
and B
represented as sorted AVL trees, this function
extracts the 'Venn diagram' components A-B
, A.B
and B-A
.
See also vennMaybe
.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
'Venn diagram' operations with the intersection component as a List.
These variants are provided for the same reasons as the Intersection as List variants.
vennToList :: (a -> b -> COrdering c) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
Same as venn
, but prepends the intersection component to the supplied list
in ascending order.
vennAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
Same as venn
, but returns the intersection component as a list in ascending order.
This is just vennToList
applied to an empty initial intersection list.
vennMaybeToList :: (a -> b -> COrdering (Maybe c)) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
Same as vennMaybe
, but prepends the intersection component to the supplied list
in ascending order.
vennMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
Same as vennMaybe
, but returns the intersection component as a list in ascending order.
This is just vennMaybeToList
applied to an empty initial intersection list.
Subset
isSubsetOf :: (a -> b -> Ordering) -> AVL a -> AVL b -> BoolSource
Uses the supplied comparison to test whether the first set is a subset of the second, both sets being represented as sorted AVL trees. This function returns True if any of the following conditions hold..
- The first set is empty (the empty set is a subset of any set).
- The two sets are equal.
- The first set is a proper subset of the second set.
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
isSubsetOfBy :: (a -> b -> COrdering Bool) -> AVL a -> AVL b -> BoolSource
Similar to isSubsetOf
, but also requires that the supplied combining
comparison returns (
for matching elements.
Eq
True)
Complexity: Not sure, but I'd appreciate it if someone could figure it out.
The AVL Zipper
An implementation of "The Zipper" for AVL trees. This can be used like a functional pointer to a serial data structure which can be navigated and modified, without having to worry about all those tricky tree balancing issues. See JFP Vol.7 part 5 or ..
http://haskell.org/haskellwiki/Zipper
Notes about efficiency:
The functions defined here provide a useful way to achieve those awkward operations which may not be covered by the rest of this package. They're reasonably efficient (mostly O(log n) or better), but zipper flexibility is bought at the expense of keeping path information explicitly as a heap data structure rather than implicitly on the stack. Since heap storage probably costs more, zipper operations will are likely to incur higher constant factors than equivalent non-zipper operations (if available).
Some of the functions provided here may appear to be weird combinations of functions from a more logical set of primitives. They are provided because they are not really simple combinations of the corresponding primitives. They are more efficient, so you should use them if possible (e.g combining deleting with Zipper closing).
Also, consider using the BAVL
as a cheaper alternative if you don't
need to navigate the tree.
Types
Abstract data type for a successfully opened AVL tree. All ZAVL's are non-empty! A ZAVL can be tought of as a functional pointer to an AVL tree element.
Opening
assertOpenL :: AVL e -> ZAVL eSource
Opens a non-empty AVL tree at the leftmost element. This function raises an error if the tree is empty.
Complexity: O(log n)
assertOpenR :: AVL e -> ZAVL eSource
Opens a non-empty AVL tree at the rightmost element. This function raises an error if the tree is empty.
Complexity: O(log n)
tryOpenL :: AVL e -> Maybe (ZAVL e)Source
Attempts to open a non-empty AVL tree at the leftmost element.
This function returns Nothing
if the tree is empty.
Complexity: O(log n)
tryOpenR :: AVL e -> Maybe (ZAVL e)Source
Attempts to open a non-empty AVL tree at the rightmost element.
This function returns Nothing
if the tree is empty.
Complexity: O(log n)
assertOpen :: (e -> Ordering) -> AVL e -> ZAVL eSource
Opens a sorted AVL tree at the element given by the supplied selector. This function raises an error if the tree does not contain such an element.
Complexity: O(log n)
tryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)Source
Attempts to open a sorted AVL tree at the element given by the supplied selector.
This function returns Nothing
if there is no such element.
Note that this operation will still create a zipper path structure on the heap (which
is promptly discarded) if the search fails, and so is potentially inefficient if failure
is likely. In cases like this it may be better to use openBAVL
, test for "fullness"
using fullBAVL
and then convert to a ZAVL
using fullBAVLtoZAVL
.
Complexity: O(log n)
tryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)Source
Attempts to open a sorted AVL tree at the least element which is greater than or equal, according to
the supplied selector. This function returns Nothing
if the tree does not contain such an element.
Complexity: O(log n)
tryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)Source
Attempts to open a sorted AVL tree at the greatest element which is less than or equal, according to the supplied selector. This function returns _Nothing_ if the tree does not contain such an element.
Complexity: O(log n)
Closing
Manipulating the current element.
getCurrent :: ZAVL e -> eSource
Gets the current element of a Zipper.
Complexity: O(1)
putCurrent :: e -> ZAVL e -> ZAVL eSource
Overwrites the current element of a Zipper.
Complexity: O(1)
applyCurrent :: (e -> e) -> ZAVL e -> ZAVL eSource
Applies a function to the current element of a Zipper (lazily).
See also applyCurrent'
for a strict version of this function.
Complexity: O(1)
applyCurrent' :: (e -> e) -> ZAVL e -> ZAVL eSource
Applies a function to the current element of a Zipper strictly.
See also applyCurrent
for a non-strict version of this function.
Complexity: O(1)
Moving
assertMoveL :: ZAVL e -> ZAVL eSource
Moves one step left. This function raises an error if the current element is already the leftmost element.
Complexity: O(1) average, O(log n) worst case.
assertMoveR :: ZAVL e -> ZAVL eSource
Moves one step right. This function raises an error if the current element is already the rightmost element.
Complexity: O(1) average, O(log n) worst case.
tryMoveL :: ZAVL e -> Maybe (ZAVL e)Source
Attempts to move one step left.
This function returns Nothing
if the current element is already the leftmost element.
Complexity: O(1) average, O(log n) worst case.
tryMoveR :: ZAVL e -> Maybe (ZAVL e)Source
Attempts to move one step right.
This function returns Nothing
if the current element is already the rightmost element.
Complexity: O(1) average, O(log n) worst case.
Inserting elements
insertL :: e -> ZAVL e -> ZAVL eSource
Inserts a new element to the immediate left of the current element.
Complexity: O(1) average, O(log n) worst case.
insertR :: ZAVL e -> e -> ZAVL eSource
Inserts a new element to the immediate right of the current element.
Complexity: O(1) average, O(log n) worst case.
insertMoveL :: e -> ZAVL e -> ZAVL eSource
Inserts a new element to the immediate left of the current element and then moves one step left (so the newly inserted element becomes the current element).
Complexity: O(1) average, O(log n) worst case.
insertMoveR :: ZAVL e -> e -> ZAVL eSource
Inserts a new element to the immediate right of the current element and then moves one step right (so the newly inserted element becomes the current element).
Complexity: O(1) average, O(log n) worst case.
Deleting elements
delClose :: ZAVL e -> AVL eSource
Deletes the current element and then closes the Zipper.
Complexity: O(log n)
assertDelMoveL :: ZAVL e -> ZAVL eSource
Deletes the current element and moves one step left. This function raises an error if the current element is already the leftmost element.
Complexity: O(1) average, O(log n) worst case.
assertDelMoveR :: ZAVL e -> ZAVL eSource
Deletes the current element and moves one step right. This function raises an error if the current element is already the rightmost element.
Complexity: O(1) average, O(log n) worst case.
tryDelMoveR :: ZAVL e -> Maybe (ZAVL e)Source
Attempts to delete the current element and move one step right.
This function returns Nothing
if the current element is already the rightmost element.
Complexity: O(1) average, O(log n) worst case.
tryDelMoveL :: ZAVL e -> Maybe (ZAVL e)Source
Attempts to delete the current element and move one step left.
This function returns Nothing
if the current element is already the leftmost element.
Complexity: O(1) average, O(log n) worst case.
delAllL :: ZAVL e -> ZAVL eSource
Delete all elements to the left of the current element.
Complexity: O(log n)
delAllR :: ZAVL e -> ZAVL eSource
Delete all elements to the right of the current element.
Complexity: O(log n)
delAllCloseL :: ZAVL e -> AVL eSource
Similar to delAllL
, in that all elements to the left of the current element are deleted,
but this function also closes the tree in the process.
Complexity: O(log n)
delAllCloseR :: ZAVL e -> AVL eSource
Similar to delAllR
, in that all elements to the right of the current element are deleted,
but this function also closes the tree in the process.
Complexity: O(log n)
delAllIncCloseL :: ZAVL e -> AVL eSource
Similar to delAllCloseL
, but in this case the current element and all
those to the left of the current element are deleted.
Complexity: O(log n)
delAllIncCloseR :: ZAVL e -> AVL eSource
Similar to delAllCloseR
, but in this case the current element and all
those to the right of the current element are deleted.
Complexity: O(log n)
Inserting AVL trees
insertTreeL :: AVL e -> ZAVL e -> ZAVL eSource
Inserts a new AVL tree to the immediate left of the current element.
Complexity: O(log n), where n is the size of the inserted tree.
insertTreeR :: ZAVL e -> AVL e -> ZAVL eSource
Inserts a new AVL tree to the immediate right of the current element.
Complexity: O(log n), where n is the size of the inserted tree.
Current element status
isLeftmost :: ZAVL e -> BoolSource
Returns True
if the current element is the leftmost element.
Complexity: O(1) average, O(log n) worst case.
isRightmost :: ZAVL e -> BoolSource
Returns True
if the current element is the rightmost element.
Complexity: O(1) average, O(log n) worst case.
Counts the number of elements to the left of the current element (this does not include the current element).
Complexity: O(n), where n is the count result.
Counts the number of elements to the right of the current element (this does not include the current element).
Complexity: O(n), where n is the count result.
Operations on whole zippers
A cheaper option is to use BAVL
These are a cheaper but more restrictive alternative to using the full Zipper.
They use "Binary Paths" (Ints) to point to a particular element of an AVL
tree.
Use these when you don't need to navigate the tree, you just want to look at a
particular element (and perhaps modify or delete it). The advantage of these is
that they don't create the usual Zipper heap structure, so they will be faster
(and reduce heap burn rate too).
If you subsequently decide you need a Zipper rather than a BAVL then some conversion utilities are provided.
Types
Opening and closing
closeBAVL :: BAVL e -> AVL eSource
Returns the original tree, extracted from the BAVL
. Typically you will not need this, as
the original tree will still be in scope in most cases.
Complexity: O(1)
Inspecting status
tryReadBAVL :: BAVL e -> Maybe eSource
readFullBAVL :: BAVL e -> eSource
Modifying the tree
pushBAVL :: e -> BAVL e -> AVL eSource
If the BAVL
is "full", this function returns the original tree with the corresponding
element replaced by the new element (first argument). If it's "empty" the original tree is returned
with the new element inserted.
Complexity: O(log n)
deleteBAVL :: BAVL e -> AVL eSource
Converting to BAVL to Zipper
These are O(log n) operations but with low constant factors because no comparisons are required (and the tree nodes on the path will most likely still be in cache as a result of opening the BAVL in the first place).
fullBAVLtoZAVL :: BAVL e -> ZAVL eSource
emptyBAVLtoPAVL :: BAVL e -> PAVL eSource
Joining AVL trees
join :: AVL e -> AVL e -> AVL eSource
Join two AVL trees. This is the AVL equivalent of (++).
asListL (l `join` r) = asListL l ++ asListL r
Complexity: O(log n), where n is the size of the larger of the two trees.
concatAVL :: [AVL e] -> AVL eSource
Concatenate a finite list of AVL trees. During construction of the resulting tree the input list is consumed lazily, but it will be consumed entirely before the result is returned.
asListL (concatAVL avls) = concatMap asListL avls
Complexity: Umm..Dunno. Uses a divide and conquer approach to splice adjacent pairs of trees in the list recursively, until only one tree remains. The complexity of each splice is proportional to the difference in tree heights.
flatConcat :: [AVL e] -> AVL eSource
Similar to concatAVL
, except the resulting tree is flat.
This function evaluates the entire list of trees before constructing the result.
Complexity: O(n), where n is the total number of elements in the resulting tree.
List related utilities for AVL trees
Converting AVL trees to Lists (fixed element order).
These functions are lazy and allow normal lazy list processing style to be used (without necessarily converting the entire tree to a list in one gulp).
List AVL tree contents in left to right order. The resulting list in ascending order if the tree is sorted.
Complexity: O(n)
toListL :: AVL e -> [e] -> [e]Source
Join the AVL tree contents to an existing list in left to right order. This is a ++ free function which behaves as if defined thusly..
avl `toListL` as = (asListL avl) ++ as
Complexity: O(n)
List AVL tree contents in right to left order. The resulting list in descending order if the tree is sorted.
Complexity: O(n)
toListR :: AVL e -> [e] -> [e]Source
Join the AVL tree contents to an existing list in right to left order. This is a ++ free function which behaves as if defined thusly..
avl `toListR` as = (asListR avl) ++ as
Complexity: O(n)
Converting Lists to AVL trees (fixed element order)
asTreeLenL :: Int -> [e] -> AVL eSource
Convert a list of known length into an AVL tree, such that the head of the list becomes the leftmost tree element. The resulting tree is flat (and also sorted if the supplied list is sorted in ascending order).
If the actual length of the list is not the same as the supplied length then an error will be raised.
Complexity: O(n)
As asTreeLenL
, except the length of the list is calculated internally, not supplied
as an argument.
Complexity: O(n)
asTreeLenR :: Int -> [e] -> AVL eSource
Convert a list of known length into an AVL tree, such that the head of the list becomes the rightmost tree element. The resulting tree is flat (and also sorted if the supplied list is sorted in descending order).
If the actual length of the list is not the same as the supplied length then an error will be raised.
Complexity: O(n)
As asTreeLenR
, except the length of the list is calculated internally, not supplied
as an argument.
Complexity: O(n)
Converting unsorted Lists to sorted AVL trees
asTree :: (e -> e -> COrdering e) -> [e] -> AVL eSource
Invokes pushList
on the empty AVL tree.
Complexity: O(n.(log n))
"Pushing" unsorted Lists in sorted AVL trees
pushList :: (e -> e -> COrdering e) -> AVL e -> [e] -> AVL eSource
Push the elements of an unsorted List in a sorted AVL tree using the supplied combining comparison.
Complexity: O(n.(log (m+n))) where n is the list length, m is the tree size.
Some analogues of common List functions
reverse :: AVL e -> AVL eSource
Reverse an AVL tree (swaps and reverses left and right sub-trees). The resulting tree is the mirror image of the original.
Complexity: O(n)
map :: (a -> b) -> AVL a -> AVL bSource
Apply a function to every element in an AVL tree. This function preserves the tree shape.
There is also a strict version of this function (map'
).
N.B. If the tree is sorted the result of this operation will only be sorted if the applied function preserves ordering (for some suitable ordering definition).
Complexity: O(n)
map' :: (a -> b) -> AVL a -> AVL bSource
Similar to map
, but the supplied function is applied strictly.
Complexity: O(n)
mapAccumL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
The AVL equivalent of Data.List.mapAccumL
on lists.
It behaves like a combination of map
and foldl
.
It applies a function to each element of a tree, passing an accumulating parameter from
left to right, and returning a final value of this accumulator together with the new tree.
Using this version with a function that is strict in it's first argument will result in
O(n) stack use. See mapAccumL'
for a strict version.
Complexity: O(n)
mapAccumR :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
The AVL equivalent of Data.List.mapAccumR
on lists.
It behaves like a combination of map
and foldr
.
It applies a function to each element of a tree, passing an accumulating parameter from
right to left, and returning a final value of this accumulator together with the new tree.
Using this version with a function that is strict in it's first argument will result in
O(n) stack use. See mapAccumR'
for a strict version.
Complexity: O(n)
mapAccumL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
This is a strict version of mapAccumL
, which is useful for functions which
are strict in their first argument. The advantage of this version is that it reduces
the stack use from the O(n) that the lazy version gives (when used with strict functions)
to O(log n).
Complexity: O(n)
mapAccumR' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
This is a strict version of mapAccumR
, which is useful for functions which
are strict in their first argument. The advantage of this version is that it reduces
the stack use from the O(n) that the lazy version gives (when used with strict functions)
to O(log n).
Complexity: O(n)
replicate :: Int -> e -> AVL eSource
Construct a flat AVL tree of size n (n>=0), where all elements are identical.
Complexity: O(log n)
filter :: (e -> Bool) -> AVL e -> AVL eSource
Remove all AVL tree elements which do not satisfy the supplied predicate. Element ordering is preserved.
Complexity: O(n)
mapMaybe :: (a -> Maybe b) -> AVL a -> AVL bSource
Remove all AVL tree elements for which the supplied function returns Nothing
.
Element ordering is preserved.
Complexity: O(n)
filterViaList :: (e -> Bool) -> AVL e -> AVL eSource
Remove all AVL tree elements which do not satisfy the supplied predicate.
Element ordering is preserved. The resulting tree is flat.
See filter
for an alternative implementation which is probably more efficient.
Complexity: O(n)
mapMaybeViaList :: (a -> Maybe b) -> AVL a -> AVL bSource
partition :: (e -> Bool) -> AVL e -> (AVL e, AVL e)Source
Partition an AVL tree using the supplied predicate. The first AVL tree in the resulting pair contains all elements for which the predicate is True, the second contains all those for which the predicate is False. Element ordering is preserved. Both of the resulting trees are flat.
Complexity: O(n)
traverseAVL :: Applicative f => (a -> f b) -> AVL a -> f (AVL b)Source
This is the non-overloaded version of the Data.Traversable.traverse
method for AVL trees.
Folds
Note that unlike folds over lists (foldr
and foldl
), there is no
significant difference between left and right folds in AVL trees, other
than which side of the tree each starts with.
Therefore this library provides strict and lazy versions of both.
foldr :: (e -> a -> a) -> a -> AVL e -> aSource
The AVL equivalent of foldr
on lists. This is a the lazy version (as lazy as the folding function
anyway). Using this version with a function that is strict in it's second argument will result in O(n)
stack use. See foldr'
for a strict version.
It behaves as if defined..
foldr f a avl = foldr f a (asListL avl)
For example, the asListL
function could be defined..
asListL = foldr (:) []
Complexity: O(n)
foldr' :: (e -> a -> a) -> a -> AVL e -> aSource
The strict version of foldr
, which is useful for functions which are strict in their second
argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
version gives (when used with strict functions) to O(log n).
Complexity: O(n)
foldr1 :: (e -> e -> e) -> AVL e -> eSource
The AVL equivalent of foldr1
on lists. This is a the lazy version (as lazy as the folding function
anyway). Using this version with a function that is strict in it's second argument will result in O(n)
stack use. See foldr1'
for a strict version.
foldr1 f avl = foldr1 f (asListL avl)
This function raises an error if the tree is empty.
Complexity: O(n)
foldr1' :: (e -> e -> e) -> AVL e -> eSource
The strict version of foldr1
, which is useful for functions which are strict in their second
argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
version gives (when used with strict functions) to O(log n).
Complexity: O(n)
foldr2 :: (e -> a -> a) -> (e -> a) -> AVL e -> aSource
This fold is a hybrid between foldr
and foldr1
. As with foldr1
, it requires
a non-empty tree, but instead of treating the rightmost element as an initial value, it applies
a function to it (second function argument) and uses the result instead. This allows
a more flexible type for the main folding function (same type as that used by foldr
).
As with foldr
and foldr1
, this function is lazy, so it's best not to use it with functions
that are strict in their second argument. See foldr2'
for a strict version.
Complexity: O(n)
foldr2' :: (e -> a -> a) -> (e -> a) -> AVL e -> aSource
The strict version of foldr2
, which is useful for functions which are strict in their second
argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
version gives (when used with strict functions) to O(log n).
Complexity: O(n)
foldl :: (a -> e -> a) -> a -> AVL e -> aSource
The AVL equivalent of foldl
on lists. This is a the lazy version (as lazy as the folding function
anyway). Using this version with a function that is strict in it's first argument will result in O(n)
stack use. See foldl'
for a strict version.
foldl f a avl = foldl f a (asListL avl)
For example, the asListR
function could be defined..
asListR = foldl (flip (:)) []
Complexity: O(n)
foldl' :: (a -> e -> a) -> a -> AVL e -> aSource
The strict version of foldl
, which is useful for functions which are strict in their first
argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
version gives (when used with strict functions) to O(log n).
Complexity: O(n)
foldl1 :: (e -> e -> e) -> AVL e -> eSource
The AVL equivalent of foldl1
on lists. This is a the lazy version (as lazy as the folding function
anyway). Using this version with a function that is strict in it's first argument will result in O(n)
stack use. See foldl1'
for a strict version.
foldl1 f avl = foldl1 f (asListL avl)
This function raises an error if the tree is empty.
Complexity: O(n)
foldl1' :: (e -> e -> e) -> AVL e -> eSource
The strict version of foldl1
, which is useful for functions which are strict in their first
argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
version gives (when used with strict functions) to O(log n).
Complexity: O(n)
foldl2 :: (a -> e -> a) -> (e -> a) -> AVL e -> aSource
This fold is a hybrid between foldl
and foldl1
. As with foldl1
, it requires
a non-empty tree, but instead of treating the leftmost element as an initial value, it applies
a function to it (second function argument) and uses the result instead. This allows
a more flexible type for the main folding function (same type as that used by foldl
).
As with foldl
and foldl1
, this function is lazy, so it's best not to use it with functions
that are strict in their first argument. See foldl2'
for a strict version.
Complexity: O(n)
foldl2' :: (a -> e -> a) -> (e -> a) -> AVL e -> aSource
The strict version of foldl2
, which is useful for functions which are strict in their first
argument. The advantage of this version is that it reduces the stack use from the O(n) that the lazy
version gives (when used with strict functions) to O(log n).
Complexity: O(n)
(GHC Only)
mapAccumL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)Source
Glasgow Haskell only. Similar to mapAccumL'
but uses an unboxed pair in the
accumulating function.
Complexity: O(n)
mapAccumR'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)Source
Glasgow Haskell only. Similar to mapAccumR'
but uses an unboxed pair in the
accumulating function.
Complexity: O(n)
foldrInt# :: (e -> Int# -> Int#) -> Int# -> AVL e -> Int#Source
This is a specialised version of foldr'
for use with an
unboxed Int accumulator.
Complexity: O(n)
Some clones of common List functions
These are a cure for the horrible O(n^2)
complexity the noddy Data.List definitions.
nub :: Ord a => [a] -> [a]Source
A fast alternative implementation for Data.List.nub
.
Deletes all but the first occurrence of an element from the input list.
Complexity: O(n.(log n))
nubBy :: (a -> a -> Ordering) -> [a] -> [a]Source
A fast alternative implementation for Data.List.nubBy
.
Deletes all but the first occurrence of an element from the input list.
Complexity: O(n.(log n))
"Flattening" AVL trees
These functions can be improve search times by reducing a tree of given size to the minimum possible height.
flatten :: AVL e -> AVL eSource
Flatten an AVL tree, preserving the ordering of the tree elements.
Complexity: O(n)
flatReverse :: AVL e -> AVL eSource
flatMap' :: (a -> b) -> AVL a -> AVL bSource
Same as flatMap
, but the supplied function is applied strictly.
Complexity: O(n)
Splitting AVL trees
Taking fixed size lumps of tree
Bear in mind that the tree size (s) is not stored in the AVL data structure, but if it is
already known for other reasons then for (n > s/2) using the appropriate complementary
function with argument (s-n) will be faster.
But it's probably not worth invoking Data.Tree.AVL.Types.size
for no reason other than to
exploit this optimisation (because this is O(s) anyway).
splitAtL :: Int -> AVL e -> Either Int (AVL e, AVL e)Source
Split an AVL tree from the Left. The Int
argument n (n >= 0) specifies the split point.
This function raises an error if n is negative.
If the tree size is greater than n the result is (Right (l,r)) where l contains the leftmost n elements and r contains the remaining rightmost elements (r will be non-empty).
If the tree size is less than or equal to n then the result is (Left s), where s is tree size.
An empty tree will always yield a result of (Left 0).
Complexity: O(n)
splitAtR :: Int -> AVL e -> Either Int (AVL e, AVL e)Source
Split an AVL tree from the Right. The Int
argument n (n >= 0) specifies the split point.
This function raises an error if n is negative.
If the tree size is greater than n the result is (Right (l,r)) where r contains the rightmost n elements and l contains the remaining leftmost elements (l will be non-empty).
If the tree size is less than or equal to n then the result is (Left s), where s is tree size.
An empty tree will always yield a result of (Left 0).
Complexity: O(n)
takeL :: Int -> AVL e -> Either Int (AVL e)Source
This is a simplified version of splitAtL
which does not return the remaining tree.
The Int
argument n (n >= 0) specifies the number of elements to take (from the left).
This function raises an error if n is negative.
If the tree size is greater than n the result is (Right l) where l contains the leftmost n elements.
If the tree size is less than or equal to n then the result is (Left s), where s is tree size.
An empty tree will always yield a result of (Left 0).
Complexity: O(n)
takeR :: Int -> AVL e -> Either Int (AVL e)Source
This is a simplified version of splitAtR
which does not return the remaining tree.
The Int
argument n (n >= 0) specifies the number of elements to take (from the right).
This function raises an error if n is negative.
If the tree size is greater than n the result is (Right r) where r contains the rightmost n elements.
If the tree size is less than or equal to n then the result is (Left s), where s is tree size.
An empty tree will always yield a result of (Left 0).
Complexity: O(n)
dropL :: Int -> AVL e -> Either Int (AVL e)Source
This is a simplified version of splitAtL
which returns the remaining tree only (rightmost elements).
This function raises an error if n is negative.
If the tree size is greater than n the result is (Right r) where r contains the remaining elements (r will be non-empty).
If the tree size is less than or equal to n then the result is (Left s), where s is tree size.
An empty tree will always yield a result of (Left 0).
Complexity: O(n)
dropR :: Int -> AVL e -> Either Int (AVL e)Source
This is a simplified version of splitAtR
which returns the remaining tree only (leftmost elements).
This function raises an error if n is negative.
If the tree size is greater than n the result is (Right l) where l contains the remaining elements (l will be non-empty).
If the tree size is less than or equal to n then the result is (Left s), where s is tree size.
An empty tree will always yield a result of (Left 0).
Complexity: O(n)
Rotations
Bear in mind that the tree size (s) is not stored in the AVL data structure, but if it is
already known for other reasons then for (n > s/2) using the appropriate complementary
function with argument (s-n) will be faster.
But it's probably not worth invoking Data.Tree.AVL.Types.size
for no reason other than to exploit this optimisation
(because this is O(s) anyway).
rotateL :: AVL e -> AVL eSource
Rotate an AVL tree one place left. This function pops the leftmost element and pushes into the rightmost position. An empty tree yields an empty tree.
Complexity: O(log n)
rotateR :: AVL e -> AVL eSource
Rotate an AVL tree one place right. This function pops the rightmost element and pushes into the leftmost position. An empty tree yields an empty tree.
Complexity: O(log n)
popRotateL :: AVL e -> (e, AVL e)Source
Similar to rotateL
, but returns the rotated element. This function raises an error if
applied to an empty tree.
Complexity: O(log n)
popRotateR :: AVL e -> (AVL e, e)Source
Similar to rotateR
, but returns the rotated element. This function raises an error if
applied to an empty tree.
Complexity: O(log n)
rotateByL :: AVL e -> Int -> AVL eSource
Rotate an AVL tree left by n places. If s is the size of the tree then ordinarily n should be in the range [0..s-1]. However, this function will deliver a correct result for any n (n<0 or n>=s), the actual rotation being given by (n `mod` s) in such cases. The result of rotating an empty tree is an empty tree.
Complexity: O(n)
rotateByR :: AVL e -> Int -> AVL eSource
Rotate an AVL tree right by n places. If s is the size of the tree then ordinarily n should be in the range [0..s-1]. However, this function will deliver a correct result for any n (n<0 or n>=s), the actual rotation being given by (n `mod` s) in such cases. The result of rotating an empty tree is an empty tree.
Complexity: O(n)
Taking lumps of tree according to a supplied predicate
spanL :: (e -> Bool) -> AVL e -> (AVL e, AVL e)Source
Span an AVL tree from the left, using the supplied predicate. This function returns a pair of trees (l,r), where l contains the leftmost consecutive elements which satisfy the predicate. The leftmost element of r (if any) is the first to fail the predicate. Either of the resulting trees may be empty. Element ordering is preserved.
Complexity: O(n), where n is the size of l.
spanR :: (e -> Bool) -> AVL e -> (AVL e, AVL e)Source
Span an AVL tree from the right, using the supplied predicate. This function returns a pair of trees (l,r), where r contains the rightmost consecutive elements which satisfy the predicate. The rightmost element of l (if any) is the first to fail the predicate. Either of the resulting trees may be empty. Element ordering is preserved.
Complexity: O(n), where n is the size of r.
takeWhileL :: (e -> Bool) -> AVL e -> AVL eSource
This is a simplified version of spanL
which does not return the remaining tree
The result is the leftmost consecutive sequence of elements which satisfy the
supplied predicate (which may be empty).
Complexity: O(n), where n is the size of the result.
dropWhileL :: (e -> Bool) -> AVL e -> AVL eSource
This is a simplified version of spanL
which does not return the tree containing
the elements which satisfy the supplied predicate.
The result is a tree whose leftmost element is the first to fail the predicate, starting from
the left (which may be empty).
Complexity: O(n), where n is the number of elements dropped.
takeWhileR :: (e -> Bool) -> AVL e -> AVL eSource
This is a simplified version of spanR
which does not return the remaining tree
The result is the rightmost consecutive sequence of elements which satisfy the
supplied predicate (which may be empty).
Complexity: O(n), where n is the size of the result.
dropWhileR :: (e -> Bool) -> AVL e -> AVL eSource
This is a simplified version of spanR
which does not return the tree containing
the elements which satisfy the supplied predicate.
The result is a tree whose rightmost element is the first to fail the predicate, starting from
the right (which may be empty).
Complexity: O(n), where n is the number of elements dropped.
Taking lumps of sorted trees
Prepare to get confused. All these functions adhere to the same Ordering convention as is used for searches. That is, if the supplied selector returns LT that means the search key is less than the current tree element. Or put another way, the current tree element is greater than the search key.
So (for example) the result of the takeLT
function is a tree containing all those elements
which are less than the notional search key. That is, all those elements for which the
supplied selector returns GT (not LT as you might expect). I know that seems backwards, but
it's consistent if you think about it.
forkL :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)Source
Divide a sorted AVL tree into left and right sorted trees (l,r), such that l contains all the elements less than or equal to according to the supplied selector and r contains all the elements greater than according to the supplied selector.
Complexity: O(log n)
forkR :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)Source
Divide a sorted AVL tree into left and right sorted trees (l,r), such that l contains all the elements less than supplied selector and r contains all the elements greater than or equal to the supplied selector.
Complexity: O(log n)
AVL tree size utilities.
(GHC Only)
addSize# :: Int# -> AVL e -> Int#Source
Fast algorithm to add the size of a tree to the first argument. This avoids visiting about 50% of tree nodes by using fact that trees with small heights can only have particular shapes. So it's still O(n), but with substantial saving in constant factors.
Complexity: O(n)
AVL tree height utilities.
addHeight :: Int# -> AVL e -> Int#Source
Adds the height of a tree to the first argument.
Complexity: O(log n)
compareHeight :: AVL a -> AVL b -> OrderingSource
A fast algorithm for comparing the heights of two trees. This algorithm avoids the need to compute the heights of both trees and should offer better performance if the trees differ significantly in height. But if you need the heights anyway it will be quicker to just evaluate them both and compare the results.
Complexity: O(log n), where n is the size of the smaller of the two trees.
Low level Binary Path utilities.
This is the low level (unsafe) API used by the BAVL
type.
A BinPath is full if the search succeeded, empty otherwise.
findFullPath :: (e -> Ordering) -> AVL e -> Int#Source
Find the path to a AVL tree element, returns -1 (invalid path) if element not found
Complexity: O(log n)
findEmptyPath :: (e -> Ordering) -> AVL e -> Int#Source
Find the path to a non-existant AVL tree element, returns -1 (invalid path) if element is found
Complexity: O(log n)
openPath :: (e -> Ordering) -> AVL e -> BinPath eSource
Get the BinPath of an element using the supplied selector.
Complexity: O(log n)
openPathWith :: (e -> COrdering a) -> AVL e -> BinPath aSource
Get the BinPath of an element using the supplied (combining) selector.
Complexity: O(log n)
readPath :: Int# -> AVL e -> eSource
Read a tree element. Assumes the path bits were extracted from FullBP
constructor.
Raises an error if the path leads to an empty tree.
Complexity: O(log n)
writePath :: Int# -> e -> AVL e -> AVL eSource
Overwrite a tree element. Assumes the path bits were extracted from FullBP
constructor.
Raises an error if the path leads to an empty tree.
N.B This operation does not change tree shape (no insertion occurs).
Complexity: O(log n)
insertPath :: Int# -> e -> AVL e -> AVL eSource
Inserts a new tree element. Assumes the path bits were extracted from a EmptyBP
constructor.
This function replaces the first Empty node it encounters with the supplied value, regardless
of the current path bits (which are not checked). DO NOT USE THIS FOR REPLACING ELEMENTS ALREADY
PRESENT IN THE TREE (use writePath
for this).
Complexity: O(log n)
deletePath :: Int# -> AVL e -> AVL eSource
Deletes a tree element. Assumes the path bits were extracted from a FullBP
constructor.
Complexity: O(log n)
Correctness checking.
isBalanced :: AVL e -> BoolSource
Verify that a tree is height balanced and that the BF of each node is correct.
Complexity: O(n)
isSorted :: (e -> e -> Ordering) -> AVL e -> BoolSource
Verify that a tree is sorted.
Complexity: O(n)
isSortedOK :: (e -> e -> Ordering) -> AVL e -> BoolSource
Verify that a tree is sorted, height balanced and the BF of each node is correct.
Complexity: O(n)
Tree parameter utilities.
minElements :: Int -> IntegerSource
Detetermine the minimum number of elements in an AVL tree of given height. This function satisfies this recurrence relation..
minElements 0 = 0 minElements 1 = 1 minElements h = 1 + minElements (h-1) + minElements (h-2) -- = Some weird expression involving the golden ratio
maxElements :: Int -> IntegerSource
Detetermine the maximum number of elements in an AVL tree of given height. This function satisfies this recurrence relation..
maxElements 0 = 0 maxElements h = 1 + 2 * maxElements (h-1) -- = 2^h-1
Deprecated
Deprecated names
These functions are all still available, but with more sensible names. They will dissapear on the next major version so you should amend your code accordingly soon.
genUnion :: (e -> e -> COrdering e) -> AVL e -> AVL e -> AVL eSource
This name is deprecated. Instead use union
.
genUnionMaybe :: (e -> e -> COrdering (Maybe e)) -> AVL e -> AVL e -> AVL eSource
This name is deprecated. Instead use unionMaybe
.
genDisjointUnion :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL eSource
This name is deprecated. Instead use disjointUnion
.
genUnions :: (e -> e -> COrdering e) -> [AVL e] -> AVL eSource
This name is deprecated. Instead use unions
.
genDifference :: (a -> b -> Ordering) -> AVL a -> AVL b -> AVL aSource
This name is deprecated. Instead use difference
.
genDifferenceMaybe :: (a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL aSource
This name is deprecated. Instead use differenceMaybe
.
genSymDifference :: (e -> e -> Ordering) -> AVL e -> AVL e -> AVL eSource
This name is deprecated. Instead use symDifference
.
genIntersection :: (a -> b -> COrdering c) -> AVL a -> AVL b -> AVL cSource
This name is deprecated. Instead use intersection
.
genIntersectionMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL cSource
This name is deprecated. Instead use intersectionMaybe
.
genIntersectionToListL :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]Source
This name is deprecated. Instead use intersectionToList
.
genIntersectionAsListL :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]Source
This name is deprecated. Instead use intersectionAsList
.
genIntersectionMaybeToListL :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]Source
This name is deprecated. Instead use intersectionMaybeToList
.
genIntersectionMaybeAsListL :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]Source
This name is deprecated. Instead use intersectionMaybeAsList
.
genVenn :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)Source
This name is deprecated. Instead use venn
.
genVennMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)Source
This name is deprecated. Instead use vennMaybe
.
genVennToList :: (a -> b -> COrdering c) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
This name is deprecated. Instead use vennToList
.
genVennAsList :: (a -> b -> COrdering c) -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
This name is deprecated. Instead use vennAsList
.
genVennMaybeToList :: (a -> b -> COrdering (Maybe c)) -> [c] -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
This name is deprecated. Instead use vennMaybeToList
.
genVennMaybeAsList :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, [c], AVL b)Source
This name is deprecated. Instead use vennMaybeAsList
.
genIsSubsetOf :: (a -> b -> Ordering) -> AVL a -> AVL b -> BoolSource
This name is deprecated. Instead use isSubsetOf
.
genIsSubsetOfBy :: (a -> b -> COrdering Bool) -> AVL a -> AVL b -> BoolSource
This name is deprecated. Instead use isSubsetOfBy
.
genAssertRead :: AVL e -> (e -> COrdering a) -> aSource
This name is deprecated. Instead use assertRead
.
genTryRead :: AVL e -> (e -> COrdering a) -> Maybe aSource
This name is deprecated. Instead use tryRead
.
genTryReadMaybe :: AVL e -> (e -> COrdering (Maybe a)) -> Maybe aSource
This name is deprecated. Instead use tryReadMaybe
.
genDefaultRead :: a -> AVL e -> (e -> COrdering a) -> aSource
This name is deprecated. Instead use defaultRead
.
genWriteFast :: (e -> COrdering e) -> AVL e -> AVL eSource
This name is deprecated. Instead use writeFast
.
genTryWrite :: (e -> COrdering e) -> AVL e -> Maybe (AVL e)Source
This name is deprecated. Instead use tryWrite
.
genWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL eSource
This name is deprecated. Instead use writeMaybe
.
genTryWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> Maybe (AVL e)Source
This name is deprecated. Instead use tryWriteMaybe
.
genDelFast :: (e -> Ordering) -> AVL e -> AVL eSource
This name is deprecated. Instead use deleteFast
.
genDelIf :: (e -> COrdering Bool) -> AVL e -> AVL eSource
This name is deprecated. Instead use deleteIf
.
genDelMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL eSource
This name is deprecated. Instead use deleteMaybe
.
genAssertPop :: (e -> COrdering a) -> AVL e -> (a, AVL e)Source
This name is deprecated. Instead use assertPop
.
genTryPop :: (e -> COrdering a) -> AVL e -> Maybe (a, AVL e)Source
This name is deprecated. Instead use tryPop
.
genAssertPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> (a, AVL e)Source
This name is deprecated. Instead use assertPopMaybe
.
genTryPopMaybe :: (e -> COrdering (a, Maybe e)) -> AVL e -> Maybe (a, AVL e)Source
This name is deprecated. Instead use tryPopMaybe
.
genAssertPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> (a, AVL e)Source
This name is deprecated. Instead use assertPopIf
.
genTryPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> Maybe (a, AVL e)Source
This name is deprecated. Instead use tryPopIf
.
genPush :: (e -> COrdering e) -> e -> AVL e -> AVL eSource
This name is deprecated. Instead use push
.
genPush' :: (e -> COrdering e) -> e -> AVL e -> AVL eSource
This name is deprecated. Instead use ' push''.
genPushMaybe :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL eSource
This name is deprecated. Instead use pushMaybe
.
genPushMaybe' :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL eSource
This name is deprecated. Instead use pushMaybe'
.
genAsTree :: (e -> e -> COrdering e) -> [e] -> AVL eSource
This name is deprecated. Instead use asTree
.
genForkL :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)Source
This name is deprecated. Instead use forkL
.
genForkR :: (e -> Ordering) -> AVL e -> (AVL e, AVL e)Source
This name is deprecated. Instead use forkR
.
genFork :: (e -> COrdering a) -> AVL e -> (AVL e, Maybe a, AVL e)Source
This name is deprecated. Instead use fork
.
genAssertOpen :: (e -> Ordering) -> AVL e -> ZAVL eSource
This name is deprecated. Instead use assertOpen
.
genTryOpen :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)Source
This name is deprecated. Instead use tryOpen
.
genTryOpenGE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)Source
This name is deprecated. Instead use tryOpenGE
.
genTryOpenLE :: (e -> Ordering) -> AVL e -> Maybe (ZAVL e)Source
This name is deprecated. Instead use tryOpenLE
.
genOpenEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)Source
This name is deprecated. Instead use openEither
.
genOpenBAVL :: (e -> Ordering) -> AVL e -> BAVL eSource
This name is deprecated. Instead use openBAVL
.
genOpenPath :: (e -> Ordering) -> AVL e -> BinPath eSource
This name is deprecated. Instead use openPath
.
genOpenPathWith :: (e -> COrdering a) -> AVL e -> BinPath aSource
This name is deprecated. Instead use openPathWith
.
reverseAVL :: AVL e -> AVL eSource
This name is deprecated. Instead use reverse
.
mapAccumLAVL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
This name is deprecated. Instead use mapAccumL
.
mapAccumRAVL :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
This name is deprecated. Instead use mapAccumR
.
mapAccumLAVL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
This name is deprecated. Instead use mapAccumL'
.
mapAccumRAVL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source
This name is deprecated. Instead use mapAccumR'
.
mapAccumLAVL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)Source
This name is deprecated. Instead use mapAccumL''
.
mapAccumRAVL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)Source
This name is deprecated. Instead use mapAccumR''
.
replicateAVL :: Int -> e -> AVL eSource
This name is deprecated. Instead use replicate
.
partitionAVL :: (e -> Bool) -> AVL e -> (AVL e, AVL e)Source
This name is deprecated. Instead use partition
.
foldr1AVL' :: (e -> e -> e) -> AVL e -> eSource
This name is deprecated. Instead use foldr1'
.
foldr2AVL :: (e -> a -> a) -> (e -> a) -> AVL e -> aSource
This name is deprecated. Instead use foldr2
.
foldr2AVL' :: (e -> a -> a) -> (e -> a) -> AVL e -> aSource
This name is deprecated. Instead use foldr2'
.
foldl1AVL' :: (e -> e -> e) -> AVL e -> eSource
This name is deprecated. Instead use foldl1'
.
foldl2AVL :: (a -> e -> a) -> (e -> a) -> AVL e -> aSource
This name is deprecated. Instead use foldl2
.
foldl2AVL' :: (a -> e -> a) -> (e -> a) -> AVL e -> aSource
This name is deprecated. Instead use foldl2'
.