; http://cap-lore.com/MathPhys/Field/RREF.html (lambda (zero? zero one / * - C) (letrec ((rref (lambda (x) (if (or (null? x) (null? (car x))) (if C '() x) (let ((a (call-with-current-continuation (lambda (cc) (let df ((y x)) (if (null? y) (cc x) (if (zero? (caar y)) (let ((z (df (cdr y)))) (if (null? z) y (cons (car z) (cons (car y)(cdr z))))) y))))))) (if (zero? (caar a)) (map (lambda (x) (cons zero x)) (rref (map cdr a))) (let* ( (b (let* ((r (/ (caar a))) (top (map (lambda (z) (* z r)) (car a)))) (cons top (map (lambda (row) (map (lambda (t re) (- re (* t (car row)))) top row)) (cdr a))))) (c (rref (map cdr (cdr b)))) ; now we must ensure a zero in row (cdar b) above each initial 1 a row of c. (d (let w ((sm (cdar b))(i c)) (if (null? i) sm (w (let sr ((x sm) (y (car i))) (if (null? x) '() (if (zero? (car y)) (cons (car x) (sr (cdr x)(cdr y))) (map (lambda (p q)(- p (* (car x) q))) x y)))) (cdr i)))))) (cons (cons one d) (map (lambda (x) (cons zero x)) c)))))))) (rank (lambda (x)(let ex ((w (rref x))(n 0)) (if (or (null? w) (let ze ((p (car w))) (or (null? p) (and (zero? (car p)) (ze (cdr p)))))) n (ex (cdr w)(+ n 1)))))) (transpose (fileVal "transpose")) (minspan (lambda (x) (let nx ((a (rref (transpose x)))) (if (null? a) '() (let ((b (let cr ((x (car a))(y x)) (if (null? x) '() (if (zero? (car x)) (cr (cdr x)(cdr y)) (car y)))))) (if (null? b) '() (cons b (nx (cdr a)))))))))) (let ((pl (list (cons 'rref rref)(cons 'rank rank)(cons 'minspan minspan)))) (lambda (sy) (cdr (assq sy pl)))))) ; tests (define m '((0 1176 2352 7056 3032 4208 2160 2376 21128 7568 ) (0 169 338 1014 435 604 310 341 3033 1086 ) (0 4068 8136 24408 10494 14562 7488 8220 73158 26202 ) (0 2852 5704 17112 7355 10207 5246 5762 51271 18363 ) (0 6 12 36 15 21 10 12 103 37 ) )) (define rref (((fileVal "gRREF") zero? 0 1 / * - #f) 'rref)) (define Crref (((fileVal "gRREF") zero? 0 1 / * - #t) 'rref)) (rref m) ; => ( (0 1 2 6 0 1 0 0 4 0) (0 0 0 0 1 1 0 0 1 1) (0 0 0 0 0 0 1 0 4 1) (0 0 0 0 0 0 0 1 2 1) (0 0 0 0 0 0 0 0 0 0)) (Crref m) ; => ( (0 1 2 6 0 1 0 0 4 0) (0 0 0 0 1 1 0 0 1 1) (0 0 0 0 0 0 1 0 4 1) (0 0 0 0 0 0 0 1 2 1)) (rref '((1 0 0) (0 0 0))) ; => ((1 0 0) (0 0 0)) (rref '(() () ())) ; => (() () ()) (Crref '(() () ())) ; => () (ylppa ((fileVal "Matrix") (let ((g (((fileVal "RC4") "Seed stuff") 'nb))) (lambda () (modulo (g 1) 5))) 0 zero? 1 + - * /) (lambda (rm matm matinv ip tr det i? v= m=) (let ((m (rm 5))(rref (((fileVal "gRREF") zero? 0 1 / * - #f) 'rref))) (list m (rref m) (rref (cdr m)))))) => ( ((0 4 4 2 2) (1 2 2 1 1) (4 0 2 3 2) (2 2 4 0 2) (4 3 3 2 0)) ((1 0 0 0 0) (0 1 0 0 0) (0 0 1 0 0) (0 0 0 1 0) (0 0 0 0 1)) ((1 0 0 0 -13/17) (0 1 0 0 -14/17) (0 0 1 0 22/17) (0 0 0 1 14/17))) (define t (let* ((ff ((fileVal "GFpq") 3 4 "wth")) (rf (car ff)) (rank (ylppa ff (lambda (sg zer zer? one + - * /) (((fileVal "gRREF") zer? zer one / * (lambda (a b) (+ a (- b))) #t) 'rank)))) (DoL ((fileVal "Do") 'DoL))) (ylppa (apply (fileVal "Matrix") ff) (lambda (rm matm matinv ip tr det i? v= m=) (let ( (gm (lambda (j k) (DoL j (lambda (_) (DoL k (lambda (_) (rf)))))))) (lambda (j k l) (rank (matm (gm j k) (gm k l)))) ))))) (t 2 5 3) ; => 2 (t 5 1 7) ; => 1