Made Gaussian elimination faster (half the scaled additions) and more

accurate (always produces zeros in the lower half)
This commit is contained in:
Neil Toronto 2013-01-01 13:05:44 -07:00
parent 3c5135fc7a
commit 5981535686
3 changed files with 18 additions and 11 deletions

View File

@ -64,7 +64,7 @@
[else (* prod sign)]))]))) [else (* prod sign)]))])))
;; =================================================================================================== ;; ===================================================================================================
;; Inversion and solving linear systems ;; Inversion
(: matrix-invertible? ((Matrix Number) -> Boolean)) (: matrix-invertible? ((Matrix Number) -> Boolean))
(define (matrix-invertible? M) (define (matrix-invertible? M)
@ -85,6 +85,9 @@
(submatrix IM^-1 (::) (:: m #f))] (submatrix IM^-1 (::) (:: m #f))]
[else (fail)])])) [else (fail)])]))
;; ===================================================================================================
;; Solving linear systems
(: matrix-solve (All (A) (case-> (: matrix-solve (All (A) (case->
((Matrix Real) (Matrix Real) -> (Matrix Real)) ((Matrix Real) (Matrix Real) -> (Matrix Real))
((Matrix Real) (Matrix Real) (-> A) -> (U A (Matrix Real))) ((Matrix Real) (Matrix Real) (-> A) -> (U A (Matrix Real)))

View File

@ -102,12 +102,14 @@
(case-> ((Vectorof (Vectorof Real)) Index Index Index Real Nonnegative-Fixnum -> Void) (case-> ((Vectorof (Vectorof Real)) Index Index Index Real Nonnegative-Fixnum -> Void)
((Vectorof (Vectorof Number)) Index Index Index Number Nonnegative-Fixnum -> Void))) ((Vectorof (Vectorof Number)) Index Index Index Number Nonnegative-Fixnum -> Void)))
(define (elim-rows! rows m i j pivot start) (define (elim-rows! rows m i j pivot start)
(define row_i (unsafe-vector-ref rows i))
(let loop ([#{l : Nonnegative-Fixnum} start]) (let loop ([#{l : Nonnegative-Fixnum} start])
(when (l . fx< . m) (when (l . fx< . m)
(unless (l . fx= . i) (unless (l . fx= . i)
(define x_lj (unsafe-vector2d-ref rows l j)) (define row_l (unsafe-vector-ref rows l))
(define x_lj (unsafe-vector-ref row_l j))
(unless (zero? x_lj) (unless (zero? x_lj)
(vector-scaled-add! (unsafe-vector-ref rows l) (vector-scaled-add! row_l row_i (- (/ x_lj pivot)) j)
(unsafe-vector-ref rows i) ;; Make sure the element below the pivot is zero
(- (/ x_lj pivot))))) (unsafe-vector-set! row_l j (- x_lj x_lj))))
(loop (fx+ l 1))))) (loop (fx+ l 1)))))

View File

@ -40,12 +40,12 @@
(define (vector-scale! vs v) (define (vector-scale! vs v)
(vector-generic-scale! vs v *)) (vector-generic-scale! vs v *))
(define-syntax-rule (vector-generic-scaled-add! vs0-expr vs1-expr v-expr + *) (define-syntax-rule (vector-generic-scaled-add! vs0-expr vs1-expr v-expr start-expr + *)
(let* ([vs0 vs0-expr] (let* ([vs0 vs0-expr]
[vs1 vs1-expr] [vs1 vs1-expr]
[v v-expr] [v v-expr]
[n (min (vector-length vs0) (vector-length vs1))]) [n (fxmin (vector-length vs0) (vector-length vs1))])
(let loop ([#{i : Nonnegative-Fixnum} 0]) (let loop ([#{i : Nonnegative-Fixnum} (fxmin start-expr n)])
(if (i . fx< . n) (if (i . fx< . n)
(begin (unsafe-vector-set! vs0 i (+ (unsafe-vector-ref vs0 i) (begin (unsafe-vector-set! vs0 i (+ (unsafe-vector-ref vs0 i)
(* (unsafe-vector-ref vs1 i) v))) (* (unsafe-vector-ref vs1 i) v)))
@ -53,9 +53,11 @@
(void))))) (void)))))
(: vector-scaled-add! (case-> ((Vectorof Real) (Vectorof Real) Real -> Void) (: vector-scaled-add! (case-> ((Vectorof Real) (Vectorof Real) Real -> Void)
((Vectorof Number) (Vectorof Number) Number -> Void))) ((Vectorof Real) (Vectorof Real) Real Index -> Void)
(define (vector-scaled-add! vs0 vs1 s) ((Vectorof Number) (Vectorof Number) Number -> Void)
(vector-generic-scaled-add! vs0 vs1 s + *)) ((Vectorof Number) (Vectorof Number) Number Index -> Void)))
(define (vector-scaled-add! vs0 vs1 s [start 0])
(vector-generic-scaled-add! vs0 vs1 s start + *))
(: vector-mag^2 (case-> ((Vectorof Real) -> Nonnegative-Real) (: vector-mag^2 (case-> ((Vectorof Real) -> Nonnegative-Real)
((Vectorof Number) -> Nonnegative-Real))) ((Vectorof Number) -> Nonnegative-Real)))