f5fa93572d
* Gram-Schmidt using vector type * QR decomposition * Operator 1-norm and maximum norm; stub for 2-norm and angle between subspaces (`matrix-basis-angle') * `matrix-absolute-error' and `matrix-relative-error'; also predicates based on them, such as `matrix-identity?' * Lots of shuffling code about * Types that can have contracts, and an exhaustive test to make sure every value exported by `math/matrix' has a contract when used in untyped code * Some more tests (still needs some)
63 lines
2.6 KiB
Racket
63 lines
2.6 KiB
Racket
#lang typed/racket/base
|
|
|
|
(require racket/fixnum
|
|
racket/list
|
|
"matrix-types.rkt"
|
|
"matrix-conversion.rkt"
|
|
"utils.rkt"
|
|
"../unsafe.rkt"
|
|
"../vector/vector-mutate.rkt")
|
|
|
|
(provide
|
|
matrix-gauss-elim
|
|
matrix-row-echelon)
|
|
|
|
(: matrix-gauss-elim
|
|
(case-> ((Matrix Real) -> (Values (Matrix Real) (Listof Index)))
|
|
((Matrix Real) Any -> (Values (Matrix Real) (Listof Index)))
|
|
((Matrix Real) Any Any -> (Values (Matrix Real) (Listof Index)))
|
|
((Matrix Number) -> (Values (Matrix Number) (Listof Index)))
|
|
((Matrix Number) Any -> (Values (Matrix Number) (Listof Index)))
|
|
((Matrix Number) Any Any -> (Values (Matrix Number) (Listof Index)))))
|
|
(define (matrix-gauss-elim M [jordan? #f] [unitize-pivot? #f])
|
|
(define-values (m n) (matrix-shape M))
|
|
(define rows (matrix->vector* M))
|
|
(let loop ([#{i : Nonnegative-Fixnum} 0]
|
|
[#{j : Nonnegative-Fixnum} 0]
|
|
[#{without-pivot : (Listof Index)} empty])
|
|
(cond
|
|
[(j . fx>= . n)
|
|
(values (vector*->matrix rows)
|
|
(reverse without-pivot))]
|
|
[(i . fx>= . m)
|
|
(values (vector*->matrix rows)
|
|
;; None of the rest of the columns can have pivots
|
|
(let loop ([#{j : Nonnegative-Fixnum} j] [without-pivot without-pivot])
|
|
(cond [(j . fx< . n) (loop (fx+ j 1) (cons j without-pivot))]
|
|
[else (reverse without-pivot)])))]
|
|
[else
|
|
(define-values (p pivot) (find-partial-pivot rows m i j))
|
|
(cond
|
|
[(zero? pivot) (loop i (fx+ j 1) (cons j without-pivot))]
|
|
[else
|
|
;; Swap pivot row with current
|
|
(vector-swap! rows i p)
|
|
;; Possibly unitize the new current row
|
|
(let ([pivot (if unitize-pivot?
|
|
(begin (vector-scale! (unsafe-vector-ref rows i) (/ pivot))
|
|
1)
|
|
pivot)])
|
|
(elim-rows! rows m i j pivot (if jordan? 0 (fx+ i 1)))
|
|
(loop (fx+ i 1) (fx+ j 1) without-pivot))])])))
|
|
|
|
(: matrix-row-echelon
|
|
(case-> ((Matrix Real) -> (Matrix Real))
|
|
((Matrix Real) Any -> (Matrix Real))
|
|
((Matrix Real) Any Any -> (Matrix Real))
|
|
((Matrix Number) -> (Matrix Number))
|
|
((Matrix Number) Any -> (Matrix Number))
|
|
((Matrix Number) Any Any -> (Matrix Number))))
|
|
(define (matrix-row-echelon M [jordan? #f] [unitize-pivot? jordan?])
|
|
(let-values ([(M _) (matrix-gauss-elim M jordan? unitize-pivot?)])
|
|
M))
|