/* set.q: ordered set data structure implemented by AVL trees
   $Id: set.q,v 1.3 2004/01/28 17:04:27 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 Set = private const nil, bin H X M1 M2;

/* Construction and type checking: */

public emptyset;		// return the empty set
public set Xs;			// create a set from list Xs
public isset X;			// check whether X is a set

/* Overloaded and public operations: */

/* The comparison operators are overloaded to implement the sub-/superset
   predicates (e.g., M1<=M2: M1 is a subset of M2, M1<M2: M1 is a proper
   subset of M2). The operators +, - and * are used to denote set union,
   difference and intersection, respectively. */

// #M				// size of set M

// null M			// tests whether M is the empty set
// 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
// insert M X			// insert X into M (replace 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: *******************************************************/

emptyset			= nil;
set Xs:List			= foldl insert nil Xs;

isset _:Set			= true;
isset _				= false otherwise;

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

null nil			= true;
null _:Set			= 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 H X M1 M2) Y	= rebal (mkbin X (insert M1 Y) M2) if X>Y;
				= rebal (mkbin X M1 (insert M2 Y)) if X<Y;
				= bin H Y M1 M2 if X=Y;

delete nil Y			= 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;

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

/* Essentially there is no faster way for determining whether two sets are
   equal than by comparing their member lists, so that is how it is
   implemented. */

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

M1:Set <= M2:Set		= all (member M2) (members M1);
M1:Set >= M2:Set		= all (member M1) (members M2);

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

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