Here I attempt a synthesis of my discoveries, mostly from web searches but some by thinking and computer exploration. This is organized around the Scheme code. I use “tandem recursion” for these reasons. The function G takes a list of tools for a Clifford algebra some degree and returns a similar list for the Clifford algebra of next higher degree. Given the tools for Cliff(n, K) it returns the tools for Cliff(n+1, K) Cliff(0, K) is isomorphic to K. (Here “Cliff(n, K)” denotes the nth order Clifford algebra over field K.) In these exercises K is the reals but the function G does not depend on this. This variation allows for quadratic forms that are not positive definite but it has too much extra hair to discard this version. The list of tools follows:
+ | C × C → C | Addition of two cns(Clifford numbers) |
− | C → C | Take the negative of a cn |
* | C × C → C | Multiplication of two cns |
zero | C | The additive identity |
one | C | The multiplicative identity |
zero? | C → bool | Predicate of zero |
/ | C → C | Multiplicative inverse |
alpha | C → C | λx.α(x) |
sg | → C | Sample generator |
bar | C → C | λx. |
tr | C → C | λx.x† |
rp | C → C | real part: λx.<x> |
sm | K × C → C | scalar multiply |
mag | C → K | Euclidean distance, taking C as Euclidean space |
basis | list of basis elements for V, expressed as elements of C |
(define (G f) (apply (lambda (+ - * zero one / = sg alpha bar tr rp sm basis) (list (lambda (a b) (cons (+ (car a)(car b))(+ (cdr a)(cdr b)))) ; + (lambda (a) (cons (-(car a))(-(cdr a)))) ; - (negation) (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))))) (d (- (* aib (alpha c))))) (cons c d)) (let ((bi (/ b))) (if bi (let* ((bia (* bi a))(d (- (/ (+ (* (alpha a) bia) (alpha b))))) (c (alpha (- (* bia d))))) (cons c d)) #f))))) (lambda (a b) (and (= (car a)(car b)) (= (cdr a)(cdr b)))) ; = (lambda () (cons (sg) (sg))) ; sg (lambda (x) (cons (alpha (car x)) (- (alpha (cdr x))))) ; alpha (lambda (x) (cons (bar (car x)) (- (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 (cons (cons zero one) (map (lambda (x) (cons x zero)) basis)) ; basis )) f)) (define (Do n p) (if (> n 0) (let ((u (- n 1))) (p u) (Do u p)))) (define (grc4 key)(let ((s (make-string 256))(i 0)(j 0)) (Do 256 (lambda(n) (string-set! s n (integer->char n)))) (let ((len (string-length key))(j 0)) (Do 256 (lambda (k) (let ((i (- 255 k))) (set! j (modulo (+ j (char->integer (string-ref s i)) (char->integer (string-ref key (modulo i len)))) 256)) (let ((t (string-ref s i))) (string-set! s i (string-ref s j)) (string-set! s j t)))))) (lambda (n)(let ((v 0)) (Do n (lambda (dm) (set! i (if (= i 255) 0 (+ i 1))) (let* ((a (string-ref s i))(A (char->integer a))) (set! j (modulo (+ j A) 256)) (let* ((b (string-ref s j))(B (char->integer b))) (string-set! s i b)(string-set! s j a) (set! v (+ (* 256 v) (char->integer (string-ref s (modulo (+ A B) 256))))))))) v)))) (define Kr (let ((ig (grc4 "vjoe"))) (lambda ()(/ (ig 1)(+ 1 (ig 1)))))) (define reals (let ((i (lambda (x) x))) (list + - * 0 1 (lambda (x) (if (zero? x) #f (/ x))) = Kr i i i i * '()))) (define P (G (G (G (G reals))))) (define C+ (car P)) ; + (define C- (cadr P)) ; - (define -- (lambda (x y) (C+ x (C- y)))) ; binary subtract (define C* (caddr P)) ; * (define C0 (cadddr P)) ; 0 (define P1 (cddddr P)) ; rest of tools (define C1 (car P1)) ; 1 (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 (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 mag (cadr P3)) ; Euclidean quadratic form on C (define basis (cadr P3)) ; list of basis elements of V (define (sp x y) (rp (C* (tr x) y))) (define (even a)(sm 1/2 (C+ a (Ca a)))) ; even part of Clifford number (define (odd a)(sm 1/2 (-- a (Ca a)))) ; odd part of Clifford number (define (Vr) (let Vr ((x basis)) (if (null? x) C0 (C+ (sm (Kr) (car x)) (Vr (cdr x)))))) ; a random vector generator (define g0 (car basis)) ; individual Clifford number basis elements for V in C. (define g1 (cadr basis)) (define g2 (caddr basis)) (define g3 (cadddr basis)) (define (ip a b) (rp (C* (bar a) b))) (define (mag x)(ip x x)) (define (gs x) (Ca (let sx ((s C0)(bs basis)) (if (null? bs) s (sx (C+ s (sm (sp x (car bs)) (car bs))) (cdr bs)))))) (define (Om cn) (let ((cni (Ca (C/ cn)))) (map (lambda (be) (map (lambda (x) (sp x (C* cn (C* (Ca be) cni)))) basis)) basis))) (define (transpose x) (if (null? (car x)) '() (cons (map car x) (transpose (map cdr x))))) (define (mm x y) (map (lambda (x) (map (lambda (y) ; matrix multiply (let ip ((a x)(b y)) (if (null? a) 0 (+ (* (car a) (car b)) (ip (cdr a)(cdr b)))))) y)) x)) (define (V? x) (C= x (gs x))) ; membership test for Space V (define (turn v x) (C* x (C* v (Ca (C/ x))))) (define (Cg? x) (and (not (zero? (sp x x))) (V? (turn (Vr) x)))) ; In Clifford group? (define (nc om cn) (let ((bp (map (lambda (or) (let sl ((sum C0)(o or)(b basis)) (if (null? o) sum (sl (C+ sum (sm (car o)(car b))) (cdr o)(cdr b))))) om))) (let ev ((cn cn)(bp bp)) (if (number? cn) (sm cn C1) (C+ (ev (car cn)(cdr bp)) (C* (ev (cdr cn) (cdr bp)) (car bp))))))) (define om '( ; Random orthogonal matrix ( 0.632029912285030 -0.345479757766476 -0.594744514125551 0.357016652088046) ( -0.592369871660068 0.170849658106720 -0.289145172937079 0.732327384740895) ( -0.007476840833518 -0.674616965961234 0.622259647858576 0.397025158819098) ( -0.499580045615879 -0.629560227885855 -0.418887768419743 -0.422618900376064))) (define (cfb op) (mag (let ((a (Cr))(b (Cr))) (-- (op (nc om a)(nc om b))(nc om (op a b)))))) (define (cfcc op) (mag (let ((a (Cr))) (-- (op (nc om a))(nc om (op a)))))) ; (map cfb (list C+ -- C*)) ; (map cfcc (list C/ Ca bar tr)) (define (cfcck op) (let ((a (Cr))(b (Cr))) (- (op (nc om a)(nc om b))(nc om (op a b))))) (define (linear? f) (let ((c (Cr))(d (Cr))(s (Kr))) ; for C -> K (and (= (* s (f c))(f (sm s c))) (= (f (C+ c d))(+ (f c)(f d)))))) (define (bilinear? f) (let ((y (Cr))) (and ; for C × C -> K (linear? (lambda (x) (f x y))) (linear? (lambda (x) (f y x)))))) (define (ng x) (map (lambda (b) (let ((y (turn b x))) (-- (gs y) y))) basis)) (define (smag x) (let v ((x x)) (if (null? x) 0 (+ (mag (car x)) (v (cdr x)))))) (define (CG? x) (zero? (smag (ng x)))) (define d .000001) (ng (C+ C1 (sm d g3))) ; => (C0 C0 C0 (sm d C1)) (ng (C+ C1 (sm d (C* g0 g1)))) ; => (C0 C0 C0 C0) (let ((a (Cr))) (-(sp a a) (-(mag (even a)) (mag (odd a))))) ; => 0