Hi,<br><br>I summarize the pattern matching method for AVL tree here:<br><a href="https://sites.google.com/site/algoxy/avltree">https://sites.google.com/site/algoxy/avltree</a><br><br>Also the proof of the height boundary and updating of the balancing factors are provided.<br>
<br>Regards.<br>-- <br>Larry<br><br><div class="gmail_quote">On Thu, May 12, 2011 at 10:54 AM, larry.liuxinyu <span dir="ltr">&lt;<a href="mailto:liuxinyu95@gmail.com">liuxinyu95@gmail.com</a>&gt;</span> wrote:<br><blockquote class="gmail_quote" style="margin:0 0 0 .8ex;border-left:1px #ccc solid;padding-left:1ex;">
Hi,<br>
<br>
I browsed the current AVL tree implementation in Hackage<br>
<a href="http://hackage.haskell.org/packages/archive/AvlTree/4.2/doc/html/src/Data-Tree-AVL-Push.html" target="_blank">http://hackage.haskell.org/packages/archive/AvlTree/4.2/doc/html/src/Data-Tree-AVL-Push.html</a><br>
<br>
AVL tree denote the different of height from right sub-tree to left<br>
sub-tree as delta, to keep the<br>
balance, abs(delta)&lt;=1 is kept as invariant.<br>
<br>
So the typical implementation define N (Negative), P (Positive), and Z<br>
(zero) as the tree valid nodes<br>
(and the Empty as the trivial case).<br>
<br>
When a new element is inserted, the program typically first check if<br>
the result will break the balance, and<br>
process rotation to keep the balance of the tree. Some other pure<br>
functional implementation takes<br>
the same approach, for example:<br>
<br>
Guy Cousineau and Michel Mauny. ``The Functional Approach to<br>
Programming&#39;&#39;. pp 173 ~ 186<br>
<br>
Consider the elegant implementation of Red-black tree in pattern<br>
matching way by Chris Okasaki, I tried to use the same method in AVL<br>
tree, and here is the result.<br>
<br>
module AVLTree where<br>
<br>
-- for easy verification, I used Quick Check package.<br>
import Test.QuickCheck<br>
import qualified Data.List as L -- for verification purpose only<br>
<br>
-- Definition of AVL tree, it is almost as same as BST, besides a new<br>
field to store delta.<br>
data AVLTree a = Empty<br>
               | Br (AVLTree a) a (AVLTree a) Int<br>
<br>
insert::(Ord a)=&gt;AVLTree a -&gt; a -&gt; AVLTree a<br>
insert t x = fst $ ins t where<br>
    -- result of ins is a pair (t, d), t: tree, d: increment of height<br>
    ins Empty = (Br Empty x Empty 0, 1)<br>
    ins (Br l k r d)<br>
        | x &lt; k     = node (ins l) k (r, 0) d<br>
        | x == k    = (Br l k r d, 0)  -- For duplicate element, we<br>
just ignore it.<br>
        | otherwise = node (l, 0) k (ins r) d<br>
<br>
-- params: (left, increment on left) key (right, increment on right)<br>
node::(AVLTree a, Int) -&gt; a -&gt; (AVLTree a, Int) -&gt; Int -&gt; (AVLTree a,<br>
Int)<br>
node (l, dl) k (r, dr) d = balance (Br l k r d&#39;, delta) where<br>
    d&#39; = d + dr - dl<br>
    delta = deltaH d d&#39; dl dr<br>
<br>
-- delta(Height) = max(|R&#39;|, |L&#39;|) - max (|R|, |L|)<br>
--  where we denote height(R) as |R|<br>
deltaH :: Int -&gt; Int -&gt; Int -&gt; Int -&gt; Int<br>
deltaH d d&#39; dl dr<br>
       | d &gt;=0 &amp;&amp; d&#39; &gt;=0 = dr<br>
       | d &lt;=0 &amp;&amp; d&#39; &gt;=0 = d+dr<br>
       | d &gt;=0 &amp;&amp; d&#39; &lt;=0 = dl - d<br>
       | otherwise = dl<br>
<br>
-- Here is the core pattern matching part, there are 4 cases need<br>
rebalance<br>
<br>
balance :: (AVLTree a, Int) -&gt; (AVLTree a, Int)<br>
balance (Br (Br (Br a x b dx) y c (-1)) z d (-2), _) = (Br (Br a x b<br>
dx) y (Br c z d 0) 0, 0)<br>
balance (Br a x (Br b y (Br c z d dz)    1)    2, _) = (Br (Br a x b<br>
0) y (Br c z d dz) 0, 0)<br>
balance (Br (Br a x (Br b y c dy)    1) z d (-2), _) = (Br (Br a x b<br>
dx&#39;) y (Br c z d dz&#39;) 0, 0) where<br>
    dx&#39; = if dy ==  1 then -1 else 0<br>
    dz&#39; = if dy == -1 then  1 else 0<br>
balance (Br a x (Br (Br b y c dy) z d (-1))    2, _) = (Br (Br a x b<br>
dx&#39;) y (Br c z d dz&#39;) 0, 0) where<br>
    dx&#39; = if dy ==  1 then -1 else 0<br>
    dz&#39; = if dy == -1 then  1 else 0<br>
balance (t, d) = (t, d)<br>
<br>
-- Here are some auxiliary functions for verification<br>
<br>
-- check if a AVLTree is valid<br>
isAVL :: (AVLTree a) -&gt; Bool<br>
isAVL Empty = True<br>
isAVL (Br l _ r d) = and [isAVL l, isAVL r, d == (height r - height<br>
l), abs d &lt;= 1]<br>
<br>
height :: (AVLTree a) -&gt; Int<br>
height Empty = 0<br>
height (Br l _ r _) = 1 + max (height l) (height r)<br>
<br>
checkDelta :: (AVLTree a) -&gt; Bool<br>
checkDelta Empty = True<br>
checkDelta (Br l _ r d) = and [checkDelta l, checkDelta r, d ==<br>
(height r - height l)]<br>
<br>
-- Auxiliary functions to build tree from a list, as same as BST<br>
<br>
fromList::(Ord a)=&gt;[a] -&gt; AVLTree a<br>
fromList = foldl insert Empty<br>
<br>
toList :: (AVLTree a) -&gt; [a]<br>
toList Empty = []<br>
toList (Br l k r _) = toList l ++ [k] ++ toList r<br>
<br>
-- test<br>
prop_bst :: (Ord a, Num a) =&gt; [a] -&gt; Bool<br>
prop_bst xs = (L.sort $ L.nub xs) == (toList $ fromList xs)<br>
<br>
prop_avl :: (Ord a, Num a) =&gt; [a] -&gt; Bool<br>
prop_avl = isAVL . fromList . L.nub<br>
<br>
And here are my result in ghci:<br>
*AVLTree&gt; test prop_avl<br>
OK, passed 100 tests.<br>
<br>
The program is available in github:<br>
<a href="http://www.google.com/url?sa=D&amp;q=https://github.com/liuxinyu95/AlgoXY/blob/algoxy/datastruct/tree/AVL-tree/src/AVLTree.hs" target="_blank">http://www.google.com/url?sa=D&amp;q=https://github.com/liuxinyu95/AlgoXY/blob/algoxy/datastruct/tree/AVL-tree/src/AVLTree.hs</a><br>

<br>
I haven&#39;t provided delete function yet.<br>
<br>
Cheers.<br>
<font color="#888888">--<br>
Larry, LIU<br>
<a href="https://github.com/liuxinyu95/AlgoXY" target="_blank">https://github.com/liuxinyu95/AlgoXY</a><br>
<br>
_______________________________________________<br>
Haskell-Cafe mailing list<br>
<a href="mailto:Haskell-Cafe@haskell.org">Haskell-Cafe@haskell.org</a><br>
<a href="http://www.haskell.org/mailman/listinfo/haskell-cafe" target="_blank">http://www.haskell.org/mailman/listinfo/haskell-cafe</a><br>
</font></blockquote></div><br><br clear="all"><br><br>