; Check conformity with <http://math.ucr.edu/home/baez/octonions/node3.html>.

(define (G f) 
(apply (lambda (conj sg zer zer? one + - * inv) (list
  (lambda (x) (cons (conj (car x)) (- zer (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 (+ (car a)(car b))(+ (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 b)(conj (cdr a))))
                      (+ (* (car b)(cdr a))(* (conj (car a))(cdr b)))))
  (lambda (x) (let ((d (inv
      (+ (* (car x)(conj (car x))) (* (cdr x)(conj (cdr x)))))))
          (cons (* d (conj (car x)))(- zer (* d (cdr x)))))))) f))

(define reals (list
   (lambda (x) x) (lambda () 2)
   0 zero? 1 + - *
   (lambda (x) (/ x))))

(define P (G (G (G reals))))
(define m (cadddr (cddddr P))) ; multiply
(define sb (caddr (cddddr P))) ; subtract
(define zer (caddr P))

(define a0 '((1 . 0) . (0 . 0)))
(define a1 '((0 . 1) . (0 . 0)))
(define a2 '((0 . 0) . (1 . 0)))
(define a3 '((0 . 0) . (0 . 1)))
(define z  '((0 . 0) . (0 . 0)))
; following definitions inspired by bicture at bottom of
; <http://math.ucr.edu/home/baez/octonions/node4.html>.
(define (neg x)(sb zer x))
(define e0 (cons a0 z))
(define e5 (cons a1 z))
(define e6 (cons a2 z))
(define e1 (cons a3 z))
(define e3 (cons z a0))
(define e2 (neg (cons z a1))) ; Really wierd!!
(define e4 (cons z a2))
(define e7 (cons z a3))

(define ol (list e0 e1 e2 e3 e4 e5 e6 e7))
(define (match x)(let ss ((k ol)(n 0)) (cond
    ((equal? x (car k)) n)
    ((equal? x (neg (car k))) (- n))
    (#t (ss (cdr k)(+ n 1))))))

(map (lambda (x) (map (lambda (y) (match (m y x))) ol)) ol)

; => (
; (0  1  2  3  4  5  6  7)
; (1  0  4  7 -2  6 -5 -3)
; (2 -4  0  5  1 -3  7 -6)
; (3 -7 -5  0  6  2 -4  1)
; (4  2 -1 -6  0  7  3 -5)
; (5 -6  3 -2 -7  0  1  4)
; (6  5 -7  4 -3 -1  0  2)
; (7  3  6 -1  5 -4 -2  0))