/* bag.q: ordered multiset data structure implemented by AVL trees
   $Id: bag.q,v 1.2 2004/01/28 16:54:43 agraef Exp $ */

/* This file is part of the Q programming system.

   The Q programming system is free software; you can redistribute it and/or
   modify it under the terms of the GNU General Public License as published by
   the Free Software Foundation; either version 2, or (at your option)
   any later version.

   The Q programming system is distributed in the hope that it will be
   useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */

include stdlib, stddecl;

public type Bag = private const nil, bin H X M1 M2;

/* Construction and type checking: */

public emptybag;		// return the empty bag
public bag Xs;			// create a bag from list Xs
public isbag X;			// check whether X is a bag

/* Overloaded and public operations: */

/* As in set.q, the comparison operators are overloaded to implement sub-/
   superbag predicates, and the operators +, - and * are used to denote bag
   union, difference and intersection, respectively. */

// #M				// size of bag M

// null M			// tests whether M is the empty bag
// member M X			// tests whether M contains X
// list M, members M		// list members of M in ascending order

// first M, last M		// return first and last member of M
// rmfirst M, rmlast M		// remove first and last member from M
// public insert M X;		// insert X into M (behind existing element)
// delete M X			// remove X from M

/* Implementation: *********************************************************/

/* 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: *******************************************************/

emptybag			= nil;
bag Xs:List			= foldl insert nil Xs;

isbag _:Bag			= true;
isbag _				= false otherwise;

#nil				= 0;
#bin _ _ M1 M2			= #M1+#M2+1;

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

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: */

(M1:Bag = M2:Bag)		= (members M1 = members M2);
M1:Bag <> M2:Bag		= members M1 <> members M2;

M1:Bag <= M2:Bag		= null (M1-M2);
M1:Bag >= M2:Bag		= null (M2-M1);

M1:Bag < M2:Bag			= (M1<=M2) and then (M1<>M2);
M1:Bag > M2:Bag			= (M1>=M2) and then (M1<>M2);

M1:Bag + M2:Bag			= foldl insert M1 (members M2);
M1:Bag - M2:Bag			= foldl delete M1 (members M2);
M1:Bag * M2:Bag			= M1-(M1-M2);