ALGOL 68(ID:311/alg019)

3rd generation ALGOL 

• Array

BEGIN # sort-tree merging,
   L. Allison 7/4/86 Dept. Computer Science, Monash University, Australia
   see: L. Allison. Some Applications of Continuations.
                    The Computer Journal 31(1) pp9-16, 1988 #

   MODE TREE = REF NODE;
   MODE NODE = STRUCT(INT e, TREE l, r);

   PROC insert = (INT e, REF TREE t)VOID:
      # NB inserts in t as a side effect #
      IF TREE(t) IS NIL THEN t := HEAP NODE := (e, TREE(NIL), TREE(NIL))
      ELIF e < e OF t THEN insert(e, l OF t)
      ELIF e > e OF t THEN insert(e, r OF t)
      FI;

   PROC show = (TREE t)VOID:
      IF t ISNT NIL THEN print("("); show(l OF t); print(e OF t);
                show(r OF t); print(")")
      FI;

   PROC merge = (TREE s, t)VOID:
   BEGIN
      MODE SCANNER = PROC(INT, SCANNER)VOID;

      PROC traverse = (INT switch, TREE t, SCANNER continue, alternative)VOID:
      IF t IS NIL THEN continue(switch, alternative)
      ELSE PROC goright = (INT sw, SCANNER alt)VOID:
              trav(sw, t, continue, alt);

           traverse(switch, l OF t, goright, alternative)
      FI;

      PROC trav = (INT switch, TREE t, SCANNER continue, alternative)VOID:
      # traverse the root node and right sub-tree of t  only. #
      IF t IS NIL THEN continue(switch, alternative)
      ELIF e OF t  <=  switch THEN
            print(e OF t);
            traverse( switch, r OF t, continue, alternative)
      ELSE  # e OF t > switch #
            PROC defer = (INT sw, SCANNER alt)VOID:
               trav(sw, t, continue, alt);

            alternative(e OF t, defer)
      FI;

      PROC m =  (TREE s, t, SCANNER scans, scant)VOID:
      IF TREE(l OF s) ISNT NIL THEN
         PROC travright = (INT sw, SCANNER alt)VOID:
            trav(sw, s, scans, alt);

         m(l OF s, t, travright, scant)
         ELIF TREE(l OF t) ISNT NIL THEN
         m(t, s, scant, scans)
      ELSE # l OF s  IS  l OF t  IS  NIL, so now have their smallest elts  #
            PROC scanstree = (INT sw, SCANNER alt)VOID:
               trav( sw, s, scans, alt);
         PROC scanttree = (INT sw, SCANNER alt)VOID:
               trav( sw, t, scant, alt);

         IF (e OF s) <= (e OF t) THEN scanstree( e OF t, scanttree)
                        ELSE scanttree( e OF s, scanstree)
      FI FI;

      SCANNER halt = (INT sw, SCANNER a)VOID: print((" the end", newline));
      SCANNER fin  = (INT sw, SCANNER a)VOID:
      (print( " finish: "); a(max int, halt));

      IF   s IS NIL THEN traverse( max int, t, halt, halt)
      ELIF t IS NIL THEN traverse( max int, s, halt, halt)
      ELSE m(s, t, fin, fin)
      FI
   END #merge#;

   LOC TREE s:=TREE(NIL), t:=TREE(NIL);
   LOC INT n;

   WHILE read(n); n>=0 DO insert(n, s) OD;
   show(s); print(newline);
   WHILE read(n); n>=0 DO insert(n, t) OD;
   show(t); print(newline);

   merge(s, t)
END
Close
Tree merging
( #
.nf
    Strassen's O(n^log2(7)) matrix multiplication algorithm
    L.Allison  wacsvax  UWA  26 June 1984
    Dept. Computer Science, Monash University, Australia #

OP * = ([,] INT a,b) [,]INT:
IF INT all=1 UPB a; all = 1 LWB a THEN # 1x1 #
   a[1,1]*b[1,1]
ELSE # nxn #
   INT half = all % 2;                      # i.e. all div 2 #

   [,]INT a11=a[1:half,1:half],             # i.e. top left quarter of a #
       a12=a[1:half,half+1:all],         # top right #
       a21=a[half+1:all,1:half],         # etc. #
       a22=a[half+1:all,half+1:all],

       b11=b[1:half,1:half],
       b12=b[1:half,half+1:all],
       b21=b[half+1:all,1:half],
       b22=b[half+1:all,half+1:all];

   LOC[1:all,1:all]INT c;                   # c will become a*b #
   REF[,]INT c11=c[1:half,1:half],
          c12=c[1:half,half+1:all],
          c21=c[half+1:all,1:half],
          c22=c[half+1:all,half+1:all];

   [,]INT m1=(a12-a22)*(b21+b22),           # NB. only 7 [,]*[,] #
          m2=(a11+a22)*(b11+b22),
          m3=(a11-a21)*(b11+b12),
          m4=(a11+a12)*b22,
          m5=a11*(b12-b22),
          m6=a22*(b21-b11),
          m7=(a21+a22)*b11;

   c11:=m1+m2-m4+m6;
   c12:=m4+m5;
   c21:=m6+m7;
   c22:=m2-m3+m5-m7;

   c                                        # i.e. return c #
FI;


OP + = ([,]INT a,b)[,]INT:
( [1:1 UPB a, 1:2 UPB a]INT c;
   FOR i TO 1 UPB a DO
      FOR j TO 2 UPB a DO
      c[i,j]:=a[i,j]+b[i,j]
      OD
   OD;
   c
);

OP - = ([,]INT a,b)[,]INT:
( [1:1 UPB a, 1:2 UPB a]INT c;
   FOR i TO 1 UPB a DO
      FOR j TO 2 UPB a DO
         c[i,j]:=a[i,j]-b[i,j]
      OD
   OD;
   c
);

PROC show = ([,]INT a)VOID:
( print(newline);
   FOR i TO 1 UPB a DO
      FOR j TO 2 UPB a DO
      print( whole(a[i,j],6) )
      OD;
      print(newline)
   OD;
   print(newline)
);


[,]INT a=((1,2,3,4),(5,6,7,8),(9,10,11,12),(13,14,15,16)),  # a little test #
       b=((17,18,19,20),(21,22,23,24),(25,26,27,28),(29,30,31,32));

show(a); show(b); show(a*b)
)
Close
Matrix multiplication
BEGIN # Algol-68 primes numbers, functional style   27/6/85 #
      # L.Allison Computer Science, University of Western Australia #
      #           Computer Science, Monash University, Australia #

   PROC error = (STRING s)VOID:
      BEGIN print(( newline, " error:", s, newline));
            GOTO stop
      END;
  
   MODE LIST = REF NODE;
   MODE NODE = STRUCT(INT h, LIST t);

   PROC cons = (INT n, LIST l)LIST:
      HEAP NODE := (n,l);

   PROC hd = (LIST l)INT:
      IF l IS NIL THEN error(" hd nil"); SKIP  ELSE h OF l FI;

   PROC tl = (LIST l)LIST:
      IF l IS NIL THEN error(" tl nil"); SKIP  ELSE t OF l FI;

   PROC show = (LIST l)VOID:
      IF l ISNT NIL THEN print((" ",whole(hd(l),0))); show(tl(l)) FI;

   PROC to = (INT n)LIST:
      BEGIN PROC f = (INT m,n)LIST:
            IF m>n THEN NIL ELSE cons(m, f(m+1,n)) FI;
     
         f(1,n)
      END;

   PROC filter = (PROC(INT)BOOL p, LIST l)LIST:
      IF l IS NIL THEN NIL
      ELIF p(hd(l)) THEN cons(hd(l), filter(p,tl(l)))
      ELSE filter(p, tl(l))
      FI;

   PROC sieve = (LIST l)LIST:
      IF l IS NIL THEN NIL
      ELSE PROC notmultiple = (INT n)BOOL:
           n MOD (hd(l)) ~= 0;
       
        cons( hd(l), sieve( filter(notmultiple,tl(l)) ))
      FI;

   PROC primes = (INT n)LIST:
      sieve(tl(to(n)));

   show( primes(100) )
END
Close
Primes