SICP PolySystem

两天时间总算完成了这题目,真尼玛多

好在书倒是懂得循序渐进的方式,一步一步的优化系统

首先是要建立最基本的多项式加减乘除

加乘作为元运算比较简单,基本无难度

之后做减法，注意这里有个比较简单的坎就是要递归的将嵌套的系数也变负，

然后是除法，多加了几个局部变量帮助理解,合理运用之前的加减乘即可获得

另外,我们之前实现的是稀疏型的多项式,要求我们也能处理稠密型,

采取的方式是类比前一次的(type 'number)我们对稠密的进行补充次数,这里就需要另一个函数来计算次数啦

然后是rational型的多项式,这里第一个感觉,好烦啊,又要改之前的代码

这里就强调了之前的代码封装性要好,其实开始写以后才发现将之前的整形操作类比为整数,然后模仿之前的rat

写完加乘,发现竟然不能化简,这也太难看了点,得到了书上的提示说类比整数gcd操作

于是利用除法获得的余数来进行辗转相除,才发现竟然如此神奇！

然后我们又实现了降次,但是又是一个问题,答案中系数竟然是分式而不是整数，这验算了一下发现是对的

接下来我们对它进行乘法避免产生分数然后迭代的寻找gcd 最后将gcd 除掉就好了

以下是代码(好长的样子)

;;put & get(define (make-table) (let ((local-table (list '*table*)))(define (lookup key-1 key-2)(let((subtable (assoc key-1 (cdr local-table))))(if subtable(let((record (assoc key-2 (cdr subtable))))(if record(cdr record)false))false)))(define (insert! key-1 key-2 value)(let((subtable (assoc key-1 (cdr local-table))))(if subtable(let((record (assoc key-2 (cdr subtable))))(if record(set-cdr! record value)(set-cdr! subtable  (cons (cons key-2 value) (cdr subtable)))))(set-cdr! local-table  (cons (list key-1 (cons key-2 value)) (cdr local-table)))))'OK)(define (dispatch m)(cond ((eq? m 'lookup-proc) lookup)((eq? m 'insert-proc) insert!)(else (error "Unknown operation -- TABLE" m))))dispatch))(define operation-table (make-table))(define get (operation-table 'lookup-proc))(define put (operation-table 'insert-proc))(define (same-variable? v1 v2) (eq? v1 v2))(define (+poly p1 p2)(if(same-variable? (variable p1) (variable p2))(make-polynomial (variable p1) (+term (term-list p1) (term-list p2)))(error "Not the same var" (list p1 p2))))(define (*poly p1 p2)(if(same-variable? (variable p1) (variable p2))(make-polynomial (variable p1) (*term (term-list p1) (term-list p2)))(error "Not the same var" (list p1 p2))))(put 'polynomial 'add +poly)(put 'polynomial 'mul *poly)(define (make-polynomial variable p1) (attach-type 'polynomial (cons variable p1)))(define (attach-type symbol obj) (cons symbol obj))(define (make-term order coeff) (list order coeff))(define (term-list p1) (cdr p1))(define (variable p1) (car p1))(define (the-empty-termlist) ())(define (order term) (car term))(define (coeff term) (cadr term))(define (highest-term list)(define (counter tmp-list) (if (null? tmp-list) 0 (+ 1 (counter (cdr tmp-list)))))(let ((tmp (car list)))(if(pair? tmp)tmp(make-term (- (counter list) 1) tmp))))(define (rest-list list) (cdr list))(define (empty-list? list)(null? list))(define (=zero? obj)((get (type obj) '=zero?) (content obj)))(define (type obj) (if (number? obj) 'number (car obj)))(define (content obj) (if (number? obj) obj (cdr obj)))(define (num=zero? obj) (= 0 obj))(define (polynomial=zero? obj)(let((t1 (term-list obj)))(define (iter list) (if(null? list)#t(and(= 0 (coeff(highest-term list))) (iter (rest-list list)))))(iter t1)))(put 'polynomial '=zero? polynomial=zero?)(put 'number '=zero? num=zero?)(define (adjoin-term term list)(if (=zero? (coeff term)) list (cons term list)))(define (+term L1 L2)(cond((empty-list? L1) L2)((empty-list? L2) L1)(else(let((t1 (highest-term L1)) (t2 (highest-term L2)))(cond((> (order t1) (order t2)) (adjoin-term t1 (+term (rest-list L1) L2)))((< (order t1) (order t2)) (adjoin-term t2 (+term L1 (rest-list L2))))(else(adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2)))(+term (rest-list L1) (rest-list L2)))))))))(define (*term L1 L2)(cond((empty-list? L1) (the-empty-termlist))(else (+term (*term (rest-list L1) L2) (*-term-by-all-terms (highest-term L1) L2)))))(define (*-term-by-all-terms t l)(if(empty-list? l) (the-empty-termlist)(adjoin-term (make-term (+ (order t) (order (highest-term l))) (mul (coeff t) (coeff (highest-term l)))) (*-term-by-all-terms t (rest-list l)))))(define (mul p1 p2)(if(eq? (type p1) (type p2))((get (type p1) 'mul) (content p1) (content p2))(cond((higher? p1 p2)(mul p1 (raise p2)))(else(mul (raise p1) p2)))))(define (raise p1)(make-polynomial 'x (adjoin-term (make-term 0 (content p1)) ())))(define (add p1 p2)(if(eq? (type p1) (type p2))((get (type p1) 'add) (content p1) (content p2))(cond((higher? p1 p2)(add p1 (raise p2)))(else(add (raise p1) p2)))))(define (higher? p1 p2)(if(and (eq? (type p1) 'polynomial) (eq? (type p2) 'number)) #t#f))(define (number+ p1 p2)(+ p1 p2))(define (number* p1 p2)(* p1 p2))(put 'number 'add number+)(put 'number 'mul number*)(define (poly- p1 p2)(if(same-variable? (variable p1) (variable p2))(make-polynomial (variable p1) (term- (term-list p1) (term-list p2)))(error "Not the same var" (list p1 p2))))(define (term- L1 L2)(cond((null? L2) L1)((null? L1) (inverse-list L2))(else(let ((t1 (highest-term L1)) (t2 (highest-term L2)))(cond((= (order t1) (order t2)) (adjoin-term (make-term (order t1) (sub (coeff t1) (coeff t2)))(term- (rest-list L1) (rest-list L2))));;in this point i need to change t2 to -t2((< (order t1) (order t2)) (adjoin-term (inverse t2) (term- L1 (rest-list L2))))(else(adjoin-term t1 (term- (rest-list L1) L2))))))))(define (sub p1 p2)(if(eq?(type p1) (type p2))((get (type p1) 'sub) (content p1) (content p2))(if(higher? p1 p2)(sub p1 (raise p2))(sub (raise p1) p2))))(define (number- p1 p2)(- p1 p2))(put 'number 'sub number-)(put 'polynomial 'sub poly-)(define (inverse t)(if(number? t)(* -1 t)(make-term (order t) (inverse (coeff t)))))(define (inverse-list l)(if(null? l)()(adjoin-term (inverse (highest-term l)) (inverse-list (rest-list l)))))(define (/poly p1 p2)(if(same-variable? (variable p1) (variable p2))(/term (term-list p1) (term-list p2))(error "Not same var")))(define (/term L1 L2)(if(empty-list? L1)(list (the-empty-termlist) (the-empty-termlist))(let((t1 (highest-term L1)) (t2 (highest-term L2)))(if(> (order t2) (order t1))(list (the-empty-termlist) L1)(let((new-c(div (coeff t1) (coeff t2)))(new-o (- (order t1) (order t2))))(let((new-t (make-term new-o new-c)))(let((new-l (adjoin-term new-t () )))(let ((rest-of-result (term- L1 (*term new-l L2))))(add-term-in-dlist new-t (/term rest-of-result L2))))))))))(define (div obj1 obj2)(let((t1 (type obj1)) (t2 (type obj2)))(if(eq? t1 t2)((get t1 'div) (content obj1) (content obj2))(if(higher? obj1 obj2)(div obj1 (raise obj2))(div (raise obj1) obj2)))))(define (poly/ p1 p2)(make-polynomial (variable p1) (car (/poly p1 p2))))(define (number/ p1 p2)(/ p1 p2))(put 'polynomial 'div poly/)(put 'number 'div number/)(define (add-term-in-dlist t1 double-list)(let((tmp1 (car double-list))(tmp2 (cadr double-list)))(list(adjoin-term t1 tmp1) tmp2)))(define (make-fraction-poly numerator demominator)(let ((tmp-gcd (gcd-poly (content numerator) (content demominator))))(if(= 0 (order (highest-term (term-list (content tmp-gcd)))))(attach-type 'fraction (cons numerator demominator))(attach-type 'fraction (cons (div numerator tmp-gcd) (div demominator tmp-gcd))))))(define (fra-content r)(if(eq? (car r) 'polynomial) r  (cdr r)))(define (fra-type r)(if(eq? (car r) 'polynomial) 'int (car r)))(define (poly-numerator r)(car r))(define (poly-demominator r)(cdr r))(define (fra+ r1 r2)(let ((t1 (variable (content (poly-numerator r1)))) (t2 (variable (content (poly-numerator r2)))))(if(eq? t1 t2)(let((nl1 (term-list (content (poly-numerator r1)))) (nl2 (term-list (content (poly-numerator r2)))) (dl1 (term-list (content (poly-demominator r1))))(dl2 (term-list (content (poly-demominator r2)))))(make-fraction-poly(make-polynomial t1 (+term (*term nl1 dl2) (*term nl2 dl1)))(make-polynomial t1 (*term dl1 dl2))))(error "Not same var!"))))(define (fra* r1 r2)(let ((t1 (variable (content (poly-numerator r1)))) (t2 (variable (content (poly-numerator r2)))))(if(eq? t1 t2)(let((nl1 (term-list (content (poly-numerator r1)))) (nl2 (term-list (content (poly-numerator r2)))) (dl1 (term-list (content (poly-demominator r1))))(dl2 (term-list (content (poly-demominator r2)))))(make-fraction-poly(make-polynomial t1 (*term nl1 nl2))(make-polynomial t1 (*term dl1 dl2))))(error "Not same var!"))))(put 'fraction 'add fra+)(put 'fraction 'mul fra*)(define (gcd-term a b)(if(empty-list? b)(simple-term a)(gcd-term b (reminder-term a b))))(define (reminder-term a b)(let((q1 (order (highest-term a))) (q2 (order (highest-term b))) (c (coeff (highest-term b))))(let ((factor (exp c (+ 1 q1 q2))))(let ((tmp-l (list (list 0 factor))))(cadr (/term (*term a tmp-l) (*term b tmp-l)))))))(define (gcd-poly p1 p2)(let((v1 (variable p1)) (v2 (variable p2)))(if(eq? v1 v2)(make-polynomial v1 (gcd-term (term-list p1) (term-list p2)))(error "Not same var"))))(define (exp a b)(define (iter result count)(if(= count b) result(iter (* a result) (+ count 1))))(iter 1 0))(define (Gcd a b)(define (reminder x y) (if (< x y) x (reminder (- x y) y)))(if (= b 0)  a  (Gcd b (reminder a b))))(define (gcd-coeff l)(define (iter number l)(if(null? l) number(iter (Gcd number (coeff (highest-term l))) (rest-list l))))(iter (coeff (highest-term l)) (rest-list l)))(define (simple-term l)(let ((tmp-list (list (list 0  (gcd-coeff l)))))(/term l tmp-list)))