; http://cap-lore.com/MathPhys/Field/Inter2.html
(lambda (zer zer? one fa fn fm /)
(let* (
; (ex (lambda (m v)(write (list m v))(newline) v))
(transpose (fileVal "transpose"))
(sub (lambda (x y) (fa x (fn y))))
(rref (((fileVal "gRREF") zer? zer one / fm sub #t) 'rref))
)
(letrec (
(cull (lambda (n) (lambda (l)
(let px ((l l)(n n)(k 0)) (if (null? n) l (if (null? l) '()
(if (= (car n) k) (px (cdr l) (cdr n) (+ k 1))
(cons (car l) (px (cdr l) n (+ k 1))))))))))
(iden (lambda (k) (if (zero? k) '() (if (= k 1) (list (list one)) (let ((z (iden (- k 1))))
(cons (cons one (cons zer (cdar z))) (map (lambda (v) (cons zer v)) z)))))))
(clz (lambda (a) (if (or (null? a) (not (zer? (car a)))) 0 (+ 1 (clz (cdr a))))))
(flip (lambda (x) (if (null? x) '() (cons
(let ifl ((a (car x))) (if (null? a) '() (cons (fn (car a)) (ifl (cdr a)))))
(flip (cdr x)))))))
(let (
(oss (lambda (k sz) (transpose (let ((k (rref k))) (if (pair? k) (let* (
(a (map clz k))
(k (let ((l (length (car k))))
(let ly ((k k) (a a)) (if (null? k) '()
(if (= l (car a)) '() (cons (car k) (ly (cdr k)(cdr a))))))))
(b (map (cull a) k)))
(let puff ((a a)(k (flip b))(i (iden (length (car b))))(j 0))
(if (and (null? k) (null? i)) '()
(if (and (not (null? a)) (= j (car a)))
(cons (car k) (puff (cdr a) (cdr k) i (+ j 1)))
(cons (car i) (puff a k (cdr i) (+ j 1)))
))))
(iden sz)))))))
(letrec (
; (gv? (lambda (x) (or (null? x) (and (ge (car x)) (gv? (cdr x))))))
; (gm? (lambda (x) (or (null? x) (and (gv (car x))(gm? (cdr x))))))
(sz (lambda (x) (and (pair? x) (length (car x)))))
(inter (lambda (a b) (let ((sz (and (sz a)(sz b))))
(if sz (let ((ul (append (oss a sz) (oss b sz)))) (if (pair? ul) (rref (oss ul 0))
(iden sz))) '())))))
(lambda (sy) (cdr (assq sy (list
(cons 'inter inter) (cons 'oss oss) (cons 'rref rref)(cons 'iden iden))))))))))
; tests
(define a '((2.534 4.22 -5.39 0.72003 3.42) (2.344 3.621 0.7 -4.335 5.344) (2.335 4.212 -4.3 -2.1 6.4)))
(define b '((2.354 6.432 3.22 7.6 -2.1) (-3.22 5.4 3.8 3.2 3) (2.6 -4.3 2.2 6.2 3.22)))
(define inters ((fileVal "gIntersect") 0 zero? 1 + - * /))
(define inter (inters 'inter))
(inter a b) ; => ((1 1.1368725202973278 0.013146313843694834 0.9791579006852599 -1.3729474047583419))
(inter a (cons '(3 4 2 6.4 3) b))
; => ((1 0.0 2.58729807982318 4.875730673673086 -8.855142884193949)
; (0 1 -2.264239587131778 -3.4274491672722904 6.581384760253313))
((inters 'inter) '((1 3)(1 4)(2 5)) '((3 7)(2 7))) ; => ((1 0) (0 1))
((((fileVal "gIntersect") 0 zero? 1 + - * /) 'inter) '((3 4 5)) '((3 4 5)))
; => ((1 4/3 5/3))