**ParaSail**. It is a balanced "AA" tree. First we have the interface to the AA_Tree module, then the class that implements it, and finally a simple test function "Test_AA_Tree."

Note that this is just part of the ParaSail standard library, which is included in the downloadable prototype compiler and virtual machine. See a separate blog entry for the most recent downloadable version. You can run the test program after installing the ParaSail release by the command "pslc aaa.psi -command Test_AA_Tree 2 9 4". See the appendix in the ParaSail reference manual for more information on running the ParaSail compiler and virtual machine.

// ParaSail Prototype Standard Library// Copyright (C) 2011-2012, S. Tucker Taft, Lexington MA, USA// To be used only for Personal, Academic, or Evaluation Purposes;// Not for Commercial Production Use.// Report errors at http://groups.google.com/group/parasail-programming-languageinterfaceAA_Tree<ElementisComparable<>>is// This module implements a balanced "AA" tree, originally// described by Arne Andersson in the "Proceedings of the Workshop// on Algorithms and Data Structures," pp 60-71, Springer Verlag, 1993.// The following algorithm and descriptions were taken from the// WikiPedia article on AA_Tree:// http://en.wikipedia.org/wiki/AA_tree// Note that various additional checks for a null tree have been added.// Only two operations are needed for maintaining balance in an AA tree.// These operations are called skew and split. Skew is a right rotation// when an insertion or deletion creates a left horizontal link. Split// is a conditional left rotation when an insertion or deletion creates two// horizontal right links, which once again corresponds to two// consecutive red links in red-black trees.op"[]"() ->optionalAA_Tree;// Create an empty treefuncInsert(varT :optionalAA_Tree; X : Element);// input: X, the value to be inserted, and// T, the root of the tree to insert it into.// output: A balanced T' including X.funcDelete(varT :optionalAA_Tree; X : Element);// input: X, the value to delete, and T,// the root of the tree from which it should be deleted.// output: T', balanced, without the value X.op"in"(X : Element; T :optionalAA_Tree) -> Boolean;funcOverlapping(T :optionalAA_Tree; X : Element) ->optionalElement;// input: X, the value to find, and T,// the root of the tree to be searched.// output: the element equal to or "unordered" relative to X.op"|="(varT :optionalAA_Tree; X : Element)isInsert;op"<|="(varT :optionalAA_Tree;varX :optionalElement);// Move X into AA_Tree, leaving X null.funcFirst(T :optionalAA_Tree) ->optionalElement;// Return first (smallest) element in treefuncLast(T :optionalAA_Tree) ->optionalElement;// Return last (greatest) element in treefuncRemove_First(varT :optionalAA_Tree) ->optionalElement;// Remove first (smallest) element in treefuncRemove_Last(varT :optionalAA_Tree) ->optionalElement;// Remove last (greatest) element in treefuncRemove_Any(varT :optionalAA_Tree) ->optionalElement;// Remove some element from treefuncCount(T :optionalAA_Tree) -> Univ_Integer;// Return a count of the nodes in the treefuncIs_Empty(T :optionalAA_Tree) -> Boolean;// Return True if the tree is emptyendinterfaceAA_Tree;classAA_TreeisvarValue : Element;varLevel : Univ_Integer := 0;varLeft :optionalAA_Tree;varRight :optionalAA_Tree;funcNode(varValue :optionalElement; Level : Univ_Integer; Left, Right :optionalAA_Tree) -> AA_Treeis// Create a new tree; move Value into it.return(Value <== Value, Level => Level, Left => Left, Right => Right);endfuncNode;funcIs_Leaf(T :optionalAA_Tree) -> BooleanisreturnTnotnullandthenT.LeftisnullandthenT.Rightisnull;endfuncIs_Leaf;funcLeftmost(refT :optionalAA_Tree) ->refoptionalAA_TreeisforL => TloopifLnotnullandthenL.Leftnotnullthen// Continue with Left until we reach nullcontinueloopwithL.Left;else// Found left-mostreturnL;endif;endloop;endfuncLeftmost;funcSuccessor(T :optionalAA_Tree) ->optionalElementis// Return element in tree greater than but closest to T.ValueifT.RightnotnullthenconstSucc := Leftmost(T.Right);{Succ;notnull}returnSucc.Value;elsereturnnull;endif;endfuncSuccessor;funcRightmost(refT :optionalAA_Tree) ->refoptionalAA_TreeisforR => TloopifRnotnullandthenR.Rightnotnullthen// Keep following down Right sidecontinueloopwithR.Right;else// Found right-mostreturnR;endif;endloop;endfuncRightmost;funcPredecessor(T :optionalAA_Tree) ->optionalElementis// Return element in tree less than but closest to T.ValueifT.LeftnotnullthenreturnRightmost(T.Left).Value;elsereturnnull;endif;endfuncPredecessor;funcSkew(varT :optionalAA_Tree)is// input: T, a node representing an AA tree that needs to be rebalanced.// output: T' Another node representing the rebalanced AA tree.ifTnotnullandthenT.LeftnotnullandthenT.Left.Level == T.Levelthen// The current T.Left becomes new root// Exchange value of T.Left with rootT.Value <=> T.Left.Value;// Move old root and T.Left.Right over to right side of treeT.Left.Right <=> T.Right; T.Left.Left <=> T.Right; T.Left <=> T.Right;endif;endfuncSkew;funcSplit(varT :optionalAA_Tree)is// input: T, a node representing an AA tree that needs to be rebalanced.// output: T' Another node representing the rebalanced AA tree.ifTnotnullandthenT.RightnotnullandthenT.Right.RightnotnullandthenT.Level == T.Right.Right.Levelthen// T.Right becomes the new root// Exchange value and level between root and T.RightT.Value <=> T.Right.Value; T.Level <=> T.Right.Level;// Move old root and T.Right.Left to left side of treeT.Left <=> T.Right.Right; T.Right.Left <=> T.Right.Right; T.Left <=> T.Right;// Increment levelT.Level += 1;endif;endfuncSplit;funcDecrease_Level(varT :optionalAA_Tree)is// input: T, a tree for which we want to remove links that skip levels.// output: T with its level decreased.ifTisnullthenreturn;endif;varShould_Be : Univ_Integer := 1;ifT.LeftnotnullthenShould_Be := T.Left.Level + 1;endif;ifT.RightnotnullthenShould_Be := Min(Should_Be, T.Right.Level + 1);endif;ifShould_Be < T.LevelthenT.Level := Should_Be;ifT.RightnotnullandthenShould_Be < T.Right.LevelthenT.Right.Level := Should_Be;endif;endif;endfuncDecrease_Level;exportsop"[]"() ->optionalAA_Treeis// Create an empty treereturnnull;endop"[]";// Insertion begins with the normal binary tree search and insertion// procedure. Then, as the call stack unwinds (assuming a recursive// implementation of the search), it's easy to check the validity of the// tree and perform any rotations as necessary. If a horizontal left link// arises, a skew will be performed, and if two horizontal right links// arise, a split will be performed, possibly incrementing the level of the// new root node of the current subtree. Note, in the code as given above,// the increment of T.Level. This makes it necessary to continue checking// the validity of the tree as the modifications bubble up from the leaves.op"<|="(varT :optionalAA_Tree;varX :optionalElement)is// Move X into AA_Tree, leaving X null.// input: X, the value to be inserted, and// T, the root of the tree to insert it into.// output: A balanced T' including X.// Do the normal binary tree insertion procedure.// Set the result of the recursive call to the correct// child in case a new node was created or the// root of the subtree changes.ifTisnullthen// Create a new leaf node with X.T := Node(X, 1,null,null);return;endif;caseX =? T.Valueof[#less] => T.Left <|= X; [#greater] => T.Right <|= X; [#equal | #unordered] =>// Note that the case of X == T.Value is unspecified.// As given, an insert will have no effect.// The implementor may desire different behavior.X :=null;return;endcase;// Perform skew and then split.// The conditionals that determine whether or// not a rotation will occur or not are inside// of the procedures, as given above.Skew(T); Split(T);endop"<|=";funcInsert(varT :optionalAA_Tree; X : Element)is// Just pass the buck to the "<|=" operationvarX_CopyforT := X; T <|= X_Copy;endfuncInsert;// As in most balanced binary trees, the deletion of an internal node can// be turned into the deletion of a leaf node by swapping the internal node// with either its closest predecessor or successor, depending on which are// in the tree or on the implementor's whims. Retrieving a predecessor is// simply a matter of following one left link and then all of the remaining// right links. Similarly, the successor can be found by going right once// and left until a null pointer is found. Because of the AA property of// all nodes of level greater than one having two children, the successor// or predecessor node will be in level 1, making their removal trivial.//// To re-balance a tree, there are a few approaches. The one described by// Andersson in his original paper is the simplest, and it is described// here, although actual implementations may opt for a more optimized// approach. After a removal, the first step to maintaining tree validity// is to lower the level of any nodes whose children are two levels below// them, or who are missing children. Then, the entire level must be skewed// and split. This approach was favored, because when laid down// conceptually, it has three easily understood separate steps://// Decrease the level, if appropriate.// Skew the level.// Split the level.//// However, we have to skew and split the entire level this time instead of// just a node, complicating our code.funcDelete(varT :optionalAA_Tree; X : Element)is// input: X, the value to delete, and T,// the root of the tree from which it should be deleted.// output: T', balanced, without the value X.ifTisnullthen// Not in tree -- should we complain?return;endif;caseX =? T.Valueof[#less] => Delete(T.Left, X); [#greater] => Delete(T.Right, X); [#equal] =>// If we're a leaf, easy, otherwise reduce to leaf case.ifIs_Leaf(T)thenT :=null;elsifT.Leftisnullthen// Get successor value and delete it from right tree,// and set root to have that valueconstSucc := Successor(T); Delete(T.Right, Succ); T.Value := Succ;else// Get predecessor value and delete it from left tree,// and set root to have that valueconstPred := Predecessor(T); Delete(T.Left, Pred); T.Value := Pred;endif; [#unordered] =>// Not in tree; should we complain?return;endcase;// Rebalance the tree. Decrease the level of all nodes in this level if// necessary, and then skew and split all nodes in the new level.ifTisnullthenreturn;endif; Decrease_Level(T); Skew(T); Skew(T.Right);ifT.RightnotnullthenSkew(T.Right.Right);endif; Split(T); Split(T.Right);endfuncDelete;op"in"(X : Element; T :optionalAA_Tree) -> Result : BooleanisforP => TwhilePnotnullloopcaseX =? P.Valueof[#less] =>continueloopwithP.Left; [#greater] =>continueloopwithP.Right; [#equal] =>return#true; [#unordered] =>return#false;endcase;endloop;return#false;// Not foundendop"in";funcFirst(T :optionalAA_Tree) ->optionalElementis// Return first (smallest) element in treeifTisnullthenreturnnull;elsereturnLeftmost(T).Value;endif;endfuncFirst;funcLast(T :optionalAA_Tree) ->optionalElementis// Return last (greatest) element in treeifTisnullthenreturnnull;elsereturnRightmost(T).Value;endif;endfuncLast;funcRemove_First(varT :optionalAA_Tree) -> Result :optionalElementis// Remove first (smallest) element in treeResult := First(T);ifResultnotnullthenDelete(T, Result);endif;endfuncRemove_First;funcRemove_Last(varT :optionalAA_Tree) -> Result :optionalElementis// Remove last (greatest) element in treeResult := Last(T);ifResultnotnullthenDelete(T, Result);endif;endfuncRemove_Last;funcRemove_Any(varT :optionalAA_Tree) -> Result :optionalElementis// Remove some element from treeifTisnullthenreturnnull;endif; Result := T.Value;ifResultnotnullthenDelete(T, Result);endif;endfuncRemove_Any;funcIs_Empty(T :optionalAA_Tree) -> Booleanis// Return True if the tree is emptyreturnTisnull;endfuncIs_Empty;funcCount(T :optionalAA_Tree) -> Univ_Integeris// Return a count of the nodes in the treeifTisnullthenreturn0;elsereturnCount(T.Left) + Count(T.Right) + 1;endif;endfuncCount;funcOverlapping(T :optionalAA_Tree; X : Element) ->optionalElementis// input: X, the value to find, and T,// the root of the tree to be searched.// output: the element equal to or "unordered" relative to X.ifTisnullorelseT.Valueisnullthenreturnnull;elsecaseX =? T.Valueof[#less] =>returnOverlapping(T.Left, X); [#greater] =>returnOverlapping(T.Right, X); [#equal | #unordered] =>// Close enoughreturnT.Value;endcase;endif;endfuncOverlapping;endclassAA_Tree;funcTest_AA_Tree(A : Univ_Integer; B : Univ_Integer; C : Univ_Integer)istypeUniv_TreeisAA_Tree<Univ_Integer>;varT : Univ_Tree := [];varX : Univ_Integer := A; Insert(T, A); Println("Count = " | Count(T) | " after insert of " | A); Insert(T, B); Println("Count = " | Count(T) | " after insert of " | B); Insert(T, C); Println("Count = " | Count(T) | " after insert of " | C); Insert(T, A); Println("Count = " | Count(T) | " after another insert of " | A); Println(A | " in T = " | (AinT)); Println(B | " in T = " | (BinT)); Println(C | " in T = " | (CinT)); Println("7 in T = " | (7inT));forE := Remove_First(T)thenRemove_First(T)whileEnotnullloopPrintln("Remove_First = " | E);endloop; Println("Count after loop : " | Count(T));forIin1..10forwardloopInsert(T, I); Println("Count = " | Count(T) | " after insert of " | I);endloop;forL := Remove_Last(T)thenRemove_Last(T)whileLnotnullloopPrintln("Remove_Last = " | L);endloop; Println("Count after loop : " | Count(T));forJin1..10reverseloopInsert(T, J); Println("Count = " | Count(T) | " after insert of " | J);endloop; Println("Count after loop : " | Count(T)); Println("Overlapping(T, 5) = " | Overlapping(T, 5));forZ := Remove_Any(T)thenRemove_Any(T)whileZnotnullloopPrintln("Remove_Any = " | Z);endloop; Println("Count after loop : " | Count(T));forKin1..10loopInsert(T, K); Println("Count = " | Count(T) | " after insert of " | K);endloop;forF := Remove_First(T)thenRemove_First(T)whileFnotnullloopPrintln("Remove_First = " | F);endloop; Println("Count after loop : " | Count(T));endfuncTest_AA_Tree;

## No comments:

## Post a Comment