wisp
 
(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