Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
4
Task/Gauss-Jordan-matrix-inversion/00-META.yaml
Normal file
4
Task/Gauss-Jordan-matrix-inversion/00-META.yaml
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
---
|
||||
category:
|
||||
- Matrices
|
||||
from: http://rosettacode.org/wiki/Gauss-Jordan_matrix_inversion
|
||||
6
Task/Gauss-Jordan-matrix-inversion/00-TASK.txt
Normal file
6
Task/Gauss-Jordan-matrix-inversion/00-TASK.txt
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
;Task:
|
||||
Invert matrix '''A''' using Gauss-Jordan method.
|
||||
|
||||
'''A''' being an '''n''' × '''n''' matrix.
|
||||
<br><br>
|
||||
|
||||
|
|
@ -0,0 +1,83 @@
|
|||
V Eps = 1e-10
|
||||
|
||||
F transformToRref(&mat)
|
||||
V lead = 0
|
||||
|
||||
L(r) 0 .< mat.len
|
||||
I lead >= mat[0].len
|
||||
R
|
||||
|
||||
V i = r
|
||||
L mat[i][lead] == 0
|
||||
i++
|
||||
I i == mat.len
|
||||
i = r
|
||||
lead++
|
||||
I lead == mat[0].len
|
||||
R
|
||||
swap(&mat[i], &mat[r])
|
||||
|
||||
V d = mat[r][lead]
|
||||
I abs(d) > Eps
|
||||
L(&item) mat[r]
|
||||
item /= d
|
||||
|
||||
L(i) 0 .< mat.len
|
||||
I i != r
|
||||
V m = mat[i][lead]
|
||||
L(c) 0 .< mat[0].len
|
||||
mat[i][c] -= mat[r][c] * m
|
||||
|
||||
lead++
|
||||
|
||||
F inverse(mat)
|
||||
V augmat = [[0.0] * (2 * mat.len)] * mat.len
|
||||
L(i) 0 .< mat.len
|
||||
L(j) 0 .< mat.len
|
||||
augmat[i][j] = mat[i][j]
|
||||
augmat[i][mat.len + i] = 1
|
||||
|
||||
transformToRref(&augmat)
|
||||
|
||||
V result = [[0.0] * mat.len] * mat.len
|
||||
L(i) 0 .< mat.len
|
||||
L(j) 0 .< mat.len
|
||||
I augmat[i][j] != Float(i == j)
|
||||
X ValueError(‘matrix is singular’)
|
||||
result[i][j] = augmat[i][mat.len + j]
|
||||
R result
|
||||
|
||||
F print_mat(mat)
|
||||
L(row) mat
|
||||
V line = ‘’
|
||||
L(val) row
|
||||
I !line.empty
|
||||
line ‘’= ‘ ’
|
||||
line ‘’= ‘#3.5’.format(val)
|
||||
print(line)
|
||||
|
||||
F runTest(mat)
|
||||
print(‘Matrix:’)
|
||||
print_mat(mat)
|
||||
print()
|
||||
print(‘Inverse:’)
|
||||
print_mat(inverse(mat))
|
||||
print()
|
||||
print()
|
||||
|
||||
V m1 = [[Float(1), 2, 3],
|
||||
[Float(4), 1, 6],
|
||||
[Float(7), 8, 9]]
|
||||
|
||||
V m2 = [[Float( 2), -1, 0],
|
||||
[Float(-1), 2, -1],
|
||||
[Float( 0), -1, 2]]
|
||||
|
||||
V m3 = [[Float(-1), -2, 3, 2],
|
||||
[Float(-4), -1, 6, 2],
|
||||
[Float( 7), -8, 9, 1],
|
||||
[Float( 1), -2, 1, 3]]
|
||||
|
||||
runTest(m1)
|
||||
runTest(m2)
|
||||
runTest(m3)
|
||||
|
|
@ -0,0 +1,199 @@
|
|||
* Gauss-Jordan matrix inversion 17/01/2021
|
||||
GAUSSJOR CSECT
|
||||
USING GAUSSJOR,R13 base register
|
||||
B 72(R15) skip savearea
|
||||
DC 17F'0' savearea
|
||||
SAVE (14,12) save previous context
|
||||
ST R13,4(R15) link backward
|
||||
ST R15,8(R13) link forward
|
||||
LR R13,R15 set addressability
|
||||
LA R6,1 i=1
|
||||
DO WHILE=(C,R6,LE,N) do i=1 to n
|
||||
LA R7,1 j=1
|
||||
DO WHILE=(C,R7,LE,N) do j=1 to n
|
||||
LR R1,R6 i
|
||||
BCTR R1,0 -1
|
||||
MH R1,HN *n
|
||||
LR R0,R7 j
|
||||
BCTR R0,0 -1
|
||||
AR R1,R0 (i-1)*n+j-1
|
||||
SLA R1,2 *4
|
||||
LE F0,AA(R1) aa(i,j)
|
||||
LR R1,R6 i
|
||||
BCTR R1,0 -1
|
||||
MH R1,HN2 *n*2
|
||||
LR R0,R7 j
|
||||
BCTR R0,0 -1
|
||||
AR R1,R0 (i-1)*n*2+j-1
|
||||
SLA R1,2 *4
|
||||
STE F0,TMP(R1) tmp(i,j)=aa(i,j)
|
||||
LA R7,1(R7) j++
|
||||
ENDDO , enddo j
|
||||
LA R7,1 j=1
|
||||
A R7,N j=n+1
|
||||
DO WHILE=(C,R7,LE,N2) do j=n+1 to 2*n
|
||||
LR R1,R6 i
|
||||
BCTR R1,0 -1
|
||||
MH R1,HN2 *n*2
|
||||
LR R0,R7 j
|
||||
BCTR R0,0 -1
|
||||
AR R1,R0 (i-1)*n*2+j-1
|
||||
SLA R1,2 *4
|
||||
LE F0,=E'0' 0
|
||||
STE F0,TMP(R1) tmp(i,j)=0
|
||||
LA R7,1(R7) j++
|
||||
ENDDO , enddo j
|
||||
LR R2,R6 i
|
||||
A R2,N i+n
|
||||
LR R1,R6 i
|
||||
BCTR R1,0 -1
|
||||
MH R1,HN2 *n*2
|
||||
BCTR R2,0 -1
|
||||
AR R1,R2 (i+n-1)*n*2+i-1
|
||||
SLA R1,2 *4
|
||||
LE F0,=E'1' 1
|
||||
STE F0,TMP(R1) tmp(i,i+n)=1
|
||||
LA R6,1(R6) i++
|
||||
ENDDO , enddo i
|
||||
LA R6,1 i=1
|
||||
DO WHILE=(C,R6,LE,N) do r=1 to n
|
||||
LR R1,R6 r
|
||||
BCTR R1,0 -1
|
||||
MH R1,HN2 *n*2
|
||||
LR R0,R6 r
|
||||
BCTR R0,0 -1
|
||||
AR R1,R0 (r-1)*n*2+r-1
|
||||
SLA R1,2 *4
|
||||
LE F0,TMP(R1) tmp(r,r)
|
||||
STE F0,T t=tmp(r,r)
|
||||
LA R7,1 c=1
|
||||
DO WHILE=(C,R7,LE,N2) do c=1 to n*2
|
||||
LR R1,R6 r
|
||||
BCTR R1,0
|
||||
MH R1,HN2
|
||||
LR R0,R7 c
|
||||
BCTR R0,0
|
||||
AR R1,R0
|
||||
SLA R1,2
|
||||
LE F0,TMP(R1)
|
||||
LTER F0,F0
|
||||
BZ *+8
|
||||
DE F0,T tmp(r,c)/t
|
||||
LR R1,R6 r
|
||||
BCTR R1,0
|
||||
MH R1,HN2
|
||||
LR R0,R7 c
|
||||
BCTR R0,0
|
||||
AR R1,R0
|
||||
SLA R1,2
|
||||
STE F0,TMP(R1) tmp(r,c)=tmp(r,c)/t
|
||||
LA R7,1(R7) c++
|
||||
ENDDO , enddo c
|
||||
LA R8,1 i=1
|
||||
DO WHILE=(C,R8,LE,N) do i=1 to n
|
||||
IF CR,R8,NE,R6 THEN if i^=r then
|
||||
LR R1,R8 i
|
||||
BCTR R1,0
|
||||
MH R1,HN2
|
||||
LR R0,R6 r
|
||||
BCTR R0,0
|
||||
AR R1,R0
|
||||
SLA R1,2
|
||||
LE F0,TMP(R1) tmp(i,r)
|
||||
STE F0,T t=tmp(i,r)
|
||||
LA R7,1 c=1
|
||||
DO WHILE=(C,R7,LE,N2) do c=1 to n*2
|
||||
LR R2,R8 i
|
||||
BCTR R2,0
|
||||
MH R2,HN2
|
||||
LR R0,R7 c
|
||||
BCTR R0,0
|
||||
AR R2,R0
|
||||
SLA R2,2
|
||||
LE F0,TMP(R2) f0=tmp(i,c)
|
||||
LR R1,R6 r
|
||||
BCTR R1,0
|
||||
MH R1,HN2
|
||||
LR R0,R7 c
|
||||
BCTR R0,0
|
||||
AR R1,R0
|
||||
SLA R1,2
|
||||
LE F2,TMP(R1) f2=tmp(r,c)
|
||||
LE F4,T t
|
||||
MER F4,F2 f4=t*tmp(r,c)
|
||||
SER F0,F4 f0=tmp(i,c)-t*tmp(r,c)
|
||||
STE F0,TMP(R2) tmp(i,c)=f0
|
||||
LA R7,1(R7) c++
|
||||
ENDDO , enddo c
|
||||
ENDIF , endif
|
||||
LA R8,1(R8) i++
|
||||
ENDDO , enddo i
|
||||
LA R6,1(R6) r++
|
||||
ENDDO , enddo r
|
||||
LA R6,1 i=1
|
||||
DO WHILE=(C,R6,LE,N) do i=1 to n
|
||||
L R7,N n
|
||||
LA R7,1(R7) j=n+1
|
||||
DO WHILE=(C,R7,LE,N2) do j=n+1 to 2*n
|
||||
LR R2,R7 j
|
||||
S R2,N -n
|
||||
LR R1,R6 i
|
||||
BCTR R1,0
|
||||
MH R1,HN2 *2*n
|
||||
LR R0,R7 j
|
||||
BCTR R0,0
|
||||
AR R1,R0
|
||||
SLA R1,2
|
||||
LE F0,TMP(R1) tmp(i,j)
|
||||
LR R1,R6 i
|
||||
BCTR R1,0
|
||||
MH R1,HN *n
|
||||
BCTR R2,0
|
||||
AR R1,R2
|
||||
SLA R1,2
|
||||
STE F0,BB(R1) bb(i,j-n)=tmp(i,j)
|
||||
LA R7,1(R7) j++
|
||||
ENDDO , enddo j
|
||||
LA R6,1(R6) i++
|
||||
ENDDO , enddo i
|
||||
LA R6,1 i=1
|
||||
DO WHILE=(C,R6,LE,N) do i=1 to n
|
||||
LA R3,PG @pg
|
||||
LA R7,1 j=1
|
||||
DO WHILE=(C,R7,LE,N) do j=1 to n
|
||||
LR R1,R6 i
|
||||
BCTR R1,0
|
||||
MH R1,HN *n
|
||||
LR R0,R7 j
|
||||
BCTR R0,0
|
||||
AR R1,R0
|
||||
SLA R1,2
|
||||
LE F0,BB(R1) bb(i,j)
|
||||
LA R0,5 number of decimals
|
||||
BAL R14,FORMATF FormatF(bb(i,j))
|
||||
MVC 0(13,R3),0(R1) edit
|
||||
LA R3,13(R3) @pg+=13
|
||||
LA R7,1(R7) j++
|
||||
ENDDO , enddo j
|
||||
XPRNT PG,L'PG print buffer
|
||||
LA R6,1(R6) i++
|
||||
ENDDO , enddo i
|
||||
L R13,4(0,R13) restore previous savearea pointer
|
||||
RETURN (14,12),RC=0 restore registers from calling save
|
||||
COPY plig\$_FORMATF.MLC format a float
|
||||
NN EQU 5
|
||||
N DC A(NN)
|
||||
N2 DC A(NN*2)
|
||||
AA DC E'3.0',E'1.0',E'5.0',E'9.0',E'7.0'
|
||||
DC E'8.0',E'2.0',E'8.0',E'0.0',E'1.0'
|
||||
DC E'1.0',E'7.0',E'2.0',E'0.0',E'3.0'
|
||||
DC E'0.0',E'1.0',E'7.0',E'0.0',E'9.0'
|
||||
DC E'3.0',E'5.0',E'6.0',E'1.0',E'1.0'
|
||||
BB DS (NN*NN)E
|
||||
TMP DS (NN*NN*2)E
|
||||
T DS E
|
||||
HN DC AL2(NN)
|
||||
HN2 DC AL2(NN*2)
|
||||
PG DC CL80' ' buffer
|
||||
REGEQU
|
||||
END GAUSSJOR
|
||||
|
|
@ -0,0 +1,66 @@
|
|||
begin
|
||||
comment Gauss-Jordan matrix inversion - 22/01/2021;
|
||||
integer n;
|
||||
n:=4;
|
||||
begin
|
||||
procedure rref(m); real array m;
|
||||
begin
|
||||
integer r, c, i;
|
||||
real d, w;
|
||||
for r := 1 step 1 until n do begin
|
||||
d := m[r,r];
|
||||
if d notequal 0 then
|
||||
for c := 1 step 1 until n*2 do
|
||||
m[r,c] := m[r,c] / d
|
||||
else
|
||||
outstring(1,"inversion impossible!\n");
|
||||
for i := 1 step 1 until n do
|
||||
if i notequal r then begin
|
||||
w := m[i,r];
|
||||
for c := 1 step 1 until n*2 do
|
||||
m[i,c] := m[i,c] - w * m[r,c]
|
||||
end
|
||||
end
|
||||
end rref;
|
||||
|
||||
procedure inverse(mat,inv); real array mat, inv;
|
||||
begin
|
||||
integer i, j;
|
||||
real array aug[1:n,1:n*2];
|
||||
for i := 1 step 1 until n do begin
|
||||
for j := 1 step 1 until n do
|
||||
aug[i,j] := mat[i,j];
|
||||
for j := 1+n step 1 until n*2 do
|
||||
aug[i,j] := 0;
|
||||
aug[i,i+n] := 1
|
||||
end;
|
||||
rref(aug);
|
||||
for i := 1 step 1 until n do
|
||||
for j := n+1 step 1 until 2*n do
|
||||
inv[i,j-n] := aug[i,j]
|
||||
end inverse;
|
||||
|
||||
procedure show(c, m); string c; real array m;
|
||||
begin
|
||||
integer i, j;
|
||||
outstring(1,"matrix "); outstring(1,c); outstring(1,"\n");
|
||||
for i := 1 step 1 until n do begin
|
||||
for j := 1 step 1 until n do
|
||||
outreal(1,m[i,j]);
|
||||
outstring(1,"\n")
|
||||
end
|
||||
end show;
|
||||
|
||||
integer i;
|
||||
real array a[1:n,1:n], b[1:n,1:n], c[1:n,1:n];
|
||||
i:=1; a[i,1]:= 2; a[i,2]:= 1; a[i,3]:= 1; a[i,4]:= 4;
|
||||
i:=2; a[i,1]:= 0; a[i,2]:=-1; a[i,3]:= 0; a[i,4]:=-1;
|
||||
i:=3; a[i,1]:= 1; a[i,2]:= 0; a[i,3]:=-2; a[i,4]:= 4;
|
||||
i:=4; a[i,1]:= 4; a[i,2]:= 1; a[i,3]:= 2; a[i,4]:= 2;
|
||||
show("a",a);
|
||||
inverse(a,b);
|
||||
show("b",b);
|
||||
inverse(b,c);
|
||||
show("c",c)
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,58 @@
|
|||
BEGIN # Gauss-Jordan matrix inversion #
|
||||
PROC rref = ( REF[,]REAL m )VOID:
|
||||
BEGIN
|
||||
INT n = 1 UPB m;
|
||||
FOR r TO n DO
|
||||
REAL d = m[ r, r ];
|
||||
IF d /= 0 THEN
|
||||
FOR c TO n * 2 DO m[ r, c ] := m[ r, c ] / d OD
|
||||
ELSE
|
||||
print( ( "inversion impossible!", newline ) )
|
||||
FI;
|
||||
FOR i TO n DO
|
||||
IF i /= r THEN
|
||||
REAL w = m[ i, r ];
|
||||
FOR c TO n * 2 DO m[ i, c ] := m[ i, c ] - w * m[ r, c ] OD
|
||||
FI
|
||||
OD
|
||||
OD
|
||||
END # rref # ;
|
||||
PROC inverse = ( REF[,]REAL mat )[,]REAL:
|
||||
BEGIN
|
||||
INT n = 1 UPB mat;
|
||||
[ 1 : n, 1 : n ]REAL inv;
|
||||
[ 1 : n, 1 : n * 2 ]REAL aug;
|
||||
FOR i TO n DO
|
||||
FOR j TO n DO aug[ i, j ] := mat[ i, j ] OD;
|
||||
FOR j FROM 1 + n TO n * 2 DO aug[ i, j ] := 0 OD;
|
||||
aug[ i, i + n ] := 1
|
||||
OD;
|
||||
rref( aug );
|
||||
FOR i TO n DO
|
||||
FOR j FROM n + 1 TO 2 * n DO inv[ i, j - n ] := aug[ i, j ] OD
|
||||
OD;
|
||||
inv
|
||||
END # inverse # ;
|
||||
PROC show = ( STRING c, [,]REAL m )VOID:
|
||||
BEGIN
|
||||
INT n = 1 UPB m;
|
||||
print( ( "matrix ", c, newline ) );
|
||||
FOR i TO n DO
|
||||
FOR j TO n DO print( ( " ", fixed( m[ i, j ], -8, 3 ) ) ) OD;
|
||||
print( ( newline ) )
|
||||
OD
|
||||
END # show #;
|
||||
|
||||
INT n = 4;
|
||||
[ 1 : n, 1 : n ]REAL a, b, c;
|
||||
a := [,]REAL( ( 2, 1, 1, 4 )
|
||||
, ( 0, -1, 0, -1 )
|
||||
, ( 1, 0, -2, 4 )
|
||||
, ( 4, 1, 2, 2 )
|
||||
);
|
||||
show( "a", a );
|
||||
b := inverse( a );
|
||||
show( "b", b );
|
||||
c := inverse( b );
|
||||
show( "c", c )
|
||||
END
|
||||
|
|
@ -0,0 +1,918 @@
|
|||
(* Set to 1 for debugging: to fill in ones and zeros and other values
|
||||
that are not actually used but are part of the theory of the
|
||||
Gauss-Jordan algorithm. *)
|
||||
#define DO_THINGS_THAT_DO_NOT_NEED_TO_BE_DONE 0
|
||||
|
||||
(* Setting this to 1 may cause rounding to change, and the change in
|
||||
rounding is not unlikely to cause detection of singularity of a
|
||||
matrix to change. (To invert a matrix that might be nearly
|
||||
singular, the SVD seems a popular method.) The
|
||||
-fexpensive-optimizations option to GCC also may cause the same
|
||||
rounding changes (due to fused-multiply-and-add instructions being
|
||||
generated). *)
|
||||
#define USE_MULTIPLY_AND_ADD 0
|
||||
|
||||
%{^
|
||||
#include <math.h>
|
||||
#include <float.h>
|
||||
%}
|
||||
|
||||
#include "share/atspre_staload.hats"
|
||||
|
||||
macdef NAN = g0f2f ($extval (float, "NAN"))
|
||||
macdef Zero = g0i2f 0
|
||||
macdef One = g0i2f 1
|
||||
macdef Two = g0i2f 2
|
||||
|
||||
#if USE_MULTIPLY_AND_ADD #then
|
||||
(* "fma" from the C math library, although your system may have it as
|
||||
a built-in. *)
|
||||
extern fn {tk : tkind} g0float_fma : (g0float tk, g0float tk, g0float tk) -<> g0float tk
|
||||
implement g0float_fma<fltknd> (x, y, z) = $extfcall (float, "fmaf", x, y, z)
|
||||
implement g0float_fma<dblknd> (x, y, z) = $extfcall (double, "fma", x, y, z)
|
||||
implement g0float_fma<ldblknd> (x, y, z) = $extfcall (ldouble, "fmal", x, y, z)
|
||||
overload fma with g0float_fma
|
||||
macdef multiply_and_add = fma
|
||||
#else
|
||||
macdef multiply_and_add (x, y, z) = (,(x) * ,(y)) + ,(z)
|
||||
#endif
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* A "little matrix library" *)
|
||||
|
||||
typedef Matrix_Index_Map (m1 : int, n1 : int, m0 : int, n0 : int) =
|
||||
{i1, j1 : pos | i1 <= m1; j1 <= n1}
|
||||
(int i1, int j1) -<cloref0>
|
||||
[i0, j0 : pos | i0 <= m0; j0 <= n0]
|
||||
@(int i0, int j0)
|
||||
|
||||
datatype Real_Matrix (tk : tkind,
|
||||
m1 : int, n1 : int,
|
||||
m0 : int, n0 : int) =
|
||||
| Real_Matrix of (matrixref (g0float tk, m0, n0),
|
||||
int m1, int n1, int m0, int n0,
|
||||
Matrix_Index_Map (m1, n1, m0, n0))
|
||||
typedef Real_Matrix (tk : tkind, m1 : int, n1 : int) =
|
||||
[m0, n0 : pos] Real_Matrix (tk, m1, n1, m0, n0)
|
||||
typedef Real_Vector (tk : tkind, m1 : int, n1 : int) =
|
||||
[m1 == 1 || n1 == 1] Real_Matrix (tk, m1, n1)
|
||||
typedef Real_Row (tk : tkind, n1 : int) = Real_Vector (tk, 1, n1)
|
||||
typedef Real_Column (tk : tkind, m1 : int) = Real_Vector (tk, m1, 1)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_make_elt :
|
||||
{m0, n0 : pos}
|
||||
(int m0, int n0, g0float tk) -< !wrt >
|
||||
Real_Matrix (tk, m0, n0, m0, n0)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_copy :
|
||||
{m1, n1 : pos}
|
||||
Real_Matrix (tk, m1, n1) -< !refwrt > Real_Matrix (tk, m1, n1)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_copy_to :
|
||||
{m1, n1 : pos}
|
||||
(Real_Matrix (tk, m1, n1), (* destination *)
|
||||
Real_Matrix (tk, m1, n1)) -< !refwrt >
|
||||
void
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_fill_with_elt :
|
||||
{m1, n1 : pos}
|
||||
(Real_Matrix (tk, m1, n1), g0float tk) -< !refwrt > void
|
||||
|
||||
extern fn {}
|
||||
Real_Matrix_dimension :
|
||||
{tk : tkind}
|
||||
{m1, n1 : pos}
|
||||
Real_Matrix (tk, m1, n1) -<> @(int m1, int n1)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_get_at :
|
||||
{m1, n1 : pos}
|
||||
{i1, j1 : pos | i1 <= m1; j1 <= n1}
|
||||
(Real_Matrix (tk, m1, n1), int i1, int j1) -< !ref > g0float tk
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_set_at :
|
||||
{m1, n1 : pos}
|
||||
{i1, j1 : pos | i1 <= m1; j1 <= n1}
|
||||
(Real_Matrix (tk, m1, n1), int i1, int j1, g0float tk) -< !refwrt >
|
||||
void
|
||||
|
||||
extern fn {}
|
||||
Real_Matrix_apply_index_map :
|
||||
{tk : tkind}
|
||||
{m1, n1 : pos}
|
||||
{m0, n0 : pos}
|
||||
(Real_Matrix (tk, m0, n0), int m1, int n1,
|
||||
Matrix_Index_Map (m1, n1, m0, n0)) -<>
|
||||
Real_Matrix (tk, m1, n1)
|
||||
|
||||
extern fn {}
|
||||
Real_Matrix_transpose :
|
||||
(* This is transposed INDEXING. It does NOT copy the data. *)
|
||||
{tk : tkind}
|
||||
{m1, n1 : pos}
|
||||
{m0, n0 : pos}
|
||||
Real_Matrix (tk, m1, n1, m0, n0) -<>
|
||||
Real_Matrix (tk, n1, m1, m0, n0)
|
||||
|
||||
extern fn {}
|
||||
Real_Matrix_block :
|
||||
(* This is block (submatrix) INDEXING. It does NOT copy the data. *)
|
||||
{tk : tkind}
|
||||
{p0, p1 : pos | p0 <= p1}
|
||||
{q0, q1 : pos | q0 <= q1}
|
||||
{m1, n1 : pos | p1 <= m1; q1 <= n1}
|
||||
{m0, n0 : pos}
|
||||
(Real_Matrix (tk, m1, n1, m0, n0),
|
||||
int p0, int p1, int q0, int q1) -<>
|
||||
Real_Matrix (tk, p1 - p0 + 1, q1 - q0 + 1, m0, n0)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_unit_matrix :
|
||||
{m : pos}
|
||||
int m -< !refwrt > Real_Matrix (tk, m, m)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_unit_matrix_to :
|
||||
{m : pos}
|
||||
Real_Matrix (tk, m, m) -< !refwrt > void
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_matrix_sum :
|
||||
{m, n : pos}
|
||||
(Real_Matrix (tk, m, n), Real_Matrix (tk, m, n)) -< !refwrt >
|
||||
Real_Matrix (tk, m, n)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_matrix_sum_to :
|
||||
{m, n : pos}
|
||||
(Real_Matrix (tk, m, n), (* destination*)
|
||||
Real_Matrix (tk, m, n),
|
||||
Real_Matrix (tk, m, n)) -< !refwrt >
|
||||
void
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_matrix_difference :
|
||||
{m, n : pos}
|
||||
(Real_Matrix (tk, m, n), Real_Matrix (tk, m, n)) -< !refwrt >
|
||||
Real_Matrix (tk, m, n)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_matrix_difference_to :
|
||||
{m, n : pos}
|
||||
(Real_Matrix (tk, m, n), (* destination*)
|
||||
Real_Matrix (tk, m, n),
|
||||
Real_Matrix (tk, m, n)) -< !refwrt >
|
||||
void
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_matrix_product :
|
||||
{m, n, p : pos}
|
||||
(Real_Matrix (tk, m, n), Real_Matrix (tk, n, p)) -< !refwrt >
|
||||
Real_Matrix (tk, m, p)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_matrix_product_to :
|
||||
{m, n, p : pos}
|
||||
(Real_Matrix (tk, m, p), (* destination*)
|
||||
Real_Matrix (tk, m, n),
|
||||
Real_Matrix (tk, n, p)) -< !refwrt >
|
||||
void
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_scalar_product :
|
||||
{m, n : pos}
|
||||
(Real_Matrix (tk, m, n), g0float tk) -< !refwrt >
|
||||
Real_Matrix (tk, m, n)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_scalar_product_2 :
|
||||
{m, n : pos}
|
||||
(g0float tk, Real_Matrix (tk, m, n)) -< !refwrt >
|
||||
Real_Matrix (tk, m, n)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_scalar_product_to :
|
||||
{m, n : pos}
|
||||
(Real_Matrix (tk, m, n), (* destination*)
|
||||
Real_Matrix (tk, m, n), g0float tk) -< !refwrt > void
|
||||
|
||||
extern fn {tk : tkind} (* Useful for debugging. *)
|
||||
Real_Matrix_fprint :
|
||||
{m, n : pos}
|
||||
(FILEref, Real_Matrix (tk, m, n)) -<1> void
|
||||
|
||||
overload copy with Real_Matrix_copy
|
||||
overload copy_to with Real_Matrix_copy_to
|
||||
overload fill_with_elt with Real_Matrix_fill_with_elt
|
||||
overload dimension with Real_Matrix_dimension
|
||||
overload [] with Real_Matrix_get_at
|
||||
overload [] with Real_Matrix_set_at
|
||||
overload apply_index_map with Real_Matrix_apply_index_map
|
||||
overload transpose with Real_Matrix_transpose
|
||||
overload block with Real_Matrix_block
|
||||
overload unit_matrix with Real_Matrix_unit_matrix
|
||||
overload unit_matrix_to with Real_Matrix_unit_matrix_to
|
||||
overload matrix_sum with Real_Matrix_matrix_sum
|
||||
overload matrix_sum_to with Real_Matrix_matrix_sum_to
|
||||
overload matrix_difference with Real_Matrix_matrix_difference
|
||||
overload matrix_difference_to with Real_Matrix_matrix_difference_to
|
||||
overload matrix_product with Real_Matrix_matrix_product
|
||||
overload matrix_product_to with Real_Matrix_matrix_product_to
|
||||
overload scalar_product with Real_Matrix_scalar_product
|
||||
overload scalar_product with Real_Matrix_scalar_product_2
|
||||
overload scalar_product_to with Real_Matrix_scalar_product_to
|
||||
overload + with matrix_sum
|
||||
overload - with matrix_difference
|
||||
overload * with matrix_product
|
||||
overload * with scalar_product
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Implementation of the "little matrix library" *)
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_make_elt (m0, n0, elt) =
|
||||
Real_Matrix (matrixref_make_elt<g0float tk> (i2sz m0, i2sz n0, elt),
|
||||
m0, n0, m0, n0, lam (i1, j1) => @(i1, j1))
|
||||
|
||||
implement {}
|
||||
Real_Matrix_dimension A =
|
||||
case+ A of Real_Matrix (_, m1, n1, _, _, _) => @(m1, n1)
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_get_at (A, i1, j1) =
|
||||
let
|
||||
val+ Real_Matrix (storage, _, _, _, n0, index_map) = A
|
||||
val @(i0, j0) = index_map (i1, j1)
|
||||
in
|
||||
matrixref_get_at<g0float tk> (storage, pred i0, n0, pred j0)
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_set_at (A, i1, j1, x) =
|
||||
let
|
||||
val+ Real_Matrix (storage, _, _, _, n0, index_map) = A
|
||||
val @(i0, j0) = index_map (i1, j1)
|
||||
in
|
||||
matrixref_set_at<g0float tk> (storage, pred i0, n0, pred j0, x)
|
||||
end
|
||||
|
||||
implement {}
|
||||
Real_Matrix_apply_index_map (A, m1, n1, index_map) =
|
||||
(* This is not the most efficient way to acquire new indexing, but
|
||||
it will work. It requires three closures, instead of the two
|
||||
needed by our implementations of "transpose" and "block". *)
|
||||
let
|
||||
val+ Real_Matrix (storage, m1a, n1a, m0, n0, index_map_1a) = A
|
||||
in
|
||||
Real_Matrix (storage, m1, n1, m0, n0,
|
||||
lam (i1, j1) =>
|
||||
index_map_1a (i1a, j1a) where
|
||||
{ val @(i1a, j1a) = index_map (i1, j1) })
|
||||
end
|
||||
|
||||
implement {}
|
||||
Real_Matrix_transpose A =
|
||||
let
|
||||
val+ Real_Matrix (storage, m1, n1, m0, n0, index_map) = A
|
||||
in
|
||||
Real_Matrix (storage, n1, m1, m0, n0,
|
||||
lam (i1, j1) => index_map (j1, i1))
|
||||
end
|
||||
|
||||
implement {}
|
||||
Real_Matrix_block (A, p0, p1, q0, q1) =
|
||||
let
|
||||
val+ Real_Matrix (storage, m1, n1, m0, n0, index_map) = A
|
||||
in
|
||||
Real_Matrix (storage, succ (p1 - p0), succ (q1 - q0), m0, n0,
|
||||
lam (i1, j1) =>
|
||||
index_map (p0 + pred i1, q0 + pred j1))
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_copy A =
|
||||
let
|
||||
val @(m1, n1) = dimension A
|
||||
val C = Real_Matrix_make_elt<tk> (m1, n1, A[1, 1])
|
||||
val () = copy_to<tk> (C, A)
|
||||
in
|
||||
C
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_copy_to (Dst, Src) =
|
||||
let
|
||||
val @(m1, n1) = dimension Src
|
||||
prval [m1 : int] EQINT () = eqint_make_gint m1
|
||||
prval [n1 : int] EQINT () = eqint_make_gint n1
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m1 + 1} .<(m1 + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m1; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n1 + 1} .<(n1 + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n1; j := succ j)
|
||||
Dst[i, j] := Src[i, j]
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_fill_with_elt (A, elt) =
|
||||
let
|
||||
val @(m1, n1) = dimension A
|
||||
prval [m1 : int] EQINT () = eqint_make_gint m1
|
||||
prval [n1 : int] EQINT () = eqint_make_gint n1
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m1 + 1} .<(m1 + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m1; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n1 + 1} .<(n1 + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n1; j := succ j)
|
||||
A[i, j] := elt
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_unit_matrix {m} m =
|
||||
let
|
||||
val A = Real_Matrix_make_elt<tk> (m, m, Zero)
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
A[i, i] := One;
|
||||
A
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_unit_matrix_to A =
|
||||
let
|
||||
val @(m, _) = dimension A
|
||||
prval [m : int] EQINT () = eqint_make_gint m
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= m + 1} .<(m + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ m; j := succ j)
|
||||
A[i, j] := (if i = j then One else Zero)
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_matrix_sum (A, B) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
val C = Real_Matrix_make_elt<tk> (m, n, NAN)
|
||||
val () = matrix_sum_to<tk> (C, A, B)
|
||||
in
|
||||
C
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_matrix_sum_to (C, A, B) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
prval [m : int] EQINT () = eqint_make_gint m
|
||||
prval [n : int] EQINT () = eqint_make_gint n
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
C[i, j] := A[i, j] + B[i, j]
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_matrix_difference (A, B) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
val C = Real_Matrix_make_elt<tk> (m, n, NAN)
|
||||
val () = matrix_difference_to<tk> (C, A, B)
|
||||
in
|
||||
C
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_matrix_difference_to (C, A, B) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
prval [m : int] EQINT () = eqint_make_gint m
|
||||
prval [n : int] EQINT () = eqint_make_gint n
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
C[i, j] := A[i, j] - B[i, j]
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_matrix_product (A, B) =
|
||||
let
|
||||
val @(m, n) = dimension A and @(_, p) = dimension B
|
||||
val C = Real_Matrix_make_elt<tk> (m, p, NAN)
|
||||
val () = matrix_product_to<tk> (C, A, B)
|
||||
in
|
||||
C
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_matrix_product_to (C, A, B) =
|
||||
let
|
||||
val @(m, n) = dimension A and @(_, p) = dimension B
|
||||
prval [m : int] EQINT () = eqint_make_gint m
|
||||
prval [n : int] EQINT () = eqint_make_gint n
|
||||
prval [p : int] EQINT () = eqint_make_gint p
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
let
|
||||
var k : intGte 1
|
||||
in
|
||||
for* {k : pos | k <= p + 1} .<(p + 1) - k>.
|
||||
(k : int k) =>
|
||||
(k := 1; k <> succ p; k := succ k)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
C[i, k] := A[i, 1] * B[1, k];
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 2; j <> succ n; j := succ j)
|
||||
C[i, k] :=
|
||||
multiply_and_add (A[i, j], B[j, k], C[i, k])
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_scalar_product (A, r) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
val C = Real_Matrix_make_elt<tk> (m, n, NAN)
|
||||
val () = scalar_product_to<tk> (C, A, r)
|
||||
in
|
||||
C
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_scalar_product_2 (r, A) =
|
||||
Real_Matrix_scalar_product<tk> (A, r)
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_scalar_product_to (C, A, r) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
prval [m : int] EQINT () = eqint_make_gint m
|
||||
prval [n : int] EQINT () = eqint_make_gint n
|
||||
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
C[i, j] := A[i, j] * r
|
||||
end
|
||||
end
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_fprint {m, n} (outf, A) =
|
||||
let
|
||||
val @(m, n) = dimension A
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ m; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
let
|
||||
typedef FILEstar = $extype"FILE *"
|
||||
extern castfn FILEref2star : FILEref -<> FILEstar
|
||||
val _ = $extfcall (int, "fprintf", FILEref2star outf,
|
||||
"%16.6g", A[i, j])
|
||||
in
|
||||
end;
|
||||
fprintln! (outf)
|
||||
end
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
(* Gauss-Jordan inversion *)
|
||||
|
||||
extern fn {tk : tkind}
|
||||
Real_Matrix_inverse_by_gauss_jordan :
|
||||
{n : pos}
|
||||
Real_Matrix (tk, n, n) -< !refwrt > Option (Real_Matrix (tk, n, n))
|
||||
|
||||
#if DO_THINGS_THAT_DO_NOT_NEED_TO_BE_DONE #then
|
||||
macdef do_needless_things = true
|
||||
#else
|
||||
macdef do_needless_things = false
|
||||
#endif
|
||||
|
||||
fn {tk : tkind}
|
||||
needlessly_set_to_value
|
||||
{n : pos}
|
||||
{i, j : pos | i <= n; j <= n}
|
||||
(A : Real_Matrix (tk, n, n),
|
||||
i : int i,
|
||||
j : int j,
|
||||
x : g0float tk) :<!refwrt> void =
|
||||
if do_needless_things then A[i, j] := x
|
||||
|
||||
implement {tk}
|
||||
Real_Matrix_inverse_by_gauss_jordan {n} A =
|
||||
let
|
||||
val @(n, _) = dimension A
|
||||
typedef one_to_n = intBtwe (1, n)
|
||||
|
||||
(* Partial pivoting. *)
|
||||
implement
|
||||
array_tabulate$fopr<one_to_n> i =
|
||||
let
|
||||
val i = g1ofg0 (sz2i (succ i))
|
||||
val () = assertloc ((1 <= i) * (i <= n))
|
||||
in
|
||||
i
|
||||
end
|
||||
val rows_permutation =
|
||||
$effmask_all arrayref_tabulate<one_to_n> (i2sz n)
|
||||
fn
|
||||
index_map : Matrix_Index_Map (n, n, n, n) =
|
||||
lam (i1, j1) => $effmask_ref
|
||||
(@(i0, j1) where { val i0 = rows_permutation[i1 - 1] })
|
||||
|
||||
val A = apply_index_map (copy<tk> A, n, n, index_map)
|
||||
and B = apply_index_map (unit_matrix<tk> n, n, n, index_map)
|
||||
|
||||
fn {}
|
||||
exchange_rows (i1 : one_to_n,
|
||||
i2 : one_to_n) :<!refwrt> void =
|
||||
if i1 <> i2 then
|
||||
let
|
||||
val k1 = rows_permutation[pred i1]
|
||||
and k2 = rows_permutation[pred i2]
|
||||
in
|
||||
rows_permutation[pred i1] := k2;
|
||||
rows_permutation[pred i2] := k1
|
||||
end
|
||||
|
||||
fn {}
|
||||
normalize_pivot_row (j : one_to_n) :<!refwrt> void =
|
||||
let
|
||||
prval [j : int] EQINT () = eqint_make_gint j
|
||||
val pivot_val = A[j, j]
|
||||
var k : intGte 1
|
||||
in
|
||||
needlessly_set_to_value (A, j, j, One);
|
||||
for* {k : int | j + 1 <= k; k <= n + 1} .<(n + 1) - k>.
|
||||
(k : int k) =>
|
||||
(k := succ j; k <> succ n; k := succ k)
|
||||
A[j, k] := A[j, k] / pivot_val;
|
||||
for* {k : int | 1 <= k; k <= n + 1} .<(n + 1) - k>.
|
||||
(k : int k) =>
|
||||
(k := 1; k <> succ n; k := succ k)
|
||||
B[j, k] := B[j, k] / pivot_val;
|
||||
end
|
||||
|
||||
fn
|
||||
subtract_normalized_pivot_row
|
||||
(i : one_to_n, j : one_to_n) :<!refwrt> void =
|
||||
let
|
||||
prval [j : int] EQINT () = eqint_make_gint j
|
||||
val lead_val = A[i, j]
|
||||
in
|
||||
if lead_val <> Zero then
|
||||
let
|
||||
val factor = ~lead_val
|
||||
var k : intGte 1
|
||||
in
|
||||
needlessly_set_to_value (A, i, j, Zero);
|
||||
for* {k : int | j + 1 <= k; k <= n + 1} .<(n + 1) - k>.
|
||||
(k : int k) =>
|
||||
(k := succ j; k <> succ n; k := succ k)
|
||||
A[i, k] :=
|
||||
multiply_and_add (A[j, k], factor, A[i, k]);
|
||||
for* {k : int | 1 <= k; k <= n + 1} .<(n + 1) - k>.
|
||||
(k : int k) =>
|
||||
(k := 1; k <> succ n; k := succ k)
|
||||
B[i, k] :=
|
||||
multiply_and_add (B[j, k], factor, B[i, k])
|
||||
end
|
||||
end
|
||||
|
||||
fun
|
||||
main_loop {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j,
|
||||
success : &bool? >> bool) :<!refwrt> void =
|
||||
if j = succ n then
|
||||
success := true
|
||||
else
|
||||
let
|
||||
fun
|
||||
select_pivot {i : int | j <= i; i <= n + 1}
|
||||
.<(n + 1) - i>.
|
||||
(i : int i,
|
||||
max_abs : g0float tk,
|
||||
i_max_abs : intBtwe (j - 1, n))
|
||||
:<!ref> intBtwe (j - 1, n) =
|
||||
if i = succ n then
|
||||
i_max_abs
|
||||
else
|
||||
let
|
||||
val abs_aij = abs A[i, j]
|
||||
in
|
||||
if abs_aij > max_abs then
|
||||
select_pivot (succ i, abs_aij, i)
|
||||
else
|
||||
select_pivot (succ i, max_abs, i_max_abs)
|
||||
end
|
||||
|
||||
val i_pivot = select_pivot (j, Zero, pred j)
|
||||
prval [i_pivot : int] EQINT () = eqint_make_gint i_pivot
|
||||
in
|
||||
if i_pivot = pred j then
|
||||
success := false
|
||||
else
|
||||
let
|
||||
var i : intGte 1
|
||||
in
|
||||
exchange_rows (i_pivot, j);
|
||||
normalize_pivot_row (j);
|
||||
for* {i : int | 1 <= i; i <= j}
|
||||
.<j - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> j; i := succ i)
|
||||
subtract_normalized_pivot_row (i, j);
|
||||
for* {i : int | j + 1 <= i; i <= n + 1}
|
||||
.<(n + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := succ j; i <> succ n; i := succ i)
|
||||
subtract_normalized_pivot_row (i, j);
|
||||
main_loop (succ j, success)
|
||||
end
|
||||
end
|
||||
|
||||
var success : bool
|
||||
val () = main_loop (1, success)
|
||||
in
|
||||
(* The returned B will "contain" the rows_permutation array and
|
||||
some extra closures. If you want a "clean" B, use "val B = copy
|
||||
B" or some such. *)
|
||||
if success then Some B else None ()
|
||||
end
|
||||
|
||||
overload inverse_by_gauss_jordan with
|
||||
Real_Matrix_inverse_by_gauss_jordan
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
||||
fn {tk : tkind}
|
||||
fprint_matrix_and_its_inverse
|
||||
{n : pos}
|
||||
(outf : FILEref,
|
||||
A : Real_Matrix (tk, n, n)) : void =
|
||||
let
|
||||
typedef FILEstar = $extype"FILE *"
|
||||
extern castfn FILEref2star : FILEref -<> FILEstar
|
||||
|
||||
macdef fmt = "%8.4f"
|
||||
macdef left_bracket = "["
|
||||
macdef right_bracket = " ]"
|
||||
macdef product = " ✕ "
|
||||
macdef equals = " = "
|
||||
macdef spacing = " "
|
||||
macdef msg_for_singular = " appears to be singular"
|
||||
|
||||
macdef print_num (x) =
|
||||
ignoret ($extfcall (int, "fprintf", FILEref2star outf,
|
||||
fmt, ,(x)))
|
||||
|
||||
val @(n, _) = dimension A
|
||||
in
|
||||
case+ inverse_by_gauss_jordan<tk> (A) of
|
||||
| None () =>
|
||||
let
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= n + 1} .<(n + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ n; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
fprint! (outf, left_bracket);
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
print_num A[i, j];
|
||||
fprint! (outf, right_bracket);
|
||||
if pred i = half n then
|
||||
fprint! (outf, msg_for_singular);
|
||||
fprintln! (outf)
|
||||
end
|
||||
end
|
||||
| Some B =>
|
||||
let
|
||||
val AB = A * B
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= n + 1} .<(n + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ n; i := succ i)
|
||||
let
|
||||
var j : intGte 1
|
||||
in
|
||||
fprint! (outf, left_bracket);
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
print_num A[i, j];
|
||||
fprint! (outf, right_bracket);
|
||||
if pred i = half n then
|
||||
fprint! (outf, product)
|
||||
else
|
||||
fprint! (outf, spacing);
|
||||
fprint! (outf, left_bracket);
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
print_num B[i, j];
|
||||
fprint! (outf, right_bracket);
|
||||
if pred i = half n then
|
||||
fprint! (outf, equals)
|
||||
else
|
||||
fprint! (outf, spacing);
|
||||
fprint! (outf, left_bracket);
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
print_num AB[i, j];
|
||||
fprint! (outf, right_bracket);
|
||||
fprintln! (outf)
|
||||
end
|
||||
end
|
||||
end
|
||||
|
||||
fn {tk : tkind} (* We like Fortran, so COLUMN major here. *)
|
||||
column_major_list_to_square_matrix
|
||||
{n : pos}
|
||||
(n : int n,
|
||||
lst : list (g0float tk, n * n))
|
||||
: Real_Matrix (tk, n, n) =
|
||||
let
|
||||
#define :: list_cons
|
||||
prval () = mul_gte_gte_gte {n, n} ()
|
||||
val A = Real_Matrix_make_elt (n, n, NAN)
|
||||
val lstref : ref (List0 (g0float tk)) = ref lst
|
||||
var j : intGte 1
|
||||
in
|
||||
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
|
||||
(j : int j) =>
|
||||
(j := 1; j <> succ n; j := succ j)
|
||||
let
|
||||
var i : intGte 1
|
||||
in
|
||||
for* {i : pos | i <= n + 1} .<(n + 1) - i>.
|
||||
(i : int i) =>
|
||||
(i := 1; i <> succ n; i := succ i)
|
||||
case- !lstref of
|
||||
| hd :: tl =>
|
||||
begin
|
||||
A[i, j] := hd;
|
||||
!lstref := tl
|
||||
end
|
||||
end;
|
||||
A
|
||||
end
|
||||
|
||||
macdef separator = "\n"
|
||||
|
||||
fn
|
||||
print_example
|
||||
{n : pos}
|
||||
(n : int n,
|
||||
lst : list (double, n * n)) : void =
|
||||
let
|
||||
val A = column_major_list_to_square_matrix (n, lst)
|
||||
in
|
||||
print! separator;
|
||||
fprint_matrix_and_its_inverse<dblknd> (stdout_ref, A)
|
||||
end
|
||||
|
||||
implement
|
||||
main0 () =
|
||||
begin
|
||||
println! ("\n(The examples are printed here after ",
|
||||
"rounding to 4 decimal places.)");
|
||||
|
||||
print_example (1, $list (0.0));
|
||||
print_example (1, $list (4.0));
|
||||
print_example (2, $list (1.0, 1.0, 1.0, 1.0));
|
||||
print_example (2, $list (2.0, 0.0, 0.0, 2.0));
|
||||
print_example (2, $list (1.0, 2.0, 3.0, 4.0));
|
||||
|
||||
println! ("\nAn orthonormal matrix of rank 5 ",
|
||||
"(its inverse will equal its transpose):");
|
||||
print_example
|
||||
(5, $list (~0.08006407690254358, ~0.1884825001438613,
|
||||
~0.8954592676839166, 0.2715238629598956,
|
||||
~0.2872134789517761, ~0.5604485383178048,
|
||||
~0.4587939881550582, ~0.01946650581921516,
|
||||
0.1609525690123523, 0.6701647842208114,
|
||||
~0.2401922307076307, 0.1517054269450593,
|
||||
~0.3178281430868086, ~0.8979459113320678,
|
||||
0.1094146586482966, ~0.3202563076101743,
|
||||
~0.6104994151001173, 0.2983616372675922,
|
||||
~0.1997416922923375, ~0.6291342872277008,
|
||||
~0.7205766921228921, 0.5985468663105067,
|
||||
0.08797363206760908, 0.2327347396799102,
|
||||
~0.2461829819586655));
|
||||
|
||||
(* The following matrix may or may not be detected as singular,
|
||||
depending on how rounding is done. *)
|
||||
(*
|
||||
print_example
|
||||
(5, $list (~0.08006407690254358, ~0.1884825001438613,
|
||||
~0.8954592676839166, 0.2715238629598956,
|
||||
~0.2872134789517761, ~0.5604485383178048,
|
||||
~0.4587939881550582, ~0.01946650581921516,
|
||||
0.1609525690123523, 0.6701647842208114,
|
||||
~0.2401922307076307, 0.1517054269450593,
|
||||
~0.3178281430868086, ~0.8979459113320678,
|
||||
0.1094146586482966, ~0.3202563076101743,
|
||||
~0.6104994151001173, 0.2983616372675922,
|
||||
~0.1997416922923375, ~0.6291342872277008,
|
||||
5.0 * ~0.08006407690254358,
|
||||
5.0 * ~0.1884825001438613,
|
||||
5.0 * ~0.8954592676839166,
|
||||
5.0 * 0.2715238629598956,
|
||||
5.0 * ~0.2872134789517761));
|
||||
*)
|
||||
|
||||
println! ("\nA 5✕5 singular matrix:");
|
||||
print_example
|
||||
(5, $list (1.0, 1.0, 2.0, 2.0, 2.0,
|
||||
5.0, 1.0, 2.0, 2.0, 2.0,
|
||||
3.0, 2.0, 3.0, 5.0, 7.0,
|
||||
1.0, 1.0, 2.0, 2.0, 2.0,
|
||||
4.0, 1.0, 2.0, 2.0, 2.0));
|
||||
|
||||
print! separator
|
||||
end
|
||||
|
||||
(*------------------------------------------------------------------*)
|
||||
|
|
@ -0,0 +1,139 @@
|
|||
#include <algorithm>
|
||||
#include <cassert>
|
||||
#include <iomanip>
|
||||
#include <iostream>
|
||||
#include <vector>
|
||||
|
||||
template <typename scalar_type> class matrix {
|
||||
public:
|
||||
matrix(size_t rows, size_t columns)
|
||||
: rows_(rows), columns_(columns), elements_(rows * columns) {}
|
||||
|
||||
matrix(size_t rows, size_t columns, scalar_type value)
|
||||
: rows_(rows), columns_(columns), elements_(rows * columns, value) {}
|
||||
|
||||
matrix(size_t rows, size_t columns, std::initializer_list<scalar_type> values)
|
||||
: rows_(rows), columns_(columns), elements_(rows * columns) {
|
||||
assert(values.size() <= rows_ * columns_);
|
||||
std::copy(values.begin(), values.end(), elements_.begin());
|
||||
}
|
||||
|
||||
size_t rows() const { return rows_; }
|
||||
size_t columns() const { return columns_; }
|
||||
|
||||
scalar_type& operator()(size_t row, size_t column) {
|
||||
assert(row < rows_);
|
||||
assert(column < columns_);
|
||||
return elements_[row * columns_ + column];
|
||||
}
|
||||
const scalar_type& operator()(size_t row, size_t column) const {
|
||||
assert(row < rows_);
|
||||
assert(column < columns_);
|
||||
return elements_[row * columns_ + column];
|
||||
}
|
||||
private:
|
||||
size_t rows_;
|
||||
size_t columns_;
|
||||
std::vector<scalar_type> elements_;
|
||||
};
|
||||
|
||||
template <typename scalar_type>
|
||||
matrix<scalar_type> product(const matrix<scalar_type>& a,
|
||||
const matrix<scalar_type>& b) {
|
||||
assert(a.columns() == b.rows());
|
||||
size_t arows = a.rows();
|
||||
size_t bcolumns = b.columns();
|
||||
size_t n = a.columns();
|
||||
matrix<scalar_type> c(arows, bcolumns);
|
||||
for (size_t i = 0; i < arows; ++i) {
|
||||
for (size_t j = 0; j < n; ++j) {
|
||||
for (size_t k = 0; k < bcolumns; ++k)
|
||||
c(i, k) += a(i, j) * b(j, k);
|
||||
}
|
||||
}
|
||||
return c;
|
||||
}
|
||||
|
||||
template <typename scalar_type>
|
||||
void swap_rows(matrix<scalar_type>& m, size_t i, size_t j) {
|
||||
size_t columns = m.columns();
|
||||
for (size_t column = 0; column < columns; ++column)
|
||||
std::swap(m(i, column), m(j, column));
|
||||
}
|
||||
|
||||
// Convert matrix to reduced row echelon form
|
||||
template <typename scalar_type>
|
||||
void rref(matrix<scalar_type>& m) {
|
||||
size_t rows = m.rows();
|
||||
size_t columns = m.columns();
|
||||
for (size_t row = 0, lead = 0; row < rows && lead < columns; ++row, ++lead) {
|
||||
size_t i = row;
|
||||
while (m(i, lead) == 0) {
|
||||
if (++i == rows) {
|
||||
i = row;
|
||||
if (++lead == columns)
|
||||
return;
|
||||
}
|
||||
}
|
||||
swap_rows(m, i, row);
|
||||
if (m(row, lead) != 0) {
|
||||
scalar_type f = m(row, lead);
|
||||
for (size_t column = 0; column < columns; ++column)
|
||||
m(row, column) /= f;
|
||||
}
|
||||
for (size_t j = 0; j < rows; ++j) {
|
||||
if (j == row)
|
||||
continue;
|
||||
scalar_type f = m(j, lead);
|
||||
for (size_t column = 0; column < columns; ++column)
|
||||
m(j, column) -= f * m(row, column);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
template <typename scalar_type>
|
||||
matrix<scalar_type> inverse(const matrix<scalar_type>& m) {
|
||||
assert(m.rows() == m.columns());
|
||||
size_t rows = m.rows();
|
||||
matrix<scalar_type> tmp(rows, 2 * rows, 0);
|
||||
for (size_t row = 0; row < rows; ++row) {
|
||||
for (size_t column = 0; column < rows; ++column)
|
||||
tmp(row, column) = m(row, column);
|
||||
tmp(row, row + rows) = 1;
|
||||
}
|
||||
rref(tmp);
|
||||
matrix<scalar_type> inv(rows, rows);
|
||||
for (size_t row = 0; row < rows; ++row) {
|
||||
for (size_t column = 0; column < rows; ++column)
|
||||
inv(row, column) = tmp(row, column + rows);
|
||||
}
|
||||
return inv;
|
||||
}
|
||||
|
||||
template <typename scalar_type>
|
||||
void print(std::ostream& out, const matrix<scalar_type>& m) {
|
||||
size_t rows = m.rows(), columns = m.columns();
|
||||
out << std::fixed << std::setprecision(4);
|
||||
for (size_t row = 0; row < rows; ++row) {
|
||||
for (size_t column = 0; column < columns; ++column) {
|
||||
if (column > 0)
|
||||
out << ' ';
|
||||
out << std::setw(7) << m(row, column);
|
||||
}
|
||||
out << '\n';
|
||||
}
|
||||
}
|
||||
|
||||
int main() {
|
||||
matrix<double> m(3, 3, {2, -1, 0, -1, 2, -1, 0, -1, 2});
|
||||
std::cout << "Matrix:\n";
|
||||
print(std::cout, m);
|
||||
auto inv(inverse(m));
|
||||
std::cout << "Inverse:\n";
|
||||
print(std::cout, inv);
|
||||
std::cout << "Product of matrix and inverse:\n";
|
||||
print(std::cout, product(m, inv));
|
||||
std::cout << "Inverse of inverse:\n";
|
||||
print(std::cout, inverse(inv));
|
||||
return 0;
|
||||
}
|
||||
|
|
@ -0,0 +1,190 @@
|
|||
using System;
|
||||
|
||||
namespace Rosetta
|
||||
{
|
||||
internal class Vector
|
||||
{
|
||||
private double[] b;
|
||||
internal readonly int rows;
|
||||
|
||||
internal Vector(int rows)
|
||||
{
|
||||
this.rows = rows;
|
||||
b = new double[rows];
|
||||
}
|
||||
|
||||
internal Vector(double[] initArray)
|
||||
{
|
||||
b = (double[])initArray.Clone();
|
||||
rows = b.Length;
|
||||
}
|
||||
|
||||
internal Vector Clone()
|
||||
{
|
||||
Vector v = new Vector(b);
|
||||
return v;
|
||||
}
|
||||
|
||||
internal double this[int row]
|
||||
{
|
||||
get { return b[row]; }
|
||||
set { b[row] = value; }
|
||||
}
|
||||
|
||||
internal void SwapRows(int r1, int r2)
|
||||
{
|
||||
if (r1 == r2) return;
|
||||
double tmp = b[r1];
|
||||
b[r1] = b[r2];
|
||||
b[r2] = tmp;
|
||||
}
|
||||
|
||||
internal double norm(double[] weights)
|
||||
{
|
||||
double sum = 0;
|
||||
for (int i = 0; i < rows; i++)
|
||||
{
|
||||
double d = b[i] * weights[i];
|
||||
sum += d*d;
|
||||
}
|
||||
return Math.Sqrt(sum);
|
||||
}
|
||||
|
||||
internal void print()
|
||||
{
|
||||
for (int i = 0; i < rows; i++)
|
||||
Console.WriteLine(b[i]);
|
||||
Console.WriteLine();
|
||||
}
|
||||
|
||||
public static Vector operator-(Vector lhs, Vector rhs)
|
||||
{
|
||||
Vector v = new Vector(lhs.rows);
|
||||
for (int i = 0; i < lhs.rows; i++)
|
||||
v[i] = lhs[i] - rhs[i];
|
||||
return v;
|
||||
}
|
||||
}
|
||||
|
||||
class Matrix
|
||||
{
|
||||
private double[] b;
|
||||
internal readonly int rows, cols;
|
||||
|
||||
internal Matrix(int rows, int cols)
|
||||
{
|
||||
this.rows = rows;
|
||||
this.cols = cols;
|
||||
b = new double[rows * cols];
|
||||
}
|
||||
|
||||
internal Matrix(int size)
|
||||
{
|
||||
this.rows = size;
|
||||
this.cols = size;
|
||||
b = new double[rows * cols];
|
||||
for (int i = 0; i < size; i++)
|
||||
this[i, i] = 1;
|
||||
}
|
||||
|
||||
internal Matrix(int rows, int cols, double[] initArray)
|
||||
{
|
||||
this.rows = rows;
|
||||
this.cols = cols;
|
||||
b = (double[])initArray.Clone();
|
||||
if (b.Length != rows * cols) throw new Exception("bad init array");
|
||||
}
|
||||
|
||||
internal double this[int row, int col]
|
||||
{
|
||||
get { return b[row * cols + col]; }
|
||||
set { b[row * cols + col] = value; }
|
||||
}
|
||||
|
||||
public static Vector operator*(Matrix lhs, Vector rhs)
|
||||
{
|
||||
if (lhs.cols != rhs.rows) throw new Exception("I can't multiply matrix by vector");
|
||||
Vector v = new Vector(lhs.rows);
|
||||
for (int i = 0; i < lhs.rows; i++)
|
||||
{
|
||||
double sum = 0;
|
||||
for (int j = 0; j < rhs.rows; j++)
|
||||
sum += lhs[i,j]*rhs[j];
|
||||
v[i] = sum;
|
||||
}
|
||||
return v;
|
||||
}
|
||||
|
||||
internal void SwapRows(int r1, int r2)
|
||||
{
|
||||
if (r1 == r2) return;
|
||||
int firstR1 = r1 * cols;
|
||||
int firstR2 = r2 * cols;
|
||||
for (int i = 0; i < cols; i++)
|
||||
{
|
||||
double tmp = b[firstR1 + i];
|
||||
b[firstR1 + i] = b[firstR2 + i];
|
||||
b[firstR2 + i] = tmp;
|
||||
}
|
||||
}
|
||||
|
||||
//with partial pivot
|
||||
internal bool InvPartial()
|
||||
{
|
||||
const double Eps = 1e-12;
|
||||
if (rows != cols) throw new Exception("rows != cols for Inv");
|
||||
Matrix M = new Matrix(rows); //unitary
|
||||
for (int diag = 0; diag < rows; diag++)
|
||||
{
|
||||
int max_row = diag;
|
||||
double max_val = Math.Abs(this[diag, diag]);
|
||||
double d;
|
||||
for (int row = diag + 1; row < rows; row++)
|
||||
if ((d = Math.Abs(this[row, diag])) > max_val)
|
||||
{
|
||||
max_row = row;
|
||||
max_val = d;
|
||||
}
|
||||
if (max_val <= Eps) return false;
|
||||
SwapRows(diag, max_row);
|
||||
M.SwapRows(diag, max_row);
|
||||
double invd = 1 / this[diag, diag];
|
||||
for (int col = diag; col < cols; col++)
|
||||
{
|
||||
this[diag, col] *= invd;
|
||||
}
|
||||
for (int col = 0; col < cols; col++)
|
||||
{
|
||||
M[diag, col] *= invd;
|
||||
}
|
||||
for (int row = 0; row < rows; row++)
|
||||
{
|
||||
d = this[row, diag];
|
||||
if (row != diag)
|
||||
{
|
||||
for (int col = diag; col < this.cols; col++)
|
||||
{
|
||||
this[row, col] -= d * this[diag, col];
|
||||
}
|
||||
for (int col = 0; col < this.cols; col++)
|
||||
{
|
||||
M[row, col] -= d * M[diag, col];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
b = M.b;
|
||||
return true;
|
||||
}
|
||||
|
||||
internal void print()
|
||||
{
|
||||
for (int i = 0; i < rows; i++)
|
||||
{
|
||||
for (int j = 0; j < cols; j++)
|
||||
Console.Write(this[i,j].ToString()+" ");
|
||||
Console.WriteLine();
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
using System;
|
||||
|
||||
namespace Rosetta
|
||||
{
|
||||
class Program
|
||||
{
|
||||
static void Main(string[] args)
|
||||
{
|
||||
Matrix M = new Matrix(4, 4, new double[] { -1, -2, 3, 2, -4, -1, 6, 2, 7, -8, 9, 1, 1, -2, 1, 3 });
|
||||
M.InvPartial();
|
||||
M.print();
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
/*----------------------------------------------------------------------
|
||||
gjinv - Invert a matrix, Gauss-Jordan algorithm
|
||||
A is destroyed. Returns 1 for a singular matrix.
|
||||
|
||||
___Name_____Type______In/Out____Description_____________________________
|
||||
a[n*n] double* In An N by N matrix
|
||||
n int In Order of matrix
|
||||
b[n*n] double* Out Inverse of A
|
||||
----------------------------------------------------------------------*/
|
||||
#include <math.h>
|
||||
int gjinv (double *a, int n, double *b)
|
||||
{
|
||||
int i, j, k, p;
|
||||
double f, g, tol;
|
||||
if (n < 1) return -1; /* Function Body */
|
||||
f = 0.; /* Frobenius norm of a */
|
||||
for (i = 0; i < n; ++i) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
g = a[j+i*n];
|
||||
f += g * g;
|
||||
}
|
||||
}
|
||||
f = sqrt(f);
|
||||
tol = f * 2.2204460492503131e-016;
|
||||
for (i = 0; i < n; ++i) { /* Set b to identity matrix. */
|
||||
for (j = 0; j < n; ++j) {
|
||||
b[j+i*n] = (i == j) ? 1. : 0.;
|
||||
}
|
||||
}
|
||||
for (k = 0; k < n; ++k) { /* Main loop */
|
||||
f = fabs(a[k+k*n]); /* Find pivot. */
|
||||
p = k;
|
||||
for (i = k+1; i < n; ++i) {
|
||||
g = fabs(a[k+i*n]);
|
||||
if (g > f) {
|
||||
f = g;
|
||||
p = i;
|
||||
}
|
||||
}
|
||||
if (f < tol) return 1; /* Matrix is singular. */
|
||||
if (p != k) { /* Swap rows. */
|
||||
for (j = k; j < n; ++j) {
|
||||
f = a[j+k*n];
|
||||
a[j+k*n] = a[j+p*n];
|
||||
a[j+p*n] = f;
|
||||
}
|
||||
for (j = 0; j < n; ++j) {
|
||||
f = b[j+k*n];
|
||||
b[j+k*n] = b[j+p*n];
|
||||
b[j+p*n] = f;
|
||||
}
|
||||
}
|
||||
f = 1. / a[k+k*n]; /* Scale row so pivot is 1. */
|
||||
for (j = k; j < n; ++j) a[j+k*n] *= f;
|
||||
for (j = 0; j < n; ++j) b[j+k*n] *= f;
|
||||
for (i = 0; i < n; ++i) { /* Subtract to get zeros. */
|
||||
if (i == k) continue;
|
||||
f = a[k+i*n];
|
||||
for (j = k; j < n; ++j) a[j+i*n] -= a[j+k*n] * f;
|
||||
for (j = 0; j < n; ++j) b[j+i*n] -= b[j+k*n] * f;
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
} /* end of gjinv */
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
/* Test matrix inversion */
|
||||
#include <stdio.h>
|
||||
int main (void)
|
||||
{
|
||||
static double aorig[16] = { -1.,-2.,3.,2.,-4.,
|
||||
-1.,6.,2.,7.,-8.,9.,1.,1.,-2.,1.,3. };
|
||||
double a[16], b[16], c[16];
|
||||
int n = 4;
|
||||
int i, j, k, ierr;
|
||||
for (i = 0; i < n; ++i) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
a[j+i*n] = aorig[j+i*n];
|
||||
}
|
||||
}
|
||||
ierr = gjinv (a, n, b);
|
||||
printf("gjinv returns #%i\n\n", ierr);
|
||||
printf("matrix:\n");
|
||||
for (i = 0; i < n; ++i) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
printf("%8.3f", aorig[j+i*n]);
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
printf("\ninverse:\n");
|
||||
for (i = 0; i < n; ++i) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
printf("%8.3f", b[j+i*n]);
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
for (j = 0; j < n; ++j) {
|
||||
for (k = 0; k < n; ++k) {
|
||||
c[k+j*n] = 0.;
|
||||
for (i = 0; i < n; ++i) {
|
||||
c[k+j*n] += aorig[i+j*n] * b[k+i*n];
|
||||
}
|
||||
}
|
||||
}
|
||||
printf("\nmatrix @ inverse:\n");
|
||||
for (i = 0; i < n; ++i) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
printf("%8.3f", c[j+i*n]);
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
ierr = gjinv (b, n, a);
|
||||
printf("\ngjinv returns #%i\n", ierr);
|
||||
printf("\ninverse of inverse:\n");
|
||||
for (i = 0; i < n; ++i) {
|
||||
for (j = 0; j < n; ++j) {
|
||||
printf("%8.3f", a[j+i*n]);
|
||||
}
|
||||
printf("\n");
|
||||
}
|
||||
return 0;
|
||||
} /* end of test program */
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
USING: kernel math.matrices math.matrices.elimination
|
||||
prettyprint sequences ;
|
||||
|
||||
! Augment a matrix with its identity. E.g.
|
||||
!
|
||||
! 1 2 3 1 2 3 1 0 0
|
||||
! 4 5 6 augment-identity -> 4 5 6 0 1 0
|
||||
! 7 8 9 7 8 9 0 0 1
|
||||
|
||||
: augment-identity ( matrix -- new-matrix )
|
||||
dup first length <identity-matrix>
|
||||
[ flip ] bi@ append flip ;
|
||||
|
||||
! Note: the 'solution' word finds the reduced row echelon form
|
||||
! of a matrix.
|
||||
|
||||
: gauss-jordan-invert ( matrix -- inverted )
|
||||
dup square-matrix? [ "Matrix must be square." throw ] unless
|
||||
augment-identity solution
|
||||
|
||||
! now remove the vestigial identity portion of the matrix
|
||||
flip halves nip flip ;
|
||||
|
||||
{
|
||||
{ -1 -2 3 2 }
|
||||
{ -4 -1 6 2 }
|
||||
{ 7 -8 9 1 }
|
||||
{ 1 -2 1 3 }
|
||||
} gauss-jordan-invert simple-table.
|
||||
|
|
@ -0,0 +1,105 @@
|
|||
!-----------------------------------------------------------------------
|
||||
! gjinv - Invert a matrix, Gauss-Jordan algorithm
|
||||
! A is destroyed.
|
||||
!
|
||||
!___Name_______Type_______________In/Out____Description_________________
|
||||
! A(LDA,N) Real In An N by N matrix
|
||||
! LDA Integer In Row bound of A
|
||||
! N Integer In Order of matrix
|
||||
! B(LDB,N) Real Out Inverse of A
|
||||
! LDB Integer In Row bound of B
|
||||
! IERR Integer Out 0 = no errors
|
||||
! 1 = singular matrix
|
||||
!-----------------------------------------------------------------------
|
||||
SUBROUTINE GJINV (A, LDA, N, B, LDB, IERR)
|
||||
IMPLICIT NONE
|
||||
INTEGER LDA, N, LDB, IERR
|
||||
REAL A(LDA,N), B(LDB,N)
|
||||
|
||||
REAL EPS ! machine constant
|
||||
PARAMETER (EPS = 1.1920929E-07)
|
||||
INTEGER I, J, K, P ! local variables
|
||||
REAL F, TOL
|
||||
|
||||
!-----------------------------------------------------------------------
|
||||
! Begin.
|
||||
!-----------------------------------------------------------------------
|
||||
IF (N < 1) THEN ! Validate.
|
||||
IERR = -1
|
||||
RETURN
|
||||
ELSE IF (N > LDA .OR. N > LDB) THEN
|
||||
IERR = -2
|
||||
RETURN
|
||||
END IF
|
||||
IERR = 0
|
||||
|
||||
F = 0. ! Frobenius norm of A
|
||||
DO J = 1, N
|
||||
DO I = 1, N
|
||||
F = F + A(I,J)**2
|
||||
END DO
|
||||
END DO
|
||||
F = SQRT(F)
|
||||
TOL = F * EPS
|
||||
|
||||
DO J = 1, N ! Set B to identity matrix.
|
||||
DO I = 1, N
|
||||
IF (I .EQ. J) THEN
|
||||
B(I,J) = 1.
|
||||
ELSE
|
||||
B(I,J) = 0.
|
||||
END IF
|
||||
END DO
|
||||
END DO
|
||||
|
||||
! Main loop
|
||||
DO K = 1, N
|
||||
F = ABS(A(K,K)) ! Find pivot.
|
||||
P = K
|
||||
DO I = K+1, N
|
||||
IF (ABS(A(I,K)) > F) THEN
|
||||
F = ABS(A(I,K))
|
||||
P = I
|
||||
END IF
|
||||
END DO
|
||||
|
||||
IF (F < TOL) THEN ! Matrix is singular.
|
||||
IERR = 1
|
||||
RETURN
|
||||
END IF
|
||||
|
||||
IF (P .NE. K) THEN ! Swap rows.
|
||||
DO J = K, N
|
||||
F = A(K,J)
|
||||
A(K,J) = A(P,J)
|
||||
A(P,J) = F
|
||||
END DO
|
||||
DO J = 1, N
|
||||
F = B(K,J)
|
||||
B(K,J) = B(P,J)
|
||||
B(P,J) = F
|
||||
END DO
|
||||
END IF
|
||||
|
||||
F = 1. / A(K,K) ! Scale row so pivot is 1.
|
||||
DO J = K, N
|
||||
A(K,J) = A(K,J) * F
|
||||
END DO
|
||||
DO J = 1, N
|
||||
B(K,J) = B(K,J) * F
|
||||
END DO
|
||||
|
||||
DO 10 I = 1, N ! Subtract to get zeros.
|
||||
IF (I .EQ. K) GO TO 10
|
||||
F = A(I,K)
|
||||
DO J = K, N
|
||||
A(I,J) = A(I,J) - A(K,J) * F
|
||||
END DO
|
||||
DO J = 1, N
|
||||
B(I,J) = B(I,J) - B(K,J) * F
|
||||
END DO
|
||||
10 CONTINUE
|
||||
END DO
|
||||
|
||||
RETURN
|
||||
END ! of gjinv
|
||||
|
|
@ -0,0 +1,73 @@
|
|||
! Test matrix inversion
|
||||
PROGRAM TINV
|
||||
IMPLICIT NONE
|
||||
INTEGER I, J, K, N, IERR
|
||||
PARAMETER (N = 4)
|
||||
REAL AORIG(N,N), A(N,N), B(N,N), C(N,N)
|
||||
DATA AORIG / -1., -4., 7., 1.,
|
||||
$ -2., -1., -8., -2.,
|
||||
$ 3., 6., 9., 1.,
|
||||
$ 2., 2., 1., 3. /
|
||||
|
||||
20 FORMAT (F8.3, $)
|
||||
30 FORMAT ()
|
||||
|
||||
DO J = 1, N
|
||||
DO I = 1, N
|
||||
A(I,J) = AORIG(I,J)
|
||||
END DO
|
||||
END DO
|
||||
|
||||
CALL GJINV (A, N, N, B, N, IERR)
|
||||
PRINT *, 'gjinv returns #', IERR
|
||||
PRINT 30
|
||||
|
||||
PRINT *, 'matrix:'
|
||||
DO I = 1, N
|
||||
DO J = 1, N
|
||||
PRINT 20, AORIG(I,J)
|
||||
END DO
|
||||
PRINT 30
|
||||
END DO
|
||||
PRINT 30
|
||||
|
||||
PRINT *, 'inverse:'
|
||||
DO I = 1, N
|
||||
DO J = 1, N
|
||||
PRINT 20, B(I,J)
|
||||
END DO
|
||||
PRINT 30
|
||||
END DO
|
||||
PRINT 30
|
||||
|
||||
DO K = 1, N
|
||||
DO J = 1, N
|
||||
C(J,K) = 0.
|
||||
DO I = 1, N
|
||||
C(J,K) = C(J,K) + AORIG(J,I) * B(I,K)
|
||||
END DO
|
||||
END DO
|
||||
END DO
|
||||
|
||||
PRINT *, 'matrix @ inverse:'
|
||||
DO I = 1, N
|
||||
DO J = 1, N
|
||||
PRINT 20, C(I,J)
|
||||
END DO
|
||||
PRINT 30
|
||||
END DO
|
||||
PRINT 30
|
||||
|
||||
CALL GJINV (B, N, N, A, N, IERR)
|
||||
PRINT *, 'gjinv returns #', IERR
|
||||
PRINT 30
|
||||
|
||||
PRINT *, 'inverse of inverse:'
|
||||
DO I = 1, N
|
||||
DO J = 1, N
|
||||
PRINT 20, A(I,J)
|
||||
END DO
|
||||
PRINT 30
|
||||
END DO
|
||||
|
||||
END ! of test program
|
||||
|
|
@ -0,0 +1,42 @@
|
|||
#include once "matmult.bas"
|
||||
#include once "rowech.bas"
|
||||
|
||||
function matinv( A as Matrix ) as Matrix
|
||||
dim ret as Matrix, working as Matrix
|
||||
dim as uinteger i, j
|
||||
if not ubound( A.m, 1 ) = ubound( A.m, 2 ) then return ret
|
||||
dim as integer n = ubound(A.m, 1)
|
||||
redim ret.m( n, n )
|
||||
working = Matrix( n+1, 2*(n+1) )
|
||||
for i = 0 to n
|
||||
for j = 0 to n
|
||||
working.m(i, j) = A.m(i, j)
|
||||
next j
|
||||
working.m(i, i+n+1) = 1
|
||||
next i
|
||||
working = rowech(working)
|
||||
for i = 0 to n
|
||||
for j = 0 to n
|
||||
ret.m(i, j) = working.m(i, j+n+1)
|
||||
next j
|
||||
next i
|
||||
return ret
|
||||
end function
|
||||
|
||||
dim as integer i, j
|
||||
dim as Matrix M = Matrix(3,3)
|
||||
for i = 0 to 2
|
||||
for j = 0 to 2
|
||||
M.m(i, j) = 1 + i*i + 3*j + (i+j) mod 2 'just some arbitrary values
|
||||
print M.m(i, j),
|
||||
next j
|
||||
print
|
||||
next i
|
||||
print
|
||||
M = matinv(M)
|
||||
for i = 0 to 2
|
||||
for j = 0 to 2
|
||||
print M.m(i, j),
|
||||
next j
|
||||
print
|
||||
next i
|
||||
|
|
@ -0,0 +1,86 @@
|
|||
package main
|
||||
|
||||
import "fmt"
|
||||
|
||||
type vector = []float64
|
||||
type matrix []vector
|
||||
|
||||
func (m matrix) inverse() matrix {
|
||||
le := len(m)
|
||||
for _, v := range m {
|
||||
if len(v) != le {
|
||||
panic("Not a square matrix")
|
||||
}
|
||||
}
|
||||
aug := make(matrix, le)
|
||||
for i := 0; i < le; i++ {
|
||||
aug[i] = make(vector, 2*le)
|
||||
copy(aug[i], m[i])
|
||||
// augment by identity matrix to right
|
||||
aug[i][i+le] = 1
|
||||
}
|
||||
aug.toReducedRowEchelonForm()
|
||||
inv := make(matrix, le)
|
||||
// remove identity matrix to left
|
||||
for i := 0; i < le; i++ {
|
||||
inv[i] = make(vector, le)
|
||||
copy(inv[i], aug[i][le:])
|
||||
}
|
||||
return inv
|
||||
}
|
||||
|
||||
// note: this mutates the matrix in place
|
||||
func (m matrix) toReducedRowEchelonForm() {
|
||||
lead := 0
|
||||
rowCount, colCount := len(m), len(m[0])
|
||||
for r := 0; r < rowCount; r++ {
|
||||
if colCount <= lead {
|
||||
return
|
||||
}
|
||||
i := r
|
||||
|
||||
for m[i][lead] == 0 {
|
||||
i++
|
||||
if rowCount == i {
|
||||
i = r
|
||||
lead++
|
||||
if colCount == lead {
|
||||
return
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
m[i], m[r] = m[r], m[i]
|
||||
if div := m[r][lead]; div != 0 {
|
||||
for j := 0; j < colCount; j++ {
|
||||
m[r][j] /= div
|
||||
}
|
||||
}
|
||||
|
||||
for k := 0; k < rowCount; k++ {
|
||||
if k != r {
|
||||
mult := m[k][lead]
|
||||
for j := 0; j < colCount; j++ {
|
||||
m[k][j] -= m[r][j] * mult
|
||||
}
|
||||
}
|
||||
}
|
||||
lead++
|
||||
}
|
||||
}
|
||||
|
||||
func (m matrix) print(title string) {
|
||||
fmt.Println(title)
|
||||
for _, v := range m {
|
||||
fmt.Printf("% f\n", v)
|
||||
}
|
||||
fmt.Println()
|
||||
}
|
||||
|
||||
func main() {
|
||||
a := matrix{{1, 2, 3}, {4, 1, 6}, {7, 8, 9}}
|
||||
a.inverse().print("Inverse of A is:\n")
|
||||
|
||||
b := matrix{{2, -1, 0}, {-1, 2, -1}, {0, -1, 2}}
|
||||
b.inverse().print("Inverse of B is:\n")
|
||||
}
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"fmt"
|
||||
"math"
|
||||
)
|
||||
|
||||
type vector = []float64
|
||||
type matrix []vector
|
||||
|
||||
func (m matrix) print(title string) {
|
||||
fmt.Println(title)
|
||||
for _, v := range m {
|
||||
fmt.Printf("% f\n", v)
|
||||
}
|
||||
}
|
||||
|
||||
func I(n int) matrix {
|
||||
b := make(matrix, n)
|
||||
for i := 0; i < n; i++ {
|
||||
b[i] = make(vector, n)
|
||||
b[i][i] = 1
|
||||
}
|
||||
return b
|
||||
}
|
||||
|
||||
func (m matrix) inverse() matrix {
|
||||
n := len(m)
|
||||
for _, v := range m {
|
||||
if n != len(v) {
|
||||
panic("Not a square matrix")
|
||||
}
|
||||
}
|
||||
b := I(n)
|
||||
a := make(matrix, n)
|
||||
for i, v := range m {
|
||||
a[i] = make(vector, n)
|
||||
copy(a[i], v)
|
||||
}
|
||||
for k := range a {
|
||||
iMax := 0
|
||||
max := -1.
|
||||
for i := k; i < n; i++ {
|
||||
row := a[i]
|
||||
// compute scale factor s = max abs in row
|
||||
s := -1.
|
||||
for j := k; j < n; j++ {
|
||||
x := math.Abs(row[j])
|
||||
if x > s {
|
||||
s = x
|
||||
}
|
||||
}
|
||||
if s == 0 {
|
||||
panic("Irregular matrix")
|
||||
}
|
||||
// scale the abs used to pick the pivot.
|
||||
if abs := math.Abs(row[k]) / s; abs > max {
|
||||
iMax = i
|
||||
max = abs
|
||||
}
|
||||
}
|
||||
if k != iMax {
|
||||
a[k], a[iMax] = a[iMax], a[k]
|
||||
b[k], b[iMax] = b[iMax], b[k]
|
||||
}
|
||||
akk := a[k][k]
|
||||
for j := 0; j < n; j++ {
|
||||
a[k][j] /= akk
|
||||
b[k][j] /= akk
|
||||
}
|
||||
for i := 0; i < n; i++ {
|
||||
if (i != k) {
|
||||
aik := a[i][k]
|
||||
for j := 0; j < n; j++ {
|
||||
a[i][j] -= a[k][j] * aik
|
||||
b[i][j] -= b[k][j] * aik
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
return b
|
||||
}
|
||||
|
||||
func main() {
|
||||
a := matrix{{1, 2, 3}, {4, 1, 6}, {7, 8, 9}}
|
||||
a.inverse().print("Inverse of A is:\n")
|
||||
|
||||
b := matrix{{2, -1, 0}, {-1, 2, -1}, {0, -1, 2}}
|
||||
b.inverse().print("Inverse of B is:\n")
|
||||
}
|
||||
|
|
@ -0,0 +1,50 @@
|
|||
isMatrix xs = null xs || all ((== (length.head $ xs)).length) xs
|
||||
|
||||
isSquareMatrix xs = null xs || all ((== (length xs)).length) xs
|
||||
|
||||
mult:: Num a => [[a]] -> [[a]] -> [[a]]
|
||||
mult uss vss = map ((\xs -> if null xs then [] else foldl1 (zipWith (+)) xs). zipWith (\vs u -> map (u*) vs) vss) uss
|
||||
|
||||
matI::(Num a) => Int -> [[a]]
|
||||
matI n = [ [fromIntegral.fromEnum $ i == j | j <- [1..n]] | i <- [1..n]]
|
||||
|
||||
inversion xs = gauss xs (matI $ length xs)
|
||||
|
||||
gauss::[[Double]] -> [[Double]] -> [[Double]]
|
||||
gauss xs bs = map (map fromRational) $ solveGauss (toR xs) (toR bs)
|
||||
where toR = map $ map toRational
|
||||
|
||||
solveGauss:: (Fractional a, Ord a) => [[a]] -> [[a]] -> [[a]]
|
||||
solveGauss xs bs | null xs || null bs || length xs /= length bs || (not $ isSquareMatrix xs) || (not $ isMatrix bs) = []
|
||||
| otherwise = uncurry solveTriangle $ triangle xs bs
|
||||
|
||||
solveTriangle::(Fractional a,Eq a) => [[a]] -> [[a]] -> [[a]]
|
||||
solveTriangle us _ | not.null.dropWhile ((/= 0).head) $ us = []
|
||||
solveTriangle ([c]:as) (b:bs) = go as bs [map (/c) b]
|
||||
where
|
||||
val us vs ws = let u = head us in map (/u) $ zipWith (-) vs (head $ mult [tail us] ws)
|
||||
go [] _ zs = zs
|
||||
go _ [] zs = zs
|
||||
go (x:xs) (y:ys) zs = go xs ys $ (val x y zs):zs
|
||||
|
||||
triangle::(Num a, Ord a) => [[a]] -> [[a]] -> ([[a]],[[a]])
|
||||
triangle xs bs = triang ([],[]) (xs,bs)
|
||||
where
|
||||
triang ts (_,[]) = ts
|
||||
triang ts ([],_) = ts
|
||||
triang (os,ps) zs = triang (us:os,cs:ps).unzip $ [(fun tus vs, fun cs es) | (v:vs,es) <- zip uss css,let fun = zipWith (\x y -> v*x - u*y)]
|
||||
where ((us@(u:tus)):uss,cs:css) = bubble zs
|
||||
|
||||
bubble::(Num a, Ord a) => ([[a]],[[a]]) -> ([[a]],[[a]])
|
||||
bubble (xs,bs) = (go xs, go bs)
|
||||
where
|
||||
idmax = snd.maximum.flip zip [0..].map (abs.head) $ xs
|
||||
go ys = let (us,vs) = splitAt idmax ys in vs ++ us
|
||||
|
||||
main = do
|
||||
let a = [[1, 2, 3], [4, 1, 6], [7, 8, 9]]
|
||||
let b = [[2, -1, 0], [-1, 2, -1], [0, -1, 2]]
|
||||
putStrLn "inversion a ="
|
||||
mapM_ print $ inversion a
|
||||
putStrLn "\ninversion b ="
|
||||
mapM_ print $ inversion b
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
require 'math/misc/linear'
|
||||
augmentR_I1=: ,. e.@i.@# NB. augment matrix on the right with its Identity matrix
|
||||
matrix_invGJ=: # }."1 [: gauss_jordan@augmentR_I1
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
]A =: 1 2 3, 4 1 6,: 7 8 9
|
||||
1 2 3
|
||||
4 1 6
|
||||
7 8 9
|
||||
matrix_invGJ A
|
||||
_0.8125 0.125 0.1875
|
||||
0.125 _0.25 0.125
|
||||
0.520833 0.125 _0.145833
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
// GaussJordan.java
|
||||
|
||||
import java.util.Random;
|
||||
|
||||
public class GaussJordan {
|
||||
public static void main(String[] args) {
|
||||
int rows = 5;
|
||||
Matrix m = new Matrix(rows, rows);
|
||||
Random r = new Random();
|
||||
for (int row = 0; row < rows; ++row) {
|
||||
for (int column = 0; column < rows; ++column)
|
||||
m.set(row, column, r.nextDouble());
|
||||
}
|
||||
System.out.println("Matrix:");
|
||||
m.print();
|
||||
System.out.println("Inverse:");
|
||||
Matrix inv = m.inverse();
|
||||
inv.print();
|
||||
System.out.println("Product of matrix and inverse:");
|
||||
Matrix.product(m, inv).print();
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,97 @@
|
|||
// Matrix.java
|
||||
|
||||
public class Matrix {
|
||||
private int rows;
|
||||
private int columns;
|
||||
private double[][] elements;
|
||||
|
||||
public Matrix(int rows, int columns) {
|
||||
this.rows = rows;
|
||||
this.columns = columns;
|
||||
elements = new double[rows][columns];
|
||||
}
|
||||
|
||||
public void set(int row, int column, double value) {
|
||||
elements[row][column] = value;
|
||||
}
|
||||
|
||||
public double get(int row, int column) {
|
||||
return elements[row][column];
|
||||
}
|
||||
|
||||
public void print() {
|
||||
for (int row = 0; row < rows; ++row) {
|
||||
for (int column = 0; column < columns; ++column) {
|
||||
if (column > 0)
|
||||
System.out.print(' ');
|
||||
System.out.printf("%7.3f", elements[row][column]);
|
||||
}
|
||||
System.out.println();
|
||||
}
|
||||
}
|
||||
|
||||
// Returns the inverse of this matrix
|
||||
public Matrix inverse() {
|
||||
assert(rows == columns);
|
||||
// Augment by identity matrix
|
||||
Matrix tmp = new Matrix(rows, columns * 2);
|
||||
for (int row = 0; row < rows; ++row) {
|
||||
System.arraycopy(elements[row], 0, tmp.elements[row], 0, columns);
|
||||
tmp.elements[row][row + columns] = 1;
|
||||
}
|
||||
tmp.toReducedRowEchelonForm();
|
||||
Matrix inv = new Matrix(rows, columns);
|
||||
for (int row = 0; row < rows; ++row)
|
||||
System.arraycopy(tmp.elements[row], columns, inv.elements[row], 0, columns);
|
||||
return inv;
|
||||
}
|
||||
|
||||
// Converts this matrix into reduced row echelon form
|
||||
public void toReducedRowEchelonForm() {
|
||||
for (int row = 0, lead = 0; row < rows && lead < columns; ++row, ++lead) {
|
||||
int i = row;
|
||||
while (elements[i][lead] == 0) {
|
||||
if (++i == rows) {
|
||||
i = row;
|
||||
if (++lead == columns)
|
||||
return;
|
||||
}
|
||||
}
|
||||
swapRows(i, row);
|
||||
if (elements[row][lead] != 0) {
|
||||
double f = elements[row][lead];
|
||||
for (int column = 0; column < columns; ++column)
|
||||
elements[row][column] /= f;
|
||||
}
|
||||
for (int j = 0; j < rows; ++j) {
|
||||
if (j == row)
|
||||
continue;
|
||||
double f = elements[j][lead];
|
||||
for (int column = 0; column < columns; ++column)
|
||||
elements[j][column] -= f * elements[row][column];
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
// Returns the matrix product of a and b
|
||||
public static Matrix product(Matrix a, Matrix b) {
|
||||
assert(a.columns == b.rows);
|
||||
Matrix result = new Matrix(a.rows, b.columns);
|
||||
for (int i = 0; i < a.rows; ++i) {
|
||||
double[] resultRow = result.elements[i];
|
||||
double[] aRow = a.elements[i];
|
||||
for (int j = 0; j < a.columns; ++j) {
|
||||
double[] bRow = b.elements[j];
|
||||
for (int k = 0; k < b.columns; ++k)
|
||||
resultRow[k] += aRow[j] * bRow[k];
|
||||
}
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
private void swapRows(int i, int j) {
|
||||
double[] tmp = elements[i];
|
||||
elements[i] = elements[j];
|
||||
elements[j] = tmp;
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,82 @@
|
|||
# Create an m x n matrix,
|
||||
# it being understood that:
|
||||
# matrix(0; _; _) evaluates to []
|
||||
def matrix(m; n; init):
|
||||
if m == 0 then []
|
||||
elif m == 1 then [[range(0;n) | init]]
|
||||
elif m > 0 then
|
||||
[range(0;n) | init] as $row
|
||||
| [range(0;m) | $row ]
|
||||
else error("matrix\(m);_;_) invalid")
|
||||
end;
|
||||
|
||||
def mprint($dec):
|
||||
def max(s): reduce s as $x (null; if . == null or $x > . then $x else . end);
|
||||
def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;
|
||||
|
||||
pow(10; $dec) as $power
|
||||
| def p: (. * $power | round) / $power;
|
||||
(max(.[][] | p | tostring | length) + 1) as $w
|
||||
| . as $in
|
||||
| range(0; length) as $i
|
||||
| reduce range(0; .[$i]|length) as $j ("|"; . + ($in[$i][$j]|p|lpad($w)))
|
||||
| . + " |" ;
|
||||
|
||||
# Swaps two rows of the input matrix using IO==0
|
||||
def swapRows(rowNum1; rowNum2):
|
||||
if (rowNum1 == rowNum2)
|
||||
then .
|
||||
else .[rowNum1] as $t
|
||||
| .[rowNum1] = .[rowNum2]
|
||||
| .[rowNum2] = $t
|
||||
end;
|
||||
|
||||
def toReducedRowEchelonForm:
|
||||
. as $in
|
||||
| length as $nr
|
||||
| (.[0]|length) as $nc
|
||||
| {a: $in, lead: 0 }
|
||||
| label $out
|
||||
| last(foreach range(0; $nr) as $r (.;
|
||||
if $nc <= .lead then ., break $out else . end
|
||||
| .i = $r
|
||||
| until( .a[.i][.lead] != 0 or .lead == $nc - 1;
|
||||
.i += 1
|
||||
| if $nr == .i
|
||||
then .i = $r
|
||||
| .lead += 1
|
||||
else .
|
||||
end
|
||||
)
|
||||
| swapRows(.i; $r)
|
||||
| if .a[$r][.lead] != 0
|
||||
then .a[$r][.lead] as $div
|
||||
| reduce range(0; $nc) as $j (.; .a[$r][$j] /= $div)
|
||||
else .
|
||||
end
|
||||
| reduce range(0; $nr) as $k (.;
|
||||
if $k != $r
|
||||
then .a[$k][.lead] as $mult
|
||||
| reduce range(0; $nc) as $j (.; .a[$k][$j] -= .a[$r][$j] * $mult)
|
||||
else .
|
||||
end)
|
||||
| .lead += 1
|
||||
))
|
||||
| .a ;
|
||||
|
||||
|
||||
# Assumption: the input is a square matrix with an inverse
|
||||
# Uses the Gauss-Jordan method.
|
||||
def inverse:
|
||||
. as $a
|
||||
| length as $nr
|
||||
| reduce range(0; $nr) as $i (
|
||||
matrix($nr; 2 * $nr; 0);
|
||||
reduce range( 0; $nr) as $j (.;
|
||||
.[$i][$j] = $a[$i][$j]
|
||||
| .[$i][$i + $nr] = 1 ))
|
||||
| last(toReducedRowEchelonForm)
|
||||
| . as $ary
|
||||
| reduce range(0; $nr) as $i ( matrix($nr; $nr; 0);
|
||||
reduce range($nr; 2 *$nr) as $j (.;
|
||||
.[$i][$j - $nr] = $ary[$i][$j] )) ;
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
def arrays: [
|
||||
[ [ 1, 2, 3],
|
||||
[ 4, 1, 6],
|
||||
[ 7, 8, 9] ],
|
||||
|
||||
[ [ 2, -1, 0 ],
|
||||
[-1, 2, -1 ],
|
||||
[ 0, -1, 2 ] ],
|
||||
|
||||
[ [ -1, -2, 3, 2 ],
|
||||
[ -4, -1, 6, 2 ],
|
||||
[ 7, -8, 9, 1 ],
|
||||
[ 1, -2, 1, 3 ] ]
|
||||
];
|
||||
|
||||
def task:
|
||||
arrays[]
|
||||
| "Original:",
|
||||
mprint(1),
|
||||
"\nInverse:",
|
||||
(inverse|mprint(6)),
|
||||
""
|
||||
;
|
||||
|
||||
task
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
A = [1 2 3; 4 1 6; 7 8 9]
|
||||
@show I / A
|
||||
@show inv(A)
|
||||
|
|
@ -0,0 +1,56 @@
|
|||
function gaussjordan(A::Matrix)
|
||||
size(A, 1) == size(A, 2) || throw(ArgumentError("A must be squared"))
|
||||
n = size(A, 1)
|
||||
M = [convert(Matrix{float(eltype(A))}, A) I]
|
||||
i = 1
|
||||
local tmp = Vector{eltype(M)}(2n)
|
||||
# forward
|
||||
while i ≤ n
|
||||
if M[i, i] ≈ 0.0
|
||||
local j = i + 1
|
||||
while j ≤ n && M[j, i] ≈ 0.0
|
||||
j += 1
|
||||
end
|
||||
if j ≤ n
|
||||
tmp .= M[i, :]
|
||||
M[i, :] .= M[j, :]
|
||||
M[j, :] .= tmp
|
||||
else
|
||||
throw(ArgumentError("matrix is singular, cannot compute the inverse"))
|
||||
end
|
||||
end
|
||||
for j in (i + 1):n
|
||||
M[j, :] .-= M[j, i] / M[i, i] .* M[i, :]
|
||||
end
|
||||
i += 1
|
||||
end
|
||||
i = n
|
||||
# backward
|
||||
while i ≥ 1
|
||||
if M[i, i] ≈ 0.0
|
||||
local j = i - 1
|
||||
while j ≥ 1 && M[j, i] ≈ 0.0
|
||||
j -= 1
|
||||
end
|
||||
if j ≥ 1
|
||||
tmp .= M[i, :]
|
||||
M[i, :] .= M[j, :]
|
||||
M[j, :] .= tmp
|
||||
else
|
||||
throw(ArgumentError("matrix is singular, cannot compute the inverse"))
|
||||
end
|
||||
end
|
||||
for j in (i - 1):-1:1
|
||||
M[j, :] .-= M[j, i] / M[i, i] .* M[i, :]
|
||||
end
|
||||
i -= 1
|
||||
end
|
||||
M ./= diag(M) # normalize
|
||||
return M[:, n+1:2n]
|
||||
end
|
||||
|
||||
@show gaussjordan(A)
|
||||
@assert gaussjordan(A) ≈ inv(A)
|
||||
|
||||
A = rand(10, 10)
|
||||
@assert gaussjordan(A) ≈ inv(A)
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
// version 1.2.21
|
||||
|
||||
typealias Matrix = Array<DoubleArray>
|
||||
|
||||
fun Matrix.inverse(): Matrix {
|
||||
val len = this.size
|
||||
require(this.all { it.size == len }) { "Not a square matrix" }
|
||||
val aug = Array(len) { DoubleArray(2 * len) }
|
||||
for (i in 0 until len) {
|
||||
for (j in 0 until len) aug[i][j] = this[i][j]
|
||||
// augment by identity matrix to right
|
||||
aug[i][i + len] = 1.0
|
||||
}
|
||||
aug.toReducedRowEchelonForm()
|
||||
val inv = Array(len) { DoubleArray(len) }
|
||||
// remove identity matrix to left
|
||||
for (i in 0 until len) {
|
||||
for (j in len until 2 * len) inv[i][j - len] = aug[i][j]
|
||||
}
|
||||
return inv
|
||||
}
|
||||
|
||||
fun Matrix.toReducedRowEchelonForm() {
|
||||
var lead = 0
|
||||
val rowCount = this.size
|
||||
val colCount = this[0].size
|
||||
for (r in 0 until rowCount) {
|
||||
if (colCount <= lead) return
|
||||
var i = r
|
||||
|
||||
while (this[i][lead] == 0.0) {
|
||||
i++
|
||||
if (rowCount == i) {
|
||||
i = r
|
||||
lead++
|
||||
if (colCount == lead) return
|
||||
}
|
||||
}
|
||||
|
||||
val temp = this[i]
|
||||
this[i] = this[r]
|
||||
this[r] = temp
|
||||
|
||||
if (this[r][lead] != 0.0) {
|
||||
val div = this[r][lead]
|
||||
for (j in 0 until colCount) this[r][j] /= div
|
||||
}
|
||||
|
||||
for (k in 0 until rowCount) {
|
||||
if (k != r) {
|
||||
val mult = this[k][lead]
|
||||
for (j in 0 until colCount) this[k][j] -= this[r][j] * mult
|
||||
}
|
||||
}
|
||||
|
||||
lead++
|
||||
}
|
||||
}
|
||||
|
||||
fun Matrix.printf(title: String) {
|
||||
println(title)
|
||||
val rowCount = this.size
|
||||
val colCount = this[0].size
|
||||
|
||||
for (r in 0 until rowCount) {
|
||||
for (c in 0 until colCount) {
|
||||
if (this[r][c] == -0.0) this[r][c] = 0.0 // get rid of negative zeros
|
||||
print("${"% 10.6f".format(this[r][c])} ")
|
||||
}
|
||||
println()
|
||||
}
|
||||
|
||||
println()
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val a = arrayOf(
|
||||
doubleArrayOf(1.0, 2.0, 3.0),
|
||||
doubleArrayOf(4.0, 1.0, 6.0),
|
||||
doubleArrayOf(7.0, 8.0, 9.0)
|
||||
)
|
||||
a.inverse().printf("Inverse of A is :\n")
|
||||
|
||||
val b = arrayOf(
|
||||
doubleArrayOf( 2.0, -1.0, 0.0),
|
||||
doubleArrayOf(-1.0, 2.0, -1.0),
|
||||
doubleArrayOf( 0.0, -1.0, 2.0)
|
||||
)
|
||||
b.inverse().printf("Inverse of B is :\n")
|
||||
}
|
||||
|
|
@ -0,0 +1,10 @@
|
|||
{require lib_matrix}
|
||||
|
||||
{M.gaussJordan
|
||||
{M.new [[1,2,3],
|
||||
[4,5,6],
|
||||
[7,8,-9]]}}
|
||||
->
|
||||
[[-1.722222222222222,0.7777777777777777,-0.05555555555555555],
|
||||
[1.4444444444444444,-0.5555555555555556,0.1111111111111111],
|
||||
[-0.05555555555555555,0.1111111111111111,-0.05555555555555555]]
|
||||
|
|
@ -0,0 +1,92 @@
|
|||
Module Gauss_Jordan_matrix_inversion (there$="") {
|
||||
open there$ for output as #f
|
||||
dim matrix(1 to 3, 2 to 4) as Double
|
||||
matrix(1,2)=2, -1, 0, -1, 2, -1, 0, -1, 2
|
||||
print #f, "Matrix 3x3:"
|
||||
disp(matrix())
|
||||
print #f, "Inverse:"
|
||||
disp(@inverse(matrix()))
|
||||
dim matrix2(2 to 4, 3 to 5) as single
|
||||
matrix2(2, 3)=1, 2, 3, 4, 1, 6, 7, 8, 9
|
||||
print #f,"Matrix 3x3:"
|
||||
disp(matrix2())
|
||||
print #f,"Inverse:"
|
||||
disp(@inverse(matrix2()))
|
||||
dim matrix3(1 to 4,1 to 4) as Currency, matrix4()
|
||||
matrix3(1,1)=-1,-2,3,2,-4,-1,6,2,7,-8,9,1,1,-2,1,3
|
||||
print #f,"Matrix 4x4:"
|
||||
disp(matrix3())
|
||||
matrix4()=@inverse(matrix3())
|
||||
Rem Print Type$(matrix4(1,1))="Currency"
|
||||
print #f,"Inverse:"
|
||||
disp(matrix4())
|
||||
close #f
|
||||
function inverse(a())
|
||||
if dimension(a())<>2 then Error "Not 2 Dimensions Matrix"
|
||||
if not dimension(a(),1)=dimension(a(),2) then Error "Not Square Matrix"
|
||||
Local aug() // this is an empty array (type of variant)
|
||||
aug()=a() // so we get the same type from a()
|
||||
dim aug(dimension(a(),1), dimension(a(),1)*2)=0
|
||||
Rem gosub disp(aug())
|
||||
Local long bi=dimension(a(), 1, 0), bj=dimension(a(), 2, 0)
|
||||
Local long bim=dimension(a(), 1)-1, bjm=dimension(a(), 2)-1
|
||||
Local long i, j
|
||||
for i=0 to bim
|
||||
for j=0 to bjm
|
||||
aug(i,j)=a(i+bi,j+bj)
|
||||
next
|
||||
aug(i, i+bjm+1)=1
|
||||
next
|
||||
aug()=@ToReducedRowEchelonForm(aug())
|
||||
for i=0 to bim
|
||||
for j=0 to bjm
|
||||
a(i+bi,j+bj)=aug(i,j+bjm+1)
|
||||
next
|
||||
next
|
||||
Rem : Print type$(aug(0,0))
|
||||
=a()
|
||||
end function
|
||||
function ToReducedRowEchelonForm(a())
|
||||
Local long bi=dimension(a(), 1, 0), bj=dimension(a(), 2, 0)
|
||||
Local long rowcount=dimension(a(), 1), columncount=dimension(a(), 2)
|
||||
Local long lead=bj, r, i, j
|
||||
|
||||
for r=bi to rowcount-1+bi {
|
||||
if columncount<=lead then exit
|
||||
i=r
|
||||
while A(i,lead)=0 {
|
||||
i++
|
||||
if rowcount=i then i=r : lead++ : if columncount<lead then exit
|
||||
}
|
||||
|
||||
for c =bj to columncount-1+bj {swap A(i, c), A(r, c)}
|
||||
|
||||
if A(r, lead)<>0 then
|
||||
div1=A(r,lead)
|
||||
For c =bj to columncount-1+bj {A(r, c)/=div1}
|
||||
end if
|
||||
for i=bi to rowcount-1+bi {
|
||||
if i<>r then {
|
||||
mult=A(i,lead)
|
||||
for j=bj to columncount-1+bj {A(i,j)-=A(r,j)*mult}
|
||||
}
|
||||
}
|
||||
lead++
|
||||
}
|
||||
=a()
|
||||
End function
|
||||
sub disp(a())
|
||||
local long i, j, c=8 // column width plus 1 space
|
||||
for i=dimension(a(), 1, 0) to dimension(a(), 1, 1)
|
||||
for j=dimension(a(), 2, 0) to dimension(a(), 2, 1)
|
||||
Print #f, format$("{0:-"+c+"} ",str$(round(A(i, j), 5),1033));
|
||||
Next
|
||||
// if pos>0 then print // not used here
|
||||
Print #f, ""
|
||||
Next
|
||||
Print #f, ""
|
||||
End sub
|
||||
}
|
||||
Gauss_Jordan_matrix_inversion // to screen
|
||||
Gauss_Jordan_matrix_inversion "out.txt"
|
||||
win "notepad", dir$+"out.txt"
|
||||
|
|
@ -0,0 +1,44 @@
|
|||
function GaussInverse(M)
|
||||
original = M;
|
||||
[n,~] = size(M);
|
||||
I = eye(n);
|
||||
for j = 1:n
|
||||
for i = j:n
|
||||
if ~(M(i,j) == 0)
|
||||
for k = 1:n
|
||||
q = M(j,k); M(j,k) = M(i,k); M(i,k) = q;
|
||||
q = I(j,k); I(j,k) = I(i,k); I(i,k) = q;
|
||||
end
|
||||
p = 1/M(j,j);
|
||||
for k = 1:n
|
||||
M(j,k) = p*M(j,k);
|
||||
I(j,k) = p*I(j,k);
|
||||
end
|
||||
for L = 1:n
|
||||
if ~(L == j)
|
||||
p = -M(L,j);
|
||||
for k = 1:n
|
||||
M(L,k) = M(L,k) + p*M(j,k);
|
||||
I(L,k) = I(L,k) + p*I(j,k);
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
inverted = I;
|
||||
end
|
||||
fprintf("Matrix:\n")
|
||||
disp(original)
|
||||
fprintf("Inverted matrix:\n")
|
||||
disp(inverted)
|
||||
fprintf("Inverted matrix calculated by built-in function:\n")
|
||||
disp(inv(original))
|
||||
fprintf("Product of matrix and inverse:\n")
|
||||
disp(original*inverted)
|
||||
end
|
||||
|
||||
A = [ 2, -1, 0;
|
||||
-1, 2, -1;
|
||||
0, -1, 2 ];
|
||||
|
||||
GaussInverse(A)
|
||||
|
|
@ -0,0 +1,3 @@
|
|||
a = N@{{1, 7, 5, 0}, {5, 8, 6, 9}, {2, 1, 6, 4}, {8, 1, 2, 4}};
|
||||
elimmat = RowReduce[Join[a, IdentityMatrix[Length[a]], 2]];
|
||||
inv = elimmat[[All, -Length[a] ;;]]
|
||||
|
|
@ -0,0 +1,107 @@
|
|||
import strformat, strutils
|
||||
|
||||
const Eps = 1e-10
|
||||
|
||||
type
|
||||
Matrix[M, N: static Positive] = array[M, array[N, float]]
|
||||
SquareMatrix[N: static Positive] = Matrix[N, N]
|
||||
|
||||
|
||||
func toSquareMatrix[N: static Positive](a: array[N, array[N, int]]): SquareMatrix[N] =
|
||||
## Convert a square matrix of integers to a square matrix of floats.
|
||||
|
||||
for i in 0..<N:
|
||||
for j in 0..<N:
|
||||
result[i][j] = a[i][j].toFloat
|
||||
|
||||
|
||||
func transformToRref(mat: var Matrix) =
|
||||
## Transform a matrix to reduced row echelon form.
|
||||
|
||||
var lead = 0
|
||||
|
||||
for r in 0..<mat.M:
|
||||
|
||||
if lead >= mat.N: return
|
||||
|
||||
var i = r
|
||||
while mat[i][lead] == 0:
|
||||
inc i
|
||||
if i == mat.M:
|
||||
i = r
|
||||
inc lead
|
||||
if lead == mat.N: return
|
||||
swap mat[i], mat[r]
|
||||
|
||||
let d = mat[r][lead]
|
||||
if abs(d) > Eps: # Checking "d != 0" will give wrong results in some cases.
|
||||
for item in mat[r].mitems:
|
||||
item /= d
|
||||
|
||||
for i in 0..<mat.M:
|
||||
if i != r:
|
||||
let m = mat[i][lead]
|
||||
for c in 0..<mat.N:
|
||||
mat[i][c] -= mat[r][c] * m
|
||||
|
||||
inc lead
|
||||
|
||||
|
||||
func inverse(mat: SquareMatrix): SquareMatrix[mat.N] =
|
||||
## Return the inverse of a matrix.
|
||||
|
||||
# Build augmented matrix.
|
||||
var augmat: Matrix[mat.N, 2 * mat.N]
|
||||
for i in 0..<mat.N:
|
||||
augmat[i][0..<mat.N] = mat[i]
|
||||
augmat[i][mat.N + i] = 1
|
||||
|
||||
# Transform it to reduced row echelon form.
|
||||
augmat.transformToRref()
|
||||
|
||||
# Check if the first half is the identity matrix and extract second half.
|
||||
for i in 0..<mat.N:
|
||||
for j in 0..<mat.N:
|
||||
if augmat[i][j] != float(i == j):
|
||||
raise newException(ValueError, "matrix is singular")
|
||||
result[i][j] = augmat[i][mat.N + j]
|
||||
|
||||
|
||||
proc `$`(mat: Matrix): string =
|
||||
## Display a matrix (which may be a square matrix).
|
||||
|
||||
for row in mat:
|
||||
var line = ""
|
||||
for val in row:
|
||||
line.addSep(" ", 0)
|
||||
line.add &"{val:9.5f}"
|
||||
echo line
|
||||
|
||||
|
||||
#———————————————————————————————————————————————————————————————————————————————————————————————————
|
||||
|
||||
template runTest(mat: SquareMatrix) =
|
||||
## Run a test using square matrix "mat".
|
||||
|
||||
echo "Matrix:"
|
||||
echo $mat
|
||||
echo "Inverse:"
|
||||
echo mat.inverse
|
||||
echo ""
|
||||
|
||||
let m1 = [[1, 2, 3],
|
||||
[4, 1, 6],
|
||||
[7, 8, 9]].toSquareMatrix()
|
||||
|
||||
let m2 = [[ 2, -1, 0],
|
||||
[-1, 2, -1],
|
||||
[ 0, -1, 2]].toSquareMatrix()
|
||||
|
||||
let m3 = [[ -1, -2, 3, 2],
|
||||
[ -4, -1, 6, 2],
|
||||
[ 7, -8, 9, 1],
|
||||
[ 1, -2, 1, 3]].toSquareMatrix()
|
||||
|
||||
runTest(m1)
|
||||
runTest(m2)
|
||||
runTest(m3)
|
||||
|
|
@ -0,0 +1,65 @@
|
|||
sub rref {
|
||||
our @m; local *m = shift;
|
||||
@m or return;
|
||||
my ($lead, $rows, $cols) = (0, scalar(@m), scalar(@{$m[0]}));
|
||||
|
||||
foreach my $r (0 .. $rows - 1) {
|
||||
$lead < $cols or return;
|
||||
my $i = $r;
|
||||
|
||||
until ($m[$i][$lead])
|
||||
{++$i == $rows or next;
|
||||
$i = $r;
|
||||
++$lead == $cols and return;}
|
||||
|
||||
@m[$i, $r] = @m[$r, $i];
|
||||
my $lv = $m[$r][$lead];
|
||||
$_ /= $lv foreach @{ $m[$r] };
|
||||
|
||||
my @mr = @{ $m[$r] };
|
||||
foreach my $i (0 .. $rows - 1)
|
||||
{$i == $r and next;
|
||||
($lv, my $n) = ($m[$i][$lead], -1);
|
||||
$_ -= $lv * $mr[++$n] foreach @{ $m[$i] };}
|
||||
|
||||
++$lead;}
|
||||
}
|
||||
|
||||
sub display { join("\n" => map join(" " => map(sprintf("%6.2f", $_), @$_)), @{+shift})."\n" }
|
||||
|
||||
sub gauss_jordan_invert {
|
||||
my(@m) = @_;
|
||||
my $rows = @m;
|
||||
my @i = identity(scalar @m);
|
||||
push @{$m[$_]}, @{$i[$_]} for 0..$rows-1;
|
||||
rref(\@m);
|
||||
map { splice @$_, 0, $rows } @m;
|
||||
@m;
|
||||
}
|
||||
|
||||
sub identity {
|
||||
my($n) = @_;
|
||||
map { [ (0) x $_, 1, (0) x ($n-1 - $_) ] } 0..$n-1
|
||||
}
|
||||
|
||||
my @tests = (
|
||||
[
|
||||
[ 2, -1, 0 ],
|
||||
[-1, 2, -1 ],
|
||||
[ 0, -1, 2 ]
|
||||
],
|
||||
[
|
||||
[ -1, -2, 3, 2 ],
|
||||
[ -4, -1, 6, 2 ],
|
||||
[ 7, -8, 9, 1 ],
|
||||
[ 1, -2, 1, 3 ]
|
||||
],
|
||||
);
|
||||
|
||||
for my $matrix (@tests) {
|
||||
print "Original Matrix:\n" . display(\@$matrix) . "\n";
|
||||
my @gj = gauss_jordan_invert( @$matrix );
|
||||
print "Gauss-Jordan Inverted Matrix:\n" . display(\@gj) . "\n";
|
||||
my @rt = gauss_jordan_invert( @gj );
|
||||
print "After round-trip:\n" . display(\@rt) . "\n";} . "\n"
|
||||
}
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">ToReducedRowEchelonForm</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">M</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">lead</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span><span style="color: #0000FF;">,</span>
|
||||
<span style="color: #000000;">rowCount</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">M</span><span style="color: #0000FF;">),</span>
|
||||
<span style="color: #000000;">columnCount</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">1</span><span style="color: #0000FF;">]),</span>
|
||||
<span style="color: #000000;">i</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">r</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">rowCount</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">lead</span><span style="color: #0000FF;">>=</span><span style="color: #000000;">columnCount</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #000000;">i</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">r</span>
|
||||
<span style="color: #008080;">while</span> <span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">lead</span><span style="color: #0000FF;">]=</span><span style="color: #000000;">0</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">i</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">rowCount</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">i</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">r</span>
|
||||
<span style="color: #000000;">lead</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">lead</span><span style="color: #0000FF;">=</span><span style="color: #000000;">columnCount</span> <span style="color: #008080;">then</span> <span style="color: #008080;">exit</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
|
||||
<span style="color: #004080;">object</span> <span style="color: #000000;">mr</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_div</span><span style="color: #0000FF;">(</span><span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">],</span><span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">lead</span><span style="color: #0000FF;">])</span>
|
||||
<span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mr</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">rowCount</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">r</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">sq_sub</span><span style="color: #0000FF;">(</span><span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">],</span><span style="color: #7060A8;">sq_mul</span><span style="color: #0000FF;">(</span><span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">][</span><span style="color: #000000;">lead</span><span style="color: #0000FF;">],</span><span style="color: #000000;">M</span><span style="color: #0000FF;">[</span><span style="color: #000000;">r</span><span style="color: #0000FF;">]))</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #000000;">lead</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">M</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
<span style="color: #000080;font-style:italic;">--</end of copy></span>
|
||||
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">inverse</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">mat</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">len</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mat</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">aug</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">len</span><span style="color: #0000FF;">),</span><span style="color: #000000;">len</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">len</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">mat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">])!=</span><span style="color: #000000;">len</span> <span style="color: #008080;">then</span> <span style="color: #0000FF;">?</span><span style="color: #000000;">9</span><span style="color: #0000FF;">/</span><span style="color: #000000;">0</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span> <span style="color: #000080;font-style:italic;">-- "Not a square matrix"</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">len</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">aug</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">mat</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #000080;font-style:italic;">-- augment by identity matrix to right</span>
|
||||
<span style="color: #000000;">aug</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">i</span> <span style="color: #0000FF;">+</span> <span style="color: #000000;">len</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #000000;">aug</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">ToReducedRowEchelonForm</span><span style="color: #0000FF;">(</span><span style="color: #000000;">aug</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">inv</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">len</span><span style="color: #0000FF;">),</span><span style="color: #000000;">len</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #000080;font-style:italic;">-- remove identity matrix to left</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">len</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">len</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">*</span><span style="color: #000000;">len</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">inv</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">-</span><span style="color: #000000;">len</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">aug</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">inv</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #008080;">constant</span> <span style="color: #000000;">test</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">}}</span>
|
||||
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">inverse</span><span style="color: #0000FF;">(</span><span style="color: #000000;">test</span><span style="color: #0000FF;">),{</span><span style="color: #004600;">pp_Nest</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">})</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,47 @@
|
|||
(phixonline)-->
|
||||
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
|
||||
<span style="color: #008080;">function</span> <span style="color: #000000;">gauss_jordan_inv</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">n</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">length</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">b</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">repeat</span><span style="color: #0000FF;">(</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span><span style="color: #000000;">n</span><span style="color: #0000FF;">),</span><span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">i</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">1</span> <span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #004080;">integer</span> <span style="color: #000000;">lmax</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">k</span>
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">amax</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">abs</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">][</span><span style="color: #000000;">k</span><span style="color: #0000FF;">])</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">l</span><span style="color: #0000FF;">=</span><span style="color: #000000;">k</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">tmp</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">abs</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">l</span><span style="color: #0000FF;">][</span><span style="color: #000000;">k</span><span style="color: #0000FF;">])</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">amax</span><span style="color: #0000FF;"><</span><span style="color: #000000;">tmp</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #000000;">amax</span><span style="color: #0000FF;">,</span><span style="color: #000000;">lmax</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">tmp</span><span style="color: #0000FF;">,</span><span style="color: #000000;">l</span><span style="color: #0000FF;">}</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">k</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">lmax</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">lmax</span><span style="color: #0000FF;">]}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">lmax</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]}</span>
|
||||
<span style="color: #0000FF;">{</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">lmax</span><span style="color: #0000FF;">]}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">lmax</span><span style="color: #0000FF;">],</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]}</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">akk</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">][</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">akk</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span> <span style="color: #008080;">then</span> <span style="color: #008080;">throw</span><span style="color: #0000FF;">(</span><span style="color: #008000;">"Irregular matrix"</span><span style="color: #0000FF;">)</span> <span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">/=</span> <span style="color: #000000;">akk</span>
|
||||
<span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">/=</span> <span style="color: #000000;">akk</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #008080;">if</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">k</span> <span style="color: #008080;">then</span>
|
||||
<span style="color: #004080;">atom</span> <span style="color: #000000;">aik</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">k</span><span style="color: #0000FF;">]</span>
|
||||
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
|
||||
<span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">aik</span>
|
||||
<span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">k</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">aik</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
|
||||
<span style="color: #008080;">return</span> <span style="color: #000000;">b</span>
|
||||
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
|
||||
|
||||
<span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">},</span>
|
||||
<span style="color: #0000FF;">{</span> <span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2</span><span style="color: #0000FF;">}},</span>
|
||||
<span style="color: #000000;">inva</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">gauss_jordan_inv</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">deep_copy</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">))</span>
|
||||
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"a = "</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,{</span><span style="color: #004600;">pp_Nest</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #004600;">pp_Indent</span><span style="color: #0000FF;">,</span><span style="color: #000000;">4</span><span style="color: #0000FF;">,</span><span style="color: #004600;">pp_IntFmt</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%2d"</span><span style="color: #0000FF;">})</span>
|
||||
<span style="color: #7060A8;">puts</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"inv(a) = "</span><span style="color: #0000FF;">)</span>
|
||||
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">inva</span><span style="color: #0000FF;">,{</span><span style="color: #004600;">pp_Nest</span><span style="color: #0000FF;">,</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #004600;">pp_Indent</span><span style="color: #0000FF;">,</span><span style="color: #000000;">9</span><span style="color: #0000FF;">,</span><span style="color: #004600;">pp_FltFmt</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%4.2f"</span><span style="color: #0000FF;">})</span>
|
||||
<!--
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
function gauss-jordan-inv([double[][]]$a) {
|
||||
$n = $a.count
|
||||
[double[][]]$b = 0..($n-1) | foreach{[double[]]$row = @(0) * $n; $row[$_] = 1; ,$row}
|
||||
for ($k = 0; $k -lt $n; $k++) {
|
||||
$lmax, $max = $k, [Math]::Abs($a[$k][$k])
|
||||
for ($l = $k+1; $l -lt $n; $l++) {
|
||||
$tmp = [Math]::Abs($a[$l][$k])
|
||||
if($max -lt $tmp) {
|
||||
$max, $lmax = $tmp, $l
|
||||
}
|
||||
}
|
||||
if ($k -ne $lmax) {
|
||||
$a[$k], $a[$lmax] = $a[$lmax], $a[$k]
|
||||
$b[$k], $b[$lmax] = $b[$lmax], $b[$k]
|
||||
}
|
||||
$akk = $a[$k][$k]
|
||||
if (0 -eq $akk) {throw "Irregular matrix"}
|
||||
for ($j = 0; $j -lt $n; $j++) {
|
||||
$a[$k][$j] /= $akk
|
||||
$b[$k][$j] /= $akk
|
||||
}
|
||||
for ($i = 0; $i -lt $n; $i++){
|
||||
if ($i -ne $k) {
|
||||
$aik = $a[$i][$k]
|
||||
for ($j = 0; $j -lt $n; $j++) {
|
||||
$a[$i][$j] -= $a[$k][$j]*$aik
|
||||
$b[$i][$j] -= $b[$k][$j]*$aik
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
$b
|
||||
}
|
||||
function show($a) { $a | foreach{ "$_"} }
|
||||
|
||||
$a = @(@(@(1, 2, 3), @(4, 1, 6), @(7, 8, 9)))
|
||||
$inva = gauss-jordan-inv $a
|
||||
"a ="
|
||||
show $a
|
||||
""
|
||||
"inv(a) ="
|
||||
show $inva
|
||||
""
|
||||
|
||||
$b = @(@(2, -1, 0), @(-1, 2, -1), @(0, -1, 2))
|
||||
"b ="
|
||||
show $b
|
||||
""
|
||||
$invb = gauss-jordan-inv $b
|
||||
"inv(b) ="
|
||||
show $invb
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
import numpy as np
|
||||
from numpy.linalg import inv
|
||||
a = np.array([[1., 2., 3.], [4., 1., 6.],[ 7., 8., 9.]])
|
||||
ainv = inv(a)
|
||||
|
||||
print(a)
|
||||
print(ainv)
|
||||
|
|
@ -0,0 +1,276 @@
|
|||
/* REXX */
|
||||
Parse Arg seed nn
|
||||
If seed='' Then
|
||||
seed=23345
|
||||
If nn='' Then nn=5
|
||||
If seed='?' Then Do
|
||||
Say 'rexx gjmi seed n computes a random matrix with n rows and columns'
|
||||
Say 'Default is 23345 5'
|
||||
Exit
|
||||
End
|
||||
Numeric Digits 50
|
||||
Call random 1,2,seed
|
||||
a=''
|
||||
Do i=1 To nn**2
|
||||
a=a random(9)+1
|
||||
End
|
||||
n2=words(a)
|
||||
Do n=2 To n2/2
|
||||
If n**2=n2 Then
|
||||
Leave
|
||||
End
|
||||
If n>n2/2 Then
|
||||
Call exit 'Not a square matrix:' a '('n2 'elements).'
|
||||
det=determinante(a,n)
|
||||
If det=0 Then
|
||||
Call exit 'Determinant is 0'
|
||||
Do j=1 To n
|
||||
Do i=1 To n
|
||||
Parse Var A a.i.j a
|
||||
aa.i.j=a.i.j
|
||||
End
|
||||
Do ii=1 To n
|
||||
z=(ii=j)
|
||||
iii=ii+n
|
||||
a.iii.j=z
|
||||
End
|
||||
End
|
||||
Call show 1,'The given matrix'
|
||||
Do m=1 To n-1
|
||||
If a.m.m=0 Then Do
|
||||
Do j=m+1 To n
|
||||
If a.m.j<>0 Then Leave
|
||||
End
|
||||
If j>n Then Do
|
||||
Say 'No pivot>0 found in column' m
|
||||
Exit
|
||||
End
|
||||
Do i=1 To n*2
|
||||
temp=a.i.m
|
||||
a.i.m=a.i.j
|
||||
a.i.j=temp
|
||||
End
|
||||
End
|
||||
Do j=m+1 To n
|
||||
If a.m.j<>0 Then Do
|
||||
jj=m
|
||||
fact=divide(a.m.m,a.m.j)
|
||||
Do i=1 To n*2
|
||||
a.i.j=subtract(multiply(a.i.j,fact),a.i.jj)
|
||||
End
|
||||
End
|
||||
End
|
||||
Call show 2 m
|
||||
End
|
||||
Say 'Lower part has all zeros'
|
||||
Say ''
|
||||
|
||||
Do j=1 To n
|
||||
If denom(a.j.j)<0 Then Do
|
||||
Do i=1 To 2*n
|
||||
a.i.j=subtract(0,a.i.j)
|
||||
End
|
||||
End
|
||||
End
|
||||
Call show 3
|
||||
|
||||
Do m=n To 2 By -1
|
||||
Do j=1 To m-1
|
||||
jj=m
|
||||
fact=divide(a.m.j,a.m.jj)
|
||||
Do i=1 To n*2
|
||||
a.i.j=subtract(a.i.j,multiply(a.i.jj,fact))
|
||||
End
|
||||
End
|
||||
Call show 4 m
|
||||
End
|
||||
Say 'Upper half has all zeros'
|
||||
Say ''
|
||||
Do j=1 To n
|
||||
If decimal(a.j.j)<>1 Then Do
|
||||
z=a.j.j
|
||||
Do i=1 To 2*n
|
||||
a.i.j=divide(a.i.j,z)
|
||||
End
|
||||
End
|
||||
End
|
||||
Call show 5
|
||||
Say 'Main diagonal has all ones'
|
||||
Say ''
|
||||
|
||||
Do j=1 To n
|
||||
Do i=1 To n
|
||||
z=i+n
|
||||
a.i.j=a.z.j
|
||||
End
|
||||
End
|
||||
Call show 6,'The inverse matrix'
|
||||
|
||||
do i = 1 to n
|
||||
do j = 1 to n
|
||||
sum=0
|
||||
Do k=1 To n
|
||||
sum=add(sum,multiply(aa.i.k,a.k.j))
|
||||
End
|
||||
c.i.j = sum
|
||||
end
|
||||
End
|
||||
Call showc 7,'The product of input and inverse matrix'
|
||||
Exit
|
||||
|
||||
show:
|
||||
Parse Arg num,text
|
||||
Say 'show' arg(1) text
|
||||
If arg(1)<>6 Then rows=n*2
|
||||
Else rows=n
|
||||
len=0
|
||||
Do j=1 To n
|
||||
Do i=1 To rows
|
||||
len=max(len,length(a.i.j))
|
||||
End
|
||||
End
|
||||
Do j=1 To n
|
||||
ol=''
|
||||
Do i=1 To rows
|
||||
ol=ol||right(a.i.j,len+1)
|
||||
End
|
||||
Say ol
|
||||
End
|
||||
Say ''
|
||||
Return
|
||||
|
||||
showc:
|
||||
Parse Arg num,text
|
||||
Say text
|
||||
clen=0
|
||||
Do j=1 To n
|
||||
Do i=1 To n
|
||||
clen=max(clen,length(c.i.j))
|
||||
End
|
||||
End
|
||||
Do j=1 To n
|
||||
ol=''
|
||||
Do i=1 To n
|
||||
ol=ol||right(c.i.j,clen+1)
|
||||
End
|
||||
Say ol
|
||||
End
|
||||
Say ''
|
||||
Return
|
||||
|
||||
denom: Procedure
|
||||
/* Return the denominator */
|
||||
Parse Arg d '/' n
|
||||
Return d
|
||||
|
||||
decimal: Procedure
|
||||
/* compute the fraction's value */
|
||||
Parse Arg a
|
||||
If pos('/',a)=0 Then a=a'/1'; Parse Var a ad '/' an
|
||||
Return ad/an
|
||||
|
||||
gcd: procedure
|
||||
/**********************************************************************
|
||||
* Greatest commn divisor
|
||||
**********************************************************************/
|
||||
Parse Arg a,b
|
||||
If b = 0 Then Return abs(a)
|
||||
Return gcd(b,a//b)
|
||||
|
||||
add: Procedure
|
||||
Parse Arg a,b
|
||||
If pos('/',a)=0 Then a=a'/1'; Parse Var a ad '/' an
|
||||
If pos('/',b)=0 Then b=b'/1'; Parse Var b bd '/' bn
|
||||
sum=divide(ad*bn+bd*an,an*bn)
|
||||
Return sum
|
||||
|
||||
multiply: Procedure
|
||||
Parse Arg a,b
|
||||
If pos('/',a)=0 Then a=a'/1'; Parse Var a ad '/' an
|
||||
If pos('/',b)=0 Then b=b'/1'; Parse Var b bd '/' bn
|
||||
prd=divide(ad*bd,an*bn)
|
||||
Return prd
|
||||
|
||||
subtract: Procedure
|
||||
Parse Arg a,b
|
||||
If pos('/',a)=0 Then a=a'/1'; Parse Var a ad '/' an
|
||||
If pos('/',b)=0 Then b=b'/1'; Parse Var b bd '/' bn
|
||||
div=divide(ad*bn-bd*an,an*bn)
|
||||
Return div
|
||||
|
||||
divide: Procedure
|
||||
Parse Arg a,b
|
||||
If pos('/',a)=0 Then a=a'/1'; Parse Var a ad '/' an
|
||||
If pos('/',b)=0 Then b=b'/1'; Parse Var b bd '/' bn
|
||||
sd=ad*bn
|
||||
sn=an*bd
|
||||
g=gcd(sd,sn)
|
||||
Select
|
||||
When sd=0 Then res='0'
|
||||
When abs(sn/g)=1 Then res=(sd/g)*sign(sn/g)
|
||||
Otherwise Do
|
||||
den=sd/g
|
||||
nom=sn/g
|
||||
If nom<0 Then Do
|
||||
If den<0 Then den=abs(den)
|
||||
Else den=-den
|
||||
nom=abs(nom)
|
||||
End
|
||||
res=den'/'nom
|
||||
End
|
||||
End
|
||||
Return res
|
||||
|
||||
determinante: Procedure
|
||||
/* REXX ***************************************************************
|
||||
* determinant.rex
|
||||
* compute the determinant of the given square matrix
|
||||
* Input: as: the representation of the matrix as vector (n**2 elements)
|
||||
* 21.05.2013 Walter Pachl
|
||||
**********************************************************************/
|
||||
Parse Arg as,n
|
||||
Do i=1 To n
|
||||
Do j=1 To n
|
||||
Parse Var as a.i.j as
|
||||
End
|
||||
End
|
||||
Select
|
||||
When n=2 Then det=subtract(multiply(a.1.1,a.2.2),multiply(a.1.2,a.2.1))
|
||||
When n=3 Then Do
|
||||
det=multiply(multiply(a.1.1,a.2.2),a.3.3)
|
||||
det=add(det,multiply(multiply(a.1.2,a.2.3),a.3.1))
|
||||
det=add(det,multiply(multiply(a.1.3,a.2.1),a.3.2))
|
||||
det=subtract(det,multiply(multiply(a.1.3,a.2.2),a.3.1))
|
||||
det=subtract(det,multiply(multiply(a.1.2,a.2.1),a.3.3))
|
||||
det=subtract(det,multiply(multiply(a.1.1,a.2.3),a.3.2))
|
||||
End
|
||||
Otherwise Do
|
||||
det=0
|
||||
Do k=1 To n
|
||||
sign=((-1)**(k+1))
|
||||
If sign=1 Then
|
||||
det=add(det,multiply(a.1.k,determinante(subm(k),n-1)))
|
||||
Else
|
||||
det=subtract(det,multiply(a.1.k,determinante(subm(k),n-1)))
|
||||
End
|
||||
End
|
||||
End
|
||||
Return det
|
||||
|
||||
subm: Procedure Expose a. n
|
||||
/**********************************************************************
|
||||
* compute the submatrix resulting when row 1 and column k are removed
|
||||
* Input: a.*.*, k
|
||||
* Output: bs the representation of the submatrix as vector
|
||||
**********************************************************************/
|
||||
Parse Arg k
|
||||
bs=''
|
||||
do i=2 To n
|
||||
Do j=1 To n
|
||||
If j=k Then Iterate
|
||||
bs=bs a.i.j
|
||||
End
|
||||
End
|
||||
Return bs
|
||||
|
||||
Exit: Say arg(1)
|
||||
|
|
@ -0,0 +1,35 @@
|
|||
/*REXX program performs a (square) matrix inversion using the Gauss─Jordan method. */
|
||||
data= 8 3 7 5 9 12 10 11 6 2 4 13 14 15 16 17 /*the matrix element values. */
|
||||
call build 4 /*assign data elements to the matrix. */
|
||||
call show '@', 'The matrix of order ' n " is:" /*display the (square) matrix. */
|
||||
call aux /*define the auxiliary (identity) array*/
|
||||
call invert /*invert the matrix, store result in X.*/
|
||||
call show 'X', "The inverted matrix is:" /*display (inverted) auxiliary matrix. */
|
||||
exit 0 /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
aux: x.= 0; do i=1 for n; x.i.i= 1; end; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
build: arg n; #=0; w=0; do r=1 for n /*read a row of the matrix.*/
|
||||
do c=1 for n; #= # + 1 /* " " col " " " */
|
||||
@.r.c= word(data, #); w= max(w, length(@.r.c) )
|
||||
end /*c*/ /*W: max width of a number*/
|
||||
end /*r*/; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
invert: do k=1 for n; t= @.k.k /*divide each matrix row by T. */
|
||||
do c=1 for n; @.k.c= @.k.c / t /*process row of original matrix.*/
|
||||
x.k.c= x.k.c / t /* " " " auxiliary " */
|
||||
end /*c*/
|
||||
do r=1 for n; if r==k then iterate /*skip if R is the same row as K.*/
|
||||
t= @.r.k
|
||||
do c=1 for n; @.r.c= @.r.c - t*@.k.c /*process row of original matrix.*/
|
||||
x.r.c= x.r.c - t*x.k.c /* " " " auxiliary " */
|
||||
end /*c*/
|
||||
end /*r*/
|
||||
end /*k*/; return
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
show: parse arg ?, title; say; say title; f= 4 /*F: fractional digits precision.*/
|
||||
do r=1 for n; _=
|
||||
do c=1 for n; if ?=='@' then _= _ right( @.r.c, w)
|
||||
else _= _ right(format(x.r.c, w, f), w + f + length(.))
|
||||
end /*c*/; say _
|
||||
end /*r*/; return
|
||||
|
|
@ -0,0 +1,14 @@
|
|||
#lang racket
|
||||
|
||||
(require math/matrix
|
||||
math/array)
|
||||
|
||||
(define (inverse M)
|
||||
(define dim (square-matrix-size M))
|
||||
(define MI (matrix-augment (list M (identity-matrix dim))))
|
||||
(submatrix (matrix-row-echelon MI #t #t) (::) (:: dim #f)))
|
||||
|
||||
(define A (matrix [[1 2 3] [4 1 6] [7 8 9]]))
|
||||
|
||||
(inverse A)
|
||||
(matrix-inverse A)
|
||||
|
|
@ -0,0 +1,67 @@
|
|||
sub gauss-jordan-invert (@m where &is-square) {
|
||||
^@m .map: { @m[$_].append: identity(+@m)[$_] };
|
||||
@m.&rref[*]»[+@m .. *];
|
||||
}
|
||||
|
||||
sub is-square (@m) { so @m == all @m[*] }
|
||||
|
||||
sub identity ($n) { [ 1, |(0 xx $n-1) ], *.rotate(-1).Array ... *.tail }
|
||||
|
||||
# reduced row echelon form (from 'Gauss-Jordan elimination' task)
|
||||
sub rref (@m) {
|
||||
my ($lead, $rows, $cols) = 0, @m, @m[0];
|
||||
|
||||
for ^$rows -> $r {
|
||||
$lead < $cols or return @m;
|
||||
my $i = $r;
|
||||
until @m[$i;$lead] {
|
||||
++$i == $rows or next;
|
||||
$i = $r;
|
||||
++$lead == $cols and return @m;
|
||||
}
|
||||
@m[$i, $r] = @m[$r, $i] if $r != $i;
|
||||
@m[$r] »/=» $ = @m[$r;$lead];
|
||||
for ^$rows -> $n {
|
||||
next if $n == $r;
|
||||
@m[$n] »-=» @m[$r] »×» (@m[$n;$lead] // 0);
|
||||
}
|
||||
++$lead;
|
||||
}
|
||||
@m
|
||||
}
|
||||
sub rat-or-int ($num) {
|
||||
return $num unless $num ~~ Rat|FatRat;
|
||||
return $num.narrow if $num.narrow ~~ Int;
|
||||
$num.nude.join: '/';
|
||||
}
|
||||
|
||||
sub say_it ($message, @array) {
|
||||
my $max;
|
||||
@array.map: {$max max= max $_».&rat-or-int.comb(/\S+/)».chars};
|
||||
say "\n$message";
|
||||
$_».&rat-or-int.fmt(" %{$max}s").put for @array;
|
||||
}
|
||||
|
||||
multi to-matrix ($str) { [$str.split(';').map(*.words.Array)] }
|
||||
multi to-matrix (@array) { @array }
|
||||
|
||||
sub hilbert-matrix ($h) {
|
||||
[ (1..$h).map( -> $n { [ ($n ..^ $n + $h).map: { (1/$_).FatRat } ] } ) ]
|
||||
}
|
||||
|
||||
my @tests =
|
||||
'1 2 3; 4 1 6; 7 8 9',
|
||||
'2 -1 0; -1 2 -1; 0 -1 2',
|
||||
'-1 -2 3 2; -4 -1 6 2; 7 -8 9 1; 1 -2 1 3',
|
||||
'1 2 3 4; 5 6 7 8; 9 33 11 12; 13 14 15 17',
|
||||
'3 1 8 9 6; 6 2 8 10 1; 5 7 2 10 3; 3 2 7 7 9; 3 5 6 1 1',
|
||||
|
||||
# Test with a Hilbert matrix
|
||||
hilbert-matrix 10;
|
||||
|
||||
@tests.map: {
|
||||
my @matrix = .&to-matrix;
|
||||
say_it( " {'=' x 20} Original Matrix: {'=' x 20}", @matrix );
|
||||
say_it( ' Gauss-Jordan Inverted:', my @invert = gauss-jordan-invert @matrix );
|
||||
say_it( ' Re-inverted:', gauss-jordan-invert @invert».Array );
|
||||
}
|
||||
|
|
@ -0,0 +1,8 @@
|
|||
require 'matrix'
|
||||
|
||||
m = Matrix[[-1, -2, 3, 2],
|
||||
[-4, -1, 6, 2],
|
||||
[ 7, -8, 9, 1],
|
||||
[ 1, -2, 1, 3]]
|
||||
|
||||
pp m.inv.row_vectors
|
||||
|
|
@ -0,0 +1,113 @@
|
|||
fn main() {
|
||||
let mut a: Vec<Vec<f64>> = vec![vec![1.0, 2.0, 3.0],
|
||||
vec![4.0, 1.0, 6.0],
|
||||
vec![7.0, 8.0, 9.0]
|
||||
];
|
||||
let mut b: Vec<Vec<f64>> = vec![vec![2.0, -1.0, 0.0],
|
||||
vec![-1.0, 2.0, -1.0],
|
||||
vec![0.0, -1.0, 2.0]
|
||||
];
|
||||
|
||||
let mut ref_a = &mut a;
|
||||
let rref_a = &mut ref_a;
|
||||
let mut ref_b = &mut b;
|
||||
let rref_b = &mut ref_b;
|
||||
|
||||
println!("Matrix A:\n");
|
||||
print_matrix(rref_a);
|
||||
println!("\nInverse of Matrix A:\n");
|
||||
print_matrix(&mut matrix_inverse(rref_a));
|
||||
println!("\n\nMatrix B:\n");
|
||||
print_matrix(rref_b);
|
||||
println!("\nInverse of Matrix B:\n");
|
||||
print_matrix(&mut matrix_inverse(rref_b));
|
||||
}
|
||||
|
||||
//Begin Matrix Inversion
|
||||
fn matrix_inverse(matrix: &mut Vec<Vec<f64>>) -> Vec<Vec<f64>>{
|
||||
let len = matrix.len();
|
||||
let mut aug = zero_matrix(len, len * 2);
|
||||
for i in 0..len {
|
||||
for j in 0.. len {
|
||||
aug[i][j] = matrix[i][j];
|
||||
}
|
||||
aug[i][i + len] = 1.0;
|
||||
}
|
||||
|
||||
gauss_jordan_general(&mut aug);
|
||||
|
||||
|
||||
let mut unaug = zero_matrix(len, len);
|
||||
for i in 0..len {
|
||||
for j in 0..len {
|
||||
unaug[i][j] = aug[i][j+len];
|
||||
}
|
||||
}
|
||||
unaug
|
||||
}
|
||||
//End Matrix Inversion
|
||||
|
||||
//Begin Generalised Reduced Row Echelon Form
|
||||
fn gauss_jordan_general(matrix: &mut Vec<Vec<f64>>) {
|
||||
let mut lead = 0;
|
||||
let row_count = matrix.len();
|
||||
let col_count = matrix[0].len();
|
||||
|
||||
for r in 0..row_count {
|
||||
if col_count <= lead {
|
||||
break;
|
||||
}
|
||||
let mut i = r;
|
||||
while matrix[i][lead] == 0.0 {
|
||||
i = i + 1;
|
||||
if row_count == i {
|
||||
i = r;
|
||||
lead = lead + 1;
|
||||
if col_count == lead {
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
let temp = matrix[i].to_owned();
|
||||
matrix[i] = matrix[r].to_owned();
|
||||
matrix[r] = temp.to_owned();
|
||||
|
||||
if matrix[r][lead] != 0.0 {
|
||||
let div = matrix[r][lead];
|
||||
for j in 0..col_count {
|
||||
matrix[r][j] = matrix[r][j] / div;
|
||||
}
|
||||
}
|
||||
|
||||
for k in 0..row_count {
|
||||
if k != r {
|
||||
let mult = matrix[k][lead];
|
||||
for j in 0..col_count {
|
||||
matrix[k][j] = matrix[k][j] - matrix[r][j] * mult;
|
||||
}
|
||||
}
|
||||
}
|
||||
lead = lead + 1;
|
||||
|
||||
}
|
||||
//matrix.to_owned()
|
||||
}
|
||||
|
||||
fn zero_matrix(rows: usize, cols: usize) -> Vec<Vec<f64>> {
|
||||
let mut matrix = Vec::with_capacity(cols);
|
||||
for _ in 0..rows {
|
||||
let mut col: Vec<f64> = Vec::with_capacity(rows);
|
||||
for _ in 0..cols {
|
||||
col.push(0.0);
|
||||
}
|
||||
matrix.push(col);
|
||||
}
|
||||
matrix
|
||||
}
|
||||
|
||||
fn print_matrix(mat: &mut Vec<Vec<f64>>) {
|
||||
for row in 0..mat.len(){
|
||||
println!("{:?}", mat[row]);
|
||||
}
|
||||
}
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
func gauss_jordan_invert (M) {
|
||||
|
||||
var I = M.len.of {|i|
|
||||
M.len.of {|j|
|
||||
i == j ? 1 : 0
|
||||
}
|
||||
}
|
||||
|
||||
var A = gather {
|
||||
^M -> each {|i| take(M[i] + I[i]) }
|
||||
}
|
||||
|
||||
rref(A).map { .last(M.len) }
|
||||
}
|
||||
|
||||
var A = [
|
||||
[-1, -2, 3, 2],
|
||||
[-4, -1, 6, 2],
|
||||
[ 7, -8, 9, 1],
|
||||
[ 1, -2, 1, 3],
|
||||
]
|
||||
|
||||
say gauss_jordan_invert(A).map {
|
||||
.map { "%6s" % .as_rat }.join(" ")
|
||||
}.join("\n")
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
Private Function inverse(mat As Variant) As Variant
|
||||
Dim len_ As Integer: len_ = UBound(mat)
|
||||
Dim tmp() As Variant
|
||||
ReDim tmp(2 * len_ + 1)
|
||||
Dim aug As Variant
|
||||
ReDim aug(len_)
|
||||
For i = 0 To len_
|
||||
If UBound(mat(i)) <> len_ Then Debug.Print 9 / 0 '-- "Not a square matrix"
|
||||
aug(i) = tmp
|
||||
For j = 0 To len_
|
||||
aug(i)(j) = mat(i)(j)
|
||||
Next j
|
||||
'-- augment by identity matrix to right
|
||||
aug(i)(i + len_ + 1) = 1
|
||||
Next i
|
||||
aug = ToReducedRowEchelonForm(aug)
|
||||
Dim inv As Variant
|
||||
inv = mat
|
||||
'-- remove identity matrix to left
|
||||
For i = 0 To len_
|
||||
For j = len_ + 1 To 2 * len_ + 1
|
||||
inv(i)(j - len_ - 1) = aug(i)(j)
|
||||
Next j
|
||||
Next i
|
||||
inverse = inv
|
||||
End Function
|
||||
|
||||
Public Sub main()
|
||||
Dim test As Variant
|
||||
test = inverse(Array( _
|
||||
Array(2, -1, 0), _
|
||||
Array(-1, 2, -1), _
|
||||
Array(0, -1, 2)))
|
||||
For i = LBound(test) To UBound(test)
|
||||
For j = LBound(test(0)) To UBound(test(0))
|
||||
Debug.Print test(i)(j),
|
||||
Next j
|
||||
Debug.Print
|
||||
Next i
|
||||
End Sub
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
' Gauss-Jordan matrix inversion - VBScript - 22/01/2021
|
||||
Option Explicit
|
||||
|
||||
Function rref(m)
|
||||
Dim r, c, i, n, div, wrk
|
||||
n=UBound(m)
|
||||
For r = 1 To n 'row
|
||||
div = m(r,r)
|
||||
If div <> 0 Then
|
||||
For c = 1 To n*2 'col
|
||||
m(r,c) = m(r,c) / div
|
||||
Next 'c
|
||||
Else
|
||||
WScript.Echo "inversion impossible!"
|
||||
WScript.Quit
|
||||
End If
|
||||
For i = 1 To n 'row
|
||||
If i <> r Then
|
||||
wrk = m(i,r)
|
||||
For c = 1 To n*2
|
||||
m(i,c) = m(i,c) - wrk * m(r,c)
|
||||
Next' c
|
||||
End If
|
||||
Next 'i
|
||||
Next 'r
|
||||
rref = m
|
||||
End Function 'rref
|
||||
|
||||
Function inverse(mat)
|
||||
Dim i, j, aug, inv, n
|
||||
n = UBound(mat)
|
||||
ReDim inv(n,n), aug(n,2*n)
|
||||
For i = 1 To n
|
||||
For j = 1 To n
|
||||
aug(i,j) = mat(i,j)
|
||||
Next 'j
|
||||
aug(i,i+n) = 1
|
||||
Next 'i
|
||||
aug = rref(aug)
|
||||
For i = 1 To n
|
||||
For j = n+1 To 2*n
|
||||
inv(i,j-n) = aug(i,j)
|
||||
Next 'j
|
||||
Next 'i
|
||||
inverse = inv
|
||||
End Function 'inverse
|
||||
|
||||
Sub wload(m)
|
||||
Dim i, j, k
|
||||
k = -1
|
||||
For i = 1 To n
|
||||
For j = 1 To n
|
||||
k = k + 1
|
||||
m(i,j) = w(k)
|
||||
Next 'j
|
||||
Next 'i
|
||||
End Sub 'wload
|
||||
|
||||
Sub show(c, m, t)
|
||||
Dim i, j, buf
|
||||
buf = "Matrix " & c &"=" & vbCrlf & vbCrlf
|
||||
For i = 1 To n
|
||||
For j = 1 To n
|
||||
If t="fixed" Then
|
||||
buf = buf & FormatNumber(m(i,j),6,,,0) & " "
|
||||
Else
|
||||
buf = buf & m(i,j) & " "
|
||||
End If
|
||||
Next 'j
|
||||
buf=buf & vbCrlf
|
||||
Next 'i
|
||||
WScript.Echo buf
|
||||
End Sub 'show
|
||||
|
||||
Dim n, a, b, c, w
|
||||
w = Array( _
|
||||
2, 1, 1, 4, _
|
||||
0, -1, 0, -1, _
|
||||
1, 0, -2, 4, _
|
||||
4, 1, 2, 2)
|
||||
n=Sqr(UBound(w)+1)
|
||||
ReDim a(n,n), b(n,n), c(n,n)
|
||||
wload a
|
||||
show "a", a, "simple"
|
||||
b = inverse(a)
|
||||
show "b", b, "fixed"
|
||||
c = inverse(b)
|
||||
show "c", c, "fixed"
|
||||
|
|
@ -0,0 +1,26 @@
|
|||
import "/matrix" for Matrix
|
||||
import "/fmt" for Fmt
|
||||
|
||||
var arrays = [
|
||||
[ [ 1, 2, 3],
|
||||
[ 4, 1, 6],
|
||||
[ 7, 8, 9] ],
|
||||
|
||||
[ [ 2, -1, 0 ],
|
||||
[-1, 2, -1 ],
|
||||
[ 0, -1, 2 ] ],
|
||||
|
||||
[ [ -1, -2, 3, 2 ],
|
||||
[ -4, -1, 6, 2 ],
|
||||
[ 7, -8, 9, 1 ],
|
||||
[ 1, -2, 1, 3 ] ]
|
||||
]
|
||||
|
||||
for (array in arrays) {
|
||||
System.print("Original:\n")
|
||||
var m = Matrix.new(array)
|
||||
Fmt.mprint(m, 2, 0)
|
||||
System.print("\nInverse:\n")
|
||||
Fmt.mprint(m.inverse, 9, 6)
|
||||
System.print()
|
||||
}
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
var [const] GSL=Import.lib("zklGSL"); // libGSL (GNU Scientific Library)
|
||||
m:=GSL.Matrix(3,3).set(1,2,3, 4,1,6, 7,8,9);
|
||||
i:=m.invert();
|
||||
i.format(10,4).println("\n");
|
||||
(m*i).format(10,4).println();
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
m:=GSL.Matrix(3,3).set(2,-1,0, -1,2,-1, 0,-1,2);
|
||||
m.invert().format(10,4).println("\n");
|
||||
Loading…
Add table
Add a link
Reference in a new issue