(Arne Babenhauserheide)
2016-12-19: cholesky: reduce approximation errors due to taking the sqrt cholesky: reduce approximation errors due to taking the sqrt
diff --git a/examples/cholesky.w b/examples/cholesky.w --- a/examples/cholesky.w +++ b/examples/cholesky.w @@ -8,7 +8,22 @@ exec guile -L $(dirname $(dirname $(real define-module : examples cholesky . #:export : cholesky! matrix-ref matrix-set! matrix-transpose matrix-multiply -use-modules : srfi srfi-42 +use-modules : srfi srfi-42 ; list-comprehension + srfi srfi-11 ; let-values + +define : ->exact-matrix list-of-lists + . "Turn a list of lists into a matrix" + map + λ : x + apply list : map inexact->exact x + . list-of-lists + +define : ->inexact-matrix list-of-lists + . "Turn a list of lists into a matrix" + map + λ : x + apply list : map exact->inexact x + . list-of-lists define : matrix-ref X row col list-ref (list-ref X row) col @@ -32,6 +47,16 @@ define : matrix-multiply X Y * : matrix-ref Y inner col matrix-ref X row inner +define : mostly-exact-sqrt n + . "Calculate an exact sqrt if possible, else use a good approximation" + let maybe-exact-sqrt : : j : inexact->exact n + cond + : integer? j + inexact->exact : sqrt j + else + / : inexact->exact : maybe-exact-sqrt : numerator j + inexact->exact : maybe-exact-sqrt : denominator j + define : cholesky! a . "Modifies the square matrix a to contain its cholesky decomposition. @@ -52,7 +77,8 @@ a is represented as list of lists." / sum matrix-ref a j j : > sum 0 ; diagonal element - matrix-set! a i i : sqrt sum + matrix-set! a i i + mostly-exact-sqrt sum else throw 'matrix-numerically-not-symmetric-positive-definite a do-ec (: i n) @@ -63,26 +89,28 @@ a is represented as list of lists." define : main args let - : X : apply list '(( 1 -1 1) - (-1 3 -.5) - ( 1 -.5 4)) - L : apply list '(( 1 0 0) - (-1 1.41421356 0) - ( 1 0.35355339 1.6955825)) + : X : ->exact-matrix '(( 1 -1 1) + (-1 3 -.5) + ( 1 -.5 4)) + L : ->exact-matrix '(( 1 0 0) + (-1 1.41421356 0) + ( 1 0.35355339 1.6955825)) format #t "X\n" - display X + display : ->inexact-matrix X newline format #t "cholesky\n" - display : cholesky! X + display : ->inexact-matrix : cholesky! X newline format #t "L\n" - display L + display : ->inexact-matrix L newline format #t "L·Lt\n" display - matrix-multiply L : matrix-transpose L + ->inexact-matrix + matrix-multiply L : matrix-transpose L newline format #t "X·Xt\n" display - matrix-multiply X : matrix-transpose X + ->inexact-matrix + matrix-multiply X : matrix-transpose X newline