Cholesky decomposition: Difference between revisions

From Rosetta Code
Content added Content deleted
m (→‎[[Cholesky_decomposition#ALGOL 68]]: Translation of C version)
m (→‎[[Cholesky decomposition#ALGOL 68]]: Translation of C version into ALGOL 68)
Line 195: Line 195:
9.899 1.625 1.850 1.393</pre>
9.899 1.625 1.850 1.393</pre>


=={{header|C}}==
=={{header|ALGOL 68}}==
{{trans|C}} Note: This specimen retains the original [[#C|C]] coding style.
<lang c>#include <stdio.h>
{{works with|ALGOL 68|Revision 1 - no extensions to language used.}}
#include <stdlib.h>
{{works with|ALGOL 68G|Any - tested with release [http://sourceforge.net/projects/algol68/files/algol68g/algol68g-1.18.0/algol68g-1.18.0-9h.tiny.el5.centos.fc11.i386.rpm/download 1.18.0-9h.tiny].}}
#include <math.h>
{{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] ''transput''.}}
<lang algol68>MODE FIELD=LONG REAL;
PROC (FIELD)FIELD field sqrt = long sqrt;
INT field prec = 5;


MODE MAT = [0,0]FIELD;
double *cholesky(double *A, int n) {
double *L = (double*)calloc(n * n, sizeof(double));
if (L == NULL)
exit(EXIT_FAILURE);


PROC cholesky = (MAT a) MAT:(
for (int i = 0; i < n; i++)
[UPB a, 2 UPB a]FIELD l;
for (int j = 0; j < (i+1); j++) {
double s = 0;
for (int k = 0; k < j; k++)
FOR i FROM LWB a TO UPB a DO
s += L[i * n + k] * L[j * n + k];
FOR j FROM 2 LWB a TO i DO
L[i * n + j] = (i == j) ?
FIELD s := 0;
sqrt(A[i * n + i] - s) :
FOR k FROM 2 LWB a TO j-1 DO
(1.0 / L[j * n + j] * (A[i * n + j] - s));
s +:= l[i,k] * l[j,k]
}
OD;
l[i,j] := IF i = j

THEN field sqrt(a[i,i] - s)
return L;
ELSE 1.0 / l[j,j] * (a[i,j] - s) FI
}
OD

OD;
void show_matrix(double *A, int n) {
l
for (int i = 0; i < n; i++) {
);
for (int j = 0; j < n; j++)
printf("%2.5f ", A[i * n + j]);
PROC show matrix=(MAT a)VOID:(
printf("\n");
FOR i FROM LWB a TO UPB a DO
}
FOR j FROM 2 LWB a TO 2 UPB a DO
}
printf(($g(-(2+1+field prec),field prec)$, a[i,j]))

OD;
int main() {
int n = 3;
printf($l$)
OD
double m1[] = {25, 15, -5,
);
15, 18, 0,
-5, 0, 11};
main: (
double *c1 = cholesky(m1, n);
show_matrix(c1, n);
MAT m1 = ((25, 15, -5),
printf("\n");
(15, 18, 0),
free(c1);
(-5, 0, 11));
MAT c1 = cholesky(m1);

n = 4;
show matrix(c1);
printf($l$);
double m2[] = {18, 22, 54, 42,
22, 70, 86, 62,
54, 86, 174, 134,
MAT m2 = ((18, 22, 54, 42),
42, 62, 134, 106};
(22, 70, 86, 62),
double *c2 = cholesky(m2, n);
(54, 86, 174, 134),
show_matrix(c2, n);
(42, 62, 134, 106));
free(c2);
MAT c2 = cholesky(m2);
show matrix(c2)

)</lang>
return 0;
}</lang>
Output:
Output:
<pre>
<pre>5.00000 0.00000 0.00000
3.00000 3.00000 0.00000
5.00000 0.00000 0.00000
3.00000 3.00000 0.00000
-1.00000 1.00000 3.00000
-1.00000 1.00000 3.00000


4.24264 0.00000 0.00000 0.00000
4.24264 0.00000 0.00000 0.00000
5.18545 6.56591 0.00000 0.00000
5.18545 6.56591 0.00000 0.00000
12.72792 3.04604 1.64974 0.00000
12.72792 3.04604 1.64974 0.00000
9.89949 1.62455 1.84971 1.39262</pre>
9.89949 1.62455 1.84971 1.39262
</pre>

=={{header|C}}==
=={{header|C}}==
<lang c>#include <stdio.h>
<lang c>#include <stdio.h>

Revision as of 02:10, 19 May 2011

Task
Cholesky decomposition
You are encouraged to solve this task according to the task description, using any language you may know.

Every symmetric, positive definite matrix A can be decomposed into a product of a unique lower triangular matrix L and its transpose:

is called the Cholesky factor of , and can be interpreted as a generalized square root of , as described in Cholesky decomposition.

In a 3x3 example, we have to solve the following system of equations:

We can see that for the diagonal elements () of there is a calculation pattern:

or in general:

For the elements below the diagonal (, where ) there is also a calculation pattern:

which can also be expressed in a general formula:

Task description

The task is to implement a routine which will return a lower Cholesky factor for every given symmetric, positive definite nxn matrix . You should then test it on the following two examples and include your output.

Example 1:

25  15  -5                 5   0   0
15  18   0         -->     3   3   0
-5   0  11                -1   1   3

Example 2:

18  22   54   42           4.24264    0.00000    0.00000    0.00000
22  70   86   62   -->     5.18545    6.56591    0.00000    0.00000
54  86  174  134          12.72792    3.04604    1.64974    0.00000
42  62  134  106           9.89949    1.62455    1.84971    1.39262


Ada

Works with: Ada 2005

decomposition.ads: <lang Ada>with Ada.Numerics.Generic_Real_Arrays; generic

  with package Matrix is new Ada.Numerics.Generic_Real_Arrays (<>);

package Decomposition is

  -- decompose a square matrix A by A = L * Transpose (L)
  procedure Decompose (A : Matrix.Real_Matrix; L : out Matrix.Real_Matrix);

end Decomposition;</lang>

decomposition.adb: <lang Ada>with Ada.Numerics.Generic_Elementary_Functions;

package body Decomposition is

  package Math is new Ada.Numerics.Generic_Elementary_Functions
    (Matrix.Real);
  procedure Decompose (A : Matrix.Real_Matrix; L : out Matrix.Real_Matrix) is
     use type Matrix.Real_Matrix, Matrix.Real;
     Order : constant Positive := A'Length (1);
     S     : Matrix.Real;
  begin
     L := (others => (others => 0.0));
     for I in 0 .. Order - 1 loop
        for K in 0 .. I loop
           S := 0.0;
           for J in 0 .. K - 1 loop
              S := S +
                L (L'First (1) + I, L'First (2) + J) *
                L (L'First (1) + K, L'First (2) + J);
           end loop;
           -- diagonals
           if K = I then
              L (L'First (1) + K, L'First (2) + K) :=
                Math.Sqrt (A (A'First (1) + K, A'First (2) + K) - S);
           else
              L (L'First (1) + I, L'First (2) + K) :=
                1.0 / L (L'First (1) + K, L'First (2) + K) *
                (A (A'First (1) + I, A'First (2) + K) - S);
           end if;
        end loop;
     end loop;
  end Decompose;

end Decomposition;</lang>

Example usage: <lang Ada>with Ada.Numerics.Real_Arrays; with Ada.Text_IO; with Decomposition; procedure Decompose_Example is

  package Real_Decomposition is new Decomposition
    (Matrix => Ada.Numerics.Real_Arrays);
  package Real_IO is new Ada.Text_IO.Float_IO (Float);
  procedure Print (M : Ada.Numerics.Real_Arrays.Real_Matrix) is
  begin
     for Row in M'Range (1) loop
        for Col in M'Range (2) loop
           Real_IO.Put (M (Row, Col), 4, 3, 0);
        end loop;
        Ada.Text_IO.New_Line;
     end loop;
  end Print;
  Example_1 : constant Ada.Numerics.Real_Arrays.Real_Matrix :=
    ((25.0, 15.0, -5.0),
     (15.0, 18.0, 0.0),
     (-5.0, 0.0, 11.0));
  L_1 : Ada.Numerics.Real_Arrays.Real_Matrix (Example_1'Range (1),
                                              Example_1'Range (2));
  Example_2 : constant Ada.Numerics.Real_Arrays.Real_Matrix :=
    ((18.0, 22.0, 54.0, 42.0),
     (22.0, 70.0, 86.0, 62.0),
     (54.0, 86.0, 174.0, 134.0),
     (42.0, 62.0, 134.0, 106.0));
  L_2 : Ada.Numerics.Real_Arrays.Real_Matrix (Example_2'Range (1),
                                              Example_2'Range (2));

begin

  Real_Decomposition.Decompose (A => Example_1,
                                L => L_1);
  Real_Decomposition.Decompose (A => Example_2,
                                L => L_2);
  Ada.Text_IO.Put_Line ("Example 1:");
  Ada.Text_IO.Put_Line ("A:"); Print (Example_1);
  Ada.Text_IO.Put_Line ("L:"); Print (L_1);
  Ada.Text_IO.New_Line;
  Ada.Text_IO.Put_Line ("Example 2:");
  Ada.Text_IO.Put_Line ("A:"); Print (Example_2);
  Ada.Text_IO.Put_Line ("L:"); Print (L_2);

end Decompose_Example;</lang>

Output:

Example 1:
A:
  25.000  15.000  -5.000
  15.000  18.000   0.000
  -5.000   0.000  11.000
L:
   5.000   0.000   0.000
   3.000   3.000   0.000
  -1.000   1.000   3.000

Example 2:
A:
  18.000  22.000  54.000  42.000
  22.000  70.000  86.000  62.000
  54.000  86.000 174.000 134.000
  42.000  62.000 134.000 106.000
L:
   4.243   0.000   0.000   0.000
   5.185   6.566   0.000   0.000
  12.728   3.046   1.650   0.000
   9.899   1.625   1.850   1.393

ALGOL 68

Translation of: C

Note: This specimen retains the original C coding style.

Works with: ALGOL 68 version Revision 1 - no extensions to language used.
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny.

<lang algol68>MODE FIELD=LONG REAL; PROC (FIELD)FIELD field sqrt = long sqrt; INT field prec = 5;

MODE MAT = [0,0]FIELD;

PROC cholesky = (MAT a) MAT:(

   [UPB a, 2 UPB a]FIELD l;

   FOR i FROM LWB a TO UPB a DO
       FOR j FROM 2 LWB a TO i DO
           FIELD s := 0;
           FOR k FROM 2 LWB a TO j-1 DO
               s +:= l[i,k] * l[j,k]
           OD;
           l[i,j] := IF i = j 
                     THEN field sqrt(a[i,i] - s) 
                     ELSE 1.0 / l[j,j] * (a[i,j] - s) FI
       OD
   OD;
   l

);

PROC show matrix=(MAT a)VOID:(

   FOR i FROM LWB a TO UPB a DO
       FOR j FROM 2 LWB a TO 2 UPB a DO
           printf(($g(-(2+1+field prec),field prec)$, a[i,j]))
       OD;
       printf($l$)
   OD

);

main: (

   MAT m1 = ((25, 15, -5),
             (15, 18,  0),
             (-5,  0, 11));
   MAT c1 = cholesky(m1);
   show matrix(c1);
   printf($l$);

   MAT m2 = ((18, 22,  54,  42),
             (22, 70,  86,  62),
             (54, 86, 174, 134),
             (42, 62, 134, 106));
   MAT c2 = cholesky(m2);
   show matrix(c2)

)</lang> Output:

 5.00000 0.00000 0.00000
 3.00000 3.00000 0.00000
-1.00000 1.00000 3.00000

 4.24264 0.00000 0.00000 0.00000
 5.18545 6.56591 0.00000 0.00000
12.72792 3.04604 1.64974 0.00000
 9.89949 1.62455 1.84971 1.39262

C

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <math.h>

double *cholesky(double *A, int n) {

   double *L = (double*)calloc(n * n, sizeof(double));
   if (L == NULL)
       exit(EXIT_FAILURE);
   for (int i = 0; i < n; i++)
       for (int j = 0; j < (i+1); j++) {
           double s = 0;
           for (int k = 0; k < j; k++)
               s += L[i * n + k] * L[j * n + k];
           L[i * n + j] = (i == j) ?
                          sqrt(A[i * n + i] - s) :
                          (1.0 / L[j * n + j] * (A[i * n + j] - s));
       }
   return L;

}

void show_matrix(double *A, int n) {

   for (int i = 0; i < n; i++) {
       for (int j = 0; j < n; j++)
           printf("%2.5f ", A[i * n + j]);
       printf("\n");
   }

}

int main() {

   int n = 3;
   double m1[] = {25, 15, -5,
                  15, 18,  0,
                  -5,  0, 11};
   double *c1 = cholesky(m1, n);
   show_matrix(c1, n);
   printf("\n");
   free(c1);
   n = 4;
   double m2[] = {18, 22,  54,  42,
                  22, 70,  86,  62,
                  54, 86, 174, 134,
                  42, 62, 134, 106};
   double *c2 = cholesky(m2, n);
   show_matrix(c2, n);
   free(c2);
   return 0;

}</lang> Output:

5.00000 0.00000 0.00000
3.00000 3.00000 0.00000
-1.00000 1.00000 3.00000

4.24264 0.00000 0.00000 0.00000
5.18545 6.56591 0.00000 0.00000
12.72792 3.04604 1.64974 0.00000
9.89949 1.62455 1.84971 1.39262

Common Lisp

<lang lisp>;; Calculates the Cholesky decomposition matrix L

for a positive-definite, symmetric nxn matrix A.

(defun chol (A)

 (let* ((n (car (array-dimensions A)))
        (L (make-array `(,n ,n) :initial-element 0)))
   (do ((k 0 (incf k))) ((> k (- n 1)) nil)
       ;; First, calculate diagonal elements L_kk.
       (setf (aref L k k)
             (sqrt (- (aref A k k)
                      (do* ((j 0 (incf j))
                            (sum (expt (aref L k j) 2) 
                                 (incf sum (expt (aref L k j) 2))))
                           ((> j (- k 1)) sum)))))
       ;; Then, all elements below a diagonal element, L_ik, i=k+1..n.
       (do ((i (+ k 1) (incf i)))
           ((> i (- n 1)) nil)
           (setf (aref L i k)
                 (/ (- (aref A i k)
                       (do* ((j 0 (incf j))
                             (sum (* (aref L i j) (aref L k j))
                                  (incf sum (* (aref L i j) (aref L k j)))))
                            ((> j (- k 1)) sum)))
                    (aref L k k)))))
   ;; Return the calculated matrix L.
   L))</lang>

<lang lisp>

Example 1

(setf A (make-array '(3 3) :initial-contents '((25 15 -5) (15 18 0) (-5 0 11)))) (chol A)

  1. 2A((5.0 0 0)
   (3.0 3.0 0)
   (-1.0 1.0 3.0))

</lang>

<lang lisp>

Example 2

(setf B (make-array '(4 4) :initial-contents '((18 22 54 42) (22 70 86 62) (54 86 174 134) (42 62 134 106)))) (chol B)

  1. 2A((4.2426405 0 0 0)
   (5.18545 6.565905 0 0)
   (12.727922 3.0460374 1.6497375 0)
   (9.899495 1.6245536 1.849715 1.3926151))

</lang>

D

<lang d>import std.stdio, std.math;

/// Calculates the Cholesky decomposition matrix L /// for a positive-definite, symmetric nxn matrix A. pure T[][] cholesky(T)(const T[][] A) {

   int n = A.length;
   auto L = new T[][](n, n);
   foreach (r, row; L)
       row[r+1 .. $] = 0;
   foreach (i; 0 .. n)
       foreach (j; 0 .. i+1) {
           T sum = 0;
           foreach (k; 0 .. j)
               sum += L[i][k] * L[j][k];
           L[i][j] = (i == j) ? sqrt(A[i][i] - sum) :
                                (1.0 / L[j][j] * (A[i][j] - sum));
       }
   return L;

}

void main() {

   double[][] m1 = [[25, 15, -5],
                    [15, 18,  0],
                    [-5,  0, 11]];
   foreach (row; cholesky(m1))
       writeln(row);
   writeln();
   double[][] m2 = [[18, 22,  54,  42],
                    [22, 70,  86,  62],
                    [54, 86, 174, 134],
                    [42, 62, 134, 106]];
   foreach (row; cholesky(m2))
       writeln(row);

}</lang> Output:

[5, 0, 0]
[3, 3, 0]
[-1, 1, 3]

[4.24264, 0, 0, 0]
[5.18545, 6.56591, 0, 0]
[12.7279, 3.04604, 1.64974, 0]
[9.89949, 1.62455, 1.84971, 1.39262]

J

Solution: <lang j>mp=: +/ . * NB. matrix product h =: +@|: NB. conjugate transpose

cholesky=: 3 : 0

n=. #A=. y
if. 1>:n do.
 assert. (A=|A)>0=A  NB. check for positive definite
 %:A
else.
 p=. >.n%2 [ q=. <.n%2
 X=. (p,p) {.A [ Y=. (p,-q){.A [ Z=. (-q,q){.A
 L0=. cholesky X
 L1=. cholesky Z-(T=.(h Y) mp %.X) mp Y
 L0,(T mp L0),.L1
end.

)</lang> See Choleski Decomposition essay on the J Wiki.

Examples: <lang j> eg1=: 25 15 _5 , 15 18 0 ,: _5 0 11

  eg2=: 18 22 54 42 , 22 70 86 62 , 54 86 174 134 ,: 42 62 134 106
  cholesky eg1
5 0 0
3 3 0

_1 1 3

  cholesky eg2

4.24264 0 0 0 5.18545 6.56591 0 0 12.7279 3.04604 1.64974 0 9.89949 1.62455 1.84971 1.39262</lang>

Java

Works with: Java version 1.5+

<lang java5>import java.util.Arrays;

public class Cholesky { public static double[][] chol(double[][] a){ int m = a.length; double[][] l = new double[m][m]; //automatically initialzed to 0's for(int i = 0; i< m;i++){ for(int k = 0; k < (i+1); k++){ double sum = 0; for(int j = 0; j < k; j++){ sum += l[i][j] * l[k][j]; } l[i][k] = (i == k) ? Math.sqrt(a[i][i] - sum) : (1.0 / l[k][k] * (a[i][k] - sum)); } } return l; }

public static void main(String[] args){ double[][] test1 = {{25, 15, -5}, {15, 18, 0}, {-5, 0, 11}}; System.out.println(Arrays.deepToString(chol(test1))); double[][] test2 = {{18, 22, 54, 42}, {22, 70, 86, 62}, {54, 86, 174, 134}, {42, 62, 134, 106}}; System.out.println(Arrays.deepToString(chol(test2))); } }</lang> Output:

[[5.0, 0.0, 0.0], [3.0, 3.0, 0.0], [-1.0, 1.0, 3.0]]
[[4.242640687119285, 0.0, 0.0, 0.0], [5.185449728701349, 6.565905201197403, 0.0, 0.0], [12.727922061357857, 3.0460384954008553, 1.6497422479090704, 0.0], [9.899494936611667, 1.624553864213788, 1.8497110052313648, 1.3926212476456026]]

PicoLisp

<lang PicoLisp>(scl 9) (load "@lib/math.l")

(de cholesky (A)

  (let L (mapcar '(() (need (length A) 0)) A)
     (for (I . R) A
        (for J I
           (let S (get R J)
              (for K (inc J)
                 (dec 'S (*/ (get L I K) (get L J K) 1.0)) )
              (set (nth L I J)
                 (if (= I J)
                    (sqrt (* 1.0 S))
                    (*/ S 1.0 (get L J J)) ) ) ) ) )
     (for R L
        (for N R (prin (align 9 (round N 5))))
        (prinl) ) ) )</lang>

Test: <lang PicoLisp>(cholesky

  '((25.0 15.0 -5.0) (15.0 18.0 0) (-5.0 0 11.0)) )

(prinl)

(cholesky

  (quote
     (18.0  22.0   54.0   42.0)
     (22.0  70.0   86.0   62.0)
     (54.0  86.0  174.0  134.0)
     (42.0  62.0  134.0  106.0) ) )</lang>

Output:

  5.00000  0.00000  0.00000
  3.00000  3.00000  0.00000
 -1.00000  1.00000  3.00000

  4.24264  0.00000  0.00000  0.00000
  5.18545  6.56591  0.00000  0.00000
 12.72792  3.04604  1.64974  0.00000
  9.89949  1.62455  1.84971  1.39262

Python

<lang python>import math, pprint

def cholesky(A):

   L = [[0.0] * len(A) for _ in xrange(len(A))]
   for i in xrange(len(A)):
       for j in xrange(i+1):
           s = sum(L[i][k] * L[j][k] for k in xrange(j))
           L[i][j] = math.sqrt(A[i][i] - s) if (i == j) else \
                     (1.0 / L[j][j] * (A[i][j] - s))
   return L

m1 = [[25, 15, -5],

     [15, 18,  0],
     [-5,  0, 11]]

pprint.pprint(cholesky(m1)) print

m2 = [[18, 22, 54, 42],

     [22, 70,  86,  62],
     [54, 86, 174, 134],
     [42, 62, 134, 106]]

pprint.pprint(cholesky(m2))</lang> Output:

[[5.0, 0.0, 0.0], [3.0, 3.0, 0.0], [-1.0, 1.0, 3.0]]

[[4.2426406871192848, 0.0, 0.0, 0.0],
 [5.1854497287013492, 6.5659052011974026, 0.0, 0.0],
 [12.727922061357857, 3.0460384954008553, 1.6497422479090704, 0.0],
 [9.8994949366116671,
  1.624553864213788,
  1.8497110052313648,
  1.3926212476456026]]

Tcl

Translation of: Java

<lang tcl>proc cholesky a {

   set m [llength $a]
   set n [llength [lindex $a 0]]
   set l [lrepeat $m [lrepeat $n 0.0]]
   for {set i 0} {$i < $m} {incr i} {

for {set k 0} {$k < $i+1} {incr k} { set sum 0.0 for {set j 0} {$j < $k} {incr j} { set sum [expr {$sum + [lindex $l $i $j] * [lindex $l $k $j]}] } lset l $i $k [expr { $i == $k ? sqrt([lindex $a $i $i] - $sum) : (1.0 / [lindex $l $k $k] * ([lindex $a $i $k] - $sum)) }] }

   }
   return $l

}</lang> Demonstration code: <lang tcl>set test1 {

   {25 15 -5}
   {15 18  0}
   {-5  0 11}

} puts [cholesky $test1] set test2 {

   {18 22  54  42}
   {22 70  86  62}
   {54 86 174 134}
   {42 62 134 106}

} puts [cholesky $test2]</lang> Output:

{5.0 0.0 0.0} {3.0 3.0 0.0} {-1.0 1.0 3.0}
{4.242640687119285 0.0 0.0 0.0} {5.185449728701349 6.565905201197403 0.0 0.0} {12.727922061357857 3.0460384954008553 1.6497422479090704 0.0} {9.899494936611667 1.624553864213788 1.8497110052313648 1.3926212476456026}