; http://cap-lore.com/code/Scheme/reposIntro/IsoTheory.html
(lambda (sig eq rn) (let ((G (lambda (k f) (apply
  (lambda (+ - * zero one / = Cr alpha bar tr rp sm Q basis R? V? Rr Vr v2C)
  (let* ((p (positive? (k 1)))(*+ (if p + -))(/+ (if p - +))) (list
  (lambda (a b) (cons (+ (car a)(car b))(+ (cdr a)(cdr b)))) ; +
  (lambda (a b) (cons (- (car a)(car b))(- (cdr a)(cdr b)))) ; - (subtraction)
  (lambda (a b) (cons (*+ (* (car a)(car b))(* (cdr a)(alpha (cdr b))))
                      (+ (* (car a)(cdr b))(* (cdr a)(alpha (car b)))))) ; *
  (cons zero zero) ; zero
  (cons one zero) ; one
  (lambda (x) (let* ((a (car x))(b (cdr x))(ai (/ a))) ; inverse
    (if ai (let* ((aib (* ai b))(c (/ (/+ a (* b (alpha aib))))))
        (and c (cons c (- zero (* aib (alpha c))))))
    (let ((bi (/ b)))
       (and bi (let* ((bia (* bi a))(d (/ (/+ (* (alpha a) bia) (alpha b)))))
         (and d (cons (alpha (* bia d)) (- zero d)))))))))
  (lambda (a b) (and (= (car a)(car b)) (= (cdr a)(cdr b)))) ; =
  (lambda () (cons (Cr) (Cr))) ; Cr 
  (lambda (x) (cons (alpha (car x)) (- zero (alpha (cdr x))))) ; alpha
  (lambda (x) (cons (bar (car x)) (- zero (tr (cdr x))))) ; bar
  (lambda (x) (cons (tr (car x)) (bar (cdr x)))) ; tr
  (lambda (x) (rp (car x))) ; rp
  (lambda (s x) (cons (sm s (car x)) (sm s (cdr x)))) ; sm
  (lambda (x) (k (Q (car x)) (Q (cdr x)))) ; quadratic form
  (cons (cons zero one) (map (lambda (x) (cons x zero)) basis)) ; basis
  (lambda (x) (and (= (cdr x) zero) (R? (car x)))) ; R?
  (lambda (x) (let ((q (V? (car x)))(u (cdr x)))
        (and q (R? u) (cons (rp u) q)))) ; in V?
  (lambda () (cons (Rr) zero)) ; Rr
  (lambda () (cons (Vr) (Rr))) ; Vr
  (lambda (cv) (cons (v2C (cdr cv)) (sm (car cv) one))) ; v2C
  ))) f)))
  (i (lambda (x) x)))
 (let GG ((sig sig)) (if (null? sig) (list + - * 0 1
      (lambda (x) (if (zero? x) #f (/ x))) eq rn i i i i *
      (lambda (x) (* x x)) '() i
      (lambda (x) (and (zero? x) '())) rn (lambda () 0) (lambda (d) 0))
    (G (car sig) (GG (cdr sig)))))))

; open test
(define sig (list + - -))
(define P ((fileVal "IndCliff") sig = ((fileVal "rr") "Ss")))
(define C+ (car P)) ; Add Clifford numbers
(define C- (cadr P)) ; subtract
(define C* (caddr P)) ; *
(define C0 (cadddr P)) ; The 0 Clifford number
(define P1 (cddddr P)) ; rest of tools
(define C1 (car P1)) ; The 1 Clifford number
(define C/ (cadr P1)) ; Multiplicative inverse
(define C= (caddr P1)) ; equality
(define Cr (cadddr P1)) ; sample generator
(define P2 (cddddr P1)) ; rest of tools
(define Ca (car P2)) ; principle involution; alpha in some texts.
(define bar (cadr P2)) ;
(define tr (caddr P2)) ; transpose
(define rp (cadddr P2)) ; real part
(define P3 (cddddr P2)) ; rest of tools
(define sm (car P3)) ; scalar multiply
(define Q (cadr P3)) ; quadratic form 
(define basis (caddr P3)) ; list of basis elements of V
(define Creal? (cadddr P3)) ; is this clifford number a real? if so as real.
(define P4 (cddddr P3)); rest of tools
(define V? (car P4)) ; is this clifford number in V? if so as list of reals.
(define Rr (cadr P4)) ; Random real Clifford number
(define Vr (caddr P4)) ; Random member of V.

(map V? basis) ; => ((1 0 0) (0 1 0) (0 0 1))
(map Creal? basis) ; => (#f #f #f)
(map Q basis) ; => (1 -1 -1)
(define (bq x y) (* 1/2 (- (Q (C+ x y)) (+ (Q x) (Q y)))))
(((fileVal "Do") 'DoL) 5 (lambda (w)
    (let ((a (+ w 17/29)) (b (Cr)) (c (Cr)) (d (Cr)))
  (list
  (= (bq d b) (bq b d))
  (= (bq d (C+ b c)) (+ (bq d b) (bq d c)))
  (= (* a (bq b c)) (bq (sm a b) c))
  ))))
; => ((#t #t #t) (#t #t #t) (#t #t #t) (#t #t #t) (#t #t #t))
; This indicates that Q is a quadratic form on Cl that agrees with the quadratic form on V which founded Cl.

(define (turn trn x) (C* (C* trn x) (Ca (C/ trn))))
(let ((a (Cr)) (b (Cr)) (c (Cr)))
  (C= (turn (C* a b) c) (turn a (turn b c)))) ; => #t
(define (Om e) (map (lambda (i) (V? (turn e i))) basis))
(map Om basis) ; => (
; ((-1 0 0) (0 1 0) (0 0 1))
; ((1 0 0) (0 -1 0) (0 0 1))
; ((1 0 0) (0 1 0) (0 0 -1)))
(define mp ((fileVal "Matrix") '() 0 zero? 1 + - * /))
(define mm (cadr mp))
(define tr (car (cddddr mp)))
(define m= (car (cddddr (cddddr mp))))

(define t (let ((eta ((fileVal "diag") (map (lambda (e) (e 1)) sig))))
  (lambda (cg) (let ((A (Om cg)))
    (list eta A (m= (mm A (mm eta (tr A))) eta))))))
(define g0 (car basis))
(define g1 (cadr basis))
(define g2 (caddr basis))

(t (C+ (sm 2 g0) g2))
; (((1 0 0) (0 -1 0) (0 0 -1)) ((-5/3 0 -4/3) (0 1 0) (4/3 0 5/3)) #t)
(t (C* (C+ (sm 2 g0) g2) (C* g1 (C+ (sm 3 g0) g2))))
; (((1 0 0) (0 -1 0) (0 0 -1)) ((13/12 0 5/12) (0 -1 0) (5/12 0 13/12)) #t)