LU decomposition: Difference between revisions

m
m (→‎{{header|Raku}}: oops, fix variable name)
m (→‎{{header|Wren}}: Minor tidy)
 
(4 intermediate revisions by 4 users not shown)
Line 194:
{{trans|Python}}
 
<langsyntaxhighlight lang="11l">F pprint(m)
L(row) m
print(row)
Line 243:
L(part) lu(b)
pprint(part)
print()</langsyntaxhighlight>
 
{{out}}
Line 279:
{{works with|Ada 2005}}
decomposition.ads:
<langsyntaxhighlight Adalang="ada">with Ada.Numerics.Generic_Real_Arrays;
generic
with package Matrix is new Ada.Numerics.Generic_Real_Arrays (<>);
Line 287:
procedure Decompose (A : Matrix.Real_Matrix; P, L, U : out Matrix.Real_Matrix);
 
end Decomposition;</langsyntaxhighlight>
 
decomposition.adb:
<langsyntaxhighlight Adalang="ada">package body Decomposition is
 
procedure Swap_Rows (M : in out Matrix.Real_Matrix; From, To : Natural) is
Line 366:
end Decompose;
 
end Decomposition;</langsyntaxhighlight>
 
Example usage:
<langsyntaxhighlight Adalang="ada">with Ada.Numerics.Real_Arrays;
with Ada.Text_IO;
with Decomposition;
Line 421:
Ada.Text_IO.Put_Line ("U:"); Print (U_2);
Ada.Text_IO.Put_Line ("P:"); Print (P_2);
end Decompose_Example;</langsyntaxhighlight>
 
{{out}}
Line 463:
0.00 1.00 0.00 0.00
0.00 0.00 0.00 1.00</pre>
 
=={{header|ATS}}==
<syntaxhighlight lang="ATS">
(* There is a "little matrix library" included below. Not all of it is
used, though unused parts may prove useful for playing with the
code.
 
One might, by the way, find interesting how I get the P matrix from
a permutation vector. *)
 
%{^
#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
 
(* You can substitute an "fma" function for this definition: *)
macdef multiply_and_add (x, y, z) = (,(x) * ,(y)) + ,(z)
 
exception Exc_degenerate_problem of string
 
(*------------------------------------------------------------------*)
(* 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} (* Useful for debugging. *)
Real_Matrix_fprint :
{m, n : pos}
(FILEref, Real_Matrix (tk, m, n)) -<1> void
 
overload copy with Real_Matrix_copy
overload copy_to with Real_Matrix_copy_to
overload fill_with_elt with Real_Matrix_fill_with_elt
overload dimension with Real_Matrix_dimension
overload [] with Real_Matrix_get_at
overload [] with Real_Matrix_set_at
overload apply_index_map with Real_Matrix_apply_index_map
overload transpose with Real_Matrix_transpose
overload block with Real_Matrix_block
overload unit_matrix with Real_Matrix_unit_matrix
overload unit_matrix_to with Real_Matrix_unit_matrix_to
overload matrix_sum with Real_Matrix_matrix_sum
overload matrix_sum_to with Real_Matrix_matrix_sum_to
overload matrix_difference with Real_Matrix_matrix_difference
overload matrix_difference_to with Real_Matrix_matrix_difference_to
overload matrix_product with Real_Matrix_matrix_product
overload matrix_product_to with Real_Matrix_matrix_product_to
overload scalar_product with Real_Matrix_scalar_product
overload scalar_product with Real_Matrix_scalar_product_2
overload scalar_product_to with Real_Matrix_scalar_product_to
overload + with matrix_sum
overload - with matrix_difference
overload * with matrix_product
overload * with scalar_product
 
(*------------------------------------------------------------------*)
(* Implementation of the "little matrix library" *)
 
implement {tk}
Real_Matrix_make_elt (m0, n0, elt) =
Real_Matrix (matrixref_make_elt<g0float tk> (i2sz m0, i2sz n0, elt),
m0, n0, m0, n0, lam (i1, j1) => @(i1, j1))
 
implement {}
Real_Matrix_dimension A =
case+ A of Real_Matrix (_, m1, n1, _, _, _) => @(m1, n1)
 
implement {tk}
Real_Matrix_get_at (A, i1, j1) =
let
val+ Real_Matrix (storage, _, _, _, n0, index_map) = A
val @(i0, j0) = index_map (i1, j1)
in
matrixref_get_at<g0float tk> (storage, pred i0, n0, pred j0)
end
 
implement {tk}
Real_Matrix_set_at (A, i1, j1, x) =
let
val+ Real_Matrix (storage, _, _, _, n0, index_map) = A
val @(i0, j0) = index_map (i1, j1)
in
matrixref_set_at<g0float tk> (storage, pred i0, n0, pred j0, x)
end
 
implement {}
Real_Matrix_apply_index_map (A, m1, n1, index_map) =
(* This is not the most efficient way to acquire new indexing, but
it will work. It requires three closures, instead of the two
needed by our implementations of "transpose" and "block". *)
let
val+ Real_Matrix (storage, m1a, n1a, m0, n0, index_map_1a) = A
in
Real_Matrix (storage, m1, n1, m0, n0,
lam (i1, j1) =>
index_map_1a (i1a, j1a) where
{ val @(i1a, j1a) = index_map (i1, j1) })
end
 
implement {}
Real_Matrix_transpose A =
let
val+ Real_Matrix (storage, m1, n1, m0, n0, index_map) = A
in
Real_Matrix (storage, n1, m1, m0, n0,
lam (i1, j1) => index_map (j1, i1))
end
 
implement {}
Real_Matrix_block (A, p0, p1, q0, q1) =
let
val+ Real_Matrix (storage, m1, n1, m0, n0, index_map) = A
in
Real_Matrix (storage, succ (p1 - p0), succ (q1 - q0), m0, n0,
lam (i1, j1) =>
index_map (p0 + pred i1, q0 + pred j1))
end
 
implement {tk}
Real_Matrix_copy A =
let
val @(m1, n1) = dimension A
val C = Real_Matrix_make_elt<tk> (m1, n1, A[1, 1])
val () = copy_to<tk> (C, A)
in
C
end
 
implement {tk}
Real_Matrix_copy_to (Dst, Src) =
let
val @(m1, n1) = dimension Src
prval [m1 : int] EQINT () = eqint_make_gint m1
prval [n1 : int] EQINT () = eqint_make_gint n1
 
var i : intGte 1
in
for* {i : pos | i <= m1 + 1} .<(m1 + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m1; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= n1 + 1} .<(n1 + 1) - j>.
(j : int j) =>
(j := 1; j <> succ n1; j := succ j)
Dst[i, j] := Src[i, j]
end
end
 
implement {tk}
Real_Matrix_fill_with_elt (A, elt) =
let
val @(m1, n1) = dimension A
prval [m1 : int] EQINT () = eqint_make_gint m1
prval [n1 : int] EQINT () = eqint_make_gint n1
 
var i : intGte 1
in
for* {i : pos | i <= m1 + 1} .<(m1 + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m1; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= n1 + 1} .<(n1 + 1) - j>.
(j : int j) =>
(j := 1; j <> succ n1; j := succ j)
A[i, j] := elt
end
end
 
implement {tk}
Real_Matrix_unit_matrix {m} m =
let
val A = Real_Matrix_make_elt<tk> (m, m, Zero)
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
A[i, i] := One;
A
end
 
implement {tk}
Real_Matrix_unit_matrix_to A =
let
val @(m, _) = dimension A
prval [m : int] EQINT () = eqint_make_gint m
 
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= m + 1} .<(m + 1) - j>.
(j : int j) =>
(j := 1; j <> succ m; j := succ j)
A[i, j] := (if i = j then One else Zero)
end
end
 
implement {tk}
Real_Matrix_matrix_sum (A, B) =
let
val @(m, n) = dimension A
val C = Real_Matrix_make_elt<tk> (m, n, NAN)
val () = matrix_sum_to<tk> (C, A, B)
in
C
end
 
implement {tk}
Real_Matrix_matrix_sum_to (C, A, B) =
let
val @(m, n) = dimension A
prval [m : int] EQINT () = eqint_make_gint m
prval [n : int] EQINT () = eqint_make_gint n
 
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
(j : int j) =>
(j := 1; j <> succ n; j := succ j)
C[i, j] := A[i, j] + B[i, j]
end
end
 
implement {tk}
Real_Matrix_matrix_difference (A, B) =
let
val @(m, n) = dimension A
val C = Real_Matrix_make_elt<tk> (m, n, NAN)
val () = matrix_difference_to<tk> (C, A, B)
in
C
end
 
implement {tk}
Real_Matrix_matrix_difference_to (C, A, B) =
let
val @(m, n) = dimension A
prval [m : int] EQINT () = eqint_make_gint m
prval [n : int] EQINT () = eqint_make_gint n
 
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
(j : int j) =>
(j := 1; j <> succ n; j := succ j)
C[i, j] := A[i, j] - B[i, j]
end
end
 
implement {tk}
Real_Matrix_matrix_product (A, B) =
let
val @(m, n) = dimension A and @(_, p) = dimension B
val C = Real_Matrix_make_elt<tk> (m, p, NAN)
val () = matrix_product_to<tk> (C, A, B)
in
C
end
 
implement {tk}
Real_Matrix_matrix_product_to (C, A, B) =
let
val @(m, n) = dimension A and @(_, p) = dimension B
prval [m : int] EQINT () = eqint_make_gint m
prval [n : int] EQINT () = eqint_make_gint n
prval [p : int] EQINT () = eqint_make_gint p
 
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
let
var k : intGte 1
in
for* {k : pos | k <= p + 1} .<(p + 1) - k>.
(k : int k) =>
(k := 1; k <> succ p; k := succ k)
let
var j : intGte 1
in
C[i, k] := A[i, 1] * B[1, k];
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
(j : int j) =>
(j := 2; j <> succ n; j := succ j)
C[i, k] :=
multiply_and_add (A[i, j], B[j, k], C[i, k])
end
end
end
 
implement {tk}
Real_Matrix_scalar_product (A, r) =
let
val @(m, n) = dimension A
val C = Real_Matrix_make_elt<tk> (m, n, NAN)
val () = scalar_product_to<tk> (C, A, r)
in
C
end
 
implement {tk}
Real_Matrix_scalar_product_2 (r, A) =
Real_Matrix_scalar_product<tk> (A, r)
 
implement {tk}
Real_Matrix_scalar_product_to (C, A, r) =
let
val @(m, n) = dimension A
prval [m : int] EQINT () = eqint_make_gint m
prval [n : int] EQINT () = eqint_make_gint n
 
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
(j : int j) =>
(j := 1; j <> succ n; j := succ j)
C[i, j] := A[i, j] * r
end
end
 
implement {tk}
Real_Matrix_fprint {m, n} (outf, A) =
let
val @(m, n) = dimension A
var i : intGte 1
in
for* {i : pos | i <= m + 1} .<(m + 1) - i>.
(i : int i) =>
(i := 1; i <> succ m; i := succ i)
let
var j : intGte 1
in
for* {j : pos | j <= n + 1} .<(n + 1) - j>.
(j : int j) =>
(j := 1; j <> succ n; j := succ j)
let
typedef FILEstar = $extype"FILE *"
extern castfn FILEref2star : FILEref -<> FILEstar
val _ = $extfcall (int, "fprintf", FILEref2star outf,
"%12.6lf", A[i, j])
in
end;
fprintln! (outf)
end
end
 
(*------------------------------------------------------------------*)
(* LUP decomposition. Based on
https://en.wikipedia.org/w/index.php?title=LU_decomposition&oldid=1146366204#C_code_example
*)
 
extern fn {tk : tkind}
Real_Matrix_LUP_decomposition :
{n : pos}
(Real_Matrix (tk, n, n),
g0float tk (* tolerance *) ) -< !exnrefwrt >
@(Real_Matrix (tk, n, n),
Real_Matrix (tk, n, n),
Real_Matrix (tk, n, n))
 
overload LUP_decomposition with Real_Matrix_LUP_decomposition
 
implement {tk}
Real_Matrix_LUP_decomposition {n} (A, tol) =
let
val @(n, _) = dimension A
typedef one_to_n = intBtwe (1, n)
 
(* The initial permutation is [1,2,3,...,n]. *)
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 permutation =
$effmask_all arrayref_tabulate<one_to_n> (i2sz n)
fn
index_map : Matrix_Index_Map (n, n, n, n) =
lam (i1, j1) => $effmask_ref
(@(i0, j1) where { val i0 = permutation[i1 - 1] })
 
val A = apply_index_map (copy<tk> A, n, n, index_map)
 
fun
select_pivot {i, k : pos | i <= k; k <= n + 1}
.<(n + 1) - k>.
(i : int i,
k : int k,
max_abs : g0float tk,
k_max_abs : intBtwe (i, n))
:<!ref> @(g0float tk, intBtwe (i, n)) =
if k = succ n then
@(max_abs, k_max_abs)
else
let
val absval = A[k, i]
in
if absval > max_abs then
select_pivot (i, succ k, absval, k)
else
select_pivot (i, succ k, max_abs, k_max_abs)
end
 
fn {}
exchange_rows (i1 : one_to_n,
i2 : one_to_n) :<!refwrt> void =
if i1 <> i2 then
let
val k1 = permutation[pred i1]
and k2 = permutation[pred i2]
in
permutation[pred i1] := k2;
permutation[pred i2] := k1
end
 
val () =
let
var i : Int
in
for* {i : pos | i <= n + 1} .<(n + 1) - i>.
(i : int i) =>
(i := 1; i <> succ n; i := succ i)
let
val @(maxabs, i_pivot) = select_pivot (i, i, Zero, i)
prval [i_pivot : int] EQINT () = eqint_make_gint i_pivot
var j : Int
in
if maxabs < tol then
$raise Exc_degenerate_problem
("Real_Matrix_LUP_decomposition");
exchange_rows (i_pivot, i);
for* {j : int | i + 1 <= j; j <= n + 1}
.<(n + 1) - j>.
(j : int j) =>
(j := succ i; j <> succ n; j := succ j)
let
var k : Int
in
A[j, i] := A[j, i] / A[i, i];
for* {k : int | i + 1 <= k; k <= n + 1}
.<(n + 1) - k>.
(k : int k) =>
(k := succ i; k <> succ n; k := succ k)
A[j, k] :=
multiply_and_add
(~A[j, i], A[i, k], A[j, k])
end
end
end
 
val U = A
val L = Real_Matrix_unit_matrix<tk> n
val () =
let
var i : Int
in
for* {i : int | 2 <= i; i <= n + 1} .<(n + 1) - i>.
(i : int i) =>
(i := 2; i <> succ n; i := succ i)
let
var j : Int
in
for* {j : pos | j <= i} .<i - j>.
(j : int j) =>
(j := 1; j <> i; j := succ j)
begin
L[i, j] := U[i, j];
U[i, j] := Zero
end
end
end
val P = apply_index_map (Real_Matrix_unit_matrix<tk> n,
n, n, index_map)
in
@(L, U, P)
end
 
(*------------------------------------------------------------------*)
 
implement
main0 () =
(* I use tolerances of zero, secure in the knowledge that IEEE
floating point will not crash the program just because a matrix
was singular. :) *)
let
val A = Real_Matrix_make_elt<dblknd> (3, 3, NAN)
val () =
(A[1, 1] := 1.0; A[1, 2] := 3.0; A[1, 3] := 5.0;
A[2, 1] := 2.0; A[2, 2] := 4.0; A[2, 3] := 7.0;
A[3, 1] := 1.0; A[3, 2] := 1.0; A[3, 3] := 0.0)
val @(L, U, P) = LUP_decomposition (A, 0.0)
val () = println! "A"
val () = Real_Matrix_fprint (stdout_ref, A)
val () = println! "L"
val () = Real_Matrix_fprint (stdout_ref, L)
val () = println! "U"
val () = Real_Matrix_fprint (stdout_ref, U)
val () = println! "P"
val () = Real_Matrix_fprint (stdout_ref, P)
val () = println! "PA - LU"
val () = Real_Matrix_fprint (stdout_ref, P * A - L * U)
 
val () = println! "\n------------------------------------------\n"
 
val A = Real_Matrix_make_elt<dblknd> (4, 4, NAN)
val () =
(A[1, 1] := 11.0; A[1, 2] := 9.0; A[1, 3] := 24.0; A[1, 4] := 2.0;
A[2, 1] := 1.0; A[2, 2] := 5.0; A[2, 3] := 2.0; A[2, 4] := 6.0;
A[3, 1] := 3.0; A[3, 2] := 17.0; A[3, 3] := 18.0; A[3, 4] := 1.0;
A[4, 1] := 2.0; A[4, 2] := 5.0; A[4, 3] := 7.0; A[4, 4] := 1.0)
val @(L, U, P) = LUP_decomposition (A, 0.0)
val () = println! "A"
val () = Real_Matrix_fprint (stdout_ref, A)
val () = println! "L"
val () = Real_Matrix_fprint (stdout_ref, L)
val () = println! "U"
val () = Real_Matrix_fprint (stdout_ref, U)
val () = println! "P"
val () = Real_Matrix_fprint (stdout_ref, P)
val () = println! "PA - LU"
val () = Real_Matrix_fprint (stdout_ref, P * A - L * U)
 
val () = println! "\n------------------------------------------\n"
 
val () = println! ("I have added an example having an asymmetric",
" permutation\nmatrix, ",
"because I needed one for testing:")
val () = println! ()
 
val A = Real_Matrix_make_elt<dblknd> (4, 4, NAN)
val () =
(A[1, 1] := 11.0; A[1, 2] := 9.0; A[1, 3] := 24.0; A[1, 4] := 2.0;
A[2, 1] := 1.0; A[2, 2] := 5.0; A[2, 3] := 2.0; A[2, 4] := 6.0;
A[3, 1] := 3.0; A[3, 2] := 175.0; A[3, 3] := 18.0; A[3, 4] := 1.0;
A[4, 1] := 2.0; A[4, 2] := 5.0; A[4, 3] := 7.0; A[4, 4] := 1.0)
val @(L, U, P) = LUP_decomposition (A, 0.0)
val () = println! "A"
val () = Real_Matrix_fprint (stdout_ref, A)
val () = println! "L"
val () = Real_Matrix_fprint (stdout_ref, L)
val () = println! "U"
val () = Real_Matrix_fprint (stdout_ref, U)
val () = println! "P"
val () = Real_Matrix_fprint (stdout_ref, P)
val () = println! "PA - LU"
val () = Real_Matrix_fprint (stdout_ref, P * A - L * U)
in
end
 
(*------------------------------------------------------------------*)
</syntaxhighlight>
 
{{out}}
<pre style="font-size:90%">$ patscc -std=gnu2x -g -O2 -march=native -DATS_MEMALLOC_GCBDW lu_decomposition_task.dats -lgc && ./a.out
A
1.000000 3.000000 5.000000
2.000000 4.000000 7.000000
1.000000 1.000000 0.000000
L
1.000000 0.000000 0.000000
0.500000 1.000000 0.000000
0.500000 -1.000000 1.000000
U
2.000000 4.000000 7.000000
0.000000 1.000000 1.500000
0.000000 0.000000 -2.000000
P
0.000000 1.000000 0.000000
1.000000 0.000000 0.000000
0.000000 0.000000 1.000000
PA - LU
0.000000 0.000000 0.000000
0.000000 0.000000 0.000000
0.000000 0.000000 0.000000
 
------------------------------------------
 
A
11.000000 9.000000 24.000000 2.000000
1.000000 5.000000 2.000000 6.000000
3.000000 17.000000 18.000000 1.000000
2.000000 5.000000 7.000000 1.000000
L
1.000000 0.000000 0.000000 0.000000
0.272727 1.000000 0.000000 0.000000
0.090909 0.287500 1.000000 0.000000
0.181818 0.231250 0.003597 1.000000
U
11.000000 9.000000 24.000000 2.000000
0.000000 14.545455 11.454545 0.454545
0.000000 0.000000 -3.475000 5.687500
0.000000 0.000000 0.000000 0.510791
P
1.000000 0.000000 0.000000 0.000000
0.000000 0.000000 1.000000 0.000000
0.000000 1.000000 0.000000 0.000000
0.000000 0.000000 0.000000 1.000000
PA - LU
0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000
 
------------------------------------------
 
I have added an example having an asymmetric permutation
matrix, because I needed one for testing:
 
A
11.000000 9.000000 24.000000 2.000000
1.000000 5.000000 2.000000 6.000000
3.000000 175.000000 18.000000 1.000000
2.000000 5.000000 7.000000 1.000000
L
1.000000 0.000000 0.000000 0.000000
0.272727 1.000000 0.000000 0.000000
0.181818 0.019494 1.000000 0.000000
0.090909 0.024236 -0.190393 1.000000
U
11.000000 9.000000 24.000000 2.000000
0.000000 172.545455 11.454545 0.454545
0.000000 0.000000 2.413066 0.627503
0.000000 0.000000 0.000000 5.926638
P
1.000000 0.000000 0.000000 0.000000
0.000000 0.000000 1.000000 0.000000
0.000000 0.000000 0.000000 1.000000
0.000000 1.000000 0.000000 0.000000
PA - LU
0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000
0.000000 0.000000 0.000000 0.000000
</pre>
 
=={{header|AutoHotkey}}==
<langsyntaxhighlight AutoHotkeylang="autohotkey">;--------------------------
LU_decomposition(A){
P := Pivot(A)
Line 536 ⟶ 1,382:
return "[" Trim(output, "`n,") "]"
}
;--------------------------</langsyntaxhighlight>
Examples:<langsyntaxhighlight AutoHotkeylang="autohotkey">A1 := [[1, 3, 5]
, [2, 4, 7]
, [1, 1, 0]]
Line 556 ⟶ 1,402:
}
MsgBox, 262144, , % result
return</langsyntaxhighlight>
{{out}}
<pre>A:=
Line 604 ⟶ 1,450:
 
=={{header|BBC BASIC}}==
<langsyntaxhighlight lang="bbcbasic"> DIM A1(2,2)
A1() = 1, 3, 5, 2, 4, 7, 1, 1, 0
PROCLUdecomposition(A1(), L1(), U1(), P1())
Line 663 ⟶ 1,509:
a$ = LEFT$(LEFT$(a$)) + CHR$(13) + CHR$(10)
NEXT i%
= a$</langsyntaxhighlight>
{{out}}
<pre>
Line 701 ⟶ 1,547:
 
=={{header|C}}==
Compiled with <code>gcc -std=gnu99 -Wall -lm -pedantic</code>. Demonstrating how to do LU decomposition, and how (not) to use macros. <langsyntaxhighlight Clang="c">#include <stdio.h>
#include <stdlib.h>
#include <math.h>
Line 829 ⟶ 1,675:
 
return 0;
}</langsyntaxhighlight>
 
=={{header|C++}}==
<langsyntaxhighlight lang="cpp">#include <cassert>
#include <cmath>
#include <iomanip>
Line 1,015 ⟶ 1,861:
 
return 0;
}</langsyntaxhighlight>
 
{{out}}
Line 1,098 ⟶ 1,944:
Uses the routine (mmul A B) from [[Matrix multiplication]].
 
<langsyntaxhighlight lang="lisp">;; Creates a nxn identity matrix.
(defun eye (n)
(let ((I (make-array `(,n ,n) :initial-element 0)))
Line 1,156 ⟶ 2,002:
 
;; Return L, U and P.
(values L U P)))</langsyntaxhighlight>
 
Example 1:
 
<langsyntaxhighlight lang="lisp">(setf g (make-array '(3 3) :initial-contents '((1 3 5) (2 4 7)(1 1 0))))
#2A((1 3 5) (2 4 7) (1 1 0))
 
Line 1,166 ⟶ 2,012:
#2A((1 0 0) (1/2 1 0) (1/2 -1 1))
#2A((2 4 7) (0 1 3/2) (0 0 -2))
#2A((0 1 0) (1 0 0) (0 0 1))</langsyntaxhighlight>
 
Example 2:
 
<langsyntaxhighlight lang="lisp">(setf h (make-array '(4 4) :initial-contents '((11 9 24 2)(1 5 2 6)(3 17 18 1)(2 5 7 1))))
#2A((11 9 24 2) (1 5 2 6) (3 17 18 1) (2 5 7 1))
 
Line 1,176 ⟶ 2,022:
#2A((1 0 0 0) (3/11 1 0 0) (1/11 23/80 1 0) (2/11 37/160 1/278 1))
#2A((11 9 24 2) (0 160/11 126/11 5/11) (0 0 -139/40 91/16) (0 0 0 71/139))
#2A((1 0 0 0) (0 0 1 0) (0 1 0 0) (0 0 0 1))</langsyntaxhighlight>
 
=={{header|D}}==
{{trans|Common Lisp}}
<langsyntaxhighlight lang="d">import std.stdio, std.algorithm, std.typecons, std.numeric,
std.array, std.conv, std.string, std.range;
 
Line 1,284 ⟶ 2,130:
foreach (immutable m; [a, b])
writefln(f, lu(m).tupleof);
}</langsyntaxhighlight>
{{out}}
<pre>[[1.0, 0.0, 0.0],
Line 1,315 ⟶ 2,161:
 
=={{header|EchoLisp}}==
<langsyntaxhighlight lang="scheme">
(lib 'matrix) ;; the matrix library provides LU-decomposition
(decimals 5)
Line 1,354 ⟶ 2,200:
0 0 -3.475 5.6875
0 0 0 0.51079
</syntaxhighlight>
</lang>
 
=={{header|Fortran}}==
<langsyntaxhighlight Fortranlang="fortran">program lu1
implicit none
call check( reshape([real(8)::1,2,1,3,4,1,5,7,0 ],[3,3]) )
Line 1,425 ⟶ 2,271:
end subroutine
 
end program</langsyntaxhighlight>
{{out}}
<pre>
Line 1,473 ⟶ 2,319:
===2D representation===
{{trans|Common Lisp}}
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,582 ⟶ 2,428:
u.print("u")
p.print("p")
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,624 ⟶ 2,470:
</pre>
===Flat representation===
<langsyntaxhighlight lang="go">package main
 
import "fmt"
Line 1,746 ⟶ 2,592:
u.print("u")
p.print("p")
}</langsyntaxhighlight>
Output is same as from 2D solution.
 
===Library gonum/mat===
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,782 ⟶ 2,628:
fmt.Printf("u: %.5f\n\n", mat.Formatted(u, mat.Prefix(" ")))
fmt.Println("p:", lu.Pivot(nil))
}</langsyntaxhighlight>
{{out}}
Pivot format is a little different here. (But library solutions don't really meet task requirements anyway.)
Line 1,819 ⟶ 2,665:
 
===Library go.matrix===
<langsyntaxhighlight lang="go">package main
 
import (
Line 1,845 ⟶ 2,691:
fmt.Printf("u:\n%v\n", u)
fmt.Printf("p:\n%v\n", p)
}</langsyntaxhighlight>
{{out}}
<pre>
Line 1,889 ⟶ 2,735:
=={{header|Haskell}}==
''Without elem-at-index modifications; doesn't find maximum but any non-zero element''
<syntaxhighlight lang="haskell">
<lang Haskell>
import Data.List
import Data.Maybe
Line 1,959 ⟶ 2,805:
main = putStrLn "Task1: \n" >> solveTask mY1 >>
putStrLn "Task2: \n" >> solveTask mY2
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 2,024 ⟶ 2,870:
===With Numeric.LinearAlgebra===
 
<langsyntaxhighlight Haskelllang="haskell">import Numeric.LinearAlgebra
 
a1, a2 :: Matrix R
Line 2,040 ⟶ 2,886:
main = do
print $ lu a1
print $ lu a2</langsyntaxhighlight>
{{out}}
<pre>((3><3)
Line 2,072 ⟶ 2,918:
 
'''Solution:'''
<syntaxhighlight lang="idris">
<lang Idris>
module Main
 
Line 2,228 ⟶ 3,074:
putStrLn "Solution 2:"
printEx ex2
</syntaxhighlight>
</lang>
 
{{out}}
Line 2,252 ⟶ 3,098:
 
'''Solution:'''
<langsyntaxhighlight lang="j">mp=: +/ .*
 
LU=: 3 : 0
Line 2,274 ⟶ 3,120:
 
permtomat=: 1 {.~"0 -@>:@:/:
LUdecompose=: (permtomat&.>@{. , }.)@:LU</langsyntaxhighlight>
 
'''Example use:'''
<langsyntaxhighlight lang="j"> A=:3 3$1 3 5 2 4 7 1 1 0
LUdecompose A
┌─────┬─────┬───────┐
Line 2,301 ⟶ 3,147:
1 5 2 6
3 17 18 1
2 5 7 1</langsyntaxhighlight>
 
=={{header|Java}}==
Translation of [[#Common_Lisp|Common Lisp]] via [[#D|D]]
{{works with|Java|8}}
<langsyntaxhighlight lang="java">import static java.util.Arrays.stream;
import java.util.Locale;
import static java.util.stream.IntStream.range;
Line 2,402 ⟶ 3,248:
print(m);
}
}</langsyntaxhighlight>
<pre> 1.0 0.0 0.0
0.5 1.0 0.0
Line 2,433 ⟶ 3,279:
=={{header|Javascript}}==
{{works with|ES5 ES6}}
<langsyntaxhighlight lang="javascript">
const mult=(a, b)=>{
let res = new Array(a.length);
Line 2,512 ⟶ 3,358:
return [...lu(A),P];
}
</syntaxhighlight>
</lang>
 
=={{header|jq}}==
Line 2,521 ⟶ 3,367:
 
'''Infrastructure'''
<langsyntaxhighlight lang="jq"># Create an m x n matrix
def matrix(m; n; init):
if m == 0 then []
Line 2,565 ⟶ 3,411:
| reduce range (0;$length) as $i
(""; . + reduce range(0;$length) as $j
(""; "\(.) \($in[$i][$j] | right )" ) + "\n" ) ;</langsyntaxhighlight>
'''LU decomposition'''
<langsyntaxhighlight lang="jq"># Create the pivot matrix for the input matrix.
# Use "range(0;$n) as $i" to handle ill-conditioned cases.
def pivotize:
Line 2,609 ⟶ 3,455:
| . + [ $P ]
;
</syntaxhighlight>
</lang>
'''Example 1''':
<langsyntaxhighlight lang="jq">def a: [[1, 3, 5], [2, 4, 7], [1, 1, 0]];
a | lup[] | neatly(4)
</syntaxhighlight>
</lang>
{{Out}}
<langsyntaxhighlight lang="sh"> $ /usr/local/bin/jq -M -n -r -f LU.jq
1 0 0
0.5 1 0
Line 2,627 ⟶ 3,473:
1 0 0
0 0 1
</syntaxhighlight>
</lang>
'''Example 2''':
<langsyntaxhighlight lang="jq">def b: [[11,9,24,2],[1,5,2,6],[3,17,18,1],[2,5,7,1]];
b | lup[] | neatly(21)</langsyntaxhighlight>
{{Out}}
<langsyntaxhighlight lang="sh">$ /usr/local/bin/jq -M -n -r -f LU.jq
1 0 0 0
0.2727272727272727 1 0 0
Line 2,646 ⟶ 3,492:
0 0 1 0
0 1 0 0
0 0 0 1</langsyntaxhighlight>
 
'''Example 3''':
<syntaxhighlight lang="jq">
<lang jq>
# A|lup|verify(A) should be true
def verify(A):
Line 2,661 ⟶ 3,507:
[0, 0, 1, -1]];
 
A|lup|verify(A)</langsyntaxhighlight>
{{out}}
true
Line 2,683 ⟶ 3,529:
 
=={{header|Kotlin}}==
<langsyntaxhighlight lang="scala">// version 1.1.4-3
 
typealias Vector = DoubleArray
Line 2,784 ⟶ 3,630:
printMatrix("U:", u2, "%8.5f")
printMatrix("P:", p2, "%1.0f")
}</langsyntaxhighlight>
 
{{out}}
Line 2,846 ⟶ 3,692:
 
=={{header|Lobster}}==
<langsyntaxhighlight Lobsterlang="lobster">import std
 
// derived from JAMA v1.03
Line 2,950 ⟶ 3,796:
print_L A
print_U A
print_P piv</langsyntaxhighlight>
{{out}}
<pre>
Line 2,992 ⟶ 3,838:
 
=={{header|Maple}}==
<syntaxhighlight lang="maple">
<lang Maple>
A:=<<1.0|3.0|5.0>,<2.0|4.0|7.0>,<1.0|1.0|0.0>>:
 
LinearAlgebra:-LUDecomposition(A);
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,005 ⟶ 3,851:
[0 0 1] [0.500000000000000 -1. 1.0] [0. 0. -2.]
</pre>
<syntaxhighlight lang="maple">
<lang Maple>
A:=<<11.0|9.0|24.0|2.0>,<1.0|5.0|2.0|6.0>,
<3.0|17.0|18.0|1.0>,<2.0|5.0|7.0|1.0>>:
Line 3,012 ⟶ 3,858:
 
LUDecomposition(A);
</syntaxhighlight>
</lang>
{{out}}
<pre>
Line 3,042 ⟶ 3,888:
 
=={{header|Mathematica}}/{{header|Wolfram Language}}==
<langsyntaxhighlight Mathematicalang="mathematica">(*Ex1*)a = {{1, 3, 5}, {2, 4, 7}, {1, 1, 0}};
{lu, p, c} = LUDecomposition[a];
l = LowerTriangularize[lu, -1] + IdentityMatrix[Length[p]];
Line 3,055 ⟶ 3,901:
P = Part[IdentityMatrix[Length[p]], p] ;
MatrixForm /@ {P.a , P, l, u, l.u}
</syntaxhighlight>
</lang>
{{out}}
[[File:LUex1.png]]
Line 3,064 ⟶ 3,910:
LU decomposition is part of language
 
<langsyntaxhighlight Matlablang="matlab"> A = [
1 3 5
2 4 7
1 1 0];
 
[L,U,P] = lu(A)</langsyntaxhighlight>
{{out}}
<pre>
Line 3,091 ⟶ 3,937:
</pre>
2nd example:
<langsyntaxhighlight Matlablang="matlab"> A = [
11 9 24 2
1 5 2 6
Line 3,097 ⟶ 3,943:
2 5 7 1 ];
 
[L,U,P] = lu(A)</langsyntaxhighlight>
{{out}}
<pre>
Line 3,123 ⟶ 3,969:
 
===Creating a MATLAB function===
<syntaxhighlight lang="matlab">
<lang Matlab>
function [ P, L, U ] = LUdecomposition(A)
 
Line 3,181 ⟶ 4,027:
end
 
</syntaxhighlight>
</lang>
 
=={{header|Maxima}}==
 
<langsyntaxhighlight lang="maxima">/* LU decomposition is built-in */
 
a: hilbert_matrix(4)$
Line 3,220 ⟶ 4,066:
 
lu_backsub(lup, transpose([1, 1, -1, -1]));
/* matrix([-204], [2100], [-4740], [2940]) */</langsyntaxhighlight>
 
=={{header|Nim}}==
Line 3,228 ⟶ 4,074:
 
For display, we use the third party module "strfmt" which allows to specify dynamically the format.
<langsyntaxhighlight Nimlang="nim">import macros, strutils
import strfmt
 
Line 3,314 ⟶ 4,160:
l2.print("L:", "8.5f")
u2.print("U:", "8.5f")
p2.print("P:", "1.0f")</langsyntaxhighlight>
 
{{out}}
Line 3,367 ⟶ 4,213:
=={{header|PARI/GP}}==
 
<langsyntaxhighlight lang="parigp">matlup(M) =
{
my (L = matid(#M), U = M, P = L);
Line 3,389 ⟶ 4,235:
 
[L,U,P] \\ return L,U,P triple matrix
}</langsyntaxhighlight>
 
Output:
Line 3,454 ⟶ 4,300:
=={{header|Perl}}==
{{trans|Raku}}
<langsyntaxhighlight lang="perl">use List::Util qw(sum);
 
for $test (
Line 3,538 ⟶ 4,384:
print "$line\n";
}
</syntaxhighlight>
</lang>
{{out}}
<pre style="height:35ex">A matrix
Line 3,597 ⟶ 4,443:
=={{header|Phix}}==
{{trans|Kotlin}}
<!--<langsyntaxhighlight Phixlang="phix">(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">matrix_mul</span><span style="color: #0000FF;">(</span><span style="color: #004080;">sequence</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">,</span> <span style="color: #004080;">sequence</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">)</span>
Line 3,674 ⟶ 4,520:
<span style="color: #7060A8;">pp</span><span style="color: #0000FF;">(</span><span style="color: #000000;">lu</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: #004600;">pp_Nest</span><span style="color: #0000FF;">,</span><span style="color: #000000;">2</span><span style="color: #0000FF;">,</span><span style="color: #004600;">pp_Pause</span><span style="color: #0000FF;">,</span><span style="color: #000000;">0</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<!--</langsyntaxhighlight>-->
{{out}}
<pre>
Line 3,710 ⟶ 4,556:
 
=={{header|PL/I}}==
<langsyntaxhighlight PLlang="pl/Ii">(subscriptrange, fofl, size): /* 2 Nov. 2013 */
LU_Decomposition: procedure options (main);
declare a1(3,3) float (18) initial ( 1, 3, 5,
Line 3,797 ⟶ 4,643:
 
end LU_Decomposition;
</syntaxhighlight>
</lang>
Derived from Fortran version above.
Results:
Line 3,841 ⟶ 4,687:
=={{header|Python}}==
{{trans|D}}
<langsyntaxhighlight lang="python">from pprint import pprint
 
def matrixMul(A, B):
Line 3,882 ⟶ 4,728:
for part in lu(b):
pprint(part)
print</langsyntaxhighlight>
{{out}}
<pre>[[1.0, 0.0, 0.0],
Line 3,913 ⟶ 4,759:
 
=={{header|R}}==
<langsyntaxhighlight Rlang="r">library(Matrix)
A <- matrix(c(1, 3, 5, 2, 4, 7, 1, 1, 0), 3, 3, byrow=T)
dim(A) <- c(3, 3)
expand(lu(A))</langsyntaxhighlight>
 
{{Out}}
Line 3,943 ⟶ 4,789:
 
=={{header|Racket}}==
<langsyntaxhighlight lang="racket">
#lang racket
(require math)
Line 3,959 ⟶ 4,805:
; #[0 -2 -3]
; #[0 0 -2]])
</syntaxhighlight>
</lang>
 
=={{header|Raku}}==
Line 3,965 ⟶ 4,811:
 
Translation of Ruby.
<syntaxhighlight lang="raku" perl6line>for ( [1, 3, 5], # Test Matrices
[2, 4, 7],
[1, 1, 0]
Line 4,034 ⟶ 4,880:
say "\n$message";
$_».&rat-int.fmt("%7s").say for @array;
}</langsyntaxhighlight>
{{out}}
<pre>A Matrix
Line 4,093 ⟶ 4,939:
 
=={{header|REXX}}==
<langsyntaxhighlight lang="rexx">/*REXX program creates a matrix from console input, performs/shows LU decomposition.*/
#= 0; P.= 0; PA.= 0; L.= 0; U.= 0 /*initialize some variables to zero. */
parse arg x /*obtain matrix elements from the C.L. */
Line 4,154 ⟶ 5,000:
end /*c*/
say _
end /*r*/; return</langsyntaxhighlight>
{{out|output|text=&nbsp; when using the input of: &nbsp; &nbsp; <tt> 1 3 5 &nbsp; &nbsp; 2 4 7 &nbsp; &nbsp; 1 1 0 </tt>}}
<pre>
Line 4,216 ⟶ 5,062:
 
=={{header|Ruby}}==
<langsyntaxhighlight lang="ruby">require 'matrix'
 
class Matrix
Line 4,280 ⟶ 5,126:
l.pretty_print(" %8.5f", "L")
u.pretty_print(" %8.5f", "U")
p.pretty_print(" %d", "P")</langsyntaxhighlight>
 
{{out}}
Line 4,326 ⟶ 5,172:
 
Matrix has a <code>lup_decomposition</code> built-in method.
<langsyntaxhighlight lang="ruby">l, u, p = a.lup_decomposition
l.pretty_print(" %8.5f", "L")
u.pretty_print(" %8.5f", "U")
p.pretty_print(" %d", "P")</langsyntaxhighlight>
Output is the same.
 
=={{header|Rust}}==
{{libheader| ndarray}}
<syntaxhighlight lang="rust">
<lang Rust>
#![allow(non_snake_case)]
use ndarray::{Array, Axis, Array2, arr2, Zip, NdFloat, s};
Line 4,421 ⟶ 5,267:
(L, U, P)
}
</syntaxhighlight>
</lang>
 
 
Line 4,466 ⟶ 5,312:
[0, 0, 0, 1]]
</pre>
===Alternative with abstalg====
{{libheader| abstalg}}
This one implements a naive LU decomposition with arbitrary fields, so it works over Rational Numbers as well as floats, (or any field)
<syntaxhighlight lang="rust">
use abstalg::*;
pub struct Matrix2D<'a, F>
where
F: Field,
{
field: MatrixRing<F>,
data: &'a mut Vec<<F as Domain>::Elem>,
rows: usize,
cols: usize,
}
 
impl<'a, F: Field + Clone> Matrix2D<'a, F> {
pub fn new(field: F, data: &'a mut Vec<<F as Domain>::Elem>, rows: usize, cols: usize) -> Self {
assert_eq!(rows * cols, data.len(), "Data does not match dimensions");
Matrix2D {
field: MatrixRing::<F>::new(field, rows),
data,
rows,
cols,
}
}
 
pub fn get(&self, row: usize, col: usize) -> &<F as Domain>::Elem {
assert!(row < self.rows && col < self.cols, "Index out of bounds");
&self.data[row * self.cols + col]
}
 
pub fn get_mut(&mut self, row: usize, col: usize) -> &mut <F as Domain>::Elem {
assert!(row < self.rows && col < self.cols, "Index out of bounds");
&mut self.data[row * self.cols + col]
}
 
pub fn get_row(&self, row: usize) -> Vec<<F as Domain>::Elem> {
assert!(row < self.rows, "Row index out of bounds");
let mut result = Vec::new();
for col in 0..self.cols {
result.push(self.get(row, col).clone());
}
result
}
 
pub fn get_col(&self, col: usize) -> Vec<<F as Domain>::Elem> {
assert!(col < self.cols, "Column index out of bounds");
let mut result = Vec::new();
for row in 0..self.rows {
result.push(self.get(row, col).clone());
}
result
}
 
pub fn set_row(&mut self, row: usize, new_row: Vec<<F as Domain>::Elem>) {
assert!(row < self.rows, "Row index out of bounds");
assert_eq!(new_row.len(), self.cols, "New row has wrong length");
for col in 0..self.cols {
*self.get_mut(row, col) = new_row[col].clone();
}
}
 
pub fn set_col(&mut self, col: usize, new_col: Vec<<F as Domain>::Elem>) {
assert!(col < self.cols, "Column index out of bounds");
assert_eq!(new_col.len(), self.rows, "New column has wrong length");
for row in 0..self.rows {
*self.get_mut(row, col) = new_col[row].clone();
}
}
 
pub fn swap_rows(&mut self, row1: usize, row2: usize) {
assert!(
row1 < self.rows && row2 < self.rows,
"Row index out of bounds"
);
if row1 != row2 {
for col in 0..self.cols {
let temp = self.get(row1, col).clone();
*self.get_mut(row1, col) = self.get(row2, col).clone();
*self.get_mut(row2, col) = temp;
}
}
}
pub fn l_u_decomposition(&mut self) -> Result<Vec<<F as Domain>::Elem>, String>
where
F: Clone,
{
// Let base = field.base()
let base = self.field.base().clone();
// Let v_a = VectorAlgebra(base, cols)
let v_a = VectorAlgebra::new(base.clone(), self.cols);
// Let the_l_matrix = I (creates an identity matrix)
let mut the_l_matrix: Vec<_> = self.field.int(1);
// Let l_matrix = Matrix2D(base, the_l_matrix, rows, cols)
let mut l_matrix = Matrix2D::new(base.clone(), &mut the_l_matrix, self.rows, self.cols);
 
// For each pivot in min(rows, cols)
for pivot in 0..std::cmp::min(self.rows, self.cols) {
// Let pivot_row = self.get_row(pivot)
let pivot_row = self.get_row(pivot);
// If pivot element (pivot_row[pivot]) is zero, LU decomposition is not possible
if base.is_zero(&pivot_row[pivot]) {
return Err(
"LU decomposition without pivoting is not possible for this matrix".into(),
);
}
// Let pivot_entry_inv = 1 / pivot_row[pivot]
let pivot_entry_inv = base.inv(&pivot_row[pivot]);
 
// For each row_idx in (pivot + 1) to rows
for row_idx in (pivot + 1)..self.rows {
// Let row = self.get_row(row_idx)
let mut row = self.get_row(row_idx);
// Let scale = row[pivot] * pivot_entry_inv
let scale = base.mul(&row[pivot], &pivot_entry_inv);
 
// row += -scale * pivot_row (Vector addition and scalar multiplication)
v_a.add_assign(
&mut row,
&v_a.neg(&mul_vector(&v_a, scale.clone(), pivot_row.clone())),
);
 
// l_matrix[row_idx][pivot] = scale
*l_matrix.get_mut(row_idx, pivot) = scale;
// self.set_row(row_idx, row) (Sets the modified row back into the matrix)
self.set_row(row_idx, row);
}
}
// Returns the L matrix
Ok(the_l_matrix)
}
 
pub fn p_l_u_decomposition(
&self,
) -> Result<
(
Vec<<F as Domain>::Elem>,
Vec<<F as Domain>::Elem>,
Vec<<F as Domain>::Elem>,
),
String,
>
where
F: Clone,
{
let base = self.field.base().clone();
let mut self2 = (*self.data).clone();
let mut cloned_vector = Matrix2D::new(base.clone(), &mut self2, self.rows, self.cols);
let mut pivot_row = 0;
 
let mut the_p_matrix: Vec<_> = self.field.zero();
let mut p_matrix = Matrix2D::new(base.clone(), &mut the_p_matrix, self.rows, self.cols);
//let mut u_matrix = self.clone(); //Initializes the U matrix as a copy of the original matrix
 
for pivot_col in 0..self.cols {
// Find a non-zero entry in the pivot column
let swap_row = (pivot_row..self.rows)
.find(|&row| !base.equals(cloned_vector.get(row, pivot_col), &base.zero()));
match swap_row {
Some(swap_row) => {
// Swap rows in U and P matrices to bring the non-zero entry to the pivot position
cloned_vector.swap_rows(pivot_row, swap_row);
p_matrix.swap_rows(pivot_row, swap_row);
pivot_row += 1;
}
None => {
// If there are no non-zero entries in the pivot column, just proceed to the next column
}
}
}
 
// Set the diagonals of P to 1
for i in 0..self.rows {
*p_matrix.get_mut(i, i) = base.one();
}
 
// Run the LU decomposition on the permuted U matrix
let l_u_result = cloned_vector.l_u_decomposition();
 
match l_u_result {
Ok(the_l_matrix) => Ok((the_p_matrix, the_l_matrix, cloned_vector.data.clone())),
Err(e) => Err(e),
}
}
}
 
use std::{error::Error, fmt};
impl<'a, T> fmt::Display for Matrix2D<'a, T>
where
<T as Domain>::Elem: fmt::Display,
T: Field,
{
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
for row in 0..self.rows {
for col in 0..self.cols {
write!(f, "{} ", self.get(row, col))?;
}
writeln!(f)?;
}
Ok(())
}
}
 
fn mul_vector<T>(
f: &VectorAlgebra<T>,
a: <T as Domain>::Elem,
d: Vec<<T as Domain>::Elem>,
) -> <VectorAlgebra<T> as Domain>::Elem
where
T: Field,
{
f.mul(&d, &f.diagonal(a))
}
 
#[cfg(test)]
mod tests {
use super::*; // bring into scope everything from the parent module
use abstalg::ReducedFractions;
use abstalg::I32;
 
fn test_p_l_u_decomposition(matrix: Vec<isize>, size: usize) {
// This test assumes that the base field is rational numbers.
// Create a test 4x4 matrix
let (matrix, size): (Vec<isize>, usize) =
(vec![11, 9, 24, 2, 1, 5, 2, 6, 3, 17, 18, 1, 2, 5, 7, 1], 4);
let field = abstalg::ReducedFractions::new(abstalg::I32);
let matrix_ring = MatrixRing::new(field.clone(), size);
let mut matrix: Vec<_> = matrix.clone().into_iter().map(|i| field.int(i)).collect();
let mut matrix2d = Matrix2D::new(field.clone(), &mut matrix, size, size);
 
// Decompose the matrix using the p_l_u_decomposition function
let p_l_u_decomposition_result = matrix2d.p_l_u_decomposition().unwrap();
let (mut p_matrix, mut l_matrix, mut u_matrix) = p_l_u_decomposition_result;
 
// Convert the matrices back to Matrix2D form for printing
let p_matrix2d = Matrix2D::new(field.clone(), &mut p_matrix, size, size);
let l_matrix2d = Matrix2D::new(field.clone(), &mut l_matrix, size, size);
let u_matrix2d = Matrix2D::new(field.clone(), &mut u_matrix, size, size);
 
println!("P={} L={} U={}", p_matrix2d, l_matrix2d, u_matrix2d,);
 
// Multiply the resulting P, L, and U matrices
let p_l = matrix_ring.mul(&p_matrix, &l_matrix);
let mut p_l_u = matrix_ring.mul(&p_l, &u_matrix);
 
//let p_l_u_2d = Matrix2D::new(field.clone(), &mut p_l_u, 4, 4);
// Check that the product of P, L, and U is equal to the original matrix
assert_eq!(matrix, p_l_u);
}
 
#[test]
fn test_p_l_u_decomposition_example() {
test_p_l_u_decomposition(vec![
11, 9, 24, 2,
1, 5, 2, 6,
3, 17, 18, 1,
2, 5, 7, 1,
], 4);
test_p_l_u_decomposition(vec![
1, 3, 5,
2, 4, 7,
1, 1, 0,
], 3);
}
}
</syntaxhighlight>
=={{header|Sidef}}==
{{trans|Raku}}
<langsyntaxhighlight lang="ruby">func is_square(m) { m.all { .len == m.len } }
func matrix_zero(n, m=n) { m.of { n.of(0) } }
func matrix_ident(n) { n.of {|i| n[i.of(0)..., {|j|1, i==j(n ?- 1i :- 1).of(0 })...] } }
 
 
func pivotize(m) {
var size = m.len
var id = matrix_ident(size)
for i in (^size) {
var max = m[i][i]
var row = i
for j in (i ..^ size-1) {
if (m[j][i] > max) {
max = m[j][i]
Line 4,485 ⟶ 5,596:
}
}
if (row  != i) {
id.swap(row, i)
}
Line 4,491 ⟶ 5,602:
return id
}
 
 
func mmult(a, b) {
var p = []
for r,c (in ^a, ~Xc in ^b[0]), i in ^b {
forp[r][c] i:= 0 += (^a[r][i] * b[i][c]) {
p[r][c] := 0 += (a[r][i] * b[i][c])
}
}
return p
}
 
 
func lu(a) {
is_square(a) || die "Defined only for square matrices!";
Line 4,509 ⟶ 5,618:
var L = matrix_ident(n)
var U = matrix_zero(n)
for i,j (in ^n, j ~Xin ^n) {
if (j >= i) {
U[i][j] = (Aʼ[i][j] - sum(^i, { U[_][j] * L[i][_] }.map(^i).sum))
} else {
L[i][j] = ((Aʼ[i][j] - sum(^j, { U[_][j] * L[i][_] }.map(^j).sum)) / U[j][j])
}
}
return [P, Aʼ, L, U]
}
 
 
func say_it(message, array) {
say "\n#{message}"
Line 4,525 ⟶ 5,634:
}
}
 
 
var t = [[
%n(1 3 5),
Line 4,536 ⟶ 5,645:
%n( 2 5 7 1),
]]
 
 
t.each { |test|
for test (t) {
say_it('A Matrix', test);
for a,b in (['P Matrix', 'Aʼ Matrix', 'L Matrix', 'U Matrix'] ~Z lu(test)) {
say_it(a, b)
}
}</langsyntaxhighlight>
<pre style="height: 40ex; overflow: scroll">
A Matrix
Line 4,604 ⟶ 5,713:
See [http://www.stata.com/help.cgi?mf_lud LU decomposition] in Stata help.
 
<langsyntaxhighlight lang="stata">mata
: lud(a=(1,3,5\2,4,7\1,1,0),l=.,u=.,p=.)
 
Line 4,637 ⟶ 5,746:
2 | 1 |
3 | 3 |
+-----+</langsyntaxhighlight>
 
=== Implementation ===
<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,662 ⟶ 5,771:
u = uppertriangle(l)
l = lowertriangle(l, 1)
}</langsyntaxhighlight>
 
'''Example''':
<langsyntaxhighlight lang="stata">: ludec(a=(1,3,5\2,4,7\1,1,0),l=.,u=.,p=.)
 
: a
Line 4,697 ⟶ 5,806:
2 | 1 |
3 | 3 |
+-----+</langsyntaxhighlight>
 
=={{header|Tcl}}==
<langsyntaxhighlight lang="tcl">package require Tcl 8.5
namespace eval matrix {
namespace path {::tcl::mathfunc ::tcl::mathop}
Line 4,767 ⟶ 5,876:
return $s
}
}</langsyntaxhighlight>
Support code:
<langsyntaxhighlight lang="tcl"># Code adapted from Matrix_multiplication and Matrix_transposition tasks
namespace eval matrix {
# Get the size of a matrix; assumes that all rows are the same length, which
Line 4,817 ⟶ 5,926:
return $max
}
}</langsyntaxhighlight>
Demonstrating:
<langsyntaxhighlight lang="tcl"># This does the decomposition and prints it out nicely
proc demo {A} {
lassign [matrix::luDecompose $A] L U P
Line 4,831 ⟶ 5,940:
demo {{1 3 5} {2 4 7} {1 1 0}}
puts "================================="
demo {{11 9 24 2} {1 5 2 6} {3 17 18 1} {2 5 7 1}}</langsyntaxhighlight>
{{out}}
<pre>
Line 4,881 ⟶ 5,990:
=={{header|VBA}}==
{{trans|Phix}}
<langsyntaxhighlight lang="vb">Option Base 1
Private Function pivotize(m As Variant) As Variant
Dim n As Integer: n = UBound(m)
Line 4,975 ⟶ 6,084:
Debug.Print
Next i
End Sub</langsyntaxhighlight>{{out}}
<pre>== a,l,u,p: ==
1 3 5
Line 5,017 ⟶ 6,126:
{{libheader|Wren-matrix}}
{{libheader|Wren-fmt}}
<langsyntaxhighlight ecmascriptlang="wren">import "./matrix" for Matrix
import "./fmt" for Fmt
 
var arrays = [
Line 5,043 ⟶ 6,152:
Fmt.mprint(lup[2], 2, 0)
System.print()
}</langsyntaxhighlight>
 
{{out}}
Line 5,102 ⟶ 6,211:
=={{header|zkl}}==
Using the GNU Scientific Library, which does the decomposition without returning the permutations:
<langsyntaxhighlight lang="zkl">var [const] GSL=Import("zklGSL"); // libGSL (GNU Scientific Library)
fcn luTask(A){
A.LUDecompose(); // in place, contains L & U
Line 5,119 ⟶ 6,228:
2.0, 5.0, 7.0, 1.0);
L,U:=luTask(A);
println("L:\n",L.format(8,4),"\nU:\n",U.format(8,4));</langsyntaxhighlight>
{{out}}
<pre>
Line 5,146 ⟶ 6,255:
 
A matrix is a list of lists, ie list of rows in row major order.
<langsyntaxhighlight lang="zkl">fcn make_array(n,m,v){ (m).pump(List.createLong(m).write,v)*n }
fcn eye(n){ // Creates a nxn identity matrix.
I:=make_array(n,n,0.0);
Line 5,195 ⟶ 6,304:
foreach i,j,k in (m,p,n){ ans[i][j]+=a[i][k]*b[k][j]; }
ans
}</langsyntaxhighlight>
Example 1
<langsyntaxhighlight lang="zkl">g:=L(L(1.0,3.0,5.0),L(2.0,4.0,7.0),L(1.0,1.0,0.0));
lu(g).apply2("println");</langsyntaxhighlight>
{{out}}
<pre>
Line 5,206 ⟶ 6,315:
</pre>
Example 2
<langsyntaxhighlight lang="zkl">lu(L( L(11.0, 9.0, 24.0, 2.0),
L( 1.0, 5.0, 2.0, 6.0),
L( 3.0, 17.0, 18.0, 1.0),
Line 5,212 ⟶ 6,321:
 
fcn printM(m) { m.pump(Console.println,rowFmt) }
fcn rowFmt(row){ ("%9.5f "*row.len()).fmt(row.xplode()) }</langsyntaxhighlight>
The list apply2 method is side effects only, it doesn't aggregate results. When given a list of actions, it applies the action and passes the result to the next action. The fpM method is partial application with a mask, "-" truncates the parameters at that point (in this case, no parameters, ie just print a blank line, not the result of printM).
{{out}}
9,479

edits