; Check conformity with . (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 ; . (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))