(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