; Adapted from . (define matpak (lambda (zero zer? one fa fs fm fi) (letrec ( (sm (lambda (s a)(map (lambda (w) (fm s w)) a))) (fms (lambda (a s b) (if (null? a) (sm (fs zero s) b) (if (null? b) a (cons (fs (car a) (fm s (car b))) (fms (cdr a) s (cdr b))))))) (deter (lambda (a) (letrec ((p #f) (tf (lambda (x) (if (null? x) (list one) (if (zer? (caar x)) (let ((z (tf (cdr x) zp))) (set! p (not p)) (cons (car z) (cons (car x) (cdr z)))) x))))) (let inx ((d one)(a a)) (if (null? a) (if p (fs zero d) d) (let* ( (A (tf a)) (i (fi (caar A))) (b (map (lambda (z) (fm z i)) (cdar A)))) (inx (fm (caar A) d) (map (lambda (x w) (fms x w b)) (map cdr (cdr A)) (map car (cdr A)))))))))) (ip (lambda (x y)(if (or (null? x) (null? y)) zero (fa (fm (car x)(car y)) (ip (cdr x)(cdr y))))))) (list deter ip)))) (apply (lambda (deter ip) (let ((aug (lambda (x)(cons (cons 1 (map (lambda (x) 1/2) (car x))) (map (lambda (x) (cons 1/2 x)) x))))) (let w ((d 2)(c 1)(s '((1)))) (write (cons c (* d (deter s))))(newline)(w (* 2 d)(+ c 1)(aug s))) )) ; Here we supply matpak with the field goodies for our current field. (matpak 0 zero? 1 + - * (lambda (x)(/ 1 x))))