A-M baby

Task/Matrix-exponentiation-operator/ALGOL-68/matrix-exponentiation-operator-1.alg

@@ -0,0 +1,31 @@
+INT default upb=3;
+MODE VEC = [default upb]COSCAL;
+MODE MAT = [default upb,default upb]COSCAL;
+
+OP * = (VEC a,b)COSCAL: (
+    COSCAL result:=0;
+    FOR i FROM LWB a TO UPB a DO result+:= a[i]*b[i] OD;
+    result
+  );
+
+OP * = (VEC a, MAT b)VEC: ( # overload vec times matrix #
+    [2 LWB b:2 UPB b]COSCAL result;
+    FOR j FROM 2 LWB b TO 2 UPB b DO result[j]:=a*b[,j] OD;
+    result
+  );
+
+OP * = (MAT a, b)MAT: ( # overload matrix times matrix #
+    [LWB a:UPB a, 2 LWB b:2 UPB b]COSCAL result;
+    FOR k FROM LWB result TO UPB result DO result[k,]:=a[k,]*b OD;
+    result
+  );
+
+OP IDENTITY = (INT upb)MAT:(
+  [upb,upb] COSCAL out;
+  FOR i TO upb DO
+    FOR j TO upb DO
+      out[i,j]:= ( i=j |1|0)
+    OD
+  OD;
+  out
+);

Task/Matrix-exponentiation-operator/ALGOL-68/matrix-exponentiation-operator-2.alg

@@ -0,0 +1,14 @@
+OP ** = (MAT base, INT exponent)MAT: (
+  BITS binary exponent:=BIN exponent ;
+  MAT out := IF bits width ELEM binary exponent THEN base ELSE IDENTITY UPB base FI;
+  MAT sq:=base;
+
+  WHILE
+    binary exponent := binary exponent SHR 1;
+    binary exponent /= BIN 0
+  DO
+    sq := sq * sq;
+    IF bits width ELEM binary exponent THEN out := out * sq FI
+  OD;
+  out
+);

Task/Matrix-exponentiation-operator/ALGOL-68/matrix-exponentiation-operator-3.alg

@@ -0,0 +1,24 @@
+#!/usr/local/bin/a68g --script #
+
+MODE COSCAL = COMPL;
+PR READ "Matrix_algebra.a68" PR
+PR READ "Matrix-exponentiation_operator.a68" PR
+
+PROC compl mat printf= (FORMAT scal fmt, MAT m)VOID:(
+  FORMAT
+    vec math = $n(2 UPB m)(f(scal fmt)"&")$,
+    mat math = $"<math>\begin{bmat}"ln(UPB m)(xxf(vec fmt)"\\"l)"\end{bmat}</math>"$,
+    vec fmt = $"("n(2 UPB m-1)(f(scal fmt)",")f(scal fmt)")"$,
+    mat fmt = $x"("n(UPB m-1)(f(vec fmt)","lxx)f(vec fmt)");"$;
+  # finally print the result #
+  printf((mat fmt,m))
+);
+
+FORMAT scal fmt = $-d.dddd,+d.dddd"i"$; # width of 4, with no leading '+' sign, 1 decimals #
+MAT mat=((sqrt(0.5)I0         , sqrt(0.5)I0        , 0I0),
+         (        0I-sqrt(0.5),         0Isqrt(0.5), 0I0),
+         (        0I0         ,         0I0        , 0I1))
+
+printf(($" mat ** "g(0)":"l$,24));
+compl mat printf(scal fmt, mat**24);
+print(newline)