A-M baby
This commit is contained in:
Ingy döt Net
parent
764da6cbbb
commit
db842d013d
19005 changed files with 197040 additions and 7 deletions
3
Task/Matrix-exponentiation-operator/0DESCRIPTION
Normal file
3
Task/Matrix-exponentiation-operator/0DESCRIPTION
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
Most programming languages have a built-in implementation of exponentiation for integers and reals only.
|
||||
Demonstrate how to implement matrix exponentiation as an operator.
|
||||
{{Omit From|Java}}
|
||||
2
Task/Matrix-exponentiation-operator/1META.yaml
Normal file
2
Task/Matrix-exponentiation-operator/1META.yaml
Normal file
|
|
@ -0,0 +1,2 @@
|
|||
---
|
||||
note: Matrices
|
||||
|
|
@ -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
|
||||
);
|
||||
|
|
@ -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
|
||||
);
|
||||
|
|
@ -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)
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
|
||||
procedure Test_Matrix is
|
||||
generic
|
||||
type Element is private;
|
||||
Zero : Element;
|
||||
One : Element;
|
||||
with function "+" (A, B : Element) return Element is <>;
|
||||
with function "*" (A, B : Element) return Element is <>;
|
||||
with function Image (X : Element) return String is <>;
|
||||
package Matrices is
|
||||
type Matrix is array (Integer range <>, Integer range <>) of Element;
|
||||
function "*" (A, B : Matrix) return Matrix;
|
||||
function "**" (A : Matrix; Power : Natural) return Matrix;
|
||||
procedure Put (A : Matrix);
|
||||
end Matrices;
|
||||
|
||||
package body Matrices is
|
||||
function "*" (A, B : Matrix) return Matrix is
|
||||
R : Matrix (A'Range (1), B'Range (2));
|
||||
Sum : Element := Zero;
|
||||
begin
|
||||
for I in R'Range (1) loop
|
||||
for J in R'Range (2) loop
|
||||
Sum := Zero;
|
||||
for K in A'Range (2) loop
|
||||
Sum := Sum + A (I, K) * B (K, J);
|
||||
end loop;
|
||||
R (I, J) := Sum;
|
||||
end loop;
|
||||
end loop;
|
||||
return R;
|
||||
end "*";
|
||||
|
||||
function "**" (A : Matrix; Power : Natural) return Matrix is
|
||||
begin
|
||||
if Power = 1 then
|
||||
return A;
|
||||
end if;
|
||||
declare
|
||||
R : Matrix (A'Range (1), A'Range (2)) := (others => (others => Zero));
|
||||
P : Matrix := A;
|
||||
E : Natural := Power;
|
||||
begin
|
||||
for I in P'Range (1) loop -- R is identity matrix
|
||||
R (I, I) := One;
|
||||
end loop;
|
||||
if E = 0 then
|
||||
return R;
|
||||
end if;
|
||||
loop
|
||||
if E mod 2 /= 0 then
|
||||
R := R * P;
|
||||
end if;
|
||||
E := E / 2;
|
||||
exit when E = 0;
|
||||
P := P * P;
|
||||
end loop;
|
||||
return R;
|
||||
end;
|
||||
end "**";
|
||||
|
||||
procedure Put (A : Matrix) is
|
||||
begin
|
||||
for I in A'Range (1) loop
|
||||
for J in A'Range (1) loop
|
||||
Put (Image (A (I, J)));
|
||||
end loop;
|
||||
New_Line;
|
||||
end loop;
|
||||
end Put;
|
||||
end Matrices;
|
||||
|
||||
package Integer_Matrices is new Matrices (Integer, 0, 1, Image => Integer'Image);
|
||||
use Integer_Matrices;
|
||||
|
||||
M : Matrix (1..2, 1..2) := ((3,2),(2,1));
|
||||
begin
|
||||
Put_Line ("M ="); Put (M);
|
||||
Put_Line ("M**0 ="); Put (M**0);
|
||||
Put_Line ("M**1 ="); Put (M**1);
|
||||
Put_Line ("M**2 ="); Put (M**2);
|
||||
Put_Line ("M*M ="); Put (M*M);
|
||||
Put_Line ("M**3 ="); Put (M**3);
|
||||
Put_Line ("M*M*M ="); Put (M*M*M);
|
||||
Put_Line ("M**4 ="); Put (M**4);
|
||||
Put_Line ("M*M*M*M ="); Put (M*M*M*M);
|
||||
Put_Line ("M**10 ="); Put (M**10);
|
||||
Put_Line ("M*M*M*M*M*M*M*M*M*M ="); Put (M*M*M*M*M*M*M*M*M*M);
|
||||
end Test_Matrix;
|
||||
|
|
@ -0,0 +1,48 @@
|
|||
with Ada.Text_IO; use Ada.Text_IO;
|
||||
with Ada.Complex_Text_IO; use Ada.Complex_Text_IO;
|
||||
with Ada.Numerics.Complex_Types; use Ada.Numerics.Complex_Types;
|
||||
with Ada.Numerics.Real_Arrays; use Ada.Numerics.Real_Arrays;
|
||||
with Ada.Numerics.Complex_Arrays; use Ada.Numerics.Complex_Arrays;
|
||||
with Ada.Numerics.Complex_Elementary_Functions; use Ada.Numerics.Complex_Elementary_Functions;
|
||||
|
||||
procedure Test_Matrix is
|
||||
function "**" (A : Complex_Matrix; Power : Complex) return Complex_Matrix is
|
||||
L : Real_Vector (A'Range (1));
|
||||
X : Complex_Matrix (A'Range (1), A'Range (2));
|
||||
R : Complex_Matrix (A'Range (1), A'Range (2));
|
||||
RL : Complex_Vector (A'Range (1));
|
||||
begin
|
||||
Eigensystem (A, L, X);
|
||||
for I in L'Range loop
|
||||
RL (I) := (L (I), 0.0) ** Power;
|
||||
end loop;
|
||||
for I in R'Range (1) loop
|
||||
for J in R'Range (2) loop
|
||||
declare
|
||||
Sum : Complex := (0.0, 0.0);
|
||||
begin
|
||||
for K in RL'Range (1) loop
|
||||
Sum := Sum + X (K, I) * RL (K) * X (K, J);
|
||||
end loop;
|
||||
R (I, J) := Sum;
|
||||
end;
|
||||
end loop;
|
||||
end loop;
|
||||
return R;
|
||||
end "**";
|
||||
procedure Put (A : Complex_Matrix) is
|
||||
begin
|
||||
for I in A'Range (1) loop
|
||||
for J in A'Range (1) loop
|
||||
Put (A (I, J));
|
||||
end loop;
|
||||
New_Line;
|
||||
end loop;
|
||||
end Put;
|
||||
M : Complex_Matrix (1..2, 1..2) := (((3.0,0.0),(2.0,1.0)),((2.0,-1.0),(1.0,0.0)));
|
||||
begin
|
||||
Put_Line ("M ="); Put (M);
|
||||
Put_Line ("M**0 ="); Put (M**(0.0,0.0));
|
||||
Put_Line ("M**1 ="); Put (M**(1.0,0.0));
|
||||
Put_Line ("M**0.5 ="); Put (M**(0.5,0.0));
|
||||
end Test_Matrix;
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
DIM matrix(1,1), output(1,1)
|
||||
matrix() = 3, 2, 2, 1
|
||||
|
||||
FOR power% = 0 TO 9
|
||||
PROCmatrixpower(matrix(), output(), power%)
|
||||
PRINT "matrix()^" ; power% " = "
|
||||
FOR row% = 0 TO DIM(output(), 1)
|
||||
FOR col% = 0 TO DIM(output(), 2)
|
||||
PRINT output(row%,col%);
|
||||
NEXT
|
||||
PRINT
|
||||
NEXT row%
|
||||
NEXT power%
|
||||
END
|
||||
|
||||
DEF PROCmatrixpower(src(), dst(), pow%)
|
||||
LOCAL i%
|
||||
dst() = 0
|
||||
FOR i% = 0 TO DIM(dst(), 1) : dst(i%,i%) = 1 : NEXT
|
||||
IF pow% THEN
|
||||
FOR i% = 1 TO pow%
|
||||
dst() = dst() . src()
|
||||
NEXT
|
||||
ENDIF
|
||||
ENDPROC
|
||||
|
|
@ -0,0 +1,49 @@
|
|||
#include <complex>
|
||||
#include <cmath>
|
||||
#include <iostream>
|
||||
using namespace std;
|
||||
|
||||
template<int MSize = 3, class T = complex<double> >
|
||||
class SqMx {
|
||||
typedef T Ax[MSize][MSize];
|
||||
typedef SqMx<MSize, T> Mx;
|
||||
|
||||
private:
|
||||
Ax a;
|
||||
SqMx() { }
|
||||
|
||||
public:
|
||||
SqMx(const Ax &_a) { // constructor with pre-defined array
|
||||
for (int r = 0; r < MSize; r++)
|
||||
for (int c = 0; c < MSize; c++)
|
||||
a[r][c] = _a[r][c];
|
||||
}
|
||||
|
||||
static Mx identity() {
|
||||
Mx m;
|
||||
for (int r = 0; r < MSize; r++)
|
||||
for (int c = 0; c < MSize; c++)
|
||||
m.a[r][c] = (r == c ? 1 : 0);
|
||||
return m;
|
||||
}
|
||||
|
||||
friend ostream &operator<<(ostream& os, const Mx &p)
|
||||
{ // ugly print
|
||||
for (int i = 0; i < MSize; i++) {
|
||||
for (int j = 0; j < MSize; j++)
|
||||
os << p.a[i][j] << ",";
|
||||
os << endl;
|
||||
}
|
||||
return os;
|
||||
}
|
||||
|
||||
Mx operator*(const Mx &b) {
|
||||
Mx d;
|
||||
for (int r = 0; r < MSize; r++)
|
||||
for (int c = 0; c < MSize; c++) {
|
||||
d.a[r][c] = 0;
|
||||
for (int k = 0; k < MSize; k++)
|
||||
d.a[r][c] += a[r][k] * b.a[k][c];
|
||||
}
|
||||
return d;
|
||||
}
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
// C++ does not have a ** operator, instead, ^ (bitwise Xor) is used.
|
||||
Mx operator^(int n) {
|
||||
if (n < 0)
|
||||
throw "Negative exponent not implemented";
|
||||
|
||||
Mx d = identity();
|
||||
for (Mx sq = *this; n > 0; sq = sq * sq, n /= 2)
|
||||
if (n % 2 != 0)
|
||||
d = d * sq;
|
||||
return d;
|
||||
}
|
||||
};
|
||||
|
||||
typedef SqMx<> M3;
|
||||
typedef complex<double> creal;
|
||||
|
||||
int main() {
|
||||
double q = sqrt(0.5);
|
||||
creal array[3][3] =
|
||||
{{creal(q, 0), creal(q, 0), creal(0, 0)},
|
||||
{creal(0, -q), creal(0, q), creal(0, 0)},
|
||||
{creal(0, 0), creal(0, 0), creal(0, 1)}};
|
||||
M3 m(array);
|
||||
|
||||
cout << "m ^ 23=" << endl
|
||||
<< (m ^ 23) << endl;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,184 @@
|
|||
#include <math.h>
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
|
||||
typedef struct squareMtxStruct {
|
||||
int dim;
|
||||
double *cells;
|
||||
double **m;
|
||||
} *SquareMtx;
|
||||
|
||||
/* function for initializing row r of a new matrix */
|
||||
typedef void (*FillFunc)( double *cells, int r, int dim, void *ff_data);
|
||||
|
||||
SquareMtx NewSquareMtx( int dim, FillFunc fillFunc, void *ff_data )
|
||||
{
|
||||
SquareMtx sm = malloc(sizeof(struct squareMtxStruct));
|
||||
if (sm) {
|
||||
int rw;
|
||||
sm->dim = dim;
|
||||
sm->cells = malloc(dim*dim * sizeof(double));
|
||||
sm->m = malloc( dim * sizeof(double *));
|
||||
if ((sm->cells != NULL) && (sm->m != NULL)) {
|
||||
for (rw=0; rw<dim; rw++) {
|
||||
sm->m[rw] = sm->cells + dim*rw;
|
||||
fillFunc( sm->m[rw], rw, dim, ff_data );
|
||||
}
|
||||
}
|
||||
else {
|
||||
free(sm->m);
|
||||
free(sm->cells);
|
||||
free(sm);
|
||||
printf("Square Matrix allocation failure\n");
|
||||
return NULL;
|
||||
}
|
||||
}
|
||||
else {
|
||||
printf("Malloc failed for square matrix\n");
|
||||
}
|
||||
return sm;
|
||||
}
|
||||
|
||||
void ffMatxSquare( double *cells, int rw, int dim, SquareMtx m0 )
|
||||
{
|
||||
int col, ix;
|
||||
double sum;
|
||||
double *m0rw = m0->m[rw];
|
||||
|
||||
for (col = 0; col < dim; col++) {
|
||||
sum = 0.0;
|
||||
for (ix=0; ix<dim; ix++)
|
||||
sum += m0rw[ix] * m0->m[ix][col];
|
||||
cells[col] = sum;
|
||||
}
|
||||
}
|
||||
|
||||
void ffMatxMulply( double *cells, int rw, int dim, SquareMtx mplcnds[] )
|
||||
{
|
||||
SquareMtx mleft = mplcnds[0];
|
||||
SquareMtx mrigt = mplcnds[1];
|
||||
double sum;
|
||||
double *m0rw = mleft->m[rw];
|
||||
int col, ix;
|
||||
|
||||
for (col = 0; col < dim; col++) {
|
||||
sum = 0.0;
|
||||
for (ix=0; ix<dim; ix++)
|
||||
sum += m0rw[ix] * mrigt->m[ix][col];
|
||||
cells[col] = sum;
|
||||
}
|
||||
}
|
||||
|
||||
void MatxMul( SquareMtx mr, SquareMtx left, SquareMtx rigt)
|
||||
{
|
||||
int rw;
|
||||
SquareMtx mplcnds[2];
|
||||
mplcnds[0] = left; mplcnds[1] = rigt;
|
||||
|
||||
for (rw = 0; rw < left->dim; rw++)
|
||||
ffMatxMulply( mr->m[rw], rw, left->dim, mplcnds);
|
||||
}
|
||||
|
||||
void ffIdentity( double *cells, int rw, int dim, void *v )
|
||||
{
|
||||
int col;
|
||||
for (col=0; col<dim; col++) cells[col] = 0.0;
|
||||
cells[rw] = 1.0;
|
||||
}
|
||||
void ffCopy(double *cells, int rw, int dim, SquareMtx m1)
|
||||
{
|
||||
int col;
|
||||
for (col=0; col<dim; col++) cells[col] = m1->m[rw][col];
|
||||
}
|
||||
|
||||
void FreeSquareMtx( SquareMtx m )
|
||||
{
|
||||
free(m->m);
|
||||
free(m->cells);
|
||||
free(m);
|
||||
}
|
||||
|
||||
SquareMtx SquareMtxPow( SquareMtx m0, int exp )
|
||||
{
|
||||
SquareMtx v0 = NewSquareMtx(m0->dim, ffIdentity, NULL);
|
||||
SquareMtx v1 = NULL;
|
||||
SquareMtx base0 = NewSquareMtx( m0->dim, ffCopy, m0);
|
||||
SquareMtx base1 = NULL;
|
||||
SquareMtx mplcnds[2], t;
|
||||
|
||||
while (exp) {
|
||||
if (exp % 2) {
|
||||
if (v1)
|
||||
MatxMul( v1, v0, base0);
|
||||
else {
|
||||
mplcnds[0] = v0; mplcnds[1] = base0;
|
||||
v1 = NewSquareMtx(m0->dim, ffMatxMulply, mplcnds);
|
||||
}
|
||||
{t = v0; v0=v1; v1 = t;}
|
||||
}
|
||||
if (base1)
|
||||
MatxMul( base1, base0, base0);
|
||||
else
|
||||
base1 = NewSquareMtx( m0->dim, ffMatxSquare, base0);
|
||||
t = base0; base0 = base1; base1 = t;
|
||||
exp = exp/2;
|
||||
}
|
||||
if (base0) FreeSquareMtx(base0);
|
||||
if (base1) FreeSquareMtx(base1);
|
||||
if (v1) FreeSquareMtx(v1);
|
||||
return v0;
|
||||
}
|
||||
|
||||
FILE *fout;
|
||||
void SquareMtxPrint( SquareMtx mtx, const char *mn )
|
||||
{
|
||||
int rw, col;
|
||||
int d = mtx->dim;
|
||||
|
||||
fprintf(fout, "%s dim:%d =\n", mn, mtx->dim);
|
||||
|
||||
for (rw=0; rw<d; rw++) {
|
||||
fprintf(fout, " |");
|
||||
for(col=0; col<d; col++)
|
||||
fprintf(fout, "%8.5f ",mtx->m[rw][col] );
|
||||
fprintf(fout, " |\n");
|
||||
}
|
||||
fprintf(fout, "\n");
|
||||
}
|
||||
|
||||
void fillInit( double *cells, int rw, int dim, void *data)
|
||||
{
|
||||
double theta = 3.1415926536/6.0;
|
||||
double c1 = cos( theta);
|
||||
double s1 = sin( theta);
|
||||
|
||||
switch(rw) {
|
||||
case 0:
|
||||
cells[0]=c1; cells[1]=s1; cells[2]=0.0;
|
||||
break;
|
||||
case 1:
|
||||
cells[0]=-s1; cells[1]=c1; cells[2]=0;
|
||||
break;
|
||||
case 2:
|
||||
cells[0]=0.0; cells[1]=0.0; cells[2]=1.0;
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
int main()
|
||||
{
|
||||
SquareMtx m0 = NewSquareMtx( 3, fillInit, NULL);
|
||||
SquareMtx m1 = SquareMtxPow( m0, 5);
|
||||
SquareMtx m2 = SquareMtxPow( m0, 9);
|
||||
SquareMtx m3 = SquareMtxPow( m0, 2);
|
||||
|
||||
// fout = stdout;
|
||||
fout = fopen("matrx_exp.txt", "w");
|
||||
SquareMtxPrint(m0, "m0"); FreeSquareMtx(m0);
|
||||
SquareMtxPrint(m1, "m0^5"); FreeSquareMtx(m1);
|
||||
SquareMtxPrint(m2, "m0^9"); FreeSquareMtx(m2);
|
||||
SquareMtxPrint(m3, "m0^2"); FreeSquareMtx(m3);
|
||||
fclose(fout);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
(defun multiply-matrices (matrix-0 matrix-1)
|
||||
"Takes two 2D arrays and returns their product, or an error if they cannot be multiplied"
|
||||
(let* ((m0-dims (array-dimensions matrix-0))
|
||||
(m1-dims (array-dimensions matrix-1))
|
||||
(m0-dim (length m0-dims))
|
||||
(m1-dim (length m1-dims)))
|
||||
(if (or (/= 2 m0-dim) (/= 2 m1-dim))
|
||||
(error "Array given not a matrix")
|
||||
(let ((m0-rows (car m0-dims))
|
||||
(m0-cols (cadr m0-dims))
|
||||
(m1-rows (car m1-dims))
|
||||
(m1-cols (cadr m1-dims)))
|
||||
(if (/= m0-cols m1-rows)
|
||||
(error "Incompatible dimensions")
|
||||
(do ((rarr (make-array (list m0-rows m1-cols)
|
||||
:initial-element 0) rarr)
|
||||
(n 0 (if (= n (1- m0-cols)) 0 (1+ n)))
|
||||
(cc 0 (if (= n (1- m0-cols))
|
||||
(if (/= cc (1- m1-cols))
|
||||
(1+ cc) 0) cc))
|
||||
(cr 0 (if (and (= (1- m0-cols) n)
|
||||
(= (1- m1-cols) cc))
|
||||
(1+ cr)
|
||||
cr)))
|
||||
((= cr m0-rows) rarr)
|
||||
(setf (aref rarr cr cc)
|
||||
(+ (aref rarr cr cc)
|
||||
(* (aref matrix-0 cr n)
|
||||
(aref matrix-1 n cc))))))))))
|
||||
|
||||
(defun matrix-identity (dim)
|
||||
"Creates a new identity matrix of size dim*dim"
|
||||
(do ((rarr (make-array (list dim dim)
|
||||
:initial-element 0) rarr)
|
||||
(n 0 (1+ n)))
|
||||
((= n dim) rarr)
|
||||
(setf (aref rarr n n) 1)))
|
||||
|
||||
(defun matrix-expt (matrix exp)
|
||||
"Takes the first argument (a matrix) and multiplies it by itself exp times"
|
||||
(let* ((m-dims (array-dimensions matrix))
|
||||
(m-rows (car m-dims))
|
||||
(m-cols (cadr m-dims)))
|
||||
(cond
|
||||
((/= m-rows m-cols) (error "Non-square matrix"))
|
||||
((zerop exp) (matrix-identity m-rows))
|
||||
((= 1 exp) (do ((rarr (make-array (list m-rows m-cols)) rarr)
|
||||
(cc 0 (if (= cc (1- m-cols))
|
||||
0
|
||||
(1+ cc)))
|
||||
(cr 0 (if (= cc (1- m-cols))
|
||||
(1+ cr)
|
||||
cr)))
|
||||
((= cr m-rows) rarr)
|
||||
(setf (aref rarr cr cc) (aref matrix cr cc))))
|
||||
((zerop (mod exp 2)) (let ((me2 (matrix-expt matrix (/ exp 2))))
|
||||
(multiply-matrices me2 me2)))
|
||||
(t (let ((me2 (matrix-expt matrix (/ (1- exp) 2))))
|
||||
(multiply-matrices matrix (multiply-matrices me2 me2)))))))
|
||||
|
|
@ -0,0 +1,81 @@
|
|||
import std.stdio, std.string, std.math, std.array;
|
||||
|
||||
struct SquareMat(T = creal) {
|
||||
static public string fmt = "%8.3f";
|
||||
private alias T[][] TM;
|
||||
private TM a;
|
||||
|
||||
public this(in size_t side) pure nothrow
|
||||
in {
|
||||
assert(side > 0);
|
||||
} body {
|
||||
a = new TM(side, side);
|
||||
}
|
||||
|
||||
public this(in TM m) pure nothrow
|
||||
in {
|
||||
assert(!m.empty);
|
||||
foreach (row; m)
|
||||
assert(m.length == m[0].length);
|
||||
} body {
|
||||
a.length = m.length;
|
||||
foreach (i, row; m)
|
||||
//a[i] = row.dup; // not nothrow
|
||||
a[i] = row ~ []; // slower
|
||||
}
|
||||
|
||||
string toString() const {
|
||||
return xformat("<%(%(" ~ fmt ~ ", %)\n %)>", a);
|
||||
}
|
||||
|
||||
public static SquareMat identity(in size_t side) pure nothrow {
|
||||
SquareMat m;
|
||||
m.a.length = side;
|
||||
foreach (r, ref row; m.a) {
|
||||
row.length = side;
|
||||
foreach (c; 0 .. side)
|
||||
row[c] = cast(T)(r == c ? 1 : 0);
|
||||
}
|
||||
return m;
|
||||
}
|
||||
|
||||
public SquareMat opBinary(string op:"*")(in SquareMat other)
|
||||
const pure nothrow in {
|
||||
assert (a.length == other.a.length);
|
||||
} body {
|
||||
immutable size_t side = other.a.length;
|
||||
SquareMat d;
|
||||
d.a = new TM(side, side);
|
||||
foreach (r; 0 .. side)
|
||||
foreach (c; 0 .. side) {
|
||||
d.a[r][c] = cast(T)0;
|
||||
foreach (k, ark; a[r])
|
||||
d.a[r][c] += ark * other.a[k][c];
|
||||
}
|
||||
return d;
|
||||
}
|
||||
|
||||
// This is the task part ---------------
|
||||
public SquareMat opBinary(string op:"^^")(int n) const pure nothrow
|
||||
in {
|
||||
assert(n >= 0, "Negative exponent not implemented.");
|
||||
} body {
|
||||
auto sq = SquareMat(this.a);
|
||||
auto d = SquareMat.identity(a.length);
|
||||
for (; n > 0; sq = sq * sq, n >>= 1)
|
||||
if (n & 1)
|
||||
d = d * sq;
|
||||
return d;
|
||||
}
|
||||
}
|
||||
|
||||
void main() {
|
||||
alias SquareMat!() M;
|
||||
immutable real q = sqrt(0.5);
|
||||
auto m = M([[ q + 0*1.0Li, q + 0*1.0Li, 0.0L + 0.0Li],
|
||||
[0.0L - q*1.0Li, 0.0L + q*1.0Li, 0.0L + 0.0Li],
|
||||
[0.0L + 0.0Li, 0.0L + 0.0Li, 0.0L + 1.0Li]]);
|
||||
M.fmt = "%5.2f";
|
||||
foreach (p; [0, 1, 23, 24])
|
||||
writefln("m ^^ %d =\n%s", p, m ^^ p);
|
||||
}
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
USING: kernel math math.matrices sequences ;
|
||||
|
||||
: my-m^n ( m n -- m' )
|
||||
dup 0 < [ "no negative exponents" throw ] [
|
||||
[ drop length identity-matrix ]
|
||||
[ swap '[ _ m. ] times ] 2bi
|
||||
] if ;
|
||||
|
|
@ -0,0 +1,53 @@
|
|||
module matmod
|
||||
implicit none
|
||||
|
||||
! Overloading the ** operator does not work because the compiler cannot
|
||||
! differentiate between matrix exponentiation and the elementwise raising
|
||||
! of an array to a power therefore we define a new operator
|
||||
interface operator (.matpow.)
|
||||
module procedure matrix_exp
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
function matrix_exp(m, n) result (res)
|
||||
real, intent(in) :: m(:,:)
|
||||
integer, intent(in) :: n
|
||||
real :: res(size(m,1),size(m,2))
|
||||
integer :: i
|
||||
|
||||
if(n == 0) then
|
||||
res = 0
|
||||
do i = 1, size(m,1)
|
||||
res(i,i) = 1
|
||||
end do
|
||||
return
|
||||
end if
|
||||
|
||||
res = m
|
||||
do i = 2, n
|
||||
res = matmul(res, m)
|
||||
end do
|
||||
|
||||
end function matrix_exp
|
||||
end module matmod
|
||||
|
||||
program Matrix_exponentiation
|
||||
use matmod
|
||||
implicit none
|
||||
|
||||
integer, parameter :: n = 3
|
||||
real, dimension(n,n) :: m1, m2
|
||||
integer :: i, j
|
||||
|
||||
m1 = reshape((/ (i, i = 1, n*n) /), (/ n, n /), order = (/ 2, 1 /))
|
||||
|
||||
do i = 0, 4
|
||||
m2 = m1 .matpow. i
|
||||
do j = 1, size(m2,1)
|
||||
write(*,*) m2(j,:)
|
||||
end do
|
||||
write(*,*)
|
||||
end do
|
||||
|
||||
end program Matrix_exponentiation
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
# Matrix exponentiation is built-in
|
||||
A := [[0 , 1], [1, 1]];
|
||||
PrintArray(A);
|
||||
# [ [ 0, 1 ],
|
||||
# [ 1, 1 ] ]
|
||||
PrintArray(A^10);
|
||||
# [ [ 34, 55 ],
|
||||
# [ 55, 89 ] ]
|
||||
|
|
@ -0,0 +1,12 @@
|
|||
import Data.List
|
||||
|
||||
xs <+> ys = zipWith (+) xs ys
|
||||
xs <*> ys = sum $ zipWith (*) xs ys
|
||||
|
||||
newtype Mat a = Mat [[a]] deriving (Eq, Show)
|
||||
|
||||
instance Num a => Num (Mat a) where
|
||||
negate (Mat x) = Mat $ map (map negate) x
|
||||
Mat x + Mat y = Mat $ zipWith (<+>) x y
|
||||
Mat x * Mat y = Mat [[xs <*> ys | ys <- transpose y] | xs <- x]
|
||||
fromInteger _ = undefined -- don't know dimension of the desired matrix
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
mp=: +/ .* NB. Matrix multiplication
|
||||
pow=: pow0=: 4 : 'mp&x^:y =i.#x'
|
||||
|
|
@ -0,0 +1 @@
|
|||
pow=: pow1=: 4 : 'mp/ mp~^:(I.|.#:y) x'
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
// IdentityMatrix is a "subclass" of Matrix
|
||||
function IdentityMatrix(n) {
|
||||
this.height = n;
|
||||
this.width = n;
|
||||
this.mtx = [];
|
||||
for (var i = 0; i < n; i++) {
|
||||
this.mtx[i] = [];
|
||||
for (var j = 0; j < n; j++) {
|
||||
this.mtx[i][j] = (i == j ? 1 : 0);
|
||||
}
|
||||
}
|
||||
}
|
||||
IdentityMatrix.prototype = Matrix.prototype;
|
||||
|
||||
// the Matrix exponentiation function
|
||||
// returns a new matrix
|
||||
Matrix.prototype.exp = function(n) {
|
||||
var result = new IdentityMatrix(this.height);
|
||||
for (var i = 1; i <= n; i++) {
|
||||
result = result.mult(this);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
var m = new Matrix([[3, 2], [2, 1]]);
|
||||
[0,1,2,3,4,10].forEach(function(e){print(m.exp(e)); print()})
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
MatrixD$ ="3, 3, 0.86603, 0.50000, 0.00000, -0.50000, 0.86603, 0.00000, 0.00000, 0.00000, 1.00000"
|
||||
|
||||
|
||||
print "Exponentiation of a matrix"
|
||||
call DisplayMatrix MatrixD$
|
||||
print " Raised to power 5 ="
|
||||
MatrixE$ =MatrixToPower$( MatrixD$, 5)
|
||||
call DisplayMatrix MatrixE$
|
||||
print " Raised to power 9 ="
|
||||
MatrixE$ =MatrixToPower$( MatrixD$, 9)
|
||||
call DisplayMatrix MatrixE$
|
||||
|
|
@ -0,0 +1,96 @@
|
|||
Matrix = {}
|
||||
|
||||
function Matrix.new( dim_y, dim_x )
|
||||
assert( dim_y and dim_x )
|
||||
|
||||
local matrix = {}
|
||||
local metatab = {}
|
||||
setmetatable( matrix, metatab )
|
||||
metatab.__add = Matrix.Add
|
||||
metatab.__mul = Matrix.Mul
|
||||
metatab.__pow = Matrix.Pow
|
||||
|
||||
matrix.dim_y = dim_y
|
||||
matrix.dim_x = dim_x
|
||||
|
||||
matrix.data = {}
|
||||
for i = 1, dim_y do
|
||||
matrix.data[i] = {}
|
||||
end
|
||||
return matrix
|
||||
end
|
||||
|
||||
function Matrix.Show( m )
|
||||
for i = 1, m.dim_y do
|
||||
for j = 1, m.dim_x do
|
||||
io.write( tostring( m.data[i][j] ), " " )
|
||||
end
|
||||
io.write( "\n" )
|
||||
end
|
||||
end
|
||||
|
||||
function Matrix.Add( m, n )
|
||||
assert( m.dim_x == n.dim_x and m.dim_y == n.dim_y )
|
||||
|
||||
local r = Matrix.new( m.dim_y, m.dim_x )
|
||||
for i = 1, m.dim_y do
|
||||
for j = 1, m.dim_x do
|
||||
r.data[i][j] = m.data[i][j] + n.data[i][j]
|
||||
end
|
||||
end
|
||||
return r
|
||||
end
|
||||
|
||||
function Matrix.Mul( m, n )
|
||||
assert( m.dim_x == n.dim_y )
|
||||
|
||||
local r = Matrix.new( m.dim_y, n.dim_x )
|
||||
for i = 1, m.dim_y do
|
||||
for j = 1, n.dim_x do
|
||||
r.data[i][j] = 0
|
||||
for k = 1, m.dim_x do
|
||||
r.data[i][j] = r.data[i][j] + m.data[i][k] * n.data[k][j]
|
||||
end
|
||||
end
|
||||
end
|
||||
return r
|
||||
end
|
||||
|
||||
function Matrix.Pow( m, p )
|
||||
assert( m.dim_x == m.dim_y )
|
||||
|
||||
local r = Matrix.new( m.dim_y, m.dim_x )
|
||||
|
||||
if p == 0 then
|
||||
for i = 1, m.dim_y do
|
||||
for j = 1, m.dim_x do
|
||||
if i == j then
|
||||
r.data[i][j] = 1
|
||||
else
|
||||
r.data[i][j] = 0
|
||||
end
|
||||
end
|
||||
end
|
||||
elseif p == 1 then
|
||||
for i = 1, m.dim_y do
|
||||
for j = 1, m.dim_x do
|
||||
r.data[i][j] = m.data[i][j]
|
||||
end
|
||||
end
|
||||
else
|
||||
r = m
|
||||
for i = 2, p do
|
||||
r = r * m
|
||||
end
|
||||
end
|
||||
|
||||
return r
|
||||
end
|
||||
|
||||
|
||||
m = Matrix.new( 2, 2 )
|
||||
m.data = { { 1, 2 }, { 3, 4 } }
|
||||
|
||||
n = m^4;
|
||||
|
||||
Matrix.Show( n )
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
function [output] = matrixexponentiation(matrixA, exponent)
|
||||
output = matrixA^(exponent);
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
function [output] = matrixexponentiation(matrixA, exponent)
|
||||
output = matrixA.^(exponent);
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
a = {{3, 2}, {4, 1}};
|
||||
MatrixPower[a, 0]
|
||||
MatrixPower[a, 1]
|
||||
MatrixPower[a, -1]
|
||||
MatrixPower[a, 4]
|
||||
MatrixPower[a, 1/2]
|
||||
MatrixPower[a, Pi]
|
||||
|
|
@ -0,0 +1 @@
|
|||
MatrixPower[{{i, j}, {k, l}}, m] // Simplify
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
a: matrix([3, 2],
|
||||
[4, 1])$
|
||||
|
||||
a ^^ 4;
|
||||
/* matrix([417, 208],
|
||||
[416, 209]) */
|
||||
|
||||
a ^^ -1;
|
||||
/* matrix([-1/5, 2/5],
|
||||
[4/5, -3/5]) */
|
||||
|
|
@ -0,0 +1,94 @@
|
|||
use strict;
|
||||
package SquareMatrix;
|
||||
use Carp; # standard, "it's not my fault" module
|
||||
|
||||
use overload (
|
||||
'""' => \&_string, # overload string operator so we can just print
|
||||
'*' => \&_mult, # multiplication, needed for expo
|
||||
'*=' => \&_mult, # ditto, explicitly defined to trigger copy
|
||||
'**' => \&_expo, # overload exponentiation
|
||||
'=' => \&_copy, # copy operator
|
||||
);
|
||||
|
||||
sub make {
|
||||
my $cls = shift;
|
||||
my $n = @_;
|
||||
for (@_) {
|
||||
# verify each row given is the right length
|
||||
confess "Bad data @$_: matrix must be square "
|
||||
if @$_ != $n;
|
||||
}
|
||||
|
||||
bless [ map [@$_], @_ ] # important: actually copy all the rows
|
||||
}
|
||||
|
||||
sub identity {
|
||||
my $self = shift;
|
||||
my $n = @$self - 1;
|
||||
my @rows = map [ (0) x $_, 1, (0) x ($n - $_) ], 0 .. $n;
|
||||
bless \@rows
|
||||
}
|
||||
|
||||
sub zero {
|
||||
my $self = shift;
|
||||
my $n = @$self;
|
||||
bless [ map [ (0) x $n ], 1 .. $n ]
|
||||
}
|
||||
|
||||
sub _string {
|
||||
"[ ".join("\n " =>
|
||||
map join(" " => map(sprintf("%12.6g", $_), @$_)), @{+shift}
|
||||
)." ]\n";
|
||||
}
|
||||
|
||||
sub _mult {
|
||||
my ($a, $b) = @_;
|
||||
my $x = $a->zero;
|
||||
my @idx = (0 .. $#$x);
|
||||
for my $j (@idx) {
|
||||
my @col = map($a->[$_][$j], @idx);
|
||||
for my $i (@idx) {
|
||||
my $row = $b->[$i];
|
||||
$x->[$i][$j] += $row->[$_] * $col[$_] for @idx;
|
||||
}
|
||||
}
|
||||
$x
|
||||
}
|
||||
|
||||
sub _expo {
|
||||
my ($self, $n) = @_;
|
||||
confess "matrix **: must be non-negative integer power"
|
||||
unless $n >= 0 && $n == int($n);
|
||||
|
||||
my ($tmp, $out) = ($self, $self->identity);
|
||||
do {
|
||||
$out *= $tmp if $n & 1;
|
||||
$tmp *= $tmp;
|
||||
} while $n >>= 1;
|
||||
|
||||
$out
|
||||
}
|
||||
|
||||
sub _copy { bless [ map [ @$_ ], @{+shift} ] }
|
||||
|
||||
# now use our matrix class
|
||||
package main;
|
||||
|
||||
my $m = SquareMatrix->make(
|
||||
[1, 2, 0],
|
||||
[0, 3, 1],
|
||||
[1, 0, 0] );
|
||||
print "### Order $_\n", $m ** $_ for 0 .. 10;
|
||||
|
||||
$m = SquareMatrix->make(
|
||||
[ 1.0001, 0, 0, 1 ],
|
||||
[ 0, 1.001, 0, 0 ],
|
||||
[ 0, 0, 1, 0.99998 ],
|
||||
[ 1e-8, 0, 0, 1.0002 ]);
|
||||
|
||||
print "\n### Matrix is now\n", $m;
|
||||
print "\n### Big power:\n", $m ** 100_000;
|
||||
print "\n### Too big:\n", $m ** 1_000_000;
|
||||
print "\n### WAY too big:\n", $m ** 1_000_000_000_000;
|
||||
print "\n### But identity matrix can handle that\n",
|
||||
$m->identity ** 1_000_000_000_000;
|
||||
|
|
@ -0,0 +1,11 @@
|
|||
(de matIdent (N)
|
||||
(let L (need N (1) 0)
|
||||
(mapcar '(() (copy (rot L))) L) ) )
|
||||
|
||||
(de matExp (Mat N)
|
||||
(let M (matIdent (length Mat))
|
||||
(do N
|
||||
(setq M (matMul M Mat)) )
|
||||
M ) )
|
||||
|
||||
(matExp '((3 2) (2 1)) 3)
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
>>> from operator import mul
|
||||
>>> def matrixMul(m1, m2):
|
||||
return map(
|
||||
lambda row:
|
||||
map(
|
||||
lambda *column:
|
||||
sum(map(mul, row, column)),
|
||||
*m2),
|
||||
m1)
|
||||
|
||||
>>> def identity(size):
|
||||
size = range(size)
|
||||
return [[(i==j)*1 for i in size] for j in size]
|
||||
|
||||
>>> def matrixExp(m, pow):
|
||||
assert pow>=0 and int(pow)==pow, "Only non-negative, integer powers allowed"
|
||||
accumulator = identity(len(m))
|
||||
for i in range(pow):
|
||||
accumulator = matrixMul(accumulator, m)
|
||||
return accumulator
|
||||
|
||||
>>> def printtable(data):
|
||||
for row in data:
|
||||
print ' '.join('%-5s' % ('%s' % cell) for cell in row)
|
||||
|
||||
|
||||
>>> m = [[3,2], [2,1]]
|
||||
>>> for i in range(5):
|
||||
print '\n%i:' % i
|
||||
printtable( matrixExp(m, i) )
|
||||
|
||||
|
||||
|
||||
0:
|
||||
1 0
|
||||
0 1
|
||||
|
||||
1:
|
||||
3 2
|
||||
2 1
|
||||
|
||||
2:
|
||||
13 8
|
||||
8 5
|
||||
|
||||
3:
|
||||
55 34
|
||||
34 21
|
||||
|
||||
4:
|
||||
233 144
|
||||
144 89
|
||||
>>> printtable( matrixExp(m, 10) )
|
||||
1346269 832040
|
||||
832040 514229
|
||||
>>>
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
library(Biodem)
|
||||
m <- matrix(c(3,2,2,1), nrow=2)
|
||||
mtx.exp(m, 0)
|
||||
# [,1] [,2]
|
||||
# [1,] 1 0
|
||||
# [2,] 0 1
|
||||
mtx.exp(m, 1)
|
||||
# [,1] [,2]
|
||||
# [1,] 3 2
|
||||
# [2,] 2 1
|
||||
mtx.exp(m, 2)
|
||||
# [,1] [,2]
|
||||
# [1,] 13 8
|
||||
# [2,] 8 5
|
||||
mtx.exp(m, 3)
|
||||
# [,1] [,2]
|
||||
# [1,] 55 34
|
||||
# [2,] 34 21
|
||||
mtx.exp(m, 10)
|
||||
# [,1] [,2]
|
||||
# [1,] 1346269 832040
|
||||
# [2,] 832040 514229
|
||||
|
|
@ -0,0 +1,38 @@
|
|||
class Matrix[T](matrix:Array[Array[T]])(implicit n: Numeric[T], m: ClassManifest[T])
|
||||
{
|
||||
import n._
|
||||
val rows=matrix.size
|
||||
val cols=matrix(0).size
|
||||
def row(i:Int)=matrix(i)
|
||||
def col(i:Int)=matrix map (_(i))
|
||||
|
||||
def *(other: Matrix[T]):Matrix[T] = new Matrix(
|
||||
Array.tabulate(rows, other.cols)((row, col) =>
|
||||
(this.row(row), other.col(col)).zipped.map(_*_) reduceLeft (_+_)
|
||||
))
|
||||
|
||||
def **(x: Int)=x match {
|
||||
case 0 => createIdentityMatrix
|
||||
case 1 => this
|
||||
case 2 => this * this
|
||||
case _ => List.fill(x)(this) reduceLeft (_*_)
|
||||
}
|
||||
|
||||
def createIdentityMatrix=new Matrix(Array.tabulate(rows, cols)((row,col) =>
|
||||
if (row == col) one else zero)
|
||||
)
|
||||
|
||||
override def toString = matrix map (_.mkString("[", ", ", "]")) mkString "\n"
|
||||
}
|
||||
|
||||
object MatrixTest {
|
||||
def main(args:Array[String])={
|
||||
val m=new Matrix[BigInt](Array(Array(3,2), Array(2,1)))
|
||||
println("-- m --\n"+m)
|
||||
|
||||
Seq(0,1,2,3,4,10,20,50) foreach {x =>
|
||||
println("-- m**"+x+" --")
|
||||
println(m**x)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,24 @@
|
|||
package require Tcl 8.5
|
||||
namespace path {::tcl::mathop ::tcl::mathfunc}
|
||||
|
||||
proc matrix_exp {m pow} {
|
||||
if { ! [string is int -strict $pow]} {
|
||||
error "non-integer exponents not implemented"
|
||||
}
|
||||
if {$pow < 0} {
|
||||
error "negative exponents not implemented"
|
||||
}
|
||||
lassign [size $m] rows cols
|
||||
# assume square matrix
|
||||
set temp [identity $rows]
|
||||
for {set n 1} {$n <= $pow} {incr n} {
|
||||
set temp [matrix_multiply $temp $m]
|
||||
}
|
||||
return $temp
|
||||
}
|
||||
|
||||
proc identity {size} {
|
||||
set i [lrepeat $size [lrepeat $size 0]]
|
||||
for {set n 0} {$n < $size} {incr n} {lset i $n $n 1}
|
||||
return $i
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue