Data update
This commit is contained in:
Ingy döt Net
parent
5150844a7d
commit
4bb20c9b71
7735 changed files with 38060 additions and 199180 deletions
|
|
@ -61,5 +61,5 @@ for my $matrix (@tests) {
|
|||
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"
|
||||
print "After round-trip:\n" . display(\@rt) . "\n";
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,51 +0,0 @@
|
|||
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
|
||||
|
|
@ -1,35 +1,64 @@
|
|||
/*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
|
||||
/*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 'M','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 matrix. */
|
||||
Exit /*stick a fork in it, we're all done. */
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
aux:
|
||||
x.=0
|
||||
Do i=1 To n
|
||||
x.i.i=1
|
||||
End
|
||||
Return
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
build: /*set m.r.c from data */
|
||||
Arg n
|
||||
k=0
|
||||
w=0 /*W: max width of a number*/
|
||||
Do r=1 To n /*loop over rows */
|
||||
Do c=1 To n /*loop over columns */
|
||||
k=k+1
|
||||
m.r.c=word(data,k)
|
||||
w=max(w,length(m.r.c))
|
||||
End /*c*/
|
||||
End /*r*/
|
||||
Return
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
invert:
|
||||
Do k=1 To n
|
||||
t=m.k.k /*divide each matrix row by T */
|
||||
Do c=1 To n
|
||||
m.k.c=m.k.c/t /*process row of original matrix.*/
|
||||
x.k.c=x.k.c/t /* ' ' ' auxiliary ' */
|
||||
End /*c*/
|
||||
Do r=1 To n
|
||||
If r<>k Then Do /*skip if R is the same row as K.*/
|
||||
t=m.r.k
|
||||
Do c=1 To n
|
||||
m.r.c=m.r.c-t*m.k.c /*process row of original matrix.*/
|
||||
x.r.c=x.r.c-t*x.k.c /* ' ' ' auxiliary ' */
|
||||
End /*c*/
|
||||
End
|
||||
End /*r*/
|
||||
End /*k*/
|
||||
Return
|
||||
/*-----------------------------------------------------------------------------------*/
|
||||
show:
|
||||
Parse Arg which,title
|
||||
Say
|
||||
Say title
|
||||
f=4 /*F: fractional digits precision.*/
|
||||
Do r=1 To n
|
||||
line=''
|
||||
Do c=1 To n
|
||||
If which=='M' Then
|
||||
line=line right(m.r.c,w)
|
||||
Else
|
||||
line=line right(format(x.r.c,w,f),w+f+1)
|
||||
End /*c*/
|
||||
Say line
|
||||
End /*r*/
|
||||
Return
|
||||
|
|
|
|||
|
|
@ -1,88 +0,0 @@
|
|||
' 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"
|
||||
Loading…
Add table
Add a link
Reference in a new issue