June 2018 Update
This commit is contained in:
Ingy döt Net
parent
ba8067c3b7
commit
22f33d4004
5278 changed files with 84726 additions and 14379 deletions
|
|
@ -1 +1,9 @@
|
|||
Problem: Solve Ax=b using Gaussian elimination then backwards substitution. A being an n by n matrix. Also, x and b are n by 1 vectors. To improve accuracy, please use partial pivoting and scaling.
|
||||
;Task:
|
||||
Solve '''Ax=b''' using Gaussian elimination then backwards substitution.
|
||||
|
||||
'''A''' being an '''n''' by '''n''' matrix.
|
||||
|
||||
Also, '''x''' and '''b''' are '''n''' by '''1''' vectors.
|
||||
|
||||
To improve accuracy, please use partial pivoting and scaling.
|
||||
<br><br>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,61 @@
|
|||
Sub GaussJordan(matrix() As Double,rhs() As Double,ans() As Double)
|
||||
Dim As Long n=Ubound(matrix,1)
|
||||
Redim ans(0):Redim ans(1 To n)
|
||||
Dim As Double b(1 To n,1 To n),r(1 To n)
|
||||
For c As Long=1 To n 'take copies
|
||||
r(c)=rhs(c)
|
||||
For d As Long=1 To n
|
||||
b(c,d)=matrix(c,d)
|
||||
Next d
|
||||
Next c
|
||||
#macro pivot(num)
|
||||
For p1 As Long = num To n - 1
|
||||
For p2 As Long = p1 + 1 To n
|
||||
If Abs(b(p1,num))<Abs(b(p2,num)) Then
|
||||
Swap r(p1),r(p2)
|
||||
For g As Long=1 To n
|
||||
Swap b(p1,g),b(p2,g)
|
||||
Next g
|
||||
End If
|
||||
Next p2
|
||||
Next p1
|
||||
#endmacro
|
||||
|
||||
For k As Long=1 To n-1
|
||||
pivot(k) 'full pivoting
|
||||
For row As Long =k To n-1
|
||||
If b(row+1,k)=0 Then Exit For
|
||||
Var f=b(k,k)/b(row+1,k)
|
||||
r(row+1)=r(row+1)*f-r(k)
|
||||
For g As Long=1 To n
|
||||
b((row+1),g)=b((row+1),g)*f-b(k,g)
|
||||
Next g
|
||||
Next row
|
||||
Next k
|
||||
'back substitute
|
||||
For z As Long=n To 1 Step -1
|
||||
ans(z)=r(z)/b(z,z)
|
||||
For j As Long = n To z+1 Step -1
|
||||
ans(z)=ans(z)-(b(z,j)*ans(j)/b(z,z))
|
||||
Next j
|
||||
Next z
|
||||
End Sub
|
||||
|
||||
dim as double a(1 to 6,1 to 6) = { _
|
||||
{1.00, 0.00, 0.00, 0.00, 0.00, 0.00}, _
|
||||
{1.00, 0.63, 0.39, 0.25, 0.16, 0.10}, _
|
||||
{1.00, 1.26, 1.58, 1.98, 2.49, 3.13}, _
|
||||
{1.00, 1.88, 3.55, 6.70, 12.62, 23.80}, _
|
||||
{1.00, 2.51, 6.32, 15.88, 39.90, 100.28}, _
|
||||
{1.00, 3.14, 9.87, 31.01, 97.41, 306.02} _
|
||||
}
|
||||
|
||||
dim as double b(1 to 6) = { -0.01, 0.61, 0.91, 0.99, 0.60, 0.02 }
|
||||
|
||||
redim as double result()
|
||||
GaussJordan(a(),b(),result())
|
||||
|
||||
for n as long=lbound(result) to ubound(result)
|
||||
print result(n)
|
||||
next n
|
||||
sleep
|
||||
94
Task/Gaussian-elimination/Go/gaussian-elimination-2.go
Normal file
94
Task/Gaussian-elimination/Go/gaussian-elimination-2.go
Normal file
|
|
@ -0,0 +1,94 @@
|
|||
package main
|
||||
|
||||
import (
|
||||
"errors"
|
||||
"fmt"
|
||||
"log"
|
||||
"math"
|
||||
)
|
||||
|
||||
type testCase struct {
|
||||
a [][]float64
|
||||
b []float64
|
||||
x []float64
|
||||
}
|
||||
|
||||
var tc = testCase{
|
||||
a: [][]float64{
|
||||
{1.00, 0.00, 0.00, 0.00, 0.00, 0.00},
|
||||
{1.00, 0.63, 0.39, 0.25, 0.16, 0.10},
|
||||
{1.00, 1.26, 1.58, 1.98, 2.49, 3.13},
|
||||
{1.00, 1.88, 3.55, 6.70, 12.62, 23.80},
|
||||
{1.00, 2.51, 6.32, 15.88, 39.90, 100.28},
|
||||
{1.00, 3.14, 9.87, 31.01, 97.41, 306.02}},
|
||||
b: []float64{-0.01, 0.61, 0.91, 0.99, 0.60, 0.02},
|
||||
x: []float64{-0.01, 1.602790394502114, -1.6132030599055613,
|
||||
1.2454941213714368, -0.4909897195846576, 0.065760696175232},
|
||||
}
|
||||
|
||||
// result from above test case turns out to be correct to this tolerance.
|
||||
const ε = 1e-14
|
||||
|
||||
func main() {
|
||||
x, err := GaussPartial(tc.a, tc.b)
|
||||
if err != nil {
|
||||
log.Fatal(err)
|
||||
}
|
||||
fmt.Println(x)
|
||||
for i, xi := range x {
|
||||
if math.Abs(tc.x[i]-xi) > ε {
|
||||
log.Println("out of tolerance")
|
||||
log.Fatal("expected", tc.x)
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
func GaussPartial(a0 [][]float64, b0 []float64) ([]float64, error) {
|
||||
m := len(b0)
|
||||
a := make([][]float64, m)
|
||||
for i, ai := range a0 {
|
||||
row := make([]float64, m+1)
|
||||
copy(row, ai)
|
||||
row[m] = b0[i]
|
||||
a[i] = row
|
||||
}
|
||||
for k := range a {
|
||||
iMax := 0
|
||||
max := -1.
|
||||
for i := k; i < m; i++ {
|
||||
row := a[i]
|
||||
// compute scale factor s = max abs in row
|
||||
s := -1.
|
||||
for j := k; j < m; j++ {
|
||||
x := math.Abs(row[j])
|
||||
if x > s {
|
||||
s = x
|
||||
}
|
||||
}
|
||||
// scale the abs used to pick the pivot.
|
||||
if abs := math.Abs(row[k]) / s; abs > max {
|
||||
iMax = i
|
||||
max = abs
|
||||
}
|
||||
}
|
||||
if a[iMax][k] == 0 {
|
||||
return nil, errors.New("singular")
|
||||
}
|
||||
a[k], a[iMax] = a[iMax], a[k]
|
||||
for i := k + 1; i < m; i++ {
|
||||
for j := k + 1; j <= m; j++ {
|
||||
a[i][j] -= a[k][j] * (a[i][k] / a[k][k])
|
||||
}
|
||||
a[i][k] = 0
|
||||
}
|
||||
}
|
||||
x := make([]float64, m)
|
||||
for i := m - 1; i >= 0; i-- {
|
||||
x[i] = a[i][m]
|
||||
for j := i + 1; j < m; j++ {
|
||||
x[i] -= a[i][j] * x[j]
|
||||
}
|
||||
x[i] /= a[i][i]
|
||||
}
|
||||
return x, nil
|
||||
}
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
elim::{[h m];h::*m::x@>*'x;
|
||||
:[2>#x;x;(,h),0,:\.f({1_x}'{x-h**x%*h}'1_m)]}
|
||||
subst::{[v];v::[];
|
||||
{v::v,((*x)-/:[[]~v;[];v*x@1+!#v])%x@1+#v}'||'x;|v}
|
||||
gauss::{subst(elim(x))}
|
||||
12
Task/Gaussian-elimination/Klong/gaussian-elimination-2.klong
Normal file
12
Task/Gaussian-elimination/Klong/gaussian-elimination-2.klong
Normal file
|
|
@ -0,0 +1,12 @@
|
|||
gauss([[1.00 0.00 0.00 0.00 0.00 0.00 -0.01]
|
||||
[1.00 0.63 0.39 0.25 0.16 0.10 0.61]
|
||||
[1.00 1.26 1.58 1.98 2.49 3.13 0.91]
|
||||
[1.00 1.88 3.55 6.70 12.62 23.80 0.99]
|
||||
[1.00 2.51 6.32 15.88 39.90 100.28 0.60]
|
||||
[1.00 3.14 9.87 31.01 97.41 306.02 0.02]]
|
||||
[-0.00999999999999981
|
||||
1.60279039450211414
|
||||
-1.6132030599055625
|
||||
1.24549412137143782
|
||||
-0.490989719584658025
|
||||
0.0657606961752320591]
|
||||
81
Task/Gaussian-elimination/Kotlin/gaussian-elimination.kotlin
Normal file
81
Task/Gaussian-elimination/Kotlin/gaussian-elimination.kotlin
Normal file
|
|
@ -0,0 +1,81 @@
|
|||
// version 1.1.51
|
||||
|
||||
val ta = arrayOf(
|
||||
doubleArrayOf(1.00, 0.00, 0.00, 0.00, 0.00, 0.00),
|
||||
doubleArrayOf(1.00, 0.63, 0.39, 0.25, 0.16, 0.10),
|
||||
doubleArrayOf(1.00, 1.26, 1.58, 1.98, 2.49, 3.13),
|
||||
doubleArrayOf(1.00, 1.88, 3.55, 6.70, 12.62, 23.80),
|
||||
doubleArrayOf(1.00, 2.51, 6.32, 15.88, 39.90, 100.28),
|
||||
doubleArrayOf(1.00, 3.14, 9.87, 31.01, 97.41, 306.02)
|
||||
)
|
||||
|
||||
val tb = doubleArrayOf(-0.01, 0.61, 0.91, 0.99, 0.60, 0.02)
|
||||
|
||||
val tx = doubleArrayOf(
|
||||
-0.01, 1.602790394502114, -1.6132030599055613,
|
||||
1.2454941213714368, -0.4909897195846576, 0.065760696175232
|
||||
)
|
||||
|
||||
const val EPSILON = 1e-14 // tolerance required
|
||||
|
||||
fun gaussPartial(a0: Array<DoubleArray>, b0: DoubleArray): DoubleArray {
|
||||
val m = b0.size
|
||||
val a = Array(m) { DoubleArray(m) }
|
||||
for ((i, ai) in a0.withIndex()) {
|
||||
val row = ai.copyOf(m + 1)
|
||||
row[m] = b0[i]
|
||||
a[i] = row
|
||||
}
|
||||
for (k in 0 until a.size) {
|
||||
var iMax = 0
|
||||
var max = -1.0
|
||||
for (i in k until m) {
|
||||
val row = a[i]
|
||||
// compute scale factor s = max abs in row
|
||||
var s = -1.0
|
||||
for (j in k until m) {
|
||||
val e = Math.abs(row[j])
|
||||
if (e > s) s = e
|
||||
}
|
||||
// scale the abs used to pick the pivot
|
||||
val abs = Math.abs(row[k]) / s
|
||||
if (abs > max) {
|
||||
iMax = i
|
||||
max = abs
|
||||
}
|
||||
}
|
||||
if (a[iMax][k] == 0.0) {
|
||||
throw RuntimeException("Matrix is singular.")
|
||||
}
|
||||
val tmp = a[k]
|
||||
a[k] = a[iMax]
|
||||
a[iMax] = tmp
|
||||
for (i in k + 1 until m) {
|
||||
for (j in k + 1..m) {
|
||||
a[i][j] -= a[k][j] * a[i][k] / a[k][k]
|
||||
}
|
||||
a[i][k] = 0.0
|
||||
}
|
||||
}
|
||||
val x = DoubleArray(m)
|
||||
for (i in m - 1 downTo 0) {
|
||||
x[i] = a[i][m]
|
||||
for (j in i + 1 until m) {
|
||||
x[i] -= a[i][j] * x[j]
|
||||
}
|
||||
x[i] /= a[i][i]
|
||||
}
|
||||
return x
|
||||
}
|
||||
|
||||
fun main(args: Array<String>) {
|
||||
val x = gaussPartial(ta, tb)
|
||||
println(x.asList())
|
||||
for ((i, xi) in x.withIndex()) {
|
||||
if (Math.abs(tx[i] - xi) > EPSILON) {
|
||||
println("Out of tolerance.")
|
||||
println("Expected values are ${tx.asList()}")
|
||||
return
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -1,54 +1,57 @@
|
|||
sub mat_elem(@a, $y, $x, $n) is rw { @a[ $y * $n + $x ] }
|
||||
sub swap_row(@a, @b, $r1, $r2, $n) {
|
||||
return if $r1 == $r2;
|
||||
for ^$n -> $i {
|
||||
(
|
||||
mat_elem(@a, $r1, $i, $n),
|
||||
mat_elem(@a, $r2, $i, $n)
|
||||
).=reverse;
|
||||
}
|
||||
@b[$r1, $r2].=reverse;
|
||||
sub gauss-jordan-solve (@a, @b) {
|
||||
@b.kv.map: { @a[$^k].append: $^v };
|
||||
@a.&rref[*]»[*-1];
|
||||
}
|
||||
|
||||
sub gauss_eliminate(@a, @b, $n) {
|
||||
sub A($y, $x) is rw { mat_elem(@a, $y, $x, $n) }
|
||||
my ($i, $j, $col, $row, $max_row, $dia);
|
||||
my ($max, $tmp);
|
||||
for ^$n -> $dia {
|
||||
for $dia ^..^ $n -> $row {
|
||||
swap_row @a, @b, $dia,
|
||||
max(:by({ abs(A($_, $dia)) }), $dia ^..^ $n),
|
||||
$n;
|
||||
$tmp = A($row, $dia) / A($dia, $dia);
|
||||
for $dia ^..^ $n -> $col {
|
||||
A($row, $col) -= $tmp * A($dia, $col);
|
||||
}
|
||||
A($row, $dia) = 0;
|
||||
@b[$row] -= $tmp * @b[$dia];
|
||||
}
|
||||
# reduced row echelon form (Gauss-Jordan elimination)
|
||||
sub rref (@m) {
|
||||
return unless @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;
|
||||
my $lv = @m[$r;$lead];
|
||||
@m[$r] »/=» $lv;
|
||||
for ^$rows -> $n {
|
||||
next if $n == $r;
|
||||
@m[$n] »-=» @m[$r] »*» (@m[$n;$lead] // 0);
|
||||
}
|
||||
++$lead;
|
||||
}
|
||||
my @x;
|
||||
for $n - 1, $n - 2 ... 0 -> $row {
|
||||
$tmp = @b[$row];
|
||||
for $n - 1, $n - 2 ...^ $row -> $j {
|
||||
$tmp -= @x[$j] * A($row, $j);
|
||||
}
|
||||
@x[$row] = $tmp / A($row, $row);
|
||||
}
|
||||
return @x;
|
||||
@m
|
||||
}
|
||||
|
||||
sub MAIN {
|
||||
my @a = <
|
||||
1.00 0.00 0.00 0.00 0.00 0.00
|
||||
1.00 0.63 0.39 0.25 0.16 0.10
|
||||
1.00 1.26 1.58 1.98 2.49 3.13
|
||||
1.00 1.88 3.55 6.70 12.62 23.80
|
||||
1.00 2.51 6.32 15.88 39.90 100.28
|
||||
1.00 3.14 9.87 31.01 97.41 306.02
|
||||
>;
|
||||
my @b = <
|
||||
-0.01 0.61 0.91 0.99 0.60 0.02
|
||||
>;
|
||||
.say for gauss_eliminate(@a, @b, 6);
|
||||
sub rat-or-int ($num) {
|
||||
return $num unless $num ~~ Rat;
|
||||
return $num.narrow if $num.narrow.WHAT ~~ Int;
|
||||
$num.nude.join: '/';
|
||||
}
|
||||
|
||||
sub say-it ($message, @array, $fmt = " %8s") {
|
||||
say "\n$message";
|
||||
$_».&rat-or-int.fmt($fmt).put for @array;
|
||||
}
|
||||
|
||||
my @a = (
|
||||
[ 1.00, 0.00, 0.00, 0.00, 0.00, 0.00 ],
|
||||
[ 1.00, 0.63, 0.39, 0.25, 0.16, 0.10 ],
|
||||
[ 1.00, 1.26, 1.58, 1.98, 2.49, 3.13 ],
|
||||
[ 1.00, 1.88, 3.55, 6.70, 12.62, 23.80 ],
|
||||
[ 1.00, 2.51, 6.32, 15.88, 39.90, 100.28 ],
|
||||
[ 1.00, 3.14, 9.87, 31.01, 97.41, 306.02 ],
|
||||
);
|
||||
my @b = ( -0.01, 0.61, 0.91, 0.99, 0.60, 0.02 );
|
||||
|
||||
say-it 'A matrix:', @a, "%6.2f";
|
||||
say-it 'or, A in exact rationals:', @a;
|
||||
say-it 'B matrix:', @b, "%6.2f";
|
||||
say-it 'or, B in exact rationals:', @b;
|
||||
say-it 'x matrix:', (my @gj = gauss-jordan-solve @a, @b), "%16.12f";
|
||||
say-it 'or, x in exact rationals:', @gj, "%28s";
|
||||
|
|
|
|||
|
|
@ -1,33 +1,40 @@
|
|||
/*REXX program solves Ax=b with Gaussian elimination & backwards substitution.*/
|
||||
parse arg iFID .; if iFID=='' then iFID='GAUSS_E.DAT' /*¬given? Use default.*/
|
||||
numeric digits 200 /*use hefty precision.*/
|
||||
do rec=1 while lines(iFID)\==0 /*read equation sets. */
|
||||
#=0
|
||||
do $=1 while lines(iFID)\==0 /*process the equation*/
|
||||
z=linein(iFID); if z='' then leave /*Blank line? e─o─data*/
|
||||
if $==1 then do; say; say center(' equations ',75,'▒'); say; end
|
||||
say z /*show an equation. */
|
||||
if left(space(z),1)=='*' then iterate /*ignore any comments.*/
|
||||
#=#+1; n=words(z)-1 /*assign equation #s. */
|
||||
do e=1 for n; a.#.e=word(z,e); end /*e*/ /*process the A #s. */
|
||||
b.#=word(z,n+1) /* " " B #s. */
|
||||
end /*$*/
|
||||
if #\==0 then call Gauss_elimination /*compute,show results*/
|
||||
end /*rec*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*────────────────────────────────────────────────────────────────────────────*/
|
||||
Gauss_elimination: do j=1 for n; jp=j+1
|
||||
do i=jp to n; _=a.j.j/a.i.j
|
||||
do k=jp to n; a.i.k=a.j.k-_*a.i.k; end /*k*/
|
||||
b.i=b.j-_*b.i
|
||||
end /*i*/
|
||||
end /*j*/
|
||||
x.n=b.n/a.n.n
|
||||
do j=n-1 to 1 by -1; _=0
|
||||
do i=j+1 to n; _=_+a.j.i*x.i; end /*i*/
|
||||
x.j=(b.j-_)/a.j.j
|
||||
end /*j*/ /* [↑] uses backwards substitution. */
|
||||
numeric digits 8 /*for the display, only use 8 digits.*/
|
||||
say; say center('solution',75,'═'); say /*a title line for articulated output*/
|
||||
do o=1 for n; say right('x['o"] = ",38) left('',x.o>=0) x.o/1; end /*o*/
|
||||
return
|
||||
/*REXX program solves Ax=b with Gaussian elimination and backwards substitution. */
|
||||
parse arg iFID . /*obtain optional argument from the CL.*/
|
||||
numeric digits 1000 /*heavy─duty decimal digits precision. */
|
||||
if iFID=='' | iFID=="," then iFID= 'GAUSS_E.DAT' /*Not specified? Then use the default.*/
|
||||
do rec=1 while lines(iFID) \== 0 /*read the equation sets. */
|
||||
#=0 /*the number of equations (so far). */
|
||||
do $=1 while lines(iFID) \== 0 /*process the equation. */
|
||||
z=linein(iFID); if z='' then leave /*Is this a blank line? end─of─data.*/
|
||||
if $==1 then do; say; say center(' equations ', 75, "▓"); say
|
||||
end /* [↑] if 1st equation, then show hdr.*/
|
||||
say z /*display an equation to the terminal. */
|
||||
if left(space(z), 1)=='*' then iterate /*Is this a comment? Then ignore it.*/
|
||||
#=# + 1; n=words(z) - 1 /*assign equation #; calculate # items.*/
|
||||
do e=1 for n; a.#.e= word(z, e)
|
||||
end /*e*/ /* [↑] process A numbers. */
|
||||
b.#=word(z, n + 1) /* ◄─── " B " */
|
||||
end /*$*/
|
||||
if #\==0 then call Gauss_elim /*Not zero? Then display the results. */
|
||||
end /*rec*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Gauss_elim: do j=1 for n; jp=j + 1
|
||||
do i=jp to n; _=a.j.j / a.i.j
|
||||
do k=jp to n; a.i.k=a.j.k - _ * a.i.k
|
||||
end /*k*/
|
||||
b.i=b.j - _ * b.i
|
||||
end /*i*/
|
||||
end /*j*/
|
||||
x.n=b.n / a.n.n
|
||||
do j=n-1 to 1 by -1; _=0
|
||||
do i=j+1 to n; _=_ + a.j.i * x.i
|
||||
end /*i*/
|
||||
x.j=(b.j - _) / a.j.j
|
||||
end /*j*/ /* [↑] uses backwards substitution. */
|
||||
say
|
||||
numeric digits 8 /*for the display, only use 8 digits. */
|
||||
say center('solution', 75, "═"); say /*a title line for articulated output. */
|
||||
do o=1 for n; say right('x['o"] = ", 38) left('', x.o>=0) x.o/1
|
||||
end /*o*/
|
||||
return
|
||||
|
|
|
|||
48
Task/Gaussian-elimination/REXX/gaussian-elimination-3.rexx
Normal file
48
Task/Gaussian-elimination/REXX/gaussian-elimination-3.rexx
Normal file
|
|
@ -0,0 +1,48 @@
|
|||
/*REXX program solves Ax=b with Gaussian elimination and backwards substitution. */
|
||||
numeric digits 1000 /*heavy─duty decimal digits precision. */
|
||||
parse arg iFID . /*obtain optional argument from the CL.*/
|
||||
if iFID=='' | iFID=="," then iFID= 'GAUSS_E.DAT' /*Not specified? Then use the default.*/
|
||||
pad=left('', 23) /*used for indenting residual numbers. */
|
||||
do rec=1 while lines(iFID) \== 0 /*read the equation sets. */
|
||||
#=0 /*the number of equations (so far). */
|
||||
do $=1 while lines(iFID) \== 0 /*process the equation. */
|
||||
z=linein(iFID); if z='' then leave /*Is this a blank line? end─of─data.*/
|
||||
if $==1 then do; say; say center(' equations ', 75, "▓"); say
|
||||
end /* [↑] if 1st equation, then show hdr.*/
|
||||
say z /*display an equation to the terminal. */
|
||||
if left(space(z), 1)=='*' then iterate /*Is this a comment? Then ignore it.*/
|
||||
#=# + 1; n=words(z) - 1 /*assign equation #; calculate # items.*/
|
||||
do e=1 for n; a.#.e= word(z, e); oa.#.e= a.#.e
|
||||
end /*e*/ /* [↑] process A numbers; save orig.*/
|
||||
b.#=word(z, n + 1); ob.#=b.# /* ◄─── " B " " " */
|
||||
end /*$*/
|
||||
if #\==0 then call Gauss_elim /*Not zero? Then display the results. */
|
||||
say
|
||||
do i=1 for n; r=0 /*display the residuals to the terminal*/
|
||||
do j=1 for n; r=r + oa.i.j * x.j /* ┌───◄ don't display a fraction if */
|
||||
end /*j*/ /* ↓ res ≤ 5% of significant digs.*/
|
||||
r=format(r - ob.i, , digits() - digits() * 0.05 % 1 , 0) / 1 /*should be tiny*/
|
||||
say pad 'residual['right(i, length(n) )"] = " left('', r>=0) r /*right justify.*/
|
||||
end /*i*/
|
||||
end /*rec*/
|
||||
exit /*stick a fork in it, we're all done. */
|
||||
/*──────────────────────────────────────────────────────────────────────────────────────*/
|
||||
Gauss_elim: do j=1 for n; jp=j + 1
|
||||
do i=jp to n; _=a.j.j / a.i.j
|
||||
do k=jp to n; a.i.k=a.j.k - _ * a.i.k
|
||||
end /*k*/
|
||||
b.i=b.j - _ * b.i
|
||||
end /*i*/
|
||||
end /*j*/
|
||||
x.n=b.n / a.n.n
|
||||
do j=n-1 to 1 by -1; _=0
|
||||
do i=j+1 to n; _=_ + a.j.i * x.i
|
||||
end /*i*/
|
||||
x.j=(b.j - _) / a.j.j
|
||||
end /*j*/ /* [↑] uses backwards substitution. */
|
||||
say
|
||||
numeric digits 8 /*for the display, only use 8 digits. */
|
||||
say center('solution', 75, "═"); say /*a title line for articulated output. */
|
||||
do o=1 for n; say right('x['o"] = ", 38) left('', x.o>=0) x.o/1
|
||||
end /*o*/
|
||||
return
|
||||
|
|
@ -1,11 +1,22 @@
|
|||
var Matrix = require('Math::Matrix');
|
||||
func gauss_jordan_solve (a, b) {
|
||||
|
||||
var a = Matrix.new([0,1,0],
|
||||
[0,0,1],
|
||||
[2,0,1]);
|
||||
var A = gather {
|
||||
^b -> each {|i| take(a[i] + b[i]) }
|
||||
}
|
||||
|
||||
var b = Matrix.new([1],
|
||||
[2],
|
||||
[4]);
|
||||
rref(A).map{ .last }
|
||||
}
|
||||
|
||||
a.concat(b).solve.print;
|
||||
var a = [
|
||||
[ 1.00, 0.00, 0.00, 0.00, 0.00, 0.00 ],
|
||||
[ 1.00, 0.63, 0.39, 0.25, 0.16, 0.10 ],
|
||||
[ 1.00, 1.26, 1.58, 1.98, 2.49, 3.13 ],
|
||||
[ 1.00, 1.88, 3.55, 6.70, 12.62, 23.80 ],
|
||||
[ 1.00, 2.51, 6.32, 15.88, 39.90, 100.28 ],
|
||||
[ 1.00, 3.14, 9.87, 31.01, 97.41, 306.02 ],
|
||||
]
|
||||
|
||||
var b = [ -0.01, 0.61, 0.91, 0.99, 0.60, 0.02 ]
|
||||
|
||||
var G = gauss_jordan_solve(a, b)
|
||||
say G.map { "%27s" % .as_rat }.join("\n")
|
||||
|
|
|
|||
29
Task/Gaussian-elimination/Stata/gaussian-elimination-1.stata
Normal file
29
Task/Gaussian-elimination/Stata/gaussian-elimination-1.stata
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
void gauss(real matrix a, real matrix b, real scalar det) {
|
||||
real scalar i,j,n,s
|
||||
real vector js
|
||||
|
||||
det = 1
|
||||
n = rows(a)
|
||||
for (i=1; i<n; i++) {
|
||||
maxindex(abs(a[i::n,i]), 1, js=., .)
|
||||
j = js[1]+i-1
|
||||
if (j!=i) {
|
||||
a[(i\j),i..n] = a[(j\i),i..n]
|
||||
b[(i\j),.] = b[(j\i),.]
|
||||
det = -det
|
||||
}
|
||||
for (j=i+1; j<=n; j++) {
|
||||
s = a[j,i]/a[i,i]
|
||||
a[j,i+1..n] = a[j,i+1..n]-s*a[i,i+1..n]
|
||||
b[j,.] = b[j,.]-s*b[i,.]
|
||||
}
|
||||
}
|
||||
|
||||
for (i=n; i>=1; i--) {
|
||||
for (j=i+1; j<=n; j++) {
|
||||
b[i,.] = b[i,.]-a[i,j]*b[j,.]
|
||||
}
|
||||
b[i,.] = b[i,.]/a[i,i]
|
||||
det = det*a[i,i]
|
||||
}
|
||||
}
|
||||
43
Task/Gaussian-elimination/Stata/gaussian-elimination-2.stata
Normal file
43
Task/Gaussian-elimination/Stata/gaussian-elimination-2.stata
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
void ludec(real matrix a, real matrix l, real matrix u, real vector p) {
|
||||
real scalar i,j,n,s
|
||||
real vector js
|
||||
|
||||
l = a
|
||||
n = rows(a)
|
||||
p = 1::n
|
||||
for (i=1; i<n; i++) {
|
||||
maxindex(abs(l[i::n,i]), 1, js=., .)
|
||||
j = js[1]+i-1
|
||||
if (j!=i) {
|
||||
l[(i\j),.] = l[(j\i),.]
|
||||
p[(i\j)] = p[(j\i)]
|
||||
}
|
||||
for (j=i+1; j<=n; j++) {
|
||||
l[j,i] = s = l[j,i]/l[i,i]
|
||||
l[j,i+1..n] = l[j,i+1..n]-s*l[i,i+1..n]
|
||||
}
|
||||
}
|
||||
|
||||
u = uppertriangle(l)
|
||||
l = lowertriangle(l, 1)
|
||||
}
|
||||
|
||||
void luback(real matrix l, real matrix u, real vector p, real matrix y) {
|
||||
real scalar i,j,n
|
||||
|
||||
n = rows(y)
|
||||
y = y[p,.]
|
||||
for (i=1; i<=n; i++) {
|
||||
for (j=1; j<i; j++) {
|
||||
y[i,.] = y[i,.]-l[i,j]*y[j,.]
|
||||
}
|
||||
/*y[i,.] = y[i,.]/l[i,i]*/
|
||||
}
|
||||
|
||||
for (i=n; i>=1; i--) {
|
||||
for (j=i+1; j<=n; j++) {
|
||||
y[i,.] = y[i,.]-u[i,j]*y[j,.]
|
||||
}
|
||||
y[i,.] = y[i,.]/u[i,i]
|
||||
}
|
||||
}
|
||||
21
Task/Gaussian-elimination/Stata/gaussian-elimination-3.stata
Normal file
21
Task/Gaussian-elimination/Stata/gaussian-elimination-3.stata
Normal file
|
|
@ -0,0 +1,21 @@
|
|||
: gauss(a=(2,9,4\7,5,3\6,1,8),b=I(3),det=.)
|
||||
|
||||
: b
|
||||
1 2 3
|
||||
+----------------------------------------------+
|
||||
1 | -.1027777778 .1888888889 -.0194444444 |
|
||||
2 | .1055555556 .0222222222 -.0611111111 |
|
||||
3 | .0638888889 -.1444444444 .1472222222 |
|
||||
+----------------------------------------------+
|
||||
|
||||
: ludec(a=(2,9,4\7,5,3\6,1,8),l=.,u=.,p=.)
|
||||
|
||||
: luback(l,u,p,y=I(3))
|
||||
|
||||
: y
|
||||
1 2 3
|
||||
+----------------------------------------------+
|
||||
1 | -.1027777778 .1888888889 -.0194444444 |
|
||||
2 | .1055555556 .0222222222 -.0611111111 |
|
||||
3 | .0638888889 -.1444444444 .1472222222 |
|
||||
+----------------------------------------------+
|
||||
Loading…
Add table
Add a link
Reference in a new issue