AvlTree-3.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.

WARNING: The constructors of this data type are exported from this module but not from the top level AVL wrapper (Data.Tree.AVL). Don't try to construct your own AVL trees unless you're sure you know what your doing. If you end up creating and using AVL trees that aren't you'll break most of the functions in this library.

Controlling Strictness.

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

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)

Show is based on showing the list produced by asListL. This definition has been placed here to avoid introducing cyclic dependency between Types.hs and List.hs

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)

AVL tree size utilities.

size :: AVL e -> IntSource

Counts the total number of elements in an AVL tree.

size = addSize 0

Complexity: O(n)

addSize :: Int -> AVL e -> IntSource

Adds the size of a tree to the first argument. This is just a convenience wrapper for fastAddSize.

Complexity: O(n)

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

Fast algorithm to calculate size. 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)

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

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

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.

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

genAssertRead :: 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)

genTryRead :: 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 genAssertRead, but returns Nothing if the search failed.

Complexity: O(log n)

genTryReadMaybe :: 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)

genDefaultRead :: 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 genAssertRead, but returns a the default value (first argument) if the search fails.

Complexity: O(log n)

Simple searches of sorted AVL trees

genContains :: 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

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

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

Functionally identical to genWrite, 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)

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

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

Similar to genWrite, 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)

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

Similar to genTryWrite, 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

genPush :: (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 genPush'

Complexity: O(log n)

genPush' :: (e -> COrdering e) -> e -> AVL e -> AVL eSource

Almost identical to genPush, 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)

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

Similar to genPush, 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 genPushMaybe'

Complexity: O(log n)

genPushMaybe' :: (e -> COrdering (Maybe e)) -> e -> AVL e -> AVL eSource

Almost identical to genPushMaybe, 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

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

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

Functionally identical to genDel, 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)

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

genDelMaybe :: (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

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

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

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

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

Similar to genAssertPopMaybe, but returns Nothing if the search fails.

Complexity: O(log n)

genAssertPopIf :: (e -> COrdering (a, Bool)) -> AVL e -> (a, AVL e)Source

A simpler version of genAssertPopMaybe. 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)

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

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

genAsTree :: (e -> e -> COrdering e) -> [e] -> AVL eSource

Invokes genPushList on the empty AVL tree.

Complexity: O(n.(log n))

"Pushing" unsorted Lists in sorted AVL trees

genPushList :: (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

reverseAVL :: 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)

mapAVL :: (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 (mapAVL').

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)

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

Similar to mapAVL, but the supplied function is applied strictly.

Complexity: O(n)

mapAccumLAVL :: (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 mapAVL and foldlAVL. 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 mapAccumLAVL' for a strict version.

Complexity: O(n)

mapAccumRAVL :: (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 mapAVL and foldrAVL. 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 mapAccumRAVL' for a strict version.

Complexity: O(n)

mapAccumLAVL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source

This is a strict version of mapAccumLAVL, 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)

mapAccumRAVL' :: (z -> a -> (z, b)) -> z -> AVL a -> (z, AVL b)Source

This is a strict version of mapAccumRAVL, 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)

mapAccumLAVL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)Source

Glasgow Haskell only. Similar to mapAccumLAVL' but uses an unboxed pair in the accumulating function.

Complexity: O(n)

mapAccumRAVL'' :: (z -> a -> (#z, b#)) -> z -> AVL a -> (z, AVL b)Source

Glasgow Haskell only. Similar to mapAccumRAVL' but uses an unboxed pair in the accumulating function.

Complexity: O(n)

traverseAVL :: Applicative f => (a -> f b) -> AVL a -> f (AVL b)Source

replicateAVL :: Int -> e -> AVL eSource

Construct a flat AVL tree of size n (n>=0), where all elements are identical.

Complexity: O(log n)

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

mapMaybeAVL :: (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 filterAVL 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 mapMaybeAVL for an alternative implementation which is probably more efficient.

Complexity: O(n)

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

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.

foldrAVL :: (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 foldrAVL' for a strict version.

It behaves as if defined..

 foldrAVL f a avl = foldr f a (asListL avl)

For example, the asListL function could be defined..

 asListL = foldrAVL (:) []

Complexity: O(n)

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

The strict version of foldrAVL, 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)

foldr1AVL :: (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 foldr1AVL' for a strict version.

 foldr1AVL f avl = foldr1 f (asListL avl)

This function raises an error if the tree is empty.

Complexity: O(n)

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

The strict version of foldr1AVL, 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)

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

This fold is a hybrid between foldrAVL and foldr1AVL. As with foldr1AVL, 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 foldrAVL). As with foldrAVL and foldr1AVL, this function is lazy, so it's best not to use it with functions that are strict in their second argument. See foldr2AVL' for a strict version.

Complexity: O(n)

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

The strict version of foldr2AVL, 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)

foldlAVL :: (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 foldlAVL' for a strict version.

 foldlAVL f a avl = foldl f a (asListL avl)

For example, the asListR function could be defined..

 asListR = foldlAVL (flip (:)) []

Complexity: O(n)

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

The strict version of foldlAVL, 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)

foldl1AVL :: (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 foldl1AVL' for a strict version.

 foldl1AVL f avl = foldl1 f (asListL avl)

This function raises an error if the tree is empty.

Complexity: O(n)

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

The strict version of foldl1AVL, 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)

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

This fold is a hybrid between foldlAVL and foldl1AVL. As with foldl1AVL, 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 foldlAVL). As with foldlAVL and foldl1AVL, this function is lazy, so it's best not to use it with functions that are strict in their first argument. See foldl2AVL' for a strict version.

Complexity: O(n)

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

The strict version of foldl2AVL, 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)

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

This is a specialised version of foldrAVL' for use with an unboxed Int accumulator (with GHC). Defaults to boxed Int for other Haskells.

Complexity: O(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 reverseAVL.

Complexity: O(n)

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

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

Complexity: O(n)

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

Same as flatMap, but the supplied function is applied strictly.

Complexity: O(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.

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

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

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

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

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

Complexity: O(log n)

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

This is a simplified version of genForkL 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 genDropGT.

Complexity: O(log n)

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

A synonym for genTakeLE.

Complexity: O(log n)

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

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

Complexity: O(log n)

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

A synonym for genTakeLT.

Complexity: O(log n)

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

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

Complexity: O(log n)

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

A synonym for genTakeGT.

Complexity: O(log n)

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

This is a simplified version of genForkR 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 genDropLT.

Complexity: O(log n)

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

A synonym for genTakeGE.

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

genUnion :: (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. (Faster than Hedge union from Data.Set at any rate).

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

Similar to genUnion, 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.

genUnions :: (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..

genUnions ccmp avls = foldl' (genUnion ccmp) empty avls

Difference

genDifference :: (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..

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

genDifferenceMaybe :: (a -> b -> COrdering (Maybe a)) -> AVL a -> AVL b -> AVL aSource

Similar to genDifference, 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.

genSymDifference :: (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

genIntersection :: (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.

genIntersectionMaybe :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> AVL cSource

Similar to genIntersection, 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.)

genIntersectionToListL :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c] -> [c]Source

Similar to genIntersection, but prepends the result to the supplied list in left to right order. This is a (++) free function which behaves as if defined:

genIntersectionToListL c setA setB cs = asListL (genIntersection c setA setB) ++ cs

Complexity: Not sure, but I'd appreciate it if someone could figure it out.

genIntersectionAsListL :: (a -> b -> COrdering c) -> AVL a -> AVL b -> [c]Source

Applies genIntersectionToListL to the empty list.

Complexity: Not sure, but I'd appreciate it if someone could figure it out.

genIntersectionMaybeToListL :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c] -> [c]Source

Similar to genIntersectionToListL, 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.

genIntersectionMaybeAsListL :: (a -> b -> COrdering (Maybe c)) -> AVL a -> AVL b -> [c]Source

Applies genIntersectionMaybeToListL to the empty list.

Complexity: Not sure, but I'd appreciate it if someone could figure it out.

Subset

genIsSubsetOf :: (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.

genIsSubsetOfBy :: (a -> b -> COrdering Bool) -> AVL a -> AVL b -> BoolSource

Similar to genIsSubsetOf, 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)

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

genTryOpen :: (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 genOpenBAVL, test for "fullness" using fullBAVL and then convert to a ZAVL using fullBAVLtoZAVL.

Complexity: O(log n)

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

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

genOpenEither :: (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

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

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

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# 

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

genOpenPath :: (e -> Ordering) -> AVL e -> BinPath eSource

Get the BinPath of an element using the supplied selector.

Complexity: O(log n)

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