/* array.q: integer-indexed arrays implemented as size-balanced binary trees
   $Id: array.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. */

/* This script implements an efficient variable-sized array data structure
   which allows to access and update individual array members, as well as
   to add and remove elements at the beginning and end of an array. All these
   operations are carried out in logarithmic time. The implementation is
   based on the same ideas as in Frank Drewes' queue data structure (see
   queue.q in the examples directory). */

include stdlib, stddecl;

public type Array = private const nil, tip X, bin B A1 A2;

/* Construction and type checking: */

public emptyarray;		// return the empty array
public array Xs;		// create an array from list Xs
public array2 Xs;		// create two-dimensional array from a list
				// of lists
public mkarray X N;		// create an array consisting of N X's
public mkarray2 X NM;		// create two-dimensional array with N rows
				// and M columns given as a pair (N,M)
public isarray X;		// check whether X is an array

/* Overloaded and public operations: */

// #A				// size of A
// A!I				// return Ith member of A
// A!(I,J)			// two-dimensional subscript

// null A			// tests whether A is the empty array
// list A, members A		// list the values stored in A
// list2 A, members2 A		// members of two-dimensional array

// first A, last A		// first and last member of A
// rmfirst A, rmlast A		// remove first and last member from A
// insert A X			// insert X at the beginning of A
// append A X			// append X to the end of A
// update A I X			// replace the Ith member of A by X
public update2 A IJ X;		// update two-dimensional array

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

/* private operations: */

private mkbin B A1 A2;		// construct a binary array node

mkbin _ nil A2			= A2;
mkbin _ A1 nil			= A1;
mkbin B A1 A2			= bin B A1 A2 otherwise;

private merge Xs Ys;		// merge lists Xs (even elements) and Ys
				// (odd elements)

merge [] Ys			= Ys;
merge [X|Xs] Ys			= [X|merge Ys Xs];

/* public operations: */

emptyarray			= nil;
array Xs:List			= foldl append nil Xs;
array2 Xs:List			= array (map array Xs);

mkarray X N:Int			= nil if N<=0;
				= tip X if N=1;
				= mkbin (N mod 2)
				  (mkarray X (N - N div 2))
				  (mkarray X (N div 2)) otherwise;

mkarray2 X (N:Int,M:Int)	= mkarray (mkarray X M) N;

isarray _:Array			= true;
isarray _			= false otherwise;

#nil				= 0;
#tip _				= 1;
#bin 0 A1 _			= #A1*2;
#bin 1 A1 _			= #A1*2-1;

tip X !0			= X;
bin _ A1 A2 !I:Int		= A1!(I div 2) if I mod 2 = 0;
				= A2!(I div 2) if I mod 2 = 1;

A:Array!(I:Int,J:Int)		= (A!I)!J;

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

members nil			= [];
members (tip X)			= [X];
members (bin _ A1 A2)		= merge (members A1) (members A2);

members2 A:Array		= map members (members A);

first (tip X)			= X;
first (bin _ A1 _)		= first A1;

last (tip X)			= X;
last (bin 0 _ A2)		= last A2;
last (bin 1 A1 _)		= last A1;

rmfirst (tip _)			= nil;
rmfirst (bin 0 A1 A2)		= mkbin 1 A2 (rmfirst A1);
rmfirst (bin 1 A1 A2)		= mkbin 0 A2 (rmfirst A1);

rmlast (tip _)			= nil;
rmlast (bin 0 A1 A2)		= mkbin 1 A1 (rmlast A2);
rmlast (bin 1 A1 A2)		= mkbin 0 (rmlast A1) A2;

insert nil Y			= tip Y;
insert (tip X) Y		= bin 0 (tip Y) (tip X);
insert (bin 0 A1 A2) Y		= mkbin 1 (insert A2 Y) A1;
insert (bin 1 A1 A2) Y		= mkbin 0 (insert A2 Y) A1;

append nil Y			= tip Y;
append (tip X) Y		= bin 0 (tip X) (tip Y);
append (bin 0 A1 A2) Y		= mkbin 1 (append A1 Y) A2;
append (bin 1 A1 A2) Y		= mkbin 0 A1 (append A2 Y);

update (tip _) 0 Y		= tip Y;
update (bin B A1 A2) I:Int Y	= bin B (update A1 (I div 2) Y) A2
				      if I mod 2 = 0;
				= bin B A1 (update A2 (I div 2) Y)
				      if I mod 2 = 1;

update2 A:Array (I:Int,J:Int) Y	= update A I (update (A!I) J Y);

/* equality: */

(nil = nil)			= true;
(nil = tip _)			= false;
(nil = bin _ _ _)		= false;
(tip _ = nil)			= false;
(tip X = tip Y)			= (X=Y);
(tip _ = bin _ _ _)		= false;
(bin _ _ _ = nil)		= false;
(bin _ _ _ = tip _)		= false;
(bin B1 A1 A2 = bin B2 A3 A4)	= (B1=B2) and then (A1=A3) and then (A2=A4);

nil <> nil			= false;
nil <> tip _			= true;
nil <> bin _ _ _		= true;
tip _ <> nil			= true;
tip X <> tip Y			= X<>Y;
tip _ <> bin _ _ _		= true;
bin _ _ _ <> nil		= true;
bin _ _ _ <> tip _		= true;
bin B1 A1 A2 <> bin B2 A3 A4	= (B1<>B2) or else (A1<>A3) or else (A2<>A4);