1MODULE MultiArrays;  (** P. Hunziker, Basel,  **)
2(**
3AIM: To provide a library solution for
4a multidimensional array type for numbers of arbitrary dimensions,
5with the following features:
6  -compatible types for 1,2,3..n dimensions, allowing exchangeable use in procedure headers etc
7    -> generic/OO procedures for multidimensional array handling can be implemented
8  -arrays can be accessed in multiple ways:
9    -a) conventional indexing (though not by using brackets[ ], but using procedure IndexN. )
10    -b) in a linear fashion (fast)
11    -c) using an "ALL()" procedure without need for index handling by the user (very fast !)
12    -d) using array riders movable along arbitrary axis (Module MultiArrayRiders)
13    -e) by reading "runs" of data with rider (Module MultiArrayRiders)
14
15A type 'scalar' is also based on the same base type as arrays, to allow mixing of arrays and scalars
16in procedure headers, for more generic procedure headers when e.g. defining array operations:
17(e.g. PROCEDURE Add(d1, d2: Data): Data;
18 can be used for mixed expressions of arrays and numbers).
19 This is in the hope that a family of array handling modules similar to the functionality of
20 MATLAB or APL will be based on these types in the future.  (Help is welcome !).
21
22  See 'Test', 'Test1', procedures in both modules for insight how to use them.
23*)
24
25
26(** Copyright 1999-2001, Patrick Hunziker
27
28  This library is free software; you can redistribute it and/or modify it under the terms of the
29  GNU Library General Public License as published by the Free Software Foundation;
30  either version 2 of the License, or any later version.
31
32  This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
33  without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
34  See the GNU Library General Public License for more details.
35
36  You should have received a copy of the GNU Library General Public License along with this library;
37  if not, write to the Free Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
38
39Patrick Hunziker,Basel.
40email Patrick.Hunziker@unibas.ch
41*)
42(** Version 0.9, 19.1.2001 *)
43IMPORT Out := Console, Input := Platform; (* Import only needed for Demo purposes *)
44
45TYPE
46    SIntPtr* = POINTER TO ARRAY OF SHORTINT;
47    IntPtr* = POINTER TO ARRAY OF INTEGER;
48    LIntPtr* = POINTER TO ARRAY OF LONGINT;
49(*    HIntPtr* = POINTER TO ARRAY OF HUGEINT; *)
50    RealPtr* = POINTER TO ARRAY OF REAL;
51    LRealPtr* = POINTER TO ARRAY OF LONGREAL;
52    BoolPtr* = POINTER TO ARRAY OF BOOLEAN;
53(*    ComplxPtr* = POINTER TO ARRAY OF COMPLEX; *)
54
55    Data* = POINTER TO DataDesc; (** abstract base type, not containing data.
56                            This could be an Objects.Object for S3 *)
57    DataDesc* = RECORD END;
58
59    Scalar* = POINTER TO ScalarDesc; (** abstract base type, not containing data. *)
60    ScalarDesc* = RECORD (DataDesc) END;
61
62    SInt* = POINTER TO SIntDesc;
63    SIntDesc* = RECORD (ScalarDesc)
64      s*: SHORTINT;
65    END;
66
67    Int* = POINTER TO IntDesc;
68    IntDesc* = RECORD (ScalarDesc)
69      i*: INTEGER;
70    END;
71
72    LInt* = POINTER TO LIntDesc;
73    LIntDesc* = RECORD (ScalarDesc)
74      j*: LONGINT;
75    END;
76
77(*    HInt* = POINTER TO HIntDesc;
78    HIntDesc* = RECORD (ScalarDesc)
79      h*: HUGEINT;
80    END;
81*)
82    Real* = POINTER TO RealDesc;
83    RealDesc* = RECORD (ScalarDesc)
84      x*: REAL;
85    END;
86
87    LReal* = POINTER TO LRealDesc;
88    LRealDesc* = RECORD (ScalarDesc)
89      y*: LONGREAL;
90    END;
91
92    Bool* = POINTER TO BoolDesc;
93    BoolDesc* = RECORD (ScalarDesc)
94      b*: BOOLEAN;
95    END;
96
97    Complex* = POINTER TO ComplexDesc;
98    ComplexDesc* = RECORD (ScalarDesc)
99      r*, i*: REAL;
100    END;
101
102    SizeVector* = POINTER TO SizeVectorDesc;   (* used for description of array size; eventually = CATLIntVector *)
103    SizeVectorDesc* = ARRAY OF LONGINT;
104
105    Array* = POINTER TO ArrayDesc;     (** abstract base type, not containing data *)
106    ArrayDesc* = RECORD  (DataDesc)
107      (*ARRAY of arbitrary dimensionality *)
108      dimension: SizeVector; (* dimension vector *)
109      len-: LONGINT; (* Overall number of array elements *)
110    END;
111
112    SIntArray* = POINTER TO SIntArrayDesc;
113    SIntArrayDesc* = RECORD (ArrayDesc)
114      s-: SIntPtr;
115    END;
116
117    IntArray* = POINTER TO IntArrayDesc;
118    IntArrayDesc* = RECORD (ArrayDesc)
119      i-: IntPtr;
120    END;
121
122    LIntArray* = POINTER TO LIntArrayDesc;
123    LIntArrayDesc* = RECORD (ArrayDesc)
124      j-: LIntPtr;
125    END;
126
127(*    HIntArray* = POINTER TO HIntArrayDesc;
128    HIntArrayDesc* = RECORD (ArrayDesc)
129      h-: HIntPtr;
130    END;
131*)
132    RealArray* = POINTER TO RealArrayDesc;
133    RealArrayDesc* = RECORD (ArrayDesc)
134      x-: RealPtr;
135    END;
136
137    LRealArray* = POINTER TO LRealArrayDesc;
138    LRealArrayDesc* = RECORD (ArrayDesc)
139      y-: LRealPtr;
140    END;
141
142    BoolArray* = POINTER TO BoolArrayDesc;
143    BoolArrayDesc* = RECORD (ArrayDesc)
144      b-: BoolPtr;
145    END;
146
147    ComplexArray* = POINTER TO ComplexArrayDesc;
148    ComplexArrayDesc* = RECORD (ArrayDesc)
149      r-, i-: RealPtr;
150    END;
151
152    PROCEDURE Order*  (A: Array): LONGINT;
153            (** returns Nr of dimensions of array A *)
154    BEGIN
155      RETURN LEN(A.dimension^)
156    END Order;
157
158    PROCEDURE  Size*   (A: Array): SizeVector;
159            (** returns dimension vector *)
160      VAR i: LONGINT; res: SizeVector;
161      BEGIN
162        NEW(res,LEN(A.dimension^));
163        FOR i := 0 TO LEN(A.dimension^)-1 DO res[i] := A.dimension[i] END;
164        RETURN res
165      END Size;
166
167    PROCEDURE   Len*   (A: Array;  dim: LONGINT): LONGINT;
168            (** returns length of dimension Nr 'dim' *)
169      BEGIN
170        IF dim >= LEN(A.dimension^) THEN HALT(100)
171        ELSE RETURN A.dimension[dim]
172        END
173      END Len;
174
175    PROCEDURE Index*(pos, dimension: ARRAY OF LONGINT): LONGINT;
176      VAR maxI,res,i: LONGINT;
177      BEGIN
178        maxI := LEN(dimension)-1;
179        ASSERT(LEN(pos) = LEN(dimension));
180        res := pos[maxI];
181        FOR i := 1 TO maxI DO res := res*dimension[maxI-i]+pos[maxI-i] END;
182        RETURN res
183      END Index;
184
185    PROCEDURE Index1*(A: Array; x: LONGINT): LONGINT;
186      BEGIN
187        ASSERT(Order(A) = 1);
188        ASSERT(x < A.len);
189        RETURN x
190      END Index1;
191
192    PROCEDURE Index2*(A: Array; x,y: LONGINT): LONGINT;
193      BEGIN
194        ASSERT(Order(A) = 2);
195        ASSERT(x < Len(A,0));
196        ASSERT(y < Len(A,1));
197        RETURN y*Len(A,0)+x
198      END Index2;
199
200    PROCEDURE Index3*(A: Array; x,y,z: LONGINT): LONGINT;
201      BEGIN
202        ASSERT(Order(A) = 3);
203        ASSERT(x < Len(A,0));
204        ASSERT(y < Len(A,1));
205        ASSERT(z < Len(A,2));
206        RETURN (z*Len(A,1)+y)*Len(A,0)+x
207      END Index3;
208
209    PROCEDURE Index4*(A: Array; x,y,z,u: LONGINT): LONGINT;
210      BEGIN
211        ASSERT(Order(A) = 4);
212        ASSERT(x < Len(A,0));
213        ASSERT(y < Len(A,1));
214        ASSERT(z < Len(A,2));
215        ASSERT(u < Len(A,3));
216        RETURN ((u*Len(A,2)+z)*Len(A,1)+y)*Len(A,0)+x
217      END Index4;
218
219    PROCEDURE SizeVector1*(VAR Vec: SizeVector; x: LONGINT);
220    BEGIN
221      IF (Vec=NIL) OR (LEN(Vec^)#1) THEN NEW(Vec,1) END;
222      Vec[0] := x
223    END SizeVector1;
224
225    PROCEDURE SizeVector2*(VAR Vec: SizeVector; x,y: LONGINT);
226    BEGIN
227      IF (Vec=NIL) OR (LEN(Vec^)#2) THEN NEW(Vec,2) END;
228      Vec[0] := x; Vec[1] := y
229    END SizeVector2;
230
231    PROCEDURE SizeVector3*(VAR Vec: SizeVector; x,y,z: LONGINT);
232    BEGIN
233      IF (Vec=NIL) OR (LEN(Vec^)#3) THEN NEW(Vec,3) END;
234      Vec[0] := x; Vec[1] := y; Vec[2] := z
235    END SizeVector3;
236
237    PROCEDURE SizeVector4*(VAR Vec: SizeVector; x,y,z,u: LONGINT);
238    BEGIN
239      IF (Vec=NIL) OR (LEN(Vec^)#4) THEN NEW(Vec,4) END;
240      Vec[0] := x; Vec[1] := y; Vec[2] := z; Vec[3] := u
241    END SizeVector4;
242
243    PROCEDURE CalculatePos*(Index: LONGINT; dimension: ARRAY OF LONGINT): SizeVector;
244      VAR maxI, n, i: LONGINT;
245            res: SizeVector;
246      BEGIN
247        n := Index;
248        maxI := LEN(dimension)-1;
249        FOR i := 0 TO maxI-1 DO
250          res[maxI-i] := n MOD dimension[maxI-i];
251          n := n DIV dimension[maxI-i]
252        END;
253        RETURN res
254      END CalculatePos;
255
256    PROCEDURE  InitSInt*  (VAR A: Array; dimension: SizeVector; data: SIntPtr; copy: BOOLEAN);
257      VAR i, n: LONGINT;
258          AA: SIntArray;
259      BEGIN
260        IF (A=NIL) OR ~(A IS SIntArray) THEN NEW(AA) ELSE IF A IS SIntArray THEN AA := A(SIntArray) END END;
261        n := 1;
262        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
263        IF data=NIL THEN NEW(data,n); copy := FALSE END;
264        ASSERT (LEN(data^)=n);
265        NEW(AA.dimension,LEN(dimension^));
266        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
267        AA.len := n;
268        IF copy
269        THEN NEW (AA.s,n); FOR i := 0 TO n-1 DO AA.s[i] := data[i] END;
270        ELSE AA.s := data
271        END;
272        A := AA
273      END InitSInt;
274
275    PROCEDURE  InitInt*  (VAR A: Array; dimension: SizeVector; data: IntPtr; copy: BOOLEAN);
276      VAR i, n: LONGINT;
277          AA: IntArray;
278      BEGIN
279        IF (A=NIL) OR ~(A IS IntArray) THEN NEW(AA) ELSE IF A IS IntArray THEN AA := A(IntArray) END END;
280        n := 1;
281        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
282        IF data=NIL THEN NEW(data,n); copy := FALSE END;
283        ASSERT (LEN(data^)=n);
284        NEW(AA.dimension,LEN(dimension^));
285        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
286        AA.len := n;
287        IF copy
288        THEN NEW (AA.i,n); FOR i := 0 TO n-1 DO AA.i[i] := data[i] END;
289        ELSE AA.i := data
290        END;
291        A := AA
292      END InitInt;
293
294    PROCEDURE  InitLInt* (VAR A: Array; dimension: SizeVector; data: LIntPtr; copy: BOOLEAN);
295      VAR i, n: LONGINT;
296          AA: LIntArray;
297      BEGIN
298        IF (A=NIL) OR ~(A IS LIntArray) THEN NEW(AA) ELSE IF A IS LIntArray THEN AA := A(LIntArray) END END;
299        n := 1;
300        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
301        IF data=NIL THEN NEW(data,n); copy := FALSE END;
302        ASSERT (LEN(data^)=n);
303        NEW(AA.dimension,LEN(dimension^));
304        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
305        AA.len := n;
306        IF copy
307        THEN NEW (AA.j,n); FOR i := 0 TO n-1 DO AA.j[i] := data[i] END;
308        ELSE AA.j := data
309        END;
310        A := AA
311      END InitLInt;
312
313(*    PROCEDURE  InitHInt* (VAR A: Array; dimension: SizeVector; data: HIntPtr; copy: BOOLEAN);
314      VAR i, n: LONGINT;
315          AA: HIntArray;
316      BEGIN
317        IF (A=NIL) OR ~(A IS HIntArray) THEN NEW(AA) ELSE WITH A: HIntArray DO AA := A END END;
318        n := 1;
319        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
320        IF data=NIL THEN NEW(data,n); copy := FALSE END;
321        ASSERT (LEN(data^)=n);
322        NEW(AA.dimension,LEN(dimension^));
323        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
324        AA.len := n;
325        IF copy
326        THEN NEW (AA.h,n); FOR i := 0 TO n-1 DO AA.h[i] := data[i] END;
327        ELSE AA.h := data
328        END;
329        A := AA
330      END InitHInt; *)
331
332    PROCEDURE  InitReal* (VAR A: Array; dimension: SizeVector; data: RealPtr; copy: BOOLEAN);
333      VAR i, n:LONGINT;
334          AA:RealArray;
335      BEGIN
336        IF (A=NIL) OR ~(A IS RealArray) THEN NEW(AA) ELSE IF A IS RealArray THEN AA := A(RealArray) END END;
337        n := 1;
338        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
339        IF data=NIL THEN NEW(data,n); copy := FALSE END;
340        ASSERT (LEN(data^)=n);
341        NEW(AA.dimension,LEN(dimension^));
342        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
343        AA.len := n;
344        IF copy
345        THEN NEW (AA.x,n); FOR i := 0 TO n-1 DO AA.x[i] := data[i] END;
346        ELSE AA.x := data
347        END;
348        A := AA
349      END InitReal;
350
351    PROCEDURE  InitLReal* (VAR A: Array; dimension: SizeVector; data: LRealPtr; copy: BOOLEAN);
352      VAR i, n: LONGINT;
353          AA: LRealArray;
354      BEGIN
355        IF (A=NIL) OR ~(A IS LRealArray) THEN NEW(AA) ELSE IF A IS LRealArray THEN AA := A(LRealArray) END END;
356        n := 1;
357        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
358        IF data=NIL THEN NEW(data,n); copy := FALSE END;
359        ASSERT (LEN(data^)=n);
360        NEW(AA.dimension,LEN(dimension^));
361        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
362        AA.len := n;
363        IF copy
364        THEN NEW (AA.y,n); FOR i := 0 TO n-1 DO AA.y[i] := data[i] END;
365        ELSE AA.y := data
366        END;
367        A := AA
368      END InitLReal;
369
370    PROCEDURE  InitBool* (VAR A: Array; dimension: SizeVector; data: BoolPtr; copy: BOOLEAN);
371      VAR i, n: LONGINT;
372          AA: BoolArray;
373      BEGIN
374        IF (A=NIL) OR ~(A IS BoolArray) THEN NEW(AA) ELSE IF A IS BoolArray THEN AA := A(BoolArray) END END;
375        n := 1;
376        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
377        IF data=NIL THEN NEW(data,n); copy := FALSE END;
378        ASSERT (LEN(data^)=n);
379        NEW(AA.dimension,LEN(dimension^));
380        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
381        AA.len := n;
382        IF copy
383        THEN NEW (AA.b,n); FOR i := 0 TO n-1 DO AA.b[i] := data[i] END
384        ELSE AA.b := data
385        END;
386        A := AA
387      END InitBool;
388
389    PROCEDURE  InitComplex* (VAR A:Array; dimension: SizeVector;
390                    dataR,dataI: RealPtr; copy:BOOLEAN);
391      VAR i, n: LONGINT;
392          AA: ComplexArray;
393      BEGIN
394        IF (A=NIL) OR ~(A IS ComplexArray) THEN NEW(AA) ELSE IF A IS ComplexArray THEN AA := A(ComplexArray) END END;
395        n := 1;
396        FOR i := 0 TO LEN(dimension^)-1 DO n := n*dimension[i] END;
397        ASSERT (LEN(dataR^)=n); ASSERT (LEN(dataI^)=n);
398        NEW(AA.dimension,LEN(dimension^));
399        FOR i := 0 TO LEN(dimension^)-1 DO AA.dimension[i] := dimension[i]; END;
400        AA.len := n;
401        IF copy
402        THEN NEW (AA.r,n); NEW (AA.i,n);
403          FOR i := 0 TO n-1 DO AA.r[i] := dataR[i]; AA.i[i] := dataI[i] END
404        ELSE AA.r := dataR; AA.i := dataI
405        END;
406        A := AA
407      END InitComplex;
408
409    PROCEDURE  Copy* (From,To:Array);
410      BEGIN
411        WITH
412          From: SIntArray DO  InitSInt(To,From.dimension,From.s,TRUE) ;
413          | From: IntArray DO InitInt(To,From.dimension,From.i,TRUE);
414          | From: LIntArray DO InitLInt(To,From.dimension,From.j,TRUE);
415  (*        | From: HIntArray DO HALT(100)  *)
416          | From: RealArray DO InitReal(To,From.dimension,From.x,TRUE);
417          | From: LRealArray DO InitLReal(To,From.dimension,From.y,TRUE);
418          | From: BoolArray DO InitBool(To,From.dimension,From.b,TRUE);
419          | From: ComplexArray DO InitComplex(To,From.dimension,From.r,From.i,TRUE);
420        ELSE HALT(100)
421        END
422      END Copy;
423
424(*    PROCEDURE CopySubArray* (A1,A2:Array; start,dimension:ARRAY OF LONGINT);
425      (** Copies subrange of Array A1, beginning at 'start' with 'dimension' to (usually smaller) array A2 *)
426    BEGIN
427      WITH A1: ...
428        ELSE HALT(100)
429      END
430      END CopySubarray; *)
431
432    PROCEDURE GetSInt* (A: Array; position: SizeVector): SHORTINT;
433    BEGIN
434      IF A IS SIntArray THEN RETURN A(SIntArray).s[Index(position^,A.dimension^)]
435      ELSE HALT (100) END
436    END GetSInt;
437
438    PROCEDURE GetInt* (A: Array; position: SizeVector): INTEGER;
439    BEGIN
440      IF A IS IntArray THEN RETURN A(IntArray).i[Index(position^,A.dimension^)]
441      ELSE HALT (100) END
442    END GetInt;
443
444    PROCEDURE GetLInt* (A: Array; position: SizeVector): LONGINT;
445    BEGIN
446      IF A IS LIntArray THEN RETURN A(LIntArray).j[Index(position^,A.dimension^)]
447      ELSE HALT (100) END
448    END GetLInt;
449
450    (*PROCEDURE GetHInt* (A: Array; position: SizeVector): HUGEINT;
451    BEGIN
452      IF A IS HIntArray THEN RETURN A(HIntArray).h[Index(position^,A.dimension^)]
453      ELSE HALT (100) END
454    END GetHInt; *)
455
456    PROCEDURE GetReal* (A: Array; position: SizeVector): REAL;
457    BEGIN
458      IF A IS RealArray THEN RETURN A(RealArray).x[Index(position^,A.dimension^)]
459      ELSE HALT (100) END
460    END GetReal;
461
462    PROCEDURE GetLReal* (A: Array; position: SizeVector): LONGREAL;
463    BEGIN
464      IF A IS LRealArray THEN RETURN A(LRealArray).y[Index(position^,A.dimension^)]
465      ELSE HALT (100) END
466    END GetLReal;
467
468    PROCEDURE GetBool* (A: Array; position: SizeVector): BOOLEAN;
469    BEGIN
470      IF A IS BoolArray THEN RETURN A(BoolArray).b[Index(position^,A.dimension^)]
471      ELSE HALT (100) END
472    END GetBool;
473
474    PROCEDURE GetComplex* (A: Array; position: SizeVector): Complex;
475    VAR res: Complex;
476    BEGIN
477      IF A IS ComplexArray
478      THEN
479        NEW(res);
480        res.r := A(ComplexArray).r[Index(position^,A.dimension^)];
481        res.i := A(ComplexArray).i[Index(position^,A.dimension^)];
482        RETURN res
483      ELSE HALT (100)
484      END
485    END GetComplex;
486
487(*    PROCEDURE   Store*  (R: Files.Rider; A: Array);
488            (* S3 specific ->eliminate from this module, into utility module *)
489            (** not yet implemented *)
490      BEGIN
491        (**)
492      END Store;
493
494    PROCEDURE   Load* (R: Files.Rider; VAR A: Array);
495            (* S3 specific ->eliminate from this module, into utility module *)
496            (** not yet implemented *)
497      BEGIN
498        (**)
499      END Load;
500*)
501    PROCEDURE AllSInt1* (A: Array;  f: PROCEDURE(s:SHORTINT): SHORTINT);
502    VAR n: LONGINT;
503    BEGIN
504      WITH A: SIntArray DO FOR n := 0 TO A.len-1 DO A.s[n] := f(A.s[n]) END
505      ELSE HALT(100)
506      END
507    END AllSInt1;
508
509    PROCEDURE AllSInt2* (A,B: Array;  f: PROCEDURE(s1,s2:SHORTINT): SHORTINT);
510    VAR n: LONGINT;
511    BEGIN
512      WITH A: SIntArray DO
513        WITH B: SIntArray DO
514          FOR n := 0 TO A.len-1 DO A.s[n] := f(A.s[n],B.s[n]) END
515        ELSE HALT(100)
516        END
517      ELSE HALT(100)
518      END;
519    END AllSInt2;
520
521    PROCEDURE AllInt1* (A: Array; f: PROCEDURE(i:INTEGER): INTEGER);
522    VAR n: LONGINT;
523    BEGIN
524      WITH A: IntArray DO FOR n := 0 TO A.len-1 DO A.i[n] := f(A.i[n]) END
525      ELSE HALT(100)
526      END
527    END AllInt1;
528
529    PROCEDURE AllInt2* (A,B: Array; f: PROCEDURE(i1,i2:INTEGER): INTEGER);
530    VAR n: LONGINT;
531    BEGIN
532      WITH A: IntArray DO
533        WITH B: IntArray DO
534          FOR n := 0 TO A.len-1 DO A.i[n] := f(A.i[n],B.i[n]) END
535        ELSE HALT(100)
536        END;
537      ELSE HALT(100)
538      END
539    END AllInt2;
540
541    PROCEDURE AllLInt1* (A: Array; f: PROCEDURE(j:LONGINT): LONGINT);
542    VAR n: LONGINT;
543    BEGIN
544      WITH A: LIntArray DO FOR n := 0 TO A.len-1 DO A.j[n] := f(A.j[n]) END
545      ELSE HALT(100)
546      END
547    END AllLInt1;
548
549    PROCEDURE AllLInt2* (A,B: Array; f: PROCEDURE(j1,j2:LONGINT): LONGINT);
550    VAR n: LONGINT;
551    BEGIN
552      WITH A: LIntArray DO
553        WITH B: LIntArray DO
554          FOR n := 0 TO A.len-1 DO A.j[n] := f(A.j[n],B.j[n]) END
555        ELSE HALT(100)
556        END;
557      ELSE HALT(100)
558      END;
559    END AllLInt2;
560
561    PROCEDURE AllReal1* (A: Array; f: PROCEDURE(x:REAL): REAL);
562    VAR n: LONGINT;
563    BEGIN
564      WITH A: RealArray DO FOR n := 0 TO A.len-1 DO A.x[n] := f(A.x[n]) END
565      ELSE HALT(100)
566      END
567    END AllReal1;
568
569    PROCEDURE AllReal2* (A,B: Array; f: PROCEDURE(x1,x2:REAL): REAL);
570    VAR n: LONGINT;
571    BEGIN
572      WITH A: RealArray DO
573        WITH B: RealArray DO
574          FOR n := 0 TO A.len-1 DO A.x[n] := f(A.x[n],B.x[n]) END
575        ELSE HALT(100)
576        END;
577      ELSE HALT(100)
578      END
579    END AllReal2;
580
581    PROCEDURE AllLReal1* (A: Array; f: PROCEDURE(y:LONGREAL): LONGREAL);
582    VAR n: LONGINT;
583    BEGIN
584      WITH A: LRealArray DO FOR n := 0 TO A.len-1 DO A.y[n] := f(A.y[n]) END
585      ELSE HALT(100)
586      END
587    END AllLReal1;
588
589    PROCEDURE AllLReal2* (A,B: Array; f: PROCEDURE(y1,y2:LONGREAL): LONGREAL);
590    VAR n: LONGINT;
591    BEGIN
592      WITH A: LRealArray DO
593        WITH B: LRealArray DO
594          FOR n := 0 TO A.len-1 DO A.y[n] := f(A.y[n],B.y[n]) END
595        ELSE HALT(100)
596        END
597      ELSE HALT(100)
598      END
599    END AllLReal2;
600
601    PROCEDURE InvertSign (s: SHORTINT): SHORTINT; (* Test procedure for unary operations *)
602    BEGIN
603      RETURN -s
604    END InvertSign;
605
606    PROCEDURE Add (s1,s2: SHORTINT): SHORTINT; (* Test procedure for unary operations *)
607    BEGIN
608      RETURN s1+s2
609    END Add;
610
611
612PROCEDURE Test*;
613    (** Compares "Allxxx" procedure with conventional indexing scheme *)
614      VAR A1: Array;
615          A2: POINTER TO ARRAY OF ARRAY OF ARRAY OF ARRAY OF SHORTINT;
616          data: SIntPtr;
617          dim1: SizeVector;
618          i, starttime, endtime, a, b, c, d: LONGINT;
619      BEGIN
620        (* ALL ELEMENT OPERATIONS *)
621        Out.String("----------------------------------"); Out.Ln;
622        NEW(A1);
623        SizeVector4(dim1, 64, 32, 32, 32);
624        NEW(data, dim1[0]*dim1[1]*dim1[2]*dim1[3]);
625        InitSInt(A1, dim1, data, FALSE);
626
627        starttime := Input.Time();
628        WITH A1: SIntArray DO
629              FOR i := 0 TO A1.len-1 DO A1.s[i] := InvertSign(A1.s[i]); END      (* linear array access *)
630            END;
631        endtime := Input.Time();
632        Out.String("ALL ELEMENT MONADIC OPERATION:"); Out.Ln;
633        Out.String("arbitrary array, linear access, invert sign:"); Out.String("  time: ");
634        Out.Int(endtime-starttime, 5); Out.String("ms  for "); Out.Int(A1.len, 10);
635        Out.String(" elements"); Out.Ln;
636
637        starttime := Input.Time();
638        AllSInt1(A1, InvertSign);      (* monadic proc. using "All" procedure *)
639        endtime := Input.Time();
640
641        Out.String("arbitrary array 'ALL procedure', invert sign:"); Out.String("  time: ");
642        Out.Int(endtime-starttime, 5); Out.String("ms  for "); Out.Int(A1.len, 10);
643        Out.String(" elements"); Out.Ln;
644        NEW(A2, 64, 32, 32, 32);
645
646        starttime := Input.Time();
647        FOR a := 0 TO LEN(A2^, 0)-1 DO      (* monadic proc. using conventional indices *)
648          FOR b := 0 TO LEN(A2^, 1)-1 DO
649            FOR c := 0 TO LEN(A2^, 2)-1 DO
650              FOR d := 0 TO LEN(A2^, 3)-1 DO
651                A2[a, b, c, d] := InvertSign(A2[a, b, c, d])
652              END
653            END
654          END
655        END;
656        endtime := Input.Time();
657
658        Out.String("conventional indexed array invert sign:"); Out.String("  time: ");
659        Out.Int(endtime-starttime, 5); Out.String("ms  for "); Out.Int(A1.len, 10);
660        Out.String(" elements"); Out.Ln;
661        Out.String("**********************************"); Out.Ln;
662
663        starttime := Input.Time();
664        AllSInt2(A1, A1, Add);      (* dyadic proc. using "All" procedure *)
665        endtime := Input.Time();
666
667        Out.String("ALL ELEMENT DYADIC OPERATION:"); Out.Ln;
668        Out.String("arbitrary array ,'ALL procedure, addition:"); Out.String("  time: ");
669        Out.Int(endtime-starttime, 5); Out.String("ms  for "); Out.Int(A1.len, 10);
670        Out.String(" elements"); Out.Ln;
671
672        starttime := Input.Time();
673        FOR a := 0 TO LEN(A2^, 0)-1 DO      (* dyadic proc. using conventional approach *)
674          FOR b := 0 TO LEN(A2^, 1)-1 DO
675            FOR c := 0 TO LEN(A2^, 2)-1 DO
676              FOR d := 0 TO LEN(A2^, 3)-1 DO
677                A2[a, b, c, d] := Add(A2[a, b, c, d], A2[a, b, c, d])
678              END
679            END
680          END
681        END;
682        endtime := Input.Time();
683
684        Out.String("conventional indexed array, addition:"); Out.String("  time: ");
685        Out.Int(endtime-starttime, 5); Out.String("ms  for "); Out.Int(A1.len, 10);
686        Out.String(" elements"); Out.Ln;
687        Out.String("**********************************"); Out.Ln
688    END Test;
689
690(*PROCEDURE Test2*;                  (* insufficient registers with Intel *)
691VAR A, B: ARRAY 2, 2, 2, 2, 2, 2 OF INTEGER;
692  i, j, k, l, m, n, o, p, q, r: INTEGER;
693BEGIN
694  Out.String('Test2: ... ');
695  FOR i := 0 TO 1 DO
696    FOR j := 0 TO 1 DO
697      FOR k := 0 TO 1 DO
698        FOR l := 0 TO 1 DO
699          FOR m := 0 TO 1 DO
700            FOR n := 0 TO 1 DO
701              A[i, j, k, l, m, n] := B[i, j, k, l, m, n]+1
702            END
703          END
704        END
705      END
706    END
707  END
708  Out.String('done'); Out.Ln
709END Test2;  *)
710
711(*PROCEDURE Test3*;                  (* insufficient registers with Intel *)
712VAR A, B: ARRAY 2,2,2,2,2,2,2,2,2,2 OF INTEGER;
713  i, j, k, l, m, n, o, p, q, r: INTEGER;
714BEGIN
715  Out.String('Test3: ... ');
716  FOR i := 0 TO 1 DO
717    FOR j := 0 TO 1 DO
718      FOR k := 0 TO 1 DO
719        FOR l := 0 TO 1 DO
720          FOR m := 0 TO 1 DO
721            FOR n := 0 TO 1 DO
722              FOR o := 0 TO 1 DO
723                FOR p := 0 TO 1 DO
724                  FOR q := 0 TO 1 DO
725                    FOR r := 0 TO 1 DO
726                      A[i, j, k, l, m, n, o, p, q, r] := B[i, j, k, l, m, n, o, p, q, r]+1
727                    END
728                  END
729                END
730              END
731            END
732          END
733        END
734      END
735    END
736  END
737  Out.String('done'); Out.Ln
738END Test3; *)
739
740BEGIN
741END MultiArrays.
742
743MultiArrays.Test
744MultiArrays.Test2
745MultiArrays.Test3
746Compiler.Compile  \xc MultiArrays.Mod  ~
747System.Free MultiArrays~
748