; notes at: http://cap-lore.com/code/Scheme/reposIntro/CliffordTurn.html
; reported results are from ((fileVal "CliffordTurn") (list + - -))
(lambda (sig) (let ((L (lambda l (write l) (display "\n"))))
  (ylppa ((fileVal "IndCliff") sig equal? ((fileVal "rr") "Futz"))
  (lambda (C+ C- C* C0 C1 C/ C= Cr Ca bar tr rp sm Q basis Creal? V? Rr Vr V2C)
(L "Bases are unreal:" (map Creal? basis)) ; ("Bases are unreal:" (#f #f #f))
(L "Bases are in V:" (map V? basis)) ; ("Bases are in V:" ((1 0 0) (0 1 0) (0 0 1)))
(L "Q of bases:" (map Q basis)) ; ("Q of bases:" (1 -1 -1))
(let* ((bq (lambda (x y) (* 1/2 (- (Q (C+ x y)) (+ (Q x) (Q y))))))
      (turn (lambda (trn x) (C* (C* trn x) (Ca (C/ trn)))))
      (G? (lambda (x) (V? (turn x (Vr))))) ; is x in Clifford group?
      (Om (lambda (e) (map (lambda (i) (V? (turn e i))) basis))))
  (L "Om of bases:" (map Om basis))
; ("Om of bases:"
;  (((-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))))
  (((fileVal "Do") 'DoL) 5 (lambda (w)
    (let ((a (+ w 17/29)) (b (Cr)) (c (Cr)) (d (Cr)))
  (L "Clifford axioms:" (and
    (C= (C* (Ca b) (Ca c))    (Ca (C* b c)))
    (C= (C* (bar b) (bar c)) (bar (C* c b)))
    (C= (C* (tr b) (tr c))    (tr (C* c b)))
    (= (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))
    (C= (turn (C* d b) c) (turn d (turn b c)))
    ))))) ; 5 ("Clifford axioms:" #t)
  (if (> (length sig) 2) (ylppa ((fileVal "Matrix") '() 0 zero? 1 + - * /)
     (lambda (rm mm matinv ip tr det i? v= m=)
       (let ((t (let ((eta ((fileVal "diag") (map (lambda (e) (e 1)) sig))))
         (lambda (cg) (let ((A (Om cg)))
           (L eta "Turned:" A (m= (mm A (mm eta (tr A))) eta))))))
      (g0 (car basis))(g1 (cadr basis))(g2 (caddr basis)))
     (t (C+ (sm 2 g0) g2))
;(((1 0 0) (0 -1 0) (0 0 -1)) "Turned:" ((-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)) "Turned:" ((13/12 0 5/12) (0 -1 0) (5/12 0 13/12)) #t)
     ))))
     (L "simple" (and (G? (Vr)) (G? (Rr)) (G? (C* (Vr) (Vr))) "yes"))
     (L "sum of products of V" (and (G? (C+ (C* (Vr) (Vr)) (C* (Vr) (Vr))))
       "Not generally"))
     (L "even vals belong to group" (G? (let ((x (Cr))) (C+ x (Ca x))))) ; not so!
     )))))

((fileVal "CliffordTurn") (list - - -))
((fileVal "CliffordTurn") (list - - - +))
((fileVal "CliffordTurn") (list - - + +))