[q-lang-cvs] q/stdlib bag.q, 1.5, 1.6 dict.q, 1.5, 1.6 hdict.q, 1.6, 1.7 set.q, 1.6, 1.7

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Update of /cvsroot/q-lang/q/stdlib
In directory sc8-pr-cvs16.sourceforge.net:/tmp/cvs-serv18298

Modified Files:
	bag.q dict.q hdict.q set.q 
Log Message:
faster AVL tree implementation by Jiri Spitz

Index: bag.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/bag.q,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** bag.q	2 Oct 2007 00:56:23 -0000	1.5
--- bag.q	21 Feb 2008 07:58:13 -0000	1.6
***************
*** 19,23 ****
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

! public type Bag = virtual bag Xs | private const nil, bin H X M1 M2;

  /* Construction and type checking: */
--- 19,38 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

! /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!    Updated: 18 February 2008 by Jiri Spitz
! 
!    Purpose: More efficient algorithm for association lists implemented
!    as AVL trees.
! 
!    The used algorithm has its origin in the SWI-Prolog implementation of
!    association lists. The original file was created by R.A.O'Keefe and
!    updated for the SWI-Prolog by Jan Wielemaker. For the original file
!    see http://www.swi-prolog.org.
! 
!    The deletion stuff (rmfirst, rmlast, delete) is new, it was missing
!    in the original assoc.pl file.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
! 
! public type Bag = virtual bag Xs | private const nil, bin X B M1 M2;

  /* Construction and type checking: */
***************
*** 56,102 ****
  @0

  /* Private Functions: ******************************************************/

! private height M;		// return height of tree
! private slope M;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin X M1 M2;		// construct node, recomputing height

! private rebal M;		// rebalance tree after insertions and 
! 				// deletions
! private rol M, ror M;		// single rotation left/right
! private shl M, shr M;		// shift to left/right (single or double
! 				// rotation)

! private join M1 M2;		// join two balanced subtrees

! height nil			= 0;
! height (bin H _ _ _)		= H;

! slope nil			= 0;
! slope (bin _ _ M1 M2)		= height M1 - height M2;

! mkbin X M1 M2			= bin (max (height M1) (height M2) + 1)
! 				  X M1 M2;

! rebal M				= shl M if slope M = -2;
! 				= shr M if slope M = 2;
! 				= M otherwise;

! rol (bin _ X1 M1 (bin _ X2 M2 M3))
! 				= mkbin X2 (mkbin X1 M1 M2) M3;
! ror (bin _ X1 (bin _ X2 M1 M2) M3)
! 				= mkbin X2 M1 (mkbin X1 M2 M3);

! shl (bin H X M1 M2)		= rol (mkbin X M1 (ror M2)) if slope M2 = 1;
! 				= rol (bin H X M1 M2) otherwise;

! shr (bin H X M1 M2)		= ror (mkbin X (rol M1) M2)
! 				      if slope M1 = -1;
! 				= ror (bin H X M1 M2) otherwise;

! join nil M2			= M2;
! join M1 M2			= rebal (mkbin (last M1) (rmlast M1) M2)
! 				      otherwise;

  /* Public Functions: *******************************************************/
--- 71,266 ----
  @0

+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/

! private inserta Tree Key;
! 	// insert a new (or replace an existing) member in the tree

! private rmfirsta Tree;
! 	// remove the first member from the tree

! private rmlasta Tree;
! 	// remove the last member from the tree

! private deletea Tree Key;
! 	// delete member with Key from the tree

! private adjusti TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after an insertion

! private rebali ToBeRebalanced Tree NewBalance;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq

! private adjustd TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after a deletion

! private rebald ToBeRebalanced Tree NewBalance WhatHasChanged;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq

! private avl_geq Tree;
! 	// single and double rotations of the tree

! private tablei BalanceBefore WhereInserted;
! 	// insert balance rules

! private tabled BalanceBefore WhereDeleted;
! 	// delete balance rules
! 
! private table2 BalanceOfSubSubNode;
! 	// balance rules for double rotations
! 
! /*
! Tree is either:
! 
! -  nil  (empty tree) or
! -  bin Key Balance Left Right  (Left, Right: trees)
!    Balance: islt, iseq, or isgt denoting |L|-|R| = 1, 0, or -1, respectively
! */
! 
! inserta nil Key			= ((bin Key iseq nil nil), true);
! 
! inserta (bin K B L R) Key if Key < K:
! 		= adjusti LeftHasChanged (bin K B NewL R) left
! 		    where (NewL, LeftHasChanged) = inserta L Key;
! 
! inserta (bin K B L R) Key if Key >= K:
! 		= adjusti RightHasChanged (bin K B L NewR) right
! 		    where (NewR, RightHasChanged) = inserta R Key;
! 
! rmfirsta nil			= (nil, false);
! rmfirsta (bin _ _ nil R)	= (R, true);
! 
! rmfirsta (bin K B L   R)
! 		= adjustd LeftHasChanged (bin K B NewL R) left
! 		    where (NewL, LeftHasChanged) = rmfirsta L;
! 
! rmlasta nil			= (nil false);
! rmlasta (bin _ _ L nil)		= (L, true);
! 
! rmlasta (bin K B L   R)
! 		= adjustd RightHasChanged (bin K B L NewR) right
! 		    where (NewR, RightHasChanged) = rmlasta R;
! 
! deletea nil _			= (nil, false);
! deletea (bin Key _ nil R  ) Key	= (R, true);
! deletea (bin Key _ L   nil) Key	= (L, true);
! 
! deletea (bin Key B (bin KL BL RL LL) R) Key
! 		= adjustd LeftHasChanged (bin LastK B NewL R) left
! 		    where
! 		      LastK			= last (bin KL BL RL LL),
! 		      (NewL, LeftHasChanged)	= rmlasta (bin KL BL RL LL);
! 
! deletea (bin K B L R) Key if Key < K:
! 		= adjustd LeftHasChanged (bin K B NewL R) left
! 		    where
! 		      (NewL, LeftHasChanged) = deletea L Key;
! 
! deletea (bin K B L R) Key if Key > K:
! 		= adjustd RightHasChanged (bin K B L NewR) right
! 		    where
! 		      (NewR, RightHasChanged) = deletea R Key;
! 
! // The insertions and deletions are dealt with separately.
! // Insertions
! adjusti false OldTree _		= (OldTree, false);
! 
! adjusti true (bin Key B0 L R) LoR
! 		= (rebali ToBeRebalanced (bin Key B0 L R) B1, WhatHasChanged)
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tablei B0 LoR;
! 
! rebali false (bin K _ L R) B	= bin K B L R;
! rebali true  OldTree _		= fst (avl_geq OldTree);
! 
! // Balance rules for insertions
! //	balance	where		balance	  whole tree	to be
! //	before	inserted	after	  increased	rebalanced
! tablei	iseq	left		= (islt,  true,		false);
! tablei	iseq	right		= (isgt,  true,		false);
! tablei	islt	left		= (iseq,  false,	true);
! tablei	islt	right		= (iseq,  false,	false);
! tablei	isgt	left		= (iseq,  false,	false);
! tablei	isgt	right		= (iseq,  false,	true);
! 
! // Deletions
! adjustd false OldTree _		= (OldTree, false);
! 
! adjustd true (bin Key B0 L R) LoR
! 		= rebald ToBeRebalanced (bin Key B0 L R) B1 WhatHasChanged
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tabled B0 LoR;
! 
! // Balance rules for deletions
! //	balance	where		balance	  whole tree	to be
! //	before	deleted		after	  decreased	rebalanced
! tabled	iseq	right		= (islt,  false,	false);
! tabled	iseq	left		= (isgt,  false,	false);
! tabled	islt	right		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! tabled	islt	left		= (iseq,  true, 	false);
! tabled	isgt	right		= (iseq,  true,		false);
! tabled	isgt	left		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! /*
!    Note that rebali and rebald are not symmetrical. With insertions it is
!    sufficient to know the original balance and insertion side in order to
!    decide whether the whole tree increases. With deletions it is sometimes not
!    sufficient and we need to know which kind of tree rotation took place.
! */
! rebald false (bin K _ L R) B WhatHasChanged
! 				= (bin K B L R, WhatHasChanged);
! rebald true  OldTree _ _	= avl_geq OldTree;
! 
! // Single and double tree rotations - these are common for insert and delete
! /*
!   The patterns isgt-isgt, isgt-islt, islt-islt and islt-isgt on the LHS always
!   change the tree height and these are the only patterns which can happen
!   after an insertion. That's the reason why we can use tablei only to decide
!   the needed changes.
!   The patterns isgt-iseq and islt-iseq do not change the tree height. After a
!   deletion any pattern can occur and so we return true or false as a flag of
!   a height change.
! */
! avl_geq (bin A isgt Alpha (bin B isgt Beta Gamma))
! 		= (bin B iseq (bin A iseq Alpha Beta) Gamma, true);
! 
! avl_geq (bin A isgt Alpha (bin B iseq Beta Gamma))
! 		= (bin B islt (bin A isgt Alpha Beta) Gamma, false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin A isgt Alpha (bin B islt (bin X B1 Beta Gamma) Delta))
! 		= (bin X iseq (bin A B2 Alpha Beta)
! 		   (bin B B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! avl_geq (bin B islt (bin A islt Alpha Beta) Gamma)
! 		= (bin A iseq Alpha (bin B iseq Beta  Gamma), true);
! 
! avl_geq (bin B islt (bin A iseq Alpha Beta) Gamma)
! 		= (bin A isgt Alpha (bin B islt Beta  Gamma), false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin B islt (bin A isgt Alpha (bin X B1 Beta Gamma)) Delta)
! 		= (bin X iseq (bin A B2 Alpha Beta)
! 		   (bin B B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! table2 islt			= (iseq, isgt);
! table2 isgt			= (islt, iseq);
! table2 iseq			= (iseq, iseq);

  /* Public Functions: *******************************************************/
***************
*** 115,145 ****

  member nil _			= false;
! member (bin _ X M1 M2) Y	= member M1 Y if X>Y;
  				= member M2 Y if X<Y;
  				= true if X=Y;

  members nil			= [];
! members (bin _ X M1 M2)		= members M1 ++ [X|members M2];

! first (bin _ X nil _)		= X;
  first (bin _ _ M1 _)		= first M1 otherwise;

! last (bin _ X _ nil)		= X;
  last (bin _ _ _ M2)		= last M2 otherwise;

! rmlast (bin _ _ M1 nil)		= M1;
! rmlast (bin _ X M1 M2)		= rebal (mkbin X M1 (rmlast M2)) otherwise;

! rmfirst (bin _ _ nil M2)	= M2;
! rmfirst (bin _ X M1 M2)		= rebal (mkbin X (rmfirst M1) M2) otherwise;

! insert nil Y			= bin 1 Y nil nil;
! insert (bin _ X M1 M2) Y	= rebal (mkbin X (insert M1 Y) M2) if X>Y;
! 				= rebal (mkbin X M1 (insert M2 Y)) if X<=Y;

! delete nil _			= nil;
! delete (bin _ X M1 M2) Y	= rebal (mkbin X (delete M1 Y) M2) if X>Y;
! 				= rebal (mkbin X M1 (delete M2 Y)) if X<Y;
! 				= join M1 M2 if X=Y;

  /* bag comparison, union, difference and intersection: */
--- 279,302 ----

  member nil _			= false;
! member (bin X _ M1 M2) Y	= member M1 Y if X>Y;
  				= member M2 Y if X<Y;
  				= true if X=Y;

  members nil			= [];
! members (bin X _ M1 M2)		= members M1 ++ [X|members M2];

! first (bin X _ nil _)		= X;
  first (bin _ _ M1 _)		= first M1 otherwise;

! last (bin X _ _ nil)		= X;
  last (bin _ _ _ M2)		= last M2 otherwise;

! rmlast Xs			= fst (rmlasta Xs);

! rmfirst Xs			= fst (rmfirsta Xs);

! insert Xs Y			= fst (inserta Xs Y);

! delete Xs Y			= fst (deletea Xs Y);

  /* bag comparison, union, difference and intersection: */

Index: hdict.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/hdict.q,v
retrieving revision 1.6
retrieving revision 1.7
diff -C2 -d -r1.6 -r1.7
*** hdict.q	2 Oct 2007 00:56:24 -0000	1.6
--- hdict.q	21 Feb 2008 07:58:13 -0000	1.7
***************
*** 19,22 ****
--- 19,37 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

+ /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    Updated: 18 February 2008 by Jiri Spitz
+ 
+    Purpose: More efficient algorithm for association lists implemented
+    as AVL trees.
+ 
+    The used algorithm has its origin in the SWI-Prolog implementation of
+    association lists. The original file was created by R.A.O'Keefe and
+    updated for the SWI-Prolog by Jan Wielemaker. For the original file
+    see http://www.swi-prolog.org.
+ 
+    The deletion stuff (delete) is new, it was missing in the original
+    assoc.pl file.
+ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
+ 
  /* This is a variation of the dictionary data structure using hashed key
     values (commonly called "hashes" or "associative arrays" in other
***************
*** 32,36 ****
     permutations of each other. */

! public type HDict = virtual hdict XYs | private const nil, bin H XY D1 D2;

  /* Construction and type checking: */
--- 47,51 ----
     permutations of each other. */

! public type HDict = virtual hdict XYs | private const nil, bin K V B D1 D2;

  /* Construction and type checking: */
***************
*** 70,129 ****
  @0

  /* Private Functions: ******************************************************/

! private height D;		// return height of tree
! private slope D;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin U D1 D2;		// construct node, recomputing height

! private rebal D;		// rebalance tree after insertions and 
! 				// deletions
! private rol D, ror D;		// single rotation left/right
! private shl D, shr D;		// shift to left/right (single or double
! 				// rotation)

! private last D, rmlast D;	// get/remove last bucket from dictionary
! private join D1 D2;		// join two balanced subtrees

! height nil			= 0;
! height (bin H _ _ _)		= H;

! slope nil			= 0;
! slope (bin _ _ D1 D2)		= height D1 - height D2;

! mkbin U D1 D2			= bin (max (height D1) (height D2) + 1)
! 				  U D1 D2;

! rebal D				= shl D if slope D = -2;
! 				= shr D if slope D = 2;
! 				= D otherwise;

! rol (bin H1 U1 D1 (bin H2 U2 D2 D3))
! 				= mkbin U2 (mkbin U1 D1 D2) D3;
! ror (bin H1 U1 (bin H2 U2 D1 D2) D3)
! 				= mkbin U2 D1 (mkbin U1 D2 D3);

! shl (bin H U D1 D2)		= rol (mkbin U D1 (ror D2))
! 				      if slope D2 = 1;
! 				= rol (bin H U D1 D2) otherwise;

! shr (bin H U D1 D2)		= ror (mkbin U (rol D1) D2)
! 				      if slope D1 = -1;
! 				= ror (bin H U D1 D2) otherwise;

! last (bin _ U _ nil)		= U;
! last (bin _ _ _ D2)		= last D2 otherwise;

! rmlast (bin _ _ D1 nil)		= D1;
! rmlast (bin _ U D1 D2)		= rebal (mkbin U D1 (rmlast D2))
! 				      otherwise;

! join nil D2			= D2;
! join D1 D2			= rebal (mkbin (last D1) (rmlast D1) D2)
! 				      otherwise;

! /* look up the value for a (K,X) pair in a dictionary, where K = hash X */

! private lookup _ _;

  /* If we can't find X, pretend we got a `nil!X', so the user can supply a
--- 85,145 ----
  @0

+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/

! private last Tree;
! 	// find the last element in the tree

! private inserta Tree Hash Key Val;
! 	// insert a new (or replace an existing) member in the tree

! private rmlasta Tree;
! 	// remove the last member from the tree

! private deletea Tree Hash Key;
! 	// delete member with Key from the tree

! private adjusti TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after an insertion

! private rebali ToBeRebalanced Tree NewBalance;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq

! private adjustd TreeHasChanged Tree LeftOrRight;
! 	// decide changes needed in order to make a well
! 	// shaped tree after a deletion

! private rebald ToBeRebalanced Tree NewBalance WhatHasChanged;
! 	// if ToBeRabalanced = false then set the balance of the root node
! 	// to NewBalance else call avl_geq

! private avl_geq Tree;
! 	// single and double rotations of the tree

! private tablei BalanceBefore WhereInserted;
! 	// insert balance rules

! private tabled BalanceBefore WhereDeleted;
! 	// delete balance rules

! private table2 BalanceOfSubSubNode;
! 	// balance rules for double rotations

! /*
! Tree is either:

! -  nil  (empty tree) or
! -  bin Key Value Balance Left Right  (Left, Right: trees)
!    Balance: islt, iseq, or isgt denoting |L|-|R| = 1, 0, or -1, respectively
! */

! /* look up the value for a (K,X) pair in a dictionary, where K = hash X */

  /* If we can't find X, pretend we got a `nil!X', so the user can supply a
***************
*** 131,192 ****
     consistent with dict.q. */

! lookup nil (K,X)		= nil!X;
! lookup (bin _ (K,XYs) D1 D2) (K1,X1)
! 				= lookup D1 (K1,X1) if K>K1;
! 				= lookup D2 (K1,X1) if K<K1;
! 				= lookup XYs X1 otherwise;

! lookup [] X			= nil!X;
! lookup [(X,Y)|_] X		= Y;
! lookup [_|XYs] X		= lookup XYs X otherwise;

  /* check whether value is in given bucket of a dictionary */

! private memberk _ _;

! memberk nil _			= false;
! memberk (bin _ (K,XYs) D1 D2) (K1,X1)
! 				= memberk D1 (K1,X1) if K>K1;
! 				= memberk D2 (K1,X1) if K<K1;
! 				= memberk XYs X1 otherwise;

! memberk [] _			= false;
! memberk [(X,Y)|_] X		= true;
! memberk [_|XYs] X		= memberk XYs X otherwise;

! /* insert value for a given hash key */

! private insertk _ _;

! insertk nil (K1,X1,Y1)		= bin 1 (K1,[(X1,Y1)]) nil nil;
! insertk (bin H (K,XYs) D1 D2) (K1,X1,Y1)
! 				= rebal (mkbin (K,XYs) (insertk D1 (K1,X1,Y1))
! 					 D2) if K>K1;
! 				= rebal (mkbin (K,XYs) D1
! 					 (insertk D2 (K1,X1,Y1))) if K<K1;
! 				= bin H (K1,insertk XYs (X1,Y1)) D1 D2
! 				    otherwise;

! insertk [] (X,Y)		= [(X,Y)];
! insertk [(X,Y)|XYs] (X,Y1)	= [(X,Y1)|XYs];
! insertk [(X,Y)|XYs] (X1,Y1)	= [(X,Y)|insertk XYs (X1,Y1)] otherwise;

! /* delete value for a given hash key */

! private deletek _ _;

! deletek nil _			= nil;
! deletek (bin H (K,XYs) D1 D2) (K1,X1)
! 				= rebal (mkbin (K,XYs) (deletek D1 (K1,X1)) D2)
! 				      if K>K1;
! 				= rebal (mkbin (K,XYs) D1 (deletek D2 (K1,X1)))
! 				      if K<K1;
! 				= bin H (K,XYs1) D1 D2 if not null XYs1
! 				    where XYs1 = deletek XYs X1;
! 				= join D1 D2 otherwise;

! deletek [] _			= [];
! deletek [(X,_)|XYs] X		= XYs;
! deletek [(X,Y)|XYs] X1		= [(X,Y)|deletek XYs X1] otherwise;

  /* Public Functions: *******************************************************/
--- 147,339 ----
     consistent with dict.q. */

! private lookup _ _ _, lookup2 _ _;

! lookup nil K X			= nil!X;
! lookup (bin K XYs _ D1 D2) K1 X1
! 				= lookup D1 K1 X1 if K>K1;
! 				= lookup D2 K1 X1 if K<K1;
! 				= lookup2 XYs X1 otherwise;
! 
! lookup2 [] X			= nil!X;
! lookup2 [(X,Y)|_] X		= Y;
! lookup2 [_|XYs] X		= lookup2 XYs X otherwise;

  /* check whether value is in given bucket of a dictionary */

! private memberk _ _ _, memberk2 _ _;

! memberk nil _ _			= false;
! memberk (bin K XYs _ D1 D2) K1 X1
! 				= memberk D1 K1 X1 if K>K1;
! 				= memberk D2 K1 X1 if K<K1;
! 				= memberk2 XYs X1 otherwise;

! memberk2 [] _			= false;
! memberk2 [(X,Y)|_] X		= true;
! memberk2 [_|XYs] X		= memberk2 XYs X otherwise;

! /* insertions */

! private inserta2 _ _ _;

! inserta nil K X Y		= ((bin K [(X, Y)] iseq nil nil), true);
! inserta (bin K V B L R) K X Y	= ((bin K (inserta2 V X Y) B L R), false);

! inserta (bin K V B L R) Key X Y	if Key < K:
! 		= adjusti LeftHasChanged (bin K V B NewL R) left
! 		    where (NewL, LeftHasChanged) = inserta L Key X Y;

! inserta (bin K V B L R) Key X Y if Key > K:
! 		= adjusti RightHasChanged (bin K V B L NewR) right
! 		    where (NewR, RightHasChanged) = inserta R Key X Y;

! inserta2 [] X Y			= [(X,Y)];
! inserta2 [(X,Y)|XYs] X Y1	= [(X,Y1)|XYs];
! inserta2 [(X,Y)|XYs] X1 Y1	= [(X,Y)|inserta2 XYs X1 Y1] otherwise;

! /* deletions */

! // find the last value in the tree
! last (bin Key Val _ _ nil)	= (Key, Val);
! last (bin _ _ _ _ R)		= last R;
! 
! // remove last value from the tree
! rmlasta nil			= (nil false);
! rmlasta (bin _ _ _ L nil)	= (L, true);
! 
! rmlasta (bin K V B L   R)
! 		= adjustd RightHasChanged (bin K V B L NewR) right
! 		    where (NewR, RightHasChanged) = rmlasta R;
! 
! private deletea2 _ _;
! 
! deletea nil _			= (nil, false);
! 
! deletea (bin Key XYs B nil R  ) Key X
! 		= if null NewXYs then (R, true)
! 		  else (bin Key NewXYs B nil R, false)
! 		    where NewXYs = deletea2 XYs X;
! 
! deletea (bin Key XYs B L   nil) Key X
! 		= if null NewXYs then (L, true)
! 		  else (bin Key NewXYs B L nil, false)
! 		    where NewXYs = deletea2 XYs X;
! 
! deletea (bin Key XYs B (bin KL VL BL RL LL) R) Key X if null (deletea2 XYs X):
! 		= adjustd LeftHasChanged (bin LastK LastV B NewL R) left
! 		    where
! 		      (LastK, LastV)		= last (bin KL VL BL RL LL),
! 		      (NewL, LeftHasChanged)	= rmlasta (bin KL VL BL RL LL);
! 
! deletea (bin Key XYs B L R) Key X
! 		= (bin Key (deletea2 XYs X) B L R, false);
! 
! deletea (bin K V B L R) Key X if Key < K:
! 		= adjustd LeftHasChanged (bin K V B NewL R) left
! 		    where
! 		      (NewL, LeftHasChanged) = deletea L Key X;
! 
! deletea (bin K V B L R) Key X if Key > K:
! 		= adjustd RightHasChanged (bin K V B L NewR) right
! 		    where
! 		      (NewR, RightHasChanged) = deletea R Key X;
! 
! deletea2 [] _			= [];
! deletea2 [(X,_)|XYs] X		= XYs;
! deletea2 [(X,Y)|XYs] X1		= [(X,Y)|deletea2 XYs X1] otherwise;
! 
! // The insertions and deletions are dealt with separately.
! // Insertions
! adjusti false OldTree _		= (OldTree, false);
! 
! adjusti true (bin Key Val B0 L R) LoR
! 		= (rebali ToBeRebalanced (bin Key Val B0 L R) B1,
! 		   WhatHasChanged)
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tablei B0 LoR;
! 
! rebali false (bin K V _ L R) B	= bin K V B L R;
! rebali true  OldTree _		= fst (avl_geq OldTree);
! 
! // Balance rules for insertions
! //	balance	where		balance	  whole tree	to be
! //	before	inserted	after	  increased	rebalanced
! tablei	iseq	left		= (islt,  true,		false);
! tablei	iseq	right		= (isgt,  true,		false);
! tablei	islt	left		= (iseq,  false,	true);
! tablei	islt	right		= (iseq,  false,	false);
! tablei	isgt	left		= (iseq,  false,	false);
! tablei	isgt	right		= (iseq,  false,	true);
! 
! // Deletions
! adjustd false OldTree _		= (OldTree, false);
! 
! adjustd true (bin Key Val B0 L R) LoR
! 		= rebald ToBeRebalanced (bin Key Val B0 L R) B1 WhatHasChanged
! 		    where
! 		      (B1, WhatHasChanged, ToBeRebalanced) = tabled B0 LoR;
! 
! // Balance rules for deletions
! //	balance	where		balance	  whole tree	to be
! //	before	deleted		after	  decreased	rebalanced
! tabled	iseq	right		= (islt,  false,	false);
! tabled	iseq	left		= (isgt,  false,	false);
! tabled	islt	right		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! tabled	islt	left		= (iseq,  true, 	false);
! tabled	isgt	right		= (iseq,  true,		false);
! tabled	isgt	left		= (iseq,  true,		true);
! //					  ^^^^
! // It depends on the tree pattern in avl_geq whether it really decreases
! 
! /*
!    Note that rebali and rebald are not symmetrical. With insertions it is
!    sufficient to know the original balance and insertion side in order to
!    decide whether the whole tree increases. With deletions it is sometimes not
!    sufficient and we need to know which kind of tree rotation took place.
! */
! rebald false (bin K V _ L R) B WhatHasChanged
! 				= (bin K V B L R, WhatHasChanged);
! rebald true  OldTree _ _	= avl_geq OldTree;
! 
! // Single and double tree rotations - these are common for insert and delete
! /*
!   The patterns isgt-isgt, isgt-islt, islt-islt and islt-isgt on the LHS always
!   change the tree height and these are the only patterns which can happen
!   after an insertion. That's the reason why we can use tablei only to decide
!   the needed changes.
!   The patterns isgt-iseq and islt-iseq do not change the tree height. After a
!   deletion any pattern can occur and so we return true or false as a flag of
!   a height change.
! */
! avl_geq (bin A VA isgt Alpha (bin B VB isgt Beta Gamma))
! 		= (bin B VB iseq (bin A VA iseq Alpha Beta) Gamma, true);
! 
! avl_geq (bin A VA isgt Alpha (bin B VB iseq Beta Gamma))
! 		= (bin B VB islt (bin A VA isgt Alpha Beta) Gamma, false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin A VA isgt Alpha (bin B VB islt (bin X VX B1 Beta Gamma) Delta))
! 		= (bin X VX iseq (bin A VA B2 Alpha Beta)
! 		   (bin B VB B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! avl_geq (bin B VB islt (bin A VA islt Alpha Beta) Gamma)
! 		= (bin A VA iseq Alpha (bin B VB iseq Beta  Gamma), true);
! 
! avl_geq (bin B VB islt (bin A VA iseq Alpha Beta) Gamma)
! 		= (bin A VA isgt Alpha (bin B VB islt Beta  Gamma), false);
! 			// the tree doesn't decrease with this pattern
! 
! avl_geq (bin B VB islt (bin A VA isgt Alpha(bin X VX B1 Beta Gamma)) Delta)
! 		= (bin X VX iseq (bin A VA B2 Alpha Beta)
! 		   (bin B VB B3 Gamma Delta), true)
! 		    where (B2, B3) = table2 B1;
! 
! table2 islt			= (iseq, isgt);
! table2 isgt			= (islt, iseq);
! table2 iseq			= (iseq, iseq);

  /* Public Functions: *******************************************************/
***************
*** 200,224 ****

  #nil				= 0;
! #bin _ (_,XYs) D1 D2		= #D1+#D2+#XYs;

! D:HDict!X			= lookup D (hash X,X) if not null D;

  null nil			= true;
  null _:HDict			= false otherwise;

! member D:HDict X		= memberk D (hash X,X);

  members nil			= [];
! members (bin _ (_,XYs) D1 D2)	= members D1 ++ XYs ++ members D2;

  keys nil			= [];
! keys (bin _ (_,XYs) D1 D2)	= keys D1 ++ map fst XYs ++ keys D2;

  vals nil			= [];
! vals (bin _ (_,XYs) D1 D2)	= vals D1 ++ map snd XYs ++ vals D2;

! insert D:HDict (X,Y)		= insertk D (hash X,X,Y);

! delete D:HDict X		= deletek D (hash X,X);

  update D:HDict X Y		= insert D (X,Y);
--- 347,371 ----

  #nil				= 0;
! #bin _ XYs _ D1 D2		= #D1+#D2+#XYs;

! D:HDict!X			= lookup D (hash X) X if not null D;

  null nil			= true;
  null _:HDict			= false otherwise;

! member D:HDict X		= memberk D (hash X) X;

  members nil			= [];
! members (bin _ XYs _ D1 D2)	= members D1 ++ XYs ++ members D2;

  keys nil			= [];
! keys (bin _ XYs _ D1 D2)	= keys D1 ++ map fst XYs ++ keys D2;

  vals nil			= [];
! vals (bin _ XYs _ D1 D2)	= vals D1 ++ map snd XYs ++ vals D2;

! insert D:HDict (X,Y)		= fst (inserta D (hash X) X Y);

! delete D:HDict X		= fst (deletea D (hash X) X);

  update D:HDict X Y		= insert D (X,Y);

Index: dict.q
===================================================================
RCS file: /cvsroot/q-lang/q/stdlib/dict.q,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** dict.q	2 Oct 2007 00:56:23 -0000	1.5
--- dict.q	21 Feb 2008 07:58:13 -0000	1.6
***************
*** 19,23 ****
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

! public type Dict = virtual dict XYs | private const nil, bin H XY D1 D2;

  /* Construction and type checking: */
--- 19,38 ----
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

! /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
!    Updated: 18 February 2008 by Jiri Spitz
! 
!    Purpose: More efficient algorithm for association lists implemented
!    as AVL trees.
! 
!    The used algorithm has its origin in the SWI-Prolog implementation of
!    association lists. The original file was created by R.A.O'Keefe and
!    updated for the SWI-Prolog by Jan Wielemaker. For the original file
!    see http://www.swi-prolog.org.
! 
!    The deletion stuff (rmfirst, rmlast, delete) is new, it was missing
!    in the original assoc.pl file.
! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
! 
! public type Dict = virtual dict XYs | private const nil, bin K V B D1 D2;

  /* Construction and type checking: */
***************
*** 60,173 ****
  @0

  /* Private Functions: ******************************************************/

! private height D;		// return height of tree
! private slope D;		// return slope (height diff between left and
! 				// right subtree)
! private mkbin XY D1 D2;		// construct node, recomputing height

! private rebal D;		// rebalance tree after insertions and 
! 				// deletions
! private rol D, ror D;		// single rotation left/right
! private shl D, shr D;		// shift to left/right (single or double
! 				// rotation)

! private join D1 D2;		// join two balanced subtrees

! height nil			= 0;
! height (bin H _ _ _)		= H;

! slope nil			= 0;
! slope (bin _ _ D1 D2)		= height D1 - height D2;

! mkbin XY D1 D2			= bin (max (height D1) (height D2) + 1)
! 				  XY D1 D2;

! rebal D				= shl D if slope D = -2;
! 				= shr D if slope D = 2;
! 				= D otherwise;

! rol (bin H1 XY1 D1 (bin H2 XY2 D2 D3))
! 				= mkbin XY2 (mkbin XY1 D1 D2) D3;
! ror (bin H1 XY1 (bin H2 XY2 D1 D2) D3)
! 				= mkbin XY2 D1 (mkbin XY1 D2 D3);

! shl (bin H XY D1 D2)		= rol (mkbin XY D1 (ror D2))
! 				      if slope D2 = 1;
! 				= rol (bin H XY D1 D2) otherwise;

! shr (bin H XY D1 D2)		= ror (mkbin XY (rol D1) D2)
! 				      if slope D1 = -1;
! 				= ror (bin H XY D1 D2) otherwise;

! join nil D2			= D2;
! join D1 D2			= rebal (mkbin (last D1) (rmlast D1) D2)
! 				      otherwise;

! /* Public Functions: *******************************************************/

! emptydict			= nil;
! dict XYs:List			= foldl insert nil XYs;
! mkdict Y Xs			= dict (zip Xs (mklist Y (#Xs)));

! isdict _:Dict			= true;
! isdict _			= false otherwise;

! #nil				= 0;
! #bin _ _ D1 D2			= #D1+#D2+1;

! bin _ (X,Y) D1 D2 !X1		= D1!X1 if X>X1;
! 				= D2!X1 if X<X1;
! 				= Y if X=X1;

! null nil			= true;
! null _:Dict			= false otherwise;

! member nil _			= false;
! member (bin _ (X,_) D1 D2) X1
! 				= member D1 X1 if X>X1;
! 				= member D2 X1 if X<X1;
! 				= true if X=X1;

! members nil			= [];
! members (bin _ XY D1 D2)	= members D1 ++ [XY|members D2];

! keys nil			= [];
! keys (bin _ (X,_) D1 D2)	= keys D1 ++ [X|keys D2];

! vals nil			= [];
! vals (bin _ (_,Y) D1 D2)	= vals D1 ++ [Y|vals D2];

! first (bin _ XY nil _)		= XY;
! first (bin _ _ D1 _)		= first D1 otherwise;

! last (bin _ XY _ nil)		= XY;
! last (bin _ _ _ D2)		= last D2 otherwise;

! rmfirst (bin _ _ nil D2)	= D2;
! rmfirst (bin _ XY D1 D2)	= rebal (mkbin XY (rmfirst D1) D2)
! 				      otherwise;

! rmlast (bin _ _ D1 nil)		= D1;
! rmlast (bin _ XY D1 D2)		= rebal (mkbin XY D1 (rmlast D2))
! 				      otherwise;

! insert nil (X1,Y1)		= bin 1 (X1,Y1) nil nil;
! insert (bin H (X,Y) D1 D2) (X1,Y1)
! 				= rebal (mkbin (X,Y) (insert D1 (X1,Y1))
! 					 D2) if X>X1;
! 				= rebal (mkbin (X,Y) D1
! 					 (insert D2 (X1,Y1))) if X<X1;
! 				= bin H (X1,Y1) D1 D2 if X=X1;

! delete nil _			= nil;
! delete (bin _ (X,Y) D1 D2) X1	= rebal (mkbin (X,Y) (delete D1 X1) D2)
! 				      if X>X1;
! 				= rebal (mkbin (X,Y) D1 (delete D2 X1))
! 				      if X<X1;
! 				= join D1 D2 if X=X1;

! update D:Dict X Y		= insert D (X,Y);

  (D1:Dict = D2:Dict)		= (members D1 = members D2);
  D1:Dict <> D2:Dict		= members D1 <> members D2;
--- 75,326 ----
  @0

+ /* Private Types: **********************************************************/
+ 
+ // For better readability of the code
+ private type Balance		= const islt, iseq, isgt;
+ private type Side		= const left, right;
+ 
  /* Private Functions: ******************************************************/

! private inserta Tree Key Val;
! 	// insert a new (or replace an existing) member in the tree