This is an earlier clunkier version of this which you should probably use.

Here we add some hair to make hacking easier, while slightly obscuring the mathematical ideas.

To our Clifford packet we add a function that maps from reals to the copy of the reals within the algebra. We also add the list of anointed basis vectors for the copy of the base space V. We rename conj as "alpha" to agree with Wikipedia. We also add the antiautomorphism "trn" transpose. 

(define (G f)
(apply (lambda (deg alpha sg zer zer? one c+ - * rls atms mag) (list
  (+ 1 deg)
  (lambda (x) (cons (alpha (car x)) (- zer (alpha (cdr x)))))
  (lambda () (cons (sg) (sg)))
  (cons zer zer)
  (lambda (a) (and (zer? (car a)) (zer? (cdr a))))
  (cons one zer)
  (lambda (a b) (cons (c+ (car a)(car b))(c+ (cdr a)(cdr b))))
  (lambda (a b) (cons (- (car a)(car b))(- (cdr a)(cdr b))))
  (lambda (a b) (cons (- (* (car a)(car b))(* (cdr a)(alpha (cdr b))))
                     (c+ (* (car a)(cdr b))(* (cdr a)(alpha (car b))))))
  (lambda (x)(cons (rls x) zer))
  (cons (cons zer one) (map (lambda (x) (cons x zer)) atms))
  (lambda (a) (+ (mag (car a))(mag (cdr a))))
  )) f))
; Use definitions for Do and grc4 for a pseudo random number generator. 
(define rr (let ((ig (grc4 "vjoe"))) (lambda ()(/ (ig 1)(+ 1 (ig 1))))))
; As in the division algebras we boot the process with the reals: 
(define reals (let ((i (lambda (x) x))) (list 0 i rr 0 zero? 1 + - *
       i '() (lambda (x) (* x x)))))
; Now we build the 4th order Clifford algebra C4 thus: 
(define P  (G (G (G (G reals)))))
; and extract the tools from the result p: 
(define Hd (car P)) ; degree
(define p (cdr P)) ; rest
(define Ha (car p)) ; main involution
(define Hsg (cadr p)) ; sample generator
(define Hzer (caddr p)) ; 0
(define Hzer? (cadddr p)) ; 0 predicate
(define q (cddddr p)) ; rest of tools
(define Hone (car q)) ; multiplicative identity
(define H+ (cadr q)) ; addition
(define H- (caddr q)) ;  subtraction
(define H* (cadddr q)) ; multiplication
(define r (cddddr q)) ; rest of tools
(define Hrls (car r)) ; returns Clifford number corresponding to real.
(define basis (cadr r)) ; list of basis vectors of V as Clifford numbers.
(define Hmag (caddr r)) ; sum of squares of components of Clifford numbers.
; Define.
(define (even a)(H* (Hrls 1/2)(H+ a (Ha a)))) ; even part of Clifford number
(define (odd a)(H* (Hrls 1/2)(H- a (Ha a)))) ; odd part of Clifford number

(define (tr z)(let v ((m 0)(n Hd)(z z))(if (= n 0)
  (if (< (modulo m 4) 2) z (- z))
   (cons (v m (- n 1)(car z))(v (+ m 1)(- n 1)(cdr z))))))

(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))
; We how have four reflections in V4. g0, ... g3 are the basis vectors for the vector space for C4. 
(let ((a (Hsg))(b (Hsg))) (list
(Hzer? (H- (H* (tr a)(tr b))(tr (H* b a))))
(Hzer? (H- (H+ (tr a)(tr b))(tr (H+ a b))))
(Hzer? (H- (H* (Ha a)(Ha b))(Ha (H* a b))))
(Hzer? (H- (H+ (Ha a)(Ha b))(Ha (H+ a b)))))) ; => (#t #t #t #t)
While small, the definition of the transpose, tr, is klunky and does not fit in the pattern. Note that the last five lines above corroborate that Ha is an automorphism and that tr is an antiautomorphism (note the (H* b a) in the first line.)

Now we provide the predicate for belonging to the Clifford Group. It takes a special equivalence predicate for we will want to test both exact and floating point Clifford numbers. sp is the inner product fot the Clifford algebra. 

(define (sp a b) (let pul ((z (H* (tr a) b))) (if (number? z) z (pul (car z)))))