AvlTree-4.2: Balanced binary trees using the AVL algorithm.

Portabilityportable
Stabilitystable
Maintainerhttp://homepages.nildram.co.uk/~ahey/em.png

Data.Tree.AVL

Contents

Description

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

Synopsis

Types.

data AVL e Source

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).

The Eq and Ord instances.

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).

The Read and Show instances.

Begining with version 4.0 these are now derived to ensure consistency with Eq instance. (Show now reveals the exact tree structure).

Constructors

E

Empty Tree

N (AVL e) e (AVL e)

BF=-1 (right height > left height)

Z (AVL e) e (AVL e)

BF= 0

P (AVL e) e (AVL e)

BF=+1 (left height > right height)

Instances

Functor AVL

AVL trees are an instance of Functor. This definition has been placed here to avoid introducing cyclic dependency between Types.hs and List.hs

Typeable1 AVL 
Foldable AVL 
Traversable AVL 
Eq e => Eq (AVL e) 
Ord e => Ord (AVL e) 
Read e => Read (AVL e) 
Show e => Show (AVL e) 

Simple AVL related utilities.

empty :: AVL eSource

The empty AVL tree.

isEmpty :: AVL e -> BoolSource

Returns True if an AVL tree is empty.

Complexity: O(1)

isNonEmpty :: AVL e -> BoolSource

Returns True if an AVL tree is non-empty.

Complexity: O(1)

singleton :: e -> AVL eSource

Creates an AVL tree with just one element.

Complexity: O(1)

pair :: e -> e -> AVL eSource

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 (Just e). Otherwise it returns Nothing.

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)

tryReadMaybe :: AVL e -> (e -> COrdering (Maybe a)) -> Maybe aSource

This version returns the result of the selector (without adding a Just wrapper) if the search succeeds, or Nothing if it fails.

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)

tryWriteL :: e -> AVL e -> Maybe (AVL e)Source

Similar to writeL, but returns Nothing 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)

tryWriteR :: AVL e -> e -> Maybe (AVL e)Source

Similar to writeR, but returns Nothing 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 (Eq e) constructor returned by the selector. If the search fails this function returns the original tree.

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)

tryWrite :: (e -> COrdering e) -> AVL e -> Maybe (AVL e)Source

A general purpose function to perform a search of a tree, using the supplied selector. The found element is replaced by the value (e) of the (Eq e) constructor returned by the selector. This function returns Nothing if the search failed.

Complexity: O(log n)

writeMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL eSource

Similar to write, but also returns the original tree if the search succeeds but the selector returns (Eq Nothing). (This version is intended to help reduce heap burn rate if it's likely that no modification of the value is needed.)

Complexity: O(log n)

tryWriteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> Maybe (AVL e)Source

Similar to tryWrite, but also returns the original tree if the search succeeds but the selector returns (Eq Nothing). (This version is intended to help reduce heap burn rate if it's likely that no modification of the value is needed.)

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 (Eq e) 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.

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 (Eq Nothing). 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.

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

delL :: AVL e -> AVL eSource

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)

delR :: AVL e -> AVL eSource

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)

deleteIf :: (e -> COrdering Bool) -> AVL e -> AVL eSource

This version only deletes the element if the supplied selector returns (Eq True). If it returns (Eq False) or if no matching element is found then this function returns the original tree.

Complexity: O(log n)

deleteMaybe :: (e -> COrdering (Maybe e)) -> AVL e -> AVL eSource

This version only deletes the element if the supplied selector returns (Eq Nothing). If it returns (Eq (Just e)) then the matching element is replaced by e. If no matching element is found then this function returns the original tree.

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 (Just e) then the new value (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.

vennMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> (AVL a, AVL c, AVL b)Source

Similar to venn, but intersection elements for which the combining comparison returns (Eq Nothing) are deleted from the intersection result.

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 (Eq True) for matching elements.

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

data ZAVL e Source

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.

data PAVL e Source

Abstract data type for an unsuccessfully opened AVL tree. A PAVL can be thought of as a functional pointer to the gap where the expected element should be (but isn't). You can fill this gap using the fill function, or fill and close at the same time using the fillClose function.

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)

openEither :: (e -> Ordering) -> AVL e -> Either (PAVL e) (ZAVL e)Source

Returns (Right zavl) if the expected element was found, (Left pavl) if the expected element was not found. It's OK to use this function on empty trees.

Complexity: O(log n)

Closing

close :: ZAVL e -> AVL eSource

Closes a Zipper.

Complexity: O(log n)

fillClose :: e -> PAVL e -> AVL eSource

Essentially the same operation as fill, but the resulting ZAVL is closed immediately.

Complexity: O(log n)

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.

fill :: e -> PAVL e -> ZAVL eSource

Fill the gap pointed to by a PAVL with the supplied element, which becomes the current element of the resulting ZAVL. The supplied filling element should be "equal" to the value used in the search which created the PAVL.

Complexity: O(1)

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.

sizeL :: ZAVL e -> IntSource

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.

sizeR :: ZAVL e -> IntSource

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

sizeZAVL :: ZAVL e -> IntSource

Counts the total number of elements in a ZAVL.

Complexity: O(n)

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

data BAVL e Source

A BAVL is like a pointer reference to somewhere inside an AVL tree. It may be either "full" (meaning it points to an actual tree node containing an element), or "empty" (meaning it points to the position in a tree where an element was expected but wasn't found).

Opening and closing

openBAVL :: (e -> Ordering) -> AVL e -> BAVL eSource

Search for an element in a sorted AVL tree using the supplied selector. Returns a "full" BAVL if a matching element was found, otherwise returns an "empty" BAVL.

Complexity: O(log n)

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

fullBAVL :: BAVL e -> BoolSource

Returns True if the BAVL is "full" (a corresponding element was found).

Complexity: O(1)

emptyBAVL :: BAVL e -> BoolSource

Returns True if the BAVL is "empty" (no corresponding element was found).

Complexity: O(1)

tryReadBAVL :: BAVL e -> Maybe eSource

Read the element value from a "full" BAVL. This function returns Nothing if applied to an "empty" BAVL.

Complexity: O(1)

readFullBAVL :: BAVL e -> eSource

Read the element value from a "full" BAVL. This function raises an error if applied to an "empty" BAVL.

Complexity: O(1)

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

If the BAVL is "full", this function returns the original tree with the corresponding element deleted. If it's "empty" the original tree is returned unmodified.

Complexity: O(log n) (or O(1) for an empty BAVL)

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

Converts a "full" BAVL as a ZAVL. Raises an error if applied to an "empty" BAVL.

Complexity: O(log n)

emptyBAVLtoPAVL :: BAVL e -> PAVL eSource

Converts an "empty" BAVL as a PAVL. Raises an error if applied to a "full" BAVL.

Complexity: O(log n)

anyBAVLtoEither :: BAVL e -> Either (PAVL e) (ZAVL e)Source

Converts a BAVL to either a PAVL or ZAVL (depending on whether it is "empty" or "full").

Complexity: O(log n)

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).

asListL :: AVL e -> [e]Source

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)

asListR :: AVL e -> [e]Source

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)

asTreeL :: [e] -> AVL eSource

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)

asTreeR :: [e] -> AVL eSource

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

Remove all AVL tree elements for which the supplied function returns Nothing. Element ordering is preserved. The resulting tree is flat. See mapMaybe for an alternative implementation which is probably more efficient.

Complexity: O(n)

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

Similar to flatten, but the tree elements are reversed. This function has higher constant factor overhead than reverse.

Complexity: O(n)

flatMap :: (a -> b) -> AVL a -> AVL bSource

Similar to map, but the resulting tree is flat. This function has higher constant factor overhead than map.

Complexity: O(n)

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)

fork :: (e -> COrdering a) -> AVL e -> (AVL e, Maybe a, AVL e)Source

Similar to forkL and forkR, but returns any equal element found (instead of incorporating it into the left or right tree results respectively).

Complexity: O(log n)

takeLE :: (e -> Ordering) -> AVL e -> AVL eSource

This is a simplified version of forkL which returns a sorted tree containing only those elements which are less than or equal to according to the supplied selector. This function also has the synonym dropGT.

Complexity: O(log n)

dropGT :: (e -> Ordering) -> AVL e -> AVL eSource

A synonym for takeLE.

Complexity: O(log n)

takeLT :: (e -> Ordering) -> AVL e -> AVL eSource

This is a simplified version of forkR which returns a sorted tree containing only those elements which are less than according to the supplied selector. This function also has the synonym dropGE.

Complexity: O(log n)

dropGE :: (e -> Ordering) -> AVL e -> AVL eSource

A synonym for takeLT.

Complexity: O(log n)

takeGT :: (e -> Ordering) -> AVL e -> AVL eSource

This is a simplified version of forkL which returns a sorted tree containing only those elements which are greater according to the supplied selector. This function also has the synonym dropLE.

Complexity: O(log n)

dropLE :: (e -> Ordering) -> AVL e -> AVL eSource

A synonym for takeGT.

Complexity: O(log n)

takeGE :: (e -> Ordering) -> AVL e -> AVL eSource

This is a simplified version of forkR which returns a sorted tree containing only those elements which are greater or equal to according to the supplied selector. This function also has the synonym dropLT.

Complexity: O(log n)

dropLT :: (e -> Ordering) -> AVL e -> AVL eSource

A synonym for takeGE.

Complexity: O(log n)

AVL tree size utilities.

size :: AVL e -> IntSource

A convenience wrapper for addSize#.

addSize :: Int -> AVL e -> IntSource

See addSize#.

clipSize :: Int -> AVL e -> Maybe IntSource

Returns the exact tree size in the form (Just n) if this is less than or equal to the input clip value. Returns Nothing of the size is greater than the clip value. This function exploits the same optimisation as addSize.

Complexity: O(min n c) where n is tree size and c is clip value.

(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)

size# :: AVL e -> Int#Source

A convenience wrapper for addSize#.

AVL tree height utilities.

height :: AVL e -> Int#Source

Determine the height of an AVL tree.

Complexity: O(log n)

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.

data BinPath a Source

A BinPath is full if the search succeeded, empty otherwise.

Constructors

FullBP !Int# a 
EmptyBP !Int# 

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.

genContains :: AVL e -> (e -> Ordering) -> BoolSource

This name is deprecated. Instead use contains.

genWrite :: (e -> COrdering e) -> AVL e -> AVL eSource

This name is deprecated. Instead use write.

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.

genDel :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use delete.

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.

genTakeLE :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use takeLE.

genDropGT :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use dropGT.

genTakeLT :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use takeLT.

genDropGE :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use dropGE.

genTakeGT :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use takeGT.

genDropLE :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use dropLE.

genTakeGE :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use takeGE.

genDropLT :: (e -> Ordering) -> AVL e -> AVL eSource

This name is deprecated. Instead use dropLT.

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.

genFindPath :: (e -> Ordering) -> AVL e -> Int#Source

This name is deprecated. Instead use findPath.

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.

fastAddSize :: Int# -> AVL e -> Int#Source

This name is deprecated. Instead use addSize or addSize#.

reverseAVL :: AVL e -> AVL eSource

This name is deprecated. Instead use reverse.

mapAVL :: (a -> b) -> AVL a -> AVL bSource

This name is deprecated. Instead use map.

mapAVL' :: (a -> b) -> AVL a -> AVL bSource

This name is deprecated. Instead use map'.

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.

filterAVL :: (e -> Bool) -> AVL e -> AVL eSource

This name is deprecated. Instead use filter.

mapMaybeAVL :: (a -> Maybe b) -> AVL a -> AVL bSource

This name is deprecated. Instead use mapMaybe.

partitionAVL :: (e -> Bool) -> AVL e -> (AVL e, AVL e)Source

This name is deprecated. Instead use partition.

foldrAVL :: (e -> a -> a) -> a -> AVL e -> aSource

This name is deprecated. Instead use foldr.

foldrAVL' :: (e -> a -> a) -> a -> AVL e -> aSource

This name is deprecated. Instead use foldr'.

foldr1AVL :: (e -> e -> e) -> AVL e -> eSource

This name is deprecated. Instead use foldr1.

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'.

foldlAVL :: (a -> e -> a) -> a -> AVL e -> aSource

This name is deprecated. Instead use foldl.

foldlAVL' :: (a -> e -> a) -> a -> AVL e -> aSource

This name is deprecated. Instead use foldl'.

foldl1AVL :: (e -> e -> e) -> AVL e -> eSource

This name is deprecated. Instead use foldl1.

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'.

foldrAVL_UINT :: (e -> Int# -> Int#) -> Int# -> AVL e -> Int#Source

This name is deprecated. Instead use foldrInt#.

findPath :: (e -> Ordering) -> AVL e -> Int#Source

This name is deprecated. Instead use findFullPath.