wisp
 
(Arne Babenhauserheide)
2016-11-10: work on the cholesky decomposition

work on the cholesky decomposition

diff --git a/examples/cholesky.w b/examples/cholesky.w
--- a/examples/cholesky.w
+++ b/examples/cholesky.w
@@ -8,14 +8,29 @@ exec guile -L $(dirname $(dirname $(real
 define-module : examples cholesky
               . #:export : cholesky!
 
-use-modules : guildhall ext foof-loop
+use-modules : srfi srfi-42
 
-define : matrrix-ref X u v
-  list-ref (list-ref X u) v
+define : matrix-ref X row col
+  list-ref (list-ref X row) col
 
-define : matrrix-set! X u v val
-  list-set! (list-ref X u) v val
+define : matrix-set! X row col val
+  let : : sublist : list-ref X row
+    list-set! sublist col val
+    list-set! X row sublist
 
+define : matrix-transpose X
+   . "Swap columns and rows of a matrix"
+   list-ec (: outer (length X)) ; outer
+     list-ec (: inner (length (list-ref X outer))) ; inner
+       matrix-ref X inner outer
+
+define : matrix-multiply X Y
+       . "Calculate the matrix product of X and Y"
+       list-ec (: row (length Y))
+         list-ec (: col (length X))
+           sum-ec (: inner (length (list-ref Y row)))
+                   * : matrix-ref X inner col
+                       matrix-ref Y row inner
 
 define : cholesky! a
   . "Modifies the square matrix a to contain its cholesky decomposition.
@@ -24,23 +39,47 @@ sets a to g with a = ggT,
 
 a is represented as list of lists."
   let : : n : length a
-    loop : : for i : up-from 1 : to n
-      loop : : for j : up-from 1 : to i
+    do-ec (: i n)
+     begin
+      do-ec (: j (+ 1 i))
         let : : sum : matrix-ref a i j
+          ; format #t "n: ~A i: ~A j: ~A\n" n i j
           when : >= j 1
-            loop : : for k : up-from 1 : to {j - 1}
+            do-ec (: k {j - 1})
               set! sum : - sum : * (matrix-ref a i k) (matrix-ref a j k)
           cond
             : > i j ; lower triangle
               matrix-set! a i j
-                / sum : matrix-ref a j j
-              . a
+                / sum
+                  matrix-ref a j j
             : > sum 0 ; diagonal element
               matrix-set! a i i : sqrt sum
-              . a
             else
-              throw 'matrix-numerically-not-symmetric-positive-definite
+              throw 'matrix-numerically-not-symmetric-positive-definite a
+      do-ec (: j (+ 1 i) n)
+        matrix-set! a i j 0
+    . a
 
 
 define : main args
-         display : cholesky! '((1 2)(2 4))
+   let : : X '((1 -1 1)
+               (-1 3 -.5)
+               (1 -.5 4))
+         format #t "cholesky\n"
+         display : cholesky! '((1 -1 1)
+                               (-1 3 -.5)
+                               (1 -.5 4))
+         newline
+         format #t "X\n"
+         display X
+         newline
+         cholesky! X
+         format #t "Lt·L\n"
+         display
+           matrix-multiply (matrix-transpose X) X
+         newline
+         display : matrix-transpose '((1 2)
+                                      (3 4))
+         newline
+         display : matrix-ref '((1 2)
+                                (3 4)) 0 1