Gaussian elimination: Difference between revisions

add output of the java code, add output of the scala code
(add output of the java code, add output of the scala code)
 
(26 intermediate revisions by 17 users not shown)
Line 18:
{{trans|C}}
 
<langsyntaxhighlight lang="11l">F swap_row(&a, &b, r1, r2)
I r1 != r2
swap(&a[r1], &a[r2])
Line 56:
V b = [-0.01, 0.61, 0.91, 0.99, 0.60, 0.02]
 
print(gauss_eliminate(&a, &b))</langsyntaxhighlight>
 
{{out}}
Line 65:
=={{header|360 Assembly}}==
{{trans|PL/I}}
<langsyntaxhighlight lang="360asm">* Gaussian elimination 09/02/2019
GAUSSEL CSECT
USING GAUSSEL,R13 base register
Line 204:
PG DC CL91' ' buffer
REGEQU
END GAUSSEL</langsyntaxhighlight>
{{out}}
<pre>
Line 217:
 
=={{header|Ada}}==
<langsyntaxhighlight Adalang="ada">with Ada.Text_IO;
with Ada.Numerics.Generic_Real_Arrays;
 
Line 335:
begin
Put (X);
end Gaussian_Eliminations;</langsyntaxhighlight>
 
{{out}}
Line 344:
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-2.4.1 algol68g-2.4.1].}}
{{wont work with|ELLA ALGOL 68|Any (with appropriate job cards) - tested with release [http://sourceforge.net/projects/algol68/files/algol68toc/algol68toc-1.8.8d/algol68toc-1.8-8d.fc9.i386.rpm/download 1.8-8d] - due to extensive use of '''format'''[ted]}}
'''File: prelude_exception.a68'''<langsyntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
COMMENT PROVIDES
MODE FIXED; INT fixed exception, unfixed exception;
Line 369:
IF raise(message) NE fixed exception THEN exception value error; FALSE FI;
 
SKIP</langsyntaxhighlight>'''File: prelude_mat_lib.a68'''<langsyntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
COMMENT PRELUDE REQUIRES
MODE SCAL = REAL;
Line 421:
);
 
SKIP</langsyntaxhighlight>'''File: prelude_gaussian_elimination.a68'''<langsyntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
COMMENT PRELUDE REQUIRES
MODE SCAL = REAL,
Line 498:
);
 
SKIP</langsyntaxhighlight>'''File: postlude_exception.a68'''<langsyntaxhighlight lang="algol68"># -*- coding: utf-8 -*- #
COMMENT POSTLUDE PROIVIDES
PROC VOID exception too many iterations, exception value error;
Line 506:
exception too many iterations:
exception value error:
stop</langsyntaxhighlight>'''File: test_Gaussian_elimination.a68'''<langsyntaxhighlight lang="algol68">#!/usr/bin/algol68g-full --script #
# -*- coding: utf-8 -*- #
 
Line 534:
printf((vec repr, gaussian elimination(a,col b)));
 
PR READ "postlude_exception.a68" PR</langsyntaxhighlight>'''Output:'''
<pre>
( -.010000000000002, 1.602790394502130, -1.613203059905640, 1.245494121371510, -.490989719584686, .065760696175236)
</pre>
 
=={{header|ATS}}==
This program was written by modifying [[Gauss-Jordan_matrix_inversion#ATS]]. There is a commented out portion of the code, whose removal makes this "Gaussian" elimination (with back substitution) rather than "Gauss-Jordan" elimination (without the need for back substitution).
 
<syntaxhighlight lang="ats">
(* There is a "little matrix library" in the code below. Not all of it
will be used, but it travels from task to task. Furthermore, the
"unused" parts are useful during the debugging phase. Also, reading
them may make it easier to understand other parts of the code. (For
instance, seeing how "block" and "transpose" work may help one
understand how "apply_index_map" works.) *)
 
(* 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
Gaussian elimination 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 :
(* For the matrix product, the destination should not be the same as
either of the other matrices. *)
{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 :
{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}
Real_Matrix_scalar_multiply_and_add_to :
{m, n : pos}
(Real_Matrix (tk, m, n), (* destination*)
Real_Matrix (tk, m, n),
g0float tk,
Real_Matrix (tk, m, n)) -< !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 scalar_multiply_and_add_to with
Real_Matrix_scalar_multiply_and_add_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_scalar_multiply_and_add_to (C, A, r, 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] := multiply_and_add (A[i, j], r, B[i, j])
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
 
(*------------------------------------------------------------------*)
(* Gaussian elimination *)
 
extern fn {tk : tkind}
Real_Matrix_gaussian_elimination :
(* Solve k systems of linear equations in n unknowns. (A special
case is if the second argument is a unit matrix. In that case,
the solution columns constitute the matrix inverse of the first
argument. See also the Gauss-Jordan matrix inversion task.) *)
{n, k : pos}
(Real_Matrix (tk, n, n), Real_Matrix (tk, n, k)) -< !refwrt >
Option (Real_Matrix (tk, n, k))
 
#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_gaussian_elimination {n, k} (A, B) =
let
val @(n, k) = dimension B
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_A : Matrix_Index_Map (n, n, n, n) =
lam (i1, j1) => $effmask_ref
(@(i0, j1) where { val i0 = rows_permutation[i1 - 1] })
fn
index_map_B : Matrix_Index_Map (n, k, n, k) =
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_A)
and B = apply_index_map (copy<tk> B, n, k, index_map_B)
 
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 p : intGte 1
in
needlessly_set_to_value (A, j, j, One);
for* {p : int | j + 1 <= p; p <= n + 1} .<(n + 1) - p>.
(p : int p) =>
(p := succ j; p <> succ n; p := succ p)
A[j, p] := A[j, p] / pivot_val;
for* {p : int | 1 <= p; p <= k + 1} .<(k + 1) - p>.
(p : int p) =>
(p := 1; p <> succ k; p := succ p)
B[j, p] := B[j, p] / 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 p : intGte 1
in
needlessly_set_to_value (A, i, j, Zero);
for* {p : int | j + 1 <= p; p <= n + 1} .<(n + 1) - p>.
(p : int p) =>
(p := succ j; p <> succ n; p := succ p)
A[i, p] :=
multiply_and_add (A[j, p], factor, A[i, p]);
for* {p : int | 1 <= p; p <= k + 1} .<(k + 1) - p>.
(p : int p) =>
(p := 1; p <> succ k; p := succ p)
B[i, p] :=
multiply_and_add (B[j, p], factor, B[i, p])
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 Gauss-Jordan elimination, we would do this,
instead of switching to back substitution:
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
if ~success then
None ()
else
(* Back substitution. (Doing this with block operations on rows,
as is done below, is not the most efficient way, but helps
convey what is going on.) *)
let
val bottom_row = block (B, n, n, 1, k)
 
(* The rows array will treat the rows of B as
submatrices. (The zeroth entry will not be used.) *)
val rows = arrayref_make_elt (i2sz (succ n), bottom_row)
 
var i : intGte 0
in
(* Fill in the rows array (ignoring its zeroth entry). *)
for* {i : nat | i <= n - 1} .<i>.
(i : int i) =>
(i := pred n; i <> 0; i := pred i)
rows[i] := block (B, i, i, 1, k);
 
(* Now do back substitution, one solution row at a time. *)
for* {i : nat | i <= n - 1} .<i>.
(i : int i) =>
(i := pred n; i <> 0; i := pred i)
let
var j : intGte 0
in
for* {j : int | i <= j; j <= n} .<j>.
(j : int j) =>
(j := n; j <> i; j := pred j)
scalar_multiply_and_add_to
(rows[i], rows[j], ~A[i, j], rows[i])
end;
 
(* The returned matrix will "contain" the rows_permutation
array and some extra closures. If you want a "clean"
matrix, you can use Real_Matrix_copy to get one. *)
Some B
end
end
 
overload gaussian_elimination with Real_Matrix_gaussian_elimination
 
(*------------------------------------------------------------------*)
 
fn {tk : tkind}
fprint_matrices_and_solutions
{n, k : pos}
(outf : FILEref,
A : Real_Matrix (tk, n, n),
B : Real_Matrix (tk, n, k)) : void =
let
typedef FILEstar = $extype"FILE *"
extern castfn FILEref2star : FILEref -<> FILEstar
 
macdef fmt = "%9.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, k) = dimension B
in
case+ gaussian_elimination<tk> (A, B) 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 X =>
let
val AX = A * X
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 <= k + 1} .<(k + 1) - j>.
(j : int j) =>
(j := 1; j <> succ k; j := succ j)
print_num X[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 <= k + 1} .<(k + 1) - j>.
(j : int j) =>
(j := 1; j <> succ k; j := succ j)
print_num AX[i, j];
fprint! (outf, right_bracket);
fprintln! (outf)
end
end
end
 
fn {tk : tkind}
column_major_list_to_matrix
{m, n : pos}
(m : int m,
n : int n,
lst : list (g0float tk, m * n))
: Real_Matrix (tk, m, n) =
let
#define :: list_cons
prval () = mul_gte_gte_gte {m, n} ()
val A = Real_Matrix_make_elt (m, 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 <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
case- !lstref of
| hd :: tl =>
begin
A[i, j] := hd;
!lstref := tl
end
end;
A
end
 
fn {tk : tkind}
row_major_list_to_matrix
{m, n : pos}
(m : int m,
n : int n,
lst : list (g0float tk, m * n))
: Real_Matrix (tk, m, n) =
transpose (column_major_list_to_matrix<tk> (n, m, lst))
 
macdef separator = "\n"
 
fn
print_example
{n, k : pos}
(n : int n,
k : int k,
lst_A : list (double, n * n),
lst_B : list (double, n * k)) : void =
let
val A = row_major_list_to_matrix (n, n, lst_A)
and B = row_major_list_to_matrix (n, k, lst_B)
in
print! separator;
fprint_matrices_and_solutions<dblknd> (stdout_ref, A, B)
end
 
implement
main0 () =
begin
println! ("\n(The examples are printed here after ",
"rounding to 4 decimal places.)");
 
println! ("\nSolving Ax=b where ",
"transpose(b)=[-0.01 0.61 0.91 0.99 0.60 0.02]:");
print_example
(6, 1, $list (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),
$list (~0.01, 0.61, 0.91, 0.99, 0.60, 0.02));
 
println! ("\nAn orthonormal matrix of rank 4,",
" solving for its inverse:");
print_example
(4, 4,
$list (~0.1543033499620918, ~0.1307837816808,
0.8649377296669811, 0.4593134032861146,
~0.6172133998483675, ~0.2062359634197235,
0.2410548538544755, ~0.7200047943403952,
~0.7715167498104593, 0.1911455270719389,
~0.3658314290169772, 0.4841411548150931,
0.0, ~0.950697489910433,
~0.2448318745080428, 0.190346095055507),
$list (1.0, 0.0, 0.0, 0.0,
0.0, 1.0, 0.0, 0.0,
0.0, 0.0, 1.0, 0.0,
0.0, 0.0, 0.0, 1.0));
 
print! separator
end
 
(*------------------------------------------------------------------*)
</syntaxhighlight>
 
{{out}}
 
On my computer, the following compiler options result in "fused multiply-and-add" instructions being generated. See the program text for a brief discussion of how that optimization may affect results, when the '''A''' matrix that is singular or nearly so.
 
<pre style="font-size:90%">$ patscc -std=gnu2x -g -O3 -march=native -DATS_MEMALLOC_GCBDW gaussian_elimination_task.dats -lgc && ./a.out
 
(The examples are printed here after rounding to 4 decimal places.)
 
Solving Ax=b where transpose(b)=[-0.01 0.61 0.91 0.99 0.60 0.02]:
 
[ 1.0000 0.0000 0.0000 0.0000 0.0000 0.0000 ] [ -0.0100 ] [ -0.0100 ]
[ 1.0000 0.6300 0.3900 0.2500 0.1600 0.1000 ] [ 1.6028 ] [ 0.6100 ]
[ 1.0000 1.2600 1.5800 1.9800 2.4900 3.1300 ] [ -1.6132 ] [ 0.9100 ]
[ 1.0000 1.8800 3.5500 6.7000 12.6200 23.8000 ] ✕ [ 1.2455 ] = [ 0.9900 ]
[ 1.0000 2.5100 6.3200 15.8800 39.9000 100.2800 ] [ -0.4910 ] [ 0.6000 ]
[ 1.0000 3.1400 9.8700 31.0100 97.4100 306.0200 ] [ 0.0658 ] [ 0.0200 ]
 
An orthonormal matrix of rank 4, solving for its inverse:
 
[ -0.1543 -0.1308 0.8649 0.4593 ] [ -0.1543 -0.6172 -0.7715 -0.0000 ] [ 1.0000 0.0000 -0.0000 0.0000 ]
[ -0.6172 -0.2062 0.2411 -0.7200 ] [ -0.1308 -0.2062 0.1911 -0.9507 ] [ -0.0000 1.0000 -0.0000 0.0000 ]
[ -0.7715 0.1911 -0.3658 0.4841 ] ✕ [ 0.8649 0.2411 -0.3658 -0.2448 ] = [ -0.0000 -0.0000 1.0000 0.0000 ]
[ 0.0000 -0.9507 -0.2448 0.1903 ] [ 0.4593 -0.7200 0.4841 0.1903 ] [ -0.0000 0.0000 0.0000 1.0000 ]
 
</pre>
 
=={{header|C}}==
This modifies A and b in place, which might not be quite desirable.
<langsyntaxhighlight lang="c">#include <stdio.h>
#include <stdlib.h>
#include <math.h>
Line 613 ⟶ 1,655:
 
return 0;
}</langsyntaxhighlight>{{out}}<pre>
-0.01
1.60279
Line 622 ⟶ 1,664:
</pre>
 
=={{header|C sharp|C#}}==
 
=={{header|Common Lisp}}==
<lang CommonLisp>
(defmacro mapcar-1 (fn n list)
"Maps a function of two parameters where the first one is fixed, over a list"
`(mapcar #'(lambda (l) (funcall ,fn ,n l)) ,list) )
 
 
(defun gauss (m)
(labels
((redc (m) ; Reduce to triangular form
(if (null (cdr m))
m
(cons (car m) (mapcar-1 #'cons 0 (redc (mapcar #'cdr (mapcar #'(lambda (r) (mapcar #'- (mapcar-1 #'* (caar m) r)
(mapcar-1 #'* (car r) (car m)))) (cdr m)))))) ))
(rev (m) ; Reverse each row except the last element
(reverse (mapcar #'(lambda (r) (append (reverse (butlast r)) (last r))) m)) ))
(catch 'result
(let ((m1 (redc (rev (redc m)))))
(reverse (mapcar #'(lambda (r) (let ((pivot (find-if-not #'zerop r))) (if pivot (/ (car (last r)) pivot) (throw 'result 'singular)))) m1)) ))))
</lang>
 
{{out}}
<pre>
(setq m1 '((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) ))
 
(gauss m1)
=> (-0.009999999 1.6027923 -1.6132091 1.2455008 -0.4909925 0.06576109)
</pre>
=={{header|C#}}==
This modifies A and b in place, which might not be quite desirable.
<langsyntaxhighlight lang="csharp">
using System;
 
Line 833 ⟶ 1,841:
}
}
</syntaxhighlight>
</lang>
<langsyntaxhighlight lang="csharp">
using System;
 
Line 856 ⟶ 1,864:
}
}
</syntaxhighlight>
</lang>
<pre>{{out}}
-0.0597391027501976
Line 864 ⟶ 1,872:
-0.553874184782179
0.0723048745759396
</pre>
 
 
=={{header|C++}}==
{{trans|Go}}
<syntaxhighlight lang="cpp">#include <algorithm>
#include <cassert>
#include <cmath>
#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,
const std::initializer_list<std::initializer_list<scalar_type>>& values)
: rows_(rows), columns_(columns), elements_(rows * columns) {
assert(values.size() <= rows_);
auto i = elements_.begin();
for (const auto& row : values) {
assert(row.size() <= columns_);
std::copy(begin(row), end(row), i);
i += columns_;
}
}
 
size_t rows() const { return rows_; }
size_t columns() const { return columns_; }
 
const scalar_type& operator()(size_t row, size_t column) const {
assert(row < rows_);
assert(column < columns_);
return elements_[row * columns_ + column];
}
scalar_type& operator()(size_t row, size_t column) {
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>
void swap_rows(matrix<scalar_type>& m, size_t i, size_t j) {
size_t columns = m.columns();
for (size_t k = 0; k < columns; ++k)
std::swap(m(i, k), m(j, k));
}
 
template <typename scalar_type>
std::vector<scalar_type> gauss_partial(const matrix<scalar_type>& a0,
const std::vector<scalar_type>& b0) {
size_t n = a0.rows();
assert(a0.columns() == n);
assert(b0.size() == n);
// make augmented matrix
matrix<scalar_type> a(n, n + 1);
for (size_t i = 0; i < n; ++i) {
for (size_t j = 0; j < n; ++j)
a(i, j) = a0(i, j);
a(i, n) = b0[i];
}
// WP algorithm from Gaussian elimination page
// produces row echelon form
for (size_t k = 0; k < n; ++k) {
// Find pivot for column k
size_t max_index = k;
scalar_type max_value = 0;
for (size_t i = k; i < n; ++i) {
// compute scale factor = max abs in row
scalar_type scale_factor = 0;
for (size_t j = k; j < n; ++j)
scale_factor = std::max(std::abs(a(i, j)), scale_factor);
if (scale_factor == 0)
continue;
// scale the abs used to pick the pivot
scalar_type abs = std::abs(a(i, k))/scale_factor;
if (abs > max_value) {
max_index = i;
max_value = abs;
}
}
if (a(max_index, k) == 0)
throw std::runtime_error("matrix is singular");
if (k != max_index)
swap_rows(a, k, max_index);
for (size_t i = k + 1; i < n; ++i) {
scalar_type f = a(i, k)/a(k, k);
for (size_t j = k + 1; j <= n; ++j)
a(i, j) -= a(k, j) * f;
a(i, k) = 0;
}
}
// now back substitute to get result
std::vector<scalar_type> x(n);
for (size_t i = n; i-- > 0; ) {
x[i] = a(i, n);
for (size_t j = i + 1; j < n; ++j)
x[i] -= a(i, j) * x[j];
x[i] /= a(i, i);
}
return x;
}
 
int main() {
matrix<double> a(6, 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}
});
std::vector<double> b{-0.01, 0.61, 0.91, 0.99, 0.60, 0.02};
std::vector<double> x{-0.01, 1.602790394502114, -1.6132030599055613,
1.2454941213714368, -0.4909897195846576, 0.065760696175232};
std::vector<double> y(gauss_partial(a, b));
std::cout << std::setprecision(16);
const double epsilon = 1e-14;
for (size_t i = 0; i < y.size(); ++i) {
assert(std::abs(x[i] - y[i]) <= epsilon);
std::cout << y[i] << '\n';
}
return 0;
}</syntaxhighlight>
 
{{out}}
<pre>
-0.01
1.602790394502113
-1.61320305990556
1.245494121371436
-0.4909897195846575
0.065760696175232
</pre>
 
=={{header|Common Lisp}}==
<syntaxhighlight lang="commonlisp">
(defmacro mapcar-1 (fn n list)
"Maps a function of two parameters where the first one is fixed, over a list"
`(mapcar #'(lambda (l) (funcall ,fn ,n l)) ,list) )
 
 
(defun gauss (m)
(labels
((redc (m) ; Reduce to triangular form
(if (null (cdr m))
m
(cons (car m) (mapcar-1 #'cons 0 (redc (mapcar #'cdr (mapcar #'(lambda (r) (mapcar #'- (mapcar-1 #'* (caar m) r)
(mapcar-1 #'* (car r) (car m)))) (cdr m)))))) ))
(rev (m) ; Reverse each row except the last element
(reverse (mapcar #'(lambda (r) (append (reverse (butlast r)) (last r))) m)) ))
(catch 'result
(let ((m1 (redc (rev (redc m)))))
(reverse (mapcar #'(lambda (r) (let ((pivot (find-if-not #'zerop r))) (if pivot (/ (car (last r)) pivot) (throw 'result 'singular)))) m1)) ))))
</syntaxhighlight>
 
{{out}}
<pre>
(setq m1 '((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) ))
 
(gauss m1)
=> (-0.009999999 1.6027923 -1.6132091 1.2455008 -0.4909925 0.06576109)
</pre>
 
=={{header|D}}==
{{trans|Go}}
<langsyntaxhighlight lang="d">import std.stdio, std.math, std.algorithm, std.range, std.numeric,
std.typecons;
 
Line 936 ⟶ 2,118:
if (abs(r.x[i] - xi) > eps)
return writeln("Out of tolerance: ", r.x[i], " ", xi);
}</langsyntaxhighlight>
{{out}}
<pre>[-0.01, 1.60279, -1.6132, 1.24549, -0.49099, 0.0657607]</pre>
 
=={{header|Delphi}}==
<langsyntaxhighlight Delphilang="delphi">program GuassianElimination;
 
// Modified from:
Line 1,086 ⟶ 2,268:
end.
 
</syntaxhighlight>
</lang>
{{out}}
<pre>1.00, 0.00, 0.00, 4.00</pre>
 
=={{header|EasyLang}}==
<syntaxhighlight>
proc gauss_elim . a[][] b[] x[] .
n = len a[][]
for i to n
maxr = i
maxv = abs a[i][i]
for j = i + 1 to n
if abs a[j][i] > maxv
maxr = j
maxv = abs a[j][i]
.
.
if maxr <> i
swap a[maxr][] a[i][]
swap b[maxr] b[i]
.
for j = i + 1 to n
f = a[j][i] / a[i][i]
for k = i to n
a[j][k] -= f * a[i][k]
.
b[j] -= f * b[i]
.
.
x[] = [ ]
len x[] n
for i = n downto 1
rhs = b[i]
for j = i + 1 to n
rhs -= a[i][j] * x[j]
.
x[i] = rhs / a[i][i]
.
.
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 ] ]
b[] = [ -0.01 0.61 0.91 0.99 0.60 0.02 ]
gauss_elim a[][] b[] x[]
print x[]
</syntaxhighlight>
 
=={{header|F_Sharp|F#}}==
===The Function===
<langsyntaxhighlight lang="fsharp">
// Gaussian Elimination. Nigel Galloway: February 2nd., 2019
let gelim augM=
Line 1,101 ⟶ 2,324:
|_->fN (i+1) (fG e g i@[g])
fN 0 augM
</syntaxhighlight>
</lang>
===The Task===
This task uses functionality from [[Continued_fraction/Arithmetic/Construct_from_rational_number#F.23]] and [[Continued_fraction#F.23]]
<langsyntaxhighlight lang="fsharp">
let test=[[ -6I; -18I; 13I; 6I; -6I; -15I; -2I; -9I; -231I];
[ 2I; 20I; 9I; 2I; 16I; -12I; -18I; -5I; 647I];
Line 1,115 ⟶ 2,338:
let fN (n,g)=cN2S(π(rI2cf n g))
gelim test |> List.map fN |> List.iteri(fun i n->(printfn "x[%d]=%1.14f " (i+1) (snd (Seq.pairwise n|> Seq.find(fun (n,g)->n-g < 0.0000000000001M)))))
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,127 ⟶ 2,350:
x[8]=23.00000000000000
</pre>
 
=={{header|Fortran}}==
Gaussian Elimination with partial pivoting using augmented matrix
<langsyntaxhighlight lang="fortran">
program ge
 
Line 1,173 ⟶ 2,397:
 
end program
</syntaxhighlight>
</lang>
 
=={{header|FreeBASIC}}==
Gaussian elimination with pivoting.
FreeBASIC version 1.05
<syntaxhighlight lang="freebasic">
<lang FreeBASIC>
 
Sub GaussJordan(matrix() As Double,rhs() As Double,ans() As Double)
Line 1,241 ⟶ 2,465:
next n
sleep
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,252 ⟶ 2,476:
 
</pre>
=={{header|Generic}}==
<syntaxhighlight lang="cpp">
generic coordinaat
{
ecs;
uuii;
 
coordinaat() { ecs=+a;uuii=+a;}
 
coordinaat(ecs_set,uuii_set) { ecs = ecs_set; uuii=uuii_set;}
 
operaator<(c)
{
iph ecs < c.ecs return troo;
iph c.ecs < ecs return phals;
iph uuii < c.uuii return troo;
return phals;
}
 
operaator==(connpair) // eecuuols and not eecuuols deriiu phronn operaator<
{
iph this < connpair return phals;
iph connpair < this return phals;
return troo;
}
 
operaator!=(connpair)
{
iph this < connpair return troo;
iph connpair < this return troo;
return phals;
}
 
too_string()
{
return "(" + ecs.too_string() + "," + uuii.too_string() + ")";
}
 
print()
{
str = too_string();
str.print();
}
 
println()
{
str = too_string();
str.println();
}
}
 
generic nnaatrics
{
s; // this is a set of coordinaat/ualioo pairs.
iteraator; // this field holds an iteraator phor the nnaatrics.
 
nnaatrics() // no parameters required phor nnaatrics construction.
{
s = nioo set(); // create a nioo set of coordinaat/ualioo pairs.
iteraator = nul; // the iteraator is initially set to nul.
}
 
nnaatrics(copee) // copee the nnaatrics.
{
s = nioo set(); // create a nioo set of coordinaat/ualioo pairs.
iteraator = nul; // the iteraator is initially set to nul.
 
r = copee.rouus;
c = copee.cols;
i = 0;
uuiil i < r
{
j = 0;
uuiil j < c
{
this[i,j] = copee[i,j];
j++;
}
i++;
}
}
 
begin { get { return s.begin; } } // property: used to commence manual iteraashon.
 
end { get { return s.end; } } // property: used to dephiin the end itenn of iteraashon
 
operaator<(a) // les than operaator is corld bii the avl tree algorithnns
{ // this operaator innpliis phor instance that you could potenshalee hav sets ou nnaatricss.
iph cees < a.cees // connpair the cee sets phurst.
return troo;
els iph a.cees < cees
return phals;
els // the cee sets are eecuuol thairphor connpair nnaatrics elennents.
{
phurst1 = begin;
lahst1 = end;
phurst2 = a.begin;
lahst2 = a.end;
 
uuiil phurst1 != lahst1 && phurst2 != lahst2
{
iph phurst1.daata.ualioo < phurst2.daata.ualioo
return troo;
els
{
iph phurst2.daata.ualioo < phurst1.daata.ualioo
return phals;
els
{
phurst1 = phurst1.necst;
phurst2 = phurst2.necst;
}
}
}
 
return phals;
}
}
 
operaator==(connpair) // eecuuols and not eecuuols deriiu phronn operaator<
{
iph this < connpair return phals;
iph connpair < this return phals;
return troo;
}
 
operaator!=(connpair)
{
iph this < connpair return troo;
iph connpair < this return troo;
return phals;
}
 
 
operaator[](cee_a,cee_b) // this is the nnaatrics indexer.
{
set
{
trii { s >> nioo cee_ualioo(new coordinaat(cee_a,cee_b)); } catch {}
s << nioo cee_ualioo(new coordinaat(nioo integer(cee_a),nioo integer(cee_b)),ualioo);
}
get
{
d = s.get(nioo cee_ualioo(new coordinaat(cee_a,cee_b)));
return d.ualioo;
}
}
 
operaator>>(coordinaat) // this operaator reennoous an elennent phronn the nnaatrics.
{
s >> nioo cee_ualioo(coordinaat);
return this;
}
 
iteraat() // and this is how to iterate on the nnaatrics.
{
iph iteraator.nul()
{
iteraator = s.lepht_nnohst;
iph iteraator == s.heder
return nioo iteraator(phals,nioo nun());
els
return nioo iteraator(troo,iteraator.daata.ualioo);
}
els
{
iteraator = iteraator.necst;
iph iteraator == s.heder
{
iteraator = nul;
return nioo iteraator(phals,nioo nun());
}
els
return nioo iteraator(troo,iteraator.daata.ualioo);
}
}
 
couunt // this property returns a couunt ou elennents in the nnaatrics.
{
get
{
return s.couunt;
}
}
 
ennptee // is the nnaatrics ennptee?
{
get
{
return s.ennptee;
}
}
 
 
lahst // returns the ualioo of the lahst elennent in the nnaatrics.
{
get
{
iph ennptee
throuu "ennptee nnaatrics";
els
return s.lahst.ualioo;
}
}
 
too_string() // conuerts the nnaatrics too aa string
{
return s.too_string();
}
 
print() // prints the nnaatrics to the consohl.
{
out = too_string();
out.print();
}
 
println() // prints the nnaatrics as a liin too the consohl.
{
out = too_string();
out.println();
}
 
cees // return the set ou cees ou the nnaatrics (a set of coordinaats).
{
get
{
k = nioo set();
phor e : s k << e.cee;
return k;
}
}
 
operaator+(p)
{
ouut = nioo nnaatrics();
phurst1 = begin;
lahst1 = end;
phurst2 = p.begin;
lahst2 = p.end;
uuiil phurst1 != lahst1 && phurst2 != lahst2
{
ouut[phurst1.daata.cee.ecs,phurst1.daata.cee.uuii] = phurst1.daata.ualioo + phurst2.daata.ualioo;
phurst1 = phurst1.necst;
phurst2 = phurst2.necst;
}
return ouut;
}
operaator-(p)
{
ouut = nioo nnaatrics();
phurst1 = begin;
lahst1 = end;
phurst2 = p.begin;
lahst2 = p.end;
uuiil phurst1 != lahst1 && phurst2 != lahst2
{
ouut[phurst1.daata.cee.ecs,phurst1.daata.cee.uuii] = phurst1.daata.ualioo - phurst2.daata.ualioo;
phurst1 = phurst1.necst;
phurst2 = phurst2.necst;
}
return ouut;
}
 
rouus
{
get
{
r = +a;
phurst1 = begin;
lahst1 = end;
uuiil phurst1 != lahst1
{
iph r < phurst1.daata.cee.ecs r = phurst1.daata.cee.ecs;
phurst1 = phurst1.necst;
}
return r + +b;
}
}
 
cols
{
get
{
c = +a;
phurst1 = begin;
lahst1 = end;
uuiil phurst1 != lahst1
{
iph c < phurst1.daata.cee.uuii c = phurst1.daata.cee.uuii;
phurst1 = phurst1.necst;
}
return c + +b;
}
}
 
operaator*(o)
{
iph cols != o.rouus throw "rouus-cols nnisnnatch";
reesult = nioo nnaatrics();
rouu_couunt = rouus;
colunn_couunt = o.cols;
loop = cols;
i = +a;
uuiil i < rouu_couunt
{
g = +a;
uuiil g < colunn_couunt
{
sunn = +a.a;
h = +a;
uuiil h < loop
{
a = this[i, h];
 
b = o[h, g];
nn = a * b;
sunn = sunn + nn;
h++;
}
 
reesult[i, g] = sunn;
 
g++;
}
i++;
}
return reesult;
}
 
suuop_rouus(a, b)
{
c = cols;
i = 0;
uuiil u < cols
{
suuop = this[a, i];
this[a, i] = this[b, i];
this[b, i] = suuop;
i++;
}
}
 
suuop_colunns(a, b)
{
r = rouus;
i = 0;
uuiil i < rouus
{
suuopp = this[i, a];
this[i, a] = this[i, b];
this[i, b] = suuop;
i++;
}
}
 
transpohs
{
get
{
reesult = new nnaatrics();
 
r = rouus;
c = cols;
i=0;
uuiil i < r
{
g = 0;
uuiil g < c
{
reesult[g, i] = this[i, g];
g++;
}
i++;
}
 
return reesult;
}
}
 
deternninant
{
get
{
rouu_couunt = rouus;
colunn_count = cols;
 
if rouu_couunt != colunn_count
throw "not a scuuair nnaatrics";
 
if rouu_couunt == 0
throw "the nnaatrics is ennptee";
 
if rouu_couunt == 1
return this[0, 0];
 
if rouu_couunt == 2
return this[0, 0] * this[1, 1] -
this[0, 1] * this[1, 0];
 
temp = nioo nnaatrics();
 
det = 0.0;
parity = 1.0;
 
j = 0;
uuiil j < rouu_couunt
{
k = 0;
uuiil k < rouu_couunt-1
{
skip_col = phals;
 
l = 0;
uuiil l < rouu_couunt-1
{
if l == j skip_col = troo;
 
if skip_col
n = l + 1;
els
n = l;
 
temp[k, l] = this[k + 1, n];
l++;
}
k++;
}
 
det = det + parity * this[0, j] * temp.deeternninant;
 
parity = 0.0 - parity;
j++;
}
 
return det;
}
}
 
ad_rouu(a, b)
{
c = cols;
i = 0;
uuiil i < c
{
this[a, i] = this[a, i] + this[b, i];
i++;
}
}
 
ad_colunn(a, b)
{
c = rouus;
i = 0;
uuiil i < c
{
this[i, a] = this[i, a] + this[i, b];
i++;
}
}
 
subtract_rouu(a, b)
{
c = cols;
i = 0;
uuiil i < c
{
this[a, i] = this[a, i] - this[b, i];
i++;
}
}
 
subtract_colunn(a, b)
{
c = rouus;
i = 0;
uuiil i < c
{
this[i, a] = this[i, a] - this[i, b];
i++;
}
}
 
nnultiplii_rouu(rouu, scalar)
{
c = cols;
i = 0;
uuiil i < c
{
this[rouu, i] = this[rouu, i] * scalar;
i++;
}
}
 
nnultiplii_colunn(colunn, scalar)
{
r = rouus;
i = 0;
uuiil i < r
{
this[i, colunn] = this[i, colunn] * scalar;
i++;
}
}
 
diuiid_rouu(rouu, scalar)
{
c = cols;
i = 0;
uuiil i < c
{
this[rouu, i] = this[rouu, i] / scalar;
i++;
}
}
 
diuiid_colunn(colunn, scalar)
{
r = rouus;
i = 0;
uuiil i < r
{
this[i, colunn] = this[i, colunn] / scalar;
i++;
}
}
 
connbiin_rouus_ad(a,b,phactor)
{
c = cols;
i = 0;
uuiil i < c
{
this[a, i] = this[a, i] + phactor * this[b, i];
i++;
}
}
 
connbiin_rouus_subtract(a,b,phactor)
{
c = cols;
i = 0;
uuiil i < c
{
this[a, i] = this[a, i] - phactor * this[b, i];
i++;
}
}
 
connbiin_colunns_ad(a,b,phactor)
{
r = rouus;
i = 0;
uuiil i < r
{
this[i, a] = this[i, a] + phactor * this[i, b];
i++;
}
}
 
connbiin_colunns_subtract(a,b,phactor)
{
r = rouus;
i = 0;
uuiil i < r
{
this[i, a] = this[i, a] - phactor * this[i, b];
i++;
}
}
 
inuers
{
get
{
rouu_couunt = rouus;
colunn_couunt = cols;
 
iph rouu_couunt != colunn_couunt
throw "nnatrics not scuuair";
 
els iph rouu_couunt == 0
throw "ennptee nnatrics";
 
els iph rouu_couunt == 1
{
r = nioo nnaatrics();
r[0, 0] = 1.0 / this[0, 0];
return r;
}
 
gauss = nioo nnaatrics(this);
 
i = 0;
uuiil i < rouu_couunt
{
j = 0;
uuiil j < rouu_couunt
{
iph i == j
 
gauss[i, j + rouu_couunt] = 1.0;
els
gauss[i, j + rouu_couunt] = 0.0;
j++;
}
 
i++;
}
 
j = 0;
uuiil j < rouu_couunt
{
iph gauss[j, j] == 0.0
{
k = j + 1;
 
uuiil k < rouu_couunt
{
if gauss[k, j] != 0.0 {gauss.nnaat.suuop_rouus(j, k); break; }
k++;
}
 
if k == rouu_couunt throw "nnatrics is singioolar";
}
 
phactor = gauss[j, j];
iph phactor != 1.0 gauss.diuiid_rouu(j, phactor);
 
i = j+1;
uuiil i < rouu_couunt
{
gauss.connbiin_rouus_subtract(i, j, gauss[i, j]);
i++;
}
 
j++;
}
 
i = rouu_couunt - 1;
uuiil i > 0
{
k = i - 1;
uuiil k >= 0
{
gauss.connbiin_rouus_subtract(k, i, gauss[k, i]);
k--;
}
i--;
}
 
reesult = nioo nnaatrics();
 
i = 0;
uuiil i < rouu_couunt
{
j = 0;
uuiil j < rouu_couunt
{
reesult[i, j] = gauss[i, j + rouu_couunt];
j++;
}
i++;
}
 
return reesult;
}
}
 
}</syntaxhighlight>
 
=={{header|Go}}==
===Partial pivoting, no scaling===
Gaussian elimination with partial pivoting by [https://en.wikipedia.org/wiki/Gaussian_elimination#Pseudocode pseudocode] on WP page [https://en.wikipedia.org/wiki/Gaussian_elimination Gaussian elimination]."
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,354 ⟶ 3,247:
}
return x, nil
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,361 ⟶ 3,254:
===Scaled partial pivoting===
Changes from above version noted with comments. For the example data scaling does help a bit.
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,454 ⟶ 3,347:
}
return x, nil
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,463 ⟶ 3,356:
 
===From scratch===
<syntaxhighlight lang="haskell">
<lang Haskell>
isMatrix xs = null xs || all ((== (length.head $ xs)).length) xs
 
Line 1,499 ⟶ 3,392:
bubble (xs,bs) = (go xs, go bs)
where
idmax = snd.minimummaximum.flip zip [0..].map (negate.abs.head) $ xs
go ys = let (us,vs) = splitAt idmax ys in vs ++ us
Line 1,511 ⟶ 3,404:
let b = [[-0.01], [0.61], [0.91], [0.99], [0.60], [0.02]]
mapM_ print $ gauss a b
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,524 ⟶ 3,417:
===Another example===
We use Rational numbers for having more precision. a % b is the rational a / b.
<langsyntaxhighlight Haskelllang="haskell">mult:: Num a => [[a]] -> [[a]] -> [[a]]
mult uss vss = map (foldl(\xs -> if null xs then [] else foldl1 (zipWith (+)) ts xs). zipWith (\vs u -> map (u*) vs) vss) uss
where ts = map (const 0).concat $ take 1 vss
 
bubble::([a] -> c) -> (c -> c -> Bool) -> [[a]] -> [[b]] -> ([[a]],[[b]])
Line 1,622 ⟶ 3,514:
let b = [[-0.01], [0.61], [0.91], [0.99], [0.60], [0.02]]
task a b
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,697 ⟶ 3,589:
 
===Determinant and permutation matrix are given===
<syntaxhighlight lang="haskell">mult:: Num a => [[a]] -> [[a]] -> [[a]]
<lang Haskell>
foldlZipWith::mult uss vss = map (a(\xs -> bif ->null c)xs ->then (d[] ->else cfoldl1 ->(zipWith d(+)) ->xs). dzipWith ->(\vs [a]u -> [b]map (u*) ->vs) vss) duss
foldlZipWith _ _ u [] _ = u
foldlZipWith _ _ u _ [] = u
foldlZipWith f g u (x:xs) (y:ys) = foldlZipWith f g (g u (f x y)) xs ys
foldl1ZipWith::(a -> b -> c) -> (c -> c -> c) -> [a] -> [b] -> c
foldl1ZipWith _ _ [] _ = error "First list is empty"
foldl1ZipWith _ _ _ [] = error "Second list is empty"
foldl1ZipWith f g (x:xs) (y:ys) = foldlZipWith f g (f x y) xs ys
multAdd::(a -> b -> c) -> (c -> c -> c) -> [[a]] -> [[b]] -> [[c]]
multAdd f g xs ys = map (\us -> foldl1ZipWith (\u vs -> map (f u) vs) (zipWith g) us ys) xs
mult:: Num a => [[a]] -> [[a]] -> [[a]]
mult xs ys = multAdd (*) (+) xs ys
 
triangle::(Fractional a, Ord a) => [[a]] -> [[a]] -> (a,[(([a],[a]),Int)])
Line 1,801 ⟶ 3,679:
let b = [[-0.01], [0.61], [0.91], [0.99], [0.60], [0.02]]
task a b
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 1,887 ⟶ 3,765:
%. , J's matrix divide verb, directly solves systems of determined and of over-determined linear equations directly. This example J session builds a noisy sine curve on the half circle, fits quintic and quadratic equations, and displays the results of evaluating these polynomials.
 
<syntaxhighlight lang="j">
<lang J>
f=: 6j2&": NB. formatting verb
 
Line 1,945 ⟶ 3,823:
0.81 0.83 0.86
0.31 0.36 0.27
</syntaxhighlight>
</lang>
 
=={{header|Java}}==
 
Naked implementation, using Java arrays instead of a matrix class.
 
<syntaxhighlight lang="java">import java.util.Locale;
 
public class GaussianElimination {
public static double solve(double[][] a, double[][] b) {
if (a == null || b == null || a.length == 0 || b.length == 0) {
throw new IllegalArgumentException("Invalid dimensions");
}
int n = b.length, p = b[0].length;
if (a.length != n || a[0].length != n) {
throw new IllegalArgumentException("Invalid dimensions");
}
 
double det = 1.0;
for (int i = 0; i < n - 1; i++) {
int k = i;
for (int j = i + 1; j < n; j++) {
if (Math.abs(a[j][i]) > Math.abs(a[k][i])) {
k = j;
}
}
if (k != i) {
det = -det;
for (int j = i; j < n; j++) {
double s = a[i][j];
a[i][j] = a[k][j];
a[k][j] = s;
}
 
for (int j = 0; j < p; j++) {
double s = b[i][j];
b[i][j] = b[k][j];
b[k][j] = s;
}
}
for (int j = i + 1; j < n; j++) {
double s = a[j][i] / a[i][i];
for (k = i + 1; k < n; k++) {
a[j][k] -= s * a[i][k];
}
for (k = 0; k < p; k++) {
b[j][k] -= s * b[i][k];
}
}
}
for (int i = n - 1; i >= 0; i--) {
for (int j = i + 1; j < n; j++) {
double s = a[i][j];
for (int k = 0; k < p; k++) {
b[i][k] -= s * b[j][k];
}
}
double s = a[i][i];
det *= s;
for (int k = 0; k < p; k++) {
b[i][k] /= s;
}
}
return det;
}
public static void main(String[] args) {
double[][] a = new double[][] {{4.0, 1.0, 0.0, 0.0, 0.0},
{1.0, 4.0, 1.0, 0.0, 0.0},
{0.0, 1.0, 4.0, 1.0, 0.0},
{0.0, 0.0, 1.0, 4.0, 1.0},
{0.0, 0.0, 0.0, 1.0, 4.0}};
 
double[][] b = new double[][] {{1.0 / 2.0},
{2.0 / 3.0},
{3.0 / 4.0},
{4.0 / 5.0},
{5.0 / 6.0}};
double[] x = {39.0 / 400.0,
11.0 / 100.0,
31.0 / 240.0,
37.0 / 300.0,
71.0 / 400.0};
System.out.println("det: " + solve(a, b));
 
for (int i = 0; i < 5; i++) {
System.out.printf(Locale.US, "%12.8f %12.4e\n", b[i][0], b[i][0] - x[i]);
}
}
}</syntaxhighlight>
{{out}}
<pre>
det: 780.0
0.09750000 0.0000e+00
0.11000000 0.0000e+00
0.12916667 0.0000e+00
0.12333333 1.3878e-17
0.17750000 2.7756e-17
</pre>
 
 
=={{header|JavaScript}}==
From Numerical Recipes in C:
<langsyntaxhighlight lang="javascript">// Lower Upper Solver
function lusolve(A, b, update) {
var lu = ludcmp(A, update)
Line 2,067 ⟶ 4,055:
[-0.01, 0.61, 0.91, 0.99, 0.60, 0.02]
)
)</langsyntaxhighlight>
 
{{output}}
<pre>-0.01000000000000004, 1.6027903945021095, -1.6132030599055475, 1.2454941213714232, -0.4909897195846526, 0.06576069617523138</pre>
 
=={{header|jq}}==
'''Adapted from [[#Wren]]'''
{{works with|jq}}
'''Works with gojq, the Go implementation of jq'''
<syntaxhighlight lang="jq">def ta: [
[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]
];
def tb:[-0.01, 0.61, 0.91, 0.99, 0.60, 0.02];
 
# Expected values:
def tx:[
-0.01, 1.602790394502114, -1.6132030599055613,
1.2454941213714368, -0.4909897195846576, 0.065760696175232
];
 
# Input: an array or an object
def swap($i;$j):
.[$i] as $tmp | .[$i] = .[$j] | .[$j] = $tmp;
 
def gaussPartial(a0; b0):
(b0|length) as $m
| reduce range(0;a0|length) as $i (
{ a: [range(0;$m)|null] };
.a[$i] = a0[$i] + [b0[$i]] )
| reduce range(0; .a|length) as $k (.;
.iMax = 0
| .max = -1
| reduce range($k;$m) as $i (.;
.a[$i] as $row
# compute scale factor s = max abs in row
| .s = -1
| reduce range($k;$m) as $j (.;
($row[$j]|length) as $e
| if ($e > .s) then .s = $e else . end )
# scale the abs used to pick the pivot
| ( ($row[$k]|length) / .s) as $abs
| if $abs > .max
then .iMax = $i | .max = $abs
else .
end )
| if (.a[.iMax][$k] == 0) then "Matrix is singular." | error
else .iMax as $iMax
| .a |= swap($k; $iMax)
| reduce range($k + 1; $m) as $i (.;
reduce range($k + 1; $m + 1 ) as $j (.;
.a[$i][$j] = .a[$i][$j] - (.a[$k][$j] * .a[$i][$k] / .a[$k][$k]) )
| .a[$i][$k] = 0 )
end
)
| .x = [range(0;$m)|0]
| reduce range($m - 1; -1; -1) as $i (.;
.x[$i] = .a[$i][$m]
| reduce range($i + 1; $m) as $j (.;
.x[$i] = .x[$i] - .a[$i][$j] * .x[$j] )
| .x[$i] = .x[$i] / .a[$i][$i] )
| .x ;
def x: gaussPartial(ta; tb);
 
# Input: the array of values to be compared againt $target
def pointwise_check($target; $EPSILON):
. as $x
| range(0; $x|length) as $i
| select( ($target[$i] - $x[$i])|length > $EPSILON )
| "\($x[$i]) vs expected value \($target[$i])" ;
 
def task:
x
| ., pointwise_check(tx; 1E-14) ;
 
task
 
</syntaxhighlight>
{{out}}
<pre>
[-0.01,1.6027903945021138,-1.6132030599055616,1.2454941213714392,-0.49098971958465953,0.06576069617523238]
</pre>
 
 
 
=={{header|Julia}}==
Using built-in LAPACK-based linear solver (which employs partial-pivoted Gaussian elimination):
<langsyntaxhighlight lang="julia">x = A \ b</langsyntaxhighlight>
 
=={{header|Klong}}==
<syntaxhighlight lang="k">
<lang K>
elim::{[h m];h::*m::x@>*'x;
:[2>#x;x;(,h),0,:\.f({1_x}'{x-h**x%*h}'1_m)]}
Line 2,083 ⟶ 4,157:
{v::v,((*x)-/:[[]~v;[];v*x@1+!#v])%x@1+#v}'||'x;|v}
gauss::{subst(elim(x))}
</syntaxhighlight>
</lang>
 
Example, matrix taken from C version:
 
<syntaxhighlight lang="k">
<lang K>
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]
Line 2,100 ⟶ 4,174:
-0.490989719584658025
0.0657606961752320591]
</syntaxhighlight>
</lang>
 
=={{header|Kotlin}}==
{{trans|Go}}
<langsyntaxhighlight lang="scala">// version 1.1.51
 
val ta = arrayOf(
Line 2,184 ⟶ 4,258:
}
}
}</langsyntaxhighlight>
 
{{out}}
Line 2,191 ⟶ 4,265:
</pre>
 
=={{header| LobsterLambdatalk}}==
<syntaxhighlight lang="scheme">
{require lib_matrix}
 
{M.solve
{M.new [[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]]}
[-0.01,0.61,0.91,0.99,0.60,0.02]}
->
[-0.01,1.6027903945021094,-1.613203059905548,1.245494121371424,-0.49098971958465304,0.06576069617523143]
</syntaxhighlight>
 
=={{header|Lobster}}==
{{trans|Go}}
<langsyntaxhighlight Lobsterlang="lobster">import std
 
// test case from Go version at http://rosettacode.org/wiki/Gaussian_elimination
Line 2,281 ⟶ 4,371:
print("out of tolerance, expected: " + tx[i] + " got: " + xi)
 
test()</langsyntaxhighlight>
{{out}}
<pre>
Line 2,289 ⟶ 4,379:
=={{header|M2000 Interpreter}}==
Faster, with accuracy of 25 decimals
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
module checkit {
Dim Base 1, a(6, 6), b(6)
Line 2,389 ⟶ 4,479:
}
checkit
</syntaxhighlight>
</lang>
 
slower with accuracy of 26 decimals
<syntaxhighlight lang="m2000 interpreter">
<lang M2000 Interpreter>
Module Checkit2 {
Dim Base 1, a(6, 6), b(6)
Line 2,536 ⟶ 4,626:
}
Checkit2
</syntaxhighlight>
</lang>
{{out}}
<pre style="height:30ex;overflow:scroll">
Line 2,620 ⟶ 4,710:
 
=={{header|Mathematica}} / {{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">GaussianElimination[A_?MatrixQ, b_?VectorQ] := Last /@ RowReduce[Flatten /@ Transpose[{A, b}]]</langsyntaxhighlight>
 
=={{header|MATLAB}}==
<syntaxhighlight lang="matlab">
<lang MATLAB>
function [ x ] = GaussElim( A, b)
 
Line 2,694 ⟶ 4,784:
 
end
</syntaxhighlight>
</lang>
 
=={{header|Modula-3}}==
Line 2,708 ⟶ 4,798:
 
;Matrix interface
<langsyntaxhighlight lang="modula3">GENERIC INTERFACE Matrix(RingElem);
 
(*
Line 2,748 ⟶ 4,838:
(* prints the matrix row-by-row; sorry, no special padding to line up columns *)
 
END Matrix.</langsyntaxhighlight>
 
;Matrix implementation
 
<langsyntaxhighlight lang="modula3">GENERIC MODULE Matrix(RingElem);
 
IMPORT IO;
Line 2,909 ⟶ 4,999:
 
BEGIN
END Matrix.</langsyntaxhighlight>
 
; interface for the ring of integers modulo an integer
 
<langsyntaxhighlight lang="modula3">INTERFACE ModularRing;
 
(*
Line 2,944 ⟶ 5,034:
*)
 
END ModularRing.</langsyntaxhighlight>
 
;test implementation
Line 2,950 ⟶ 5,040:
It's fairly easy to initialize an array of types in Modula-3, but it can get cumbersome with structured types, so we wrote a procedure to convert an integer matrix to a matrix of integers modulo a number.
 
<langsyntaxhighlight lang="modula3">MODULE GaussianElimination EXPORTS Main;
 
IMPORT IO, ModularRing AS MR, IntMatrix AS IM, ModMatrix AS MM;
Line 3,016 ⟶ 5,106:
IO.PutChar('\n');
 
END GaussianElimination.</langsyntaxhighlight>
 
{{out}}
Line 3,044 ⟶ 5,134:
 
</pre>
 
=={{header|Nim}}==
{{trans|Kotlin}}
<syntaxhighlight lang="nim">const Eps = 1e-14 # Tolerance required.
 
type
 
Vector[N: static Positive] = array[N, float]
Matrix[M, N: static Positive] = array[M, Vector[N]]
SquareMatrix[N: static Positive] = Matrix[N, N]
 
func gaussPartialScaled(a: SquareMatrix; b: Vector): Vector =
 
doAssert a.N == b.N, "matrix and vector have incompatible dimensions"
const N = a.N
 
var m: Matrix[N, N + 1]
for i, row in a:
m[i][0..<N] = row
m[i][N] = b[i]
 
for k in 0..<N:
var imax = 0
var vmax = -1.0
 
for i in k..<N:
# Compute scale factor s = max abs in row.
var s = -1.0
for j in k..N:
let e = abs(m[i][j])
if e > s: s = e
# Scale the abs used to pick the pivot.
let val = abs(m[i][k]) / s
if val > vmax:
imax = i
vmax = val
 
if m[imax][k] == 0:
raise newException(ValueError, "matrix is singular")
 
swap m[imax], m[k]
 
for i in (k + 1)..<N:
for j in (k + 1)..N:
m[i][j] -= m[k][j] * m[i][k] / m[k][k]
m[i][k] = 0
 
for i in countdown(N - 1, 0):
result[i] = m[i][N]
for j in (i + 1)..<N:
result[i] -= m[i][j] * result[j]
result[i] /= m[i][i]
 
 
#———————————————————————————————————————————————————————————————————————————————————————————————————
 
let a: SquareMatrix[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]]
 
let b: Vector[6] = [-0.01, 0.61, 0.91, 0.99, 0.60, 0.02]
 
let refx: Vector[6] = [-0.01, 1.602790394502114, -1.6132030599055613,
1.2454941213714368, -0.4909897195846576, 0.065760696175232]
 
let x = gaussPartialScaled(a, b)
echo x
for i, xi in x:
if abs(xi - refx[i]) > Eps:
echo "Out of tolerance."
echo "Expected values are ", refx
break</syntaxhighlight>
 
{{out}}
<pre>[-0.01, 1.602790394502114, -1.613203059905562, 1.245494121371439, -0.4909897195846595, 0.06576069617523238]</pre>
 
=={{header|OCaml}}==
The OCaml stdlib is fairly lean, so these stand-alone solutions often need to include support functions which would be part of a codebase, like these...
<syntaxhighlight lang="ocaml">
<lang OCaml>
module Array = struct
include Array
Line 3,076 ⟶ 5,244:
if n > b then acc else aux (f acc n) (succ n)
in aux init a
</syntaxhighlight>
</lang>
The solver:
<syntaxhighlight lang="ocaml">
<lang OCaml>
(* Some less-general support functions for 'solve'. *)
let swap_elem m i j = let x = m.(i) in m.(i) <- m.(j); m.(j) <- x
Line 3,117 ⟶ 5,285:
done;
x
</syntaxhighlight>
</lang>
Example data...
<syntaxhighlight lang="ocaml">
<lang OCaml>
let a =
[| [| 1.00; 0.00; 0.00; 0.00; 0.00; 0.00 |];
Line 3,128 ⟶ 5,296:
[| 1.00; 3.14; 9.87; 31.01; 97.41; 306.02 |] |]
let b = [| -0.01; 0.61; 0.91; 0.99; 0.60; 0.02 |]
</syntaxhighlight>
</lang>
In the REPL, the solution is:
<syntaxhighlight lang="ocaml">
<lang OCaml>
# let x = solve a b;;
val x : float array =
[|-0.0100000000000000991; 1.60279039450210536; -1.61320305990553226;
1.24549412137140547; -0.490989719584644546; 0.0657606961752301433|]
</syntaxhighlight>
</lang>
Further, let's define multiplication and subtraction to check our results...
<syntaxhighlight lang="ocaml">
<lang OCaml>
let mul m v =
Array.mapi (fun i u ->
Line 3,146 ⟶ 5,314:
 
let sub u v = Array.mapi (fun i e -> e -. v.(i)) u
</syntaxhighlight>
</lang>
Now 'x' can be plugged into the equation to calculate the residual:
<syntaxhighlight lang="ocaml">
<lang OCaml>
# let residual = sub b (mul a x);;
val residual : float array =
[|9.8879238130678e-17; 1.11022302462515654e-16; 2.22044604925031308e-16;
8.88178419700125232e-16; -5.5511151231257827e-16; 4.26741975090294545e-16|]
</syntaxhighlight>
</lang>
 
=={{header|PARI/GP}}==
If A and B have floating-point numbers (<code>t_REAL</code>s) then the following uses Gaussian elimination:
<syntaxhighlight lang ="parigp">matsolve(A,B)</langsyntaxhighlight>
 
If the entries are integers, then ''p''-adic lifting (Dixon 1982) is used instead.
Line 3,163 ⟶ 5,331:
=={{header|Perl}}==
{{libheader|Math&#58;&#58;Matrix}}
<langsyntaxhighlight Perllang="perl">use Math::Matrix;
my $a = Math::Matrix->new([0,1,0],
[0,0,1],
Line 3,171 ⟶ 5,339:
[4]);
my $x = $a->concat($b)->solve;
print $x;</langsyntaxhighlight>
 
<code>Math::Matrix</code> <code>solve()</code> expects the column vector to be an extra column in the matrix, hence <code>concat()</code>. Putting not just a column there but a whole identity matrix (making Nx2N) is how its <code>invert()</code> is implemented. Note that <code>solve()</code> doesn't notice singular matrices and still gives a return when there is in fact no solution to Ax=B.
 
=={{header|Perl 6}}==
{{works with|Rakudo|2018.03}}
Gaussian elimination results in a matrix in row echelon form. Gaussian elimination with back-substitution (also known as Gauss-Jordan elimination) results in a matrix in reduced row echelon form. That being the case, we can reuse much of the code from the [[Reduced row echelon form]] task. Perl&nbsp;6 stores and does calculations on decimal numbers within its limit of precision using Rational numbers by default, meaning the calculations are exact.
 
<lang perl6>sub gauss-jordan-solve (@a, @b) {
@b.kv.map: { @a[$^k].append: $^v };
@a.&rref[*]»[*-1];
}
 
# 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;
}
@m
}
 
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";
</lang>
{{out}}
<pre>A matrix:
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
 
or, A in exact rationals:
1 0 0 0 0 0
1 63/100 39/100 1/4 4/25 1/10
1 63/50 79/50 99/50 249/100 313/100
1 47/25 71/20 67/10 631/50 119/5
1 251/100 158/25 397/25 399/10 2507/25
1 157/50 987/100 3101/100 9741/100 15301/50
 
B matrix:
-0.01
0.61
0.91
0.99
0.60
0.02
 
or, B in exact rationals:
-1/100
61/100
91/100
99/100
3/5
1/50
 
x matrix:
-0.010000000000
1.602790394502
-1.613203059906
1.245494121371
-0.490989719585
0.065760696175
 
or, x in exact rationals:
-1/100
655870882787/409205648497
-660131804286/409205648497
509663229635/409205648497
-200915766608/409205648497
26909648324/409205648497
</pre>
 
=={{header|Phix}}==
{{trans|PHP}}
<!--<syntaxhighlight lang="phix">(phixonline)-->
<lang Phix>function gauss_eliminate(sequence a, b)
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
integer n = length(b)
<span style="color: #008080;">function</span> <span style="color: #000000;">gauss_eliminate</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: #000000;">b</span><span style="color: #0000FF;">)</span>
atom tmp
<span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">}</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: #000000;">b</span><span style="color: #0000FF;">})</span>
for col=1 to n do
<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;">b</span><span style="color: #0000FF;">)</span>
integer m = col
<span style="color: #004080;">atom</span> <span style="color: #000000;">tmp</span>
atom mx = a[m][m]
<span style="color: #008080;">for</span> <span style="color: #000000;">col</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>
for i=col+1 to n do
<span style="color: #004080;">integer</span> <span style="color: #000000;">m</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">col</span>
tmp = abs(a[i][col])
<span style="color: #004080;">atom</span> <span style="color: #000000;">mx</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</span><span style="color: #0000FF;">][</span><span style="color: #000000;">m</span><span style="color: #0000FF;">]</span>
if tmp>mx then
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">col</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>
{m,mx} = {i,tmp}
<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;">i</span><span style="color: #0000FF;">][</span><span style="color: #000000;">col</span><span style="color: #0000FF;">])</span>
end if
<span style="color: #008080;">if</span> <span style="color: #000000;">tmp</span><span style="color: #0000FF;">></span><span style="color: #000000;">mx</span> <span style="color: #008080;">then</span>
end for
<span style="color: #0000FF;">{</span><span style="color: #000000;">m</span><span style="color: #0000FF;">,</span><span style="color: #000000;">mx</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">i</span><span style="color: #0000FF;">,</span><span style="color: #000000;">tmp</span><span style="color: #0000FF;">}</span>
if col!=m then
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
{a[col],a[m]} = {a[m],a[col]}
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
{b[col],b[m]} = {b[m],b[col]}
<span style="color: #008080;">if</span> <span style="color: #000000;">col</span><span style="color: #0000FF;">!=</span><span style="color: #000000;">m</span> <span style="color: #008080;">then</span>
end if
<span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">],</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</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;">m</span><span style="color: #0000FF;">],</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">]}</span>
for i=col+1 to n do
<span style="color: #0000FF;">{</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">],</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">m</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;">m</span><span style="color: #0000FF;">],</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">]}</span>
tmp = a[i][col]/a[col][col]
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
for j=col+1 to n do
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">col</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>
a[i][j] -= tmp*a[col][j]
<span style="color: #000000;">tmp</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;">col</span><span style="color: #0000FF;">]/</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">][</span><span style="color: #000000;">col</span><span style="color: #0000FF;">]</span>
end for
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">col</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>
a[i][col] = 0
<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;">tmp</span><span style="color: #0000FF;">*</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
b[i] -= tmp*b[col]
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
end for
<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;">col</span><span style="color: #0000FF;">]</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">0</span>
end for
<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: #0000FF;">-=</span> <span style="color: #000000;">tmp</span><span style="color: #0000FF;">*</span><span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">]</span>
sequence x = repeat(0,n)
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
for col=n to 1 by -1 do
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
tmp = b[col]
<span style="color: #004080;">sequence</span> <span style="color: #000000;">x</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>
for j=n to col+1 by -1 do
<span style="color: #008080;">for</span> <span style="color: #000000;">col</span><span style="color: #0000FF;">=</span><span style="color: #000000;">n</span> <span style="color: #008080;">to</span> <span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
tmp -= x[j]*a[col][j]
<span style="color: #000000;">tmp</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">]</span>
end for
<span style="color: #008080;">for</span> <span style="color: #000000;">j</span><span style="color: #0000FF;">=</span><span style="color: #000000;">n</span> <span style="color: #008080;">to</span> <span style="color: #000000;">col</span><span style="color: #0000FF;">+</span><span style="color: #000000;">1</span> <span style="color: #008080;">by</span> <span style="color: #0000FF;">-</span><span style="color: #000000;">1</span> <span style="color: #008080;">do</span>
x[col] = tmp/a[col][col]
<span style="color: #000000;">tmp</span> <span style="color: #0000FF;">-=</span> <span style="color: #000000;">x</span><span style="color: #0000FF;">[</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]*</span><span style="color: #000000;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">][</span><span style="color: #000000;">j</span><span style="color: #0000FF;">]</span>
end for
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
return x
<span style="color: #000000;">x</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</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;">a</span><span style="color: #0000FF;">[</span><span style="color: #000000;">col</span><span style="color: #0000FF;">][</span><span style="color: #000000;">col</span><span style="color: #0000FF;">]</span>
end function
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">x</span>
constant a = {{1.00, 0.00, 0.00, 0.00, 0.00, 0.00},
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
{1.00, 0.63, 0.39, 0.25, 0.16, 0.10},
{1.00, 1.26, 1.58, 1.98, 2.49, 3.13},
<span style="color: #008080;">constant</span> <span style="color: #000000;">a</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{{</span><span style="color: #000000;">1.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.00</span><span style="color: #0000FF;">},</span>
{1.00, 1.88, 3.55, 6.70, 12.62, 23.80},
<span style="color: #0000FF;">{</span><span style="color: #000000;">1.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.63</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.39</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.25</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.16</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.10</span><span style="color: #0000FF;">},</span>
{1.00, 2.51, 6.32, 15.88, 39.90, 100.28},
<span style="color: #0000FF;">{</span><span style="color: #000000;">1.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1.26</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1.58</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1.98</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2.49</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3.13</span><span style="color: #0000FF;">},</span>
{1.00, 3.14, 9.87, 31.01, 97.41, 306.02}},
<span style="color: #0000FF;">{</span><span style="color: #000000;">1.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">1.88</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3.55</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">6.70</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">12.62</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">23.80</span><span style="color: #0000FF;">},</span>
b = {-0.01, 0.61, 0.91, 0.99, 0.60, 0.02}
<span style="color: #0000FF;">{</span><span style="color: #000000;">1.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">2.51</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">6.32</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">15.88</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">39.90</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">100.28</span><span style="color: #0000FF;">},</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">1.00</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">3.14</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">9.87</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">31.01</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">97.41</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">306.02</span><span style="color: #0000FF;">}},</span>
pp(gauss_eliminate(a, b))</lang>
<span style="color: #000000;">b</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{-</span><span style="color: #000000;">0.01</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.61</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.91</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.99</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.60</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">0.02</span><span style="color: #0000FF;">}</span>
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">gauss_eliminate</span><span style="color: #0000FF;">(</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">))</span>
<!--</syntaxhighlight>-->
{{out}}
<pre>
Line 3,340 ⟶ 5,400:
 
=={{header|PHP}}==
<langsyntaxhighlight lang="php">function swap_rows(&$a, &$b, $r1, $r2)
{
if ($r1 == $r2) return;
Line 3,414 ⟶ 5,474:
}
 
test_gauss();</langsyntaxhighlight>
 
{{out}}
Line 3,430 ⟶ 5,490:
 
=={{header|PL/I}}==
<langsyntaxhighlight lang="pli">Solve: procedure options (main); /* 11 January 2014 */
 
declare n fixed binary;
Line 3,500 ⟶ 5,560:
end Backward_substitution;
 
end Solve;</langsyntaxhighlight>
{{out}}
<pre>
Line 3,524 ⟶ 5,584:
=={{header|PowerShell}}==
===Gauss===
<syntaxhighlight lang="powershell">
<lang PowerShell>
function gauss($a,$b) {
$n = $a.count
Line 3,579 ⟶ 5,639:
gauss $a $b
 
</syntaxhighlight>
</lang>
<b>Output:</b>
<pre>
Line 3,607 ⟶ 5,667:
</pre>
===Gauss-Jordan===
<syntaxhighlight lang="powershell">
<lang PowerShell>
function gauss-jordan($a,$b) {
$n = $a.count
Line 3,659 ⟶ 5,719:
"x ="
gauss-jordan $a $b
</syntaxhighlight>
</lang>
<b>Output:</b>
<pre>
Line 3,688 ⟶ 5,748:
 
=={{header|Python}}==
<langsyntaxhighlight lang="python"># The 'gauss' function takes two matrices, 'a' and 'b', with 'a' square, and it return the determinant of 'a' and a matrix 'x' such that a*x = b.
# If 'b' is the identity, then 'x' is the inverse of 'a'.
 
Line 3,783 ⟶ 5,843:
[[Fraction(1, 1), Fraction(0, 1), Fraction(0, 1)],
[Fraction(0, 1), Fraction(1, 1), Fraction(0, 1)],
[Fraction(0, 1), Fraction(0, 1), Fraction(1, 1)]]</langsyntaxhighlight>
===Using numpy===
<langsyntaxhighlight lang="python3">
$ python3
Python 3.6.0 |Anaconda custom (64-bit)| (default, Dec 23 2016, 12:22:00)
Line 3,799 ⟶ 5,859:
[ 0.06388889, -0.14444444, 0.14722222]])
>>>
</syntaxhighlight>
</lang>
 
=={{header|R}}==
Line 3,805 ⟶ 5,865:
Here 'b' is a matrix. Partial pivoting is used, and the determinant of 'a' is returned as well.
 
<langsyntaxhighlight Rlang="r">gauss <- function(a, b) {
n <- nrow(a)
det <- 1
Line 3,839 ⟶ 5,899:
 
a <- matrix(c(2, 9, 4, 7, 5, 3, 6, 1, 8), 3, 3, byrow=T)
gauss(a, diag(3))</langsyntaxhighlight>
 
{{out}}
Line 3,853 ⟶ 5,913:
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
(require math/matrix)
Line 3,867 ⟶ 5,927:
 
(matrix-solve A b)
</syntaxhighlight>
</lang>
{{out}}
<langsyntaxhighlight lang="racket">
#<array
'#(6 1)
Line 3,878 ⟶ 5,938:
-0.4909897195846582
0.06576069617523222]>
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
(formerly Perl 6)
 
Gaussian elimination results in a matrix in row echelon form. Gaussian elimination with back-substitution (also known as Gauss-Jordan elimination) results in a matrix in reduced row echelon form. That being the case, we can reuse much of the code from the [[Reduced row echelon form]] task. Raku stores and does calculations on decimal numbers within its limit of precision using Rational numbers by default, meaning the calculations are exact.
 
<syntaxhighlight lang="raku" line>sub gauss-jordan-solve (@a, @b) {
@b.kv.map: { @a[$^k].append: $^v };
@a.&rref[*]»[*-1];
}
 
# reduced row echelon form
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;
return $num.narrow if $num.narrow ~~ 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";
</syntaxhighlight>
{{out}}
<pre>A matrix:
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
 
or, A in exact rationals:
1 0 0 0 0 0
1 63/100 39/100 1/4 4/25 1/10
1 63/50 79/50 99/50 249/100 313/100
1 47/25 71/20 67/10 631/50 119/5
1 251/100 158/25 397/25 399/10 2507/25
1 157/50 987/100 3101/100 9741/100 15301/50
 
B matrix:
-0.01
0.61
0.91
0.99
0.60
0.02
 
or, B in exact rationals:
-1/100
61/100
91/100
99/100
3/5
1/50
 
x matrix:
-0.010000000000
1.602790394502
-1.613203059906
1.245494121371
-0.490989719585
0.065760696175
 
or, x in exact rationals:
-1/100
655870882787/409205648497
-660131804286/409205648497
509663229635/409205648497
-200915766608/409205648497
26909648324/409205648497
</pre>
 
=={{header|REXX}}==
===version 1===
<langsyntaxhighlight lang="rexx">/* REXX ---------------------------------------------------------------
* 07.08.2014 Walter Pachl translated from PL/I)
* improved to get integer results for, e.g. this input:
Line 3,971 ⟶ 6,142:
x.j = (b.j - t) / a.j.j
end
Return</langsyntaxhighlight>
{{out}}
<pre>The equations are:
Line 4,016 ⟶ 6,187:
 
Only &nbsp; '''8''' &nbsp; (fractional) decimal digits were used for the output display.
<langsyntaxhighlight lang="rexx">/*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.*/
Line 4,054 ⟶ 6,225:
do o=1 for n; say right('x['o"] = ", 38) left('', x.o>=0) x.o/1
end /*o*/
return</langsyntaxhighlight>
{{out|input file|text=: &nbsp; &nbsp; <tt> GAUSS_E.DAT </tt>}}
<pre>
Line 4,112 ⟶ 6,283:
This is the same as version 2, but in addition, it also shows the residuals.
 
Code was added to this program version to keep a copy of the original &nbsp; '''A.i.k''' &nbsp; and &nbsp; '''B.#''' &nbsp; arrays &nbsp; (for calculating the residuals).
<br>residuals).
<br>Also added was rounding the residual numbers to zero if the number of significant decimal digits was
 
less or equal to 5% of the number of significant fractional decimal digits &nbsp; (in this case, 5% of 1,000 digits for the decimal fraction).
Also added was the rounding the residual numbers to zero &nbsp;if&nbsp; the number of significant decimal digits was &nbsp; <big> &le; </big> &nbsp;5%&nbsp; of
<lang rexx>/*REXX program solves Ax=b with Gaussian elimination and backwards substitution. */
<br>the number of significant fractional decimal digits &nbsp; (in this case, &nbsp;5%&nbsp; of &nbsp;1,000&nbsp; digits for the decimal fraction).
<syntaxhighlight lang="rexx">/*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.*/
Line 4,161 ⟶ 6,334:
do o=1 for n; say right('x['o"] = ", 38) left('', x.o>=0) x.o/1
end /*o*/
return</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the same default input file as for version 2:}}
<pre>
Line 4,211 ⟶ 6,384:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">
require 'bigdecimal/ludcmp'
include LUSolve
Line 4,229 ⟶ 6,402:
one = BigDecimal("1.0")
 
lusolve(a, b, ludecomp(a, n, zero,one), zero).each{|v| puts v.to_s('F')[0..20]}</langsyntaxhighlight>
{{Output}}
<pre>
Line 4,241 ⟶ 6,414:
 
=={{header|Rust}}==
<langsyntaxhighlight lang="rust">
// using a Vec<f32> might be a better idea
// for now, let us create a fixed size array
Line 4,324 ⟶ 6,497:
}
}
</syntaxhighlight>
</lang>
 
=={{header|Scala}}==
{{trans|Java}}
<syntaxhighlight lang="Scala">
object GaussianElimination {
def solve(a: Array[Array[Double]], b: Array[Array[Double]]): Double = {
if (a == null || b == null || a.length == 0 || b.length == 0) {
throw new IllegalArgumentException("Invalid dimensions")
}
 
val n = b.length
val p = b(0).length
 
if (a.length != n || a(0).length != n) {
throw new IllegalArgumentException("Invalid dimensions")
}
 
var det = 1.0
 
for (i <- 0 until n - 1) {
var k = i
 
for (j <- i + 1 until n) {
if (Math.abs(a(j)(i)) > Math.abs(a(k)(i))) {
k = j
}
}
 
if (k != i) {
det = -det
 
for (j <- i until n) {
val s = a(i)(j)
a(i)(j) = a(k)(j)
a(k)(j) = s
}
 
for (j <- 0 until p) {
val s = b(i)(j)
b(i)(j) = b(k)(j)
b(k)(j) = s
}
}
 
for (j <- i + 1 until n) {
val s = a(j)(i) / a(i)(i)
 
for (k <- i + 1 until n) {
a(j)(k) -= s * a(i)(k)
}
 
for (k <- 0 until p) {
b(j)(k) -= s * b(i)(k)
}
}
}
 
for (i <- n - 1 to 0 by -1) {
for (j <- i + 1 until n) {
val s = a(i)(j)
 
for (k <- 0 until p) {
b(i)(k) -= s * b(j)(k)
}
}
 
val s = a(i)(i)
det *= s
 
for (k <- 0 until p) {
b(i)(k) /= s
}
}
 
det
}
 
def main(args: Array[String]): Unit = {
val a = Array(
Array(4.0, 1.0, 0.0, 0.0, 0.0),
Array(1.0, 4.0, 1.0, 0.0, 0.0),
Array(0.0, 1.0, 4.0, 1.0, 0.0),
Array(0.0, 0.0, 1.0, 4.0, 1.0),
Array(0.0, 0.0, 0.0, 1.0, 4.0)
)
 
val b = Array(
Array(1.0 / 2.0),
Array(2.0 / 3.0),
Array(3.0 / 4.0),
Array(4.0 / 5.0),
Array(5.0 / 6.0)
)
 
val x = Array(39.0 / 400.0, 11.0 / 100.0, 31.0 / 240.0, 37.0 / 300.0, 71.0 / 400.0)
 
println("det: " + solve(a, b))
 
for (i <- 0 until 5) {
printf("%12.8f %12.4e\n", b(i)(0), b(i)(0) - x(i))
}
}
}
</syntaxhighlight>
{{out}}
<pre>
det: 780.0
0.09750000 0.0000e+00
0.11000000 0.0000e+00
0.12916667 0.0000e+00
0.12333333 1.3878e-17
0.17750000 2.7756e-17
</pre>
 
=={{header|Sidef}}==
Uses the '''rref(A)''' function from [https://rosettacode.org/wiki/Reduced_row_echelon_form#Sidef Reduced row echelon form].
{{trans|Perl 6Raku}}
<langsyntaxhighlight lang="ruby">func gauss_jordan_solve (a, b) {
 
var A = gather {
Line 4,350 ⟶ 6,636:
 
var G = gauss_jordan_solve(a, b)
say G.map { "%27s" % .as_rat }.join("\n")</langsyntaxhighlight>
{{out}}
<pre>
Line 4,365 ⟶ 6,651:
This implementation computes also the determinant of the matrix A, as it requires only a few operations. The matrix B is overwritten with the solution of the system, and A is overwritten with garbage.
 
<langsyntaxhighlight lang="stata">void gauss(real matrix a, real matrix b, real scalar det) {
real scalar i,j,n,s
real vector js
Line 4,393 ⟶ 6,679:
det = det*a[i,i]
}
}</langsyntaxhighlight>
 
=== LU decomposition and backsubstitution ===
 
<langsyntaxhighlight lang="stata">void ludec(real matrix a, real matrix l, real matrix u, real vector p) {
real scalar i,j,n,s
real vector js
Line 4,439 ⟶ 6,725:
y[i,.] = y[i,.]/u[i,i]
}
}</langsyntaxhighlight>
 
=== Example ===
Here we are computing the inverse of a 3x3 matrix (which happens to be a magic square), using both methods.
 
<langsyntaxhighlight lang="stata">: gauss(a=(2,9,4\7,5,3\6,1,8),b=I(3),det=.)
 
: b
Line 4,464 ⟶ 6,750:
2 | .1055555556 .0222222222 -.0611111111 |
3 | .0638888889 -.1444444444 .1472222222 |
+----------------------------------------------+</langsyntaxhighlight>
 
=={{header|Swift}}==
 
{{trans|Rust}}
 
<syntaxhighlight lang="swift">func gaussEliminate(_ sys: [[Double]]) -> [Double]? {
var system = sys
 
let size = system.count
 
for i in 0..<size-1 where system[i][i] != 0 {
for j in i..<size-1 {
let factor = system[j + 1][i] / system[i][i]
 
for k in i..<size+1 {
system[j + 1][k] -= factor * system[i][k]
}
}
}
 
for i in (1..<size).reversed() where system[i][i] != 0 {
for j in (1..<i+1).reversed() {
let factor = system[j - 1][i] / system[i][i]
 
for k in (0..<size+1).reversed() {
system[j - 1][k] -= factor * system[i][k]
}
}
}
 
var solutions = [Double]()
 
for i in 0..<size {
guard system[i][i] != 0 else {
return nil
}
 
system[i][size] /= system[i][i]
system[i][i] = 1
solutions.append(system[i][size])
}
 
return solutions
}
 
let sys = [
[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]
]
 
guard let sols = gaussEliminate(sys) else {
fatalError("No solutions")
}
 
for (i, f) in sols.enumerated() {
print("X\(i + 1) = \(f)")
}</syntaxhighlight>
 
{{out}}
 
<pre>X1 = -0.01
X2 = 1.6027903945021138
X3 = -1.613203059905563
X4 = 1.245494121371438
X5 = -0.4909897195846575
X6 = 0.065760696175232</pre>
 
=={{header|Tcl}}==
{{tcllib|math::linearalgebra}}
<langsyntaxhighlight lang="tcl">package require math::linearalgebra
 
set A {
Line 4,479 ⟶ 6,835:
}
set b {-0.01 0.61 0.91 0.99 0.60 0.02}
puts -nonewline [math::linearalgebra::show [math::linearalgebra::solveGauss $A $b] "%.2f"]</langsyntaxhighlight>
{{out}}
<pre>
Line 4,500 ⟶ 6,856:
On TI-83 or TI-84, another way to solve this task is to use the '''PlySmlt2''' internal apps and choose
"simult equ solver" with 6 equations and 6 unknowns.
<langsyntaxhighlight lang="ti83b">[[ 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]
Line 4,507 ⟶ 6,863:
[ 1.00 3.14 9.87 31.01 97.41 306.02 0.02]]→[A]
Matr>List(rref([A]),7,L1)
L1</langsyntaxhighlight>
{{out}}
<pre>
Line 4,514 ⟶ 6,870:
 
=={{header|VBA}}==
{{trans|Phix}}<langsyntaxhighlight lang="vb">'Option Base 1
Private Function gauss_eliminate(a As Variant, b As Variant) As Variant
Dim n As Integer: n = UBound(b)
Line 4,570 ⟶ 6,926:
t = Join(s, ", ")
Debug.Print t; ")"
End Sub</langsyntaxhighlight>{{out}}
<pre>(-0.01, 1.60279039450209, -1.61320305990548, 1.24549412137136, -0.490989719584628, 0.065760696175228)</pre>
 
=={{header|VBScript}}==
<langsyntaxhighlight lang="vb">' Gaussian elimination - VBScript
const n=6
dim a(6,6),b(6),x(6),ab
Line 4,618 ⟶ 6,975:
buf=buf&right(space(8)&formatnumber(x(i),2),8)&vbcrlf
next
wscript.echo buf</langsyntaxhighlight>
{{out}}
<pre>
Line 4,627 ⟶ 6,984:
-0,49
0,07
</pre>
 
=={{header|Wren}}==
{{trans|Kotlin}}
{{libheader|Wren-iterate}}
<syntaxhighlight lang="wren">import "./iterate" for Stepped
 
var ta = [
[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 tb = [-0.01, 0.61, 0.91, 0.99, 0.60, 0.02]
var tx = [
-0.01, 1.602790394502114, -1.6132030599055613,
1.2454941213714368, -0.4909897195846576, 0.065760696175232
]
 
var EPSILON = 1e-14 // tolerance required
 
var gaussPartial = Fn.new { |a0, b0|
var m = b0.count
var a = List.filled(m, null)
var i = 0
for (ai in a0) {
var row = ai.toList
row.add(b0[i])
a[i] = row
i = i + 1
}
for (k in 0...a.count) {
var iMax = 0
var max = -1
for (i in Stepped.ascend(k...m)) {
var row = a[i]
// compute scale factor s = max abs in row
var s = -1
for (j in Stepped.ascend(k...m)) {
var e = row[j].abs
if (e > s) s = e
}
// scale the abs used to pick the pivot
var abs = row[k].abs / s
if (abs > max) {
iMax = i
max = abs
}
}
if (a[iMax][k] == 0) Fiber.abort("Matrix is singular.")
a.swap(k, iMax)
for (i in Stepped.ascend(k + 1...m)) {
for (j in Stepped.ascend(k + 1..m)) {
a[i][j] = a[i][j] - a[k][j] * a[i][k] / a[k][k]
}
a[i][k] = 0
}
}
var x = List.filled(m, 0)
for (i in Stepped.descend(m - 1..0)) {
x[i] = a[i][m]
for (j in Stepped.ascend(i + 1...m)) {
x[i] = x[i] - a[i][j] * x[j]
}
x[i] = x[i] / a[i][i]
}
return x
}
 
var x = gaussPartial.call(ta, tb)
System.print(x)
var i = 0
for (xi in x) {
if ((tx[i] - xi).abs > EPSILON) {
System.print("Out of tolerance.")
System.print("Expected values are %(tx)")
return
}
i = i + 1
}</syntaxhighlight>
 
{{out}}
<pre>
[-0.01, 1.6027903945021, -1.6132030599056, 1.2454941213714, -0.49098971958466, 0.065760696175232]
</pre>
 
=={{header|zkl}}==
Using the GNU Scientific Library:
<langsyntaxhighlight lang="zkl">var [const] GSL=Import("zklGSL"); // libGSL (GNU Scientific Library)
a:=GSL.Matrix(6,6).set(
1.00, 0.00, 0.00, 0.00, 0.00, 0.00,
Line 4,641 ⟶ 7,086:
b:=GSL.VectorFromData(-0.01, 0.61, 0.91, 0.99, 0.60, 0.02);
x:=a.AxEQb(b);
x.format(8,5).println();</langsyntaxhighlight>
{{out}}
<pre>
Line 4,648 ⟶ 7,093:
Or, using lists:
{{trans|C}}
<langsyntaxhighlight lang="zkl">fcn gaussEliminate(a,b){ // modifies a&b --> vector
n:=b.len();
foreach dia in ([0..n-1]){
Line 4,670 ⟶ 7,115:
}
x
}</langsyntaxhighlight>
<langsyntaxhighlight lang="zkl">a:=List( List(1.00, 0.00, 0.00, 0.00, 0.00, 0.00,),
List(1.00, 0.63, 0.39, 0.25, 0.16, 0.10,),
List(1.00, 1.26, 1.58, 1.98, 2.49, 3.13,),
Line 4,678 ⟶ 7,123:
List(1.00, 3.14, 9.87, 31.01, 97.41, 306.02) );
b:=List( -0.01, 0.61, 0.91, 0.99, 0.60, 0.02 );
gaussEliminate(a,b).println();</langsyntaxhighlight>
{{out}}
<pre>L(-0.01,1.60279,-1.6132,1.24549,-0.49099,0.0657607)</pre>
337

edits