说一下程序的思路，比如一个x变量的多项式 (2+y^2)* x ^3 + x^2+7，我们要把他转化为关于变量y的多项，怎么来转化？ 首先按照多项式的次数，分别进行转化，第一项 (2+y^2)* x ^3 ，第二项 1x ^2，第三项 7**x ^0,。 每一项的转化思路，把次数和系数分别转化成关于y变量的多项式，然后相乘，得到的多项式就是最终转化为y变量的多项式，也就是多项式(2+y^2) 乘以多项式(1x ^3) * y ^0,每一项都按照这个思路进行转化，就得到了最终的结果。 接着我们写出多项式系数转化方法term-coeff->poly，多项式次数转化term-order->poly 每一项的转化term->poly，term->poly是将term-coeff->poly和term-order->poly结果相乘。 最后再写出变化变量的poly->poly过程。
另外我们还需要加一个强制，就是将数字转化为多项式的强制过程number->poly。这样可以保证系数如果一个是多项式，另一个是数字之间的运算问题。 具体实现如下。
(define (poly->poly p newvar) ;;把这一项的次数部分转化成新变量的表达式,比如x^2转化为1*x^2*y^0的表达式。 (define (term-order->poly order oldvar) (make-polynomial newvar (make-sparse-terms (list (make-term 0 (make-polynomial oldvar (make-sparse-terms (list (make-term order 1))))))))) ;;把这一项的系数部分转化成新变量的表达式, ;;如果系数是数字，转化成关于新变量的多项式7*y^0。 ;;如果系数是多项式且变量与新变量相同，直接采用该系数就可以。 ;;如果系数是多项式且变量与新变量不相同，化成关于新变量y，系数为多项式(6*z^3+z^2)，次数y^0的多项式 (define (term-coeff->poly coeff) (cond ((number? coeff) (number->poly coeff newvar)) ((eq? (variable coeff) newvar) coeff) (else (make-polynomial newvar (make-sparse-terms (list (make-term 0 coeff))))))) ;;把这一项系数和次数转化后的多项式相乘，得到的就是该项转化后的结果 (define (term->poly term oldvar) (mul (term-order->poly (order term) oldvar) (term-coeff->poly (coeff term)))) (cond ((eq? (variable p) newvar) p) ((empty-terms? (term-list p)) (make-polynomial newvar (make-sparse-terms '()))) ((add (term->poly (first-terms (term-list p)) (variable p)) (poly->poly (make-polynomial (variable p) (make-sparse-terms (rest-terms (term-list p)))) newvar))))) ;;数字转化为多项式的方法 (define (number->poly n var) (make-polynomial var (make-sparse-terms (list (make-term 0 n))))) (put-coercion 'scheme-number 'polynomial number->poly)附上完整过程
#lang racket ;put get实现 (define *op-table* (make-hash)) (define (put op type proc) (hash-set! *op-table* (list op type) proc)) (define (get op type) (hash-ref *op-table* (list op type) #f)) (define *type-coercion* (make-hash)) (define (put-coercion type1 type2 proc) (hash-set! *type-coercion* (list type1 type2) proc)) (define (get-coercion type1 type2) (hash-ref *type-coercion* (list type1 type2) #f)) (define (attach-tag type-tag contents) (cond ((eq? type-tag 'scheme-number) contents) (else (cons type-tag contents)))) (define (type-tag datum) (cond ((number? datum) 'scheme-number) ((pair? datum) (car datum)) (else (error "Bad tagged datum -- TYPE-TAG" datum)))) (define (contents datum) (cond ((number? datum) datum) ((pair? datum) (cdr datum)) (else (error "Bad tagged datum -- CONTENTS" datum)))) (define (apply-generic op . args) (let ((type-tags (map type-tag args))) (let ((proc (get op type-tags))) (if proc (apply proc (map contents args)) (if (= (length args) 2) (let ((type1 (car type-tags)) (type2 (cadr type-tags)) (a1 (car args)) (a2 (cadr args))) (let ((t1->t2 (get-coercion type1 type2)) (t2->t1 (get-coercion type2 type1))) (cond (t1->t2 (apply-generic op (t1->t2 a1 (variable a2)) a2)) (t2->t1 (apply-generic op a1 (t2->t1 a2 (variable a1)))) (else (error "No method for these types" (list op type-tags)))))) (error "No method for these types" (list op type-tags))))))) (define (add x y) (apply-generic 'add x y)) (define (sub x y) (apply-generic 'sub x y)) (define (mul x y) (apply-generic 'mul x y)) (define (div x y) (apply-generic 'div x y)) (define (=zero? x) (apply-generic '=zero? x)) (define (coeff-all-zero? x) (apply-generic 'coeff-all-zero? x)) (define (install-scheme-number-package) (define (tag x) (attach-tag 'scheme-number x)) (put 'add '(scheme-number scheme-number) (lambda (x y) (tag (+ x y)))) (put 'sub '(scheme-number scheme-number) (lambda (x y) (tag (- x y)))) (put 'mul '(scheme-number scheme-number) (lambda (x y) (tag (* x y)))) (put 'div '(scheme-number scheme-number) (lambda (x y) (tag (/ x y)))) (put '=zero? '(scheme-number) (lambda (x) (= x 0))) (put 'make 'scheme-number (lambda (x) (tag x))) 'done) (define (make-scheme-number n) ((get 'make 'scheme-number) n)) (define (install-polynomial-package) (define (make-poly variable term-list) (cons variable term-list)) (define (variable p) (car p)) (define (term-list p) (cdr p)) (define (add-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (add (term-list p1) (term-list p2))) (add-poly p1 (contents (poly->poly (tag p2) (variable p1)))))) (define (sub-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (sub (term-list p1) (term-list p2))) (sub-poly p1 (contents(poly->poly (tag p2) (variable p1)))))) (define (mul-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (mul (term-list p1) (term-list p2))) (mul-poly p1 (contents(poly->poly (tag p2) (variable p1)))))) (define (div-poly p1 p2) (if (same-variable? (variable p1) (variable p2)) (make-poly (variable p1) (div (term-list p1) (term-list p2))) (div-poly p1 (contents(poly->poly (tag p2) (variable p1)))))) (define (=zero-poly? poly) (coeff-all-zero? (term-list poly))) (define (tag p) (attach-tag 'polynomial p)) (put 'add '(polynomial polynomial) (lambda (p1 p2) (tag (add-poly p1 p2)))) (put 'mul '(polynomial polynomial) (lambda (p1 p2) (tag (mul-poly p1 p2)))) (put 'sub '(polynomial polynomial) (lambda (p1 p2) (tag (sub-poly p1 p2)))) (put 'div '(polynomial polynomial) (lambda (p1 p2) (tag (div-poly p1 p2)))) (put 'variable '(polynomial) (lambda (p) (variable p))) (put 'term-list '(polynomial) (lambda (p) (term-list p))) (put '=zero? '(polynomial) =zero-poly?) (put 'make 'polynomial (lambda (var terms) (tag (make-poly var terms)))) 'done) (define (poly->poly p newvar) ;;把这一项的指数部分转化成旧变量的表达式,比如3*x^2转化为系数为1*x^2*y^0的表达式,用来作为新变量的系数。 (define (term-order->poly order oldvar) (make-polynomial newvar (make-sparse-terms (list (make-term 0 (make-polynomial oldvar (make-sparse-terms (list (make-term order 1))))))))) (define (term-coeff->poly coeff) (cond ((number? coeff) (number->poly coeff newvar)) ((eq? (variable coeff) newvar) coeff) (else (make-polynomial newvar (make-sparse-terms (list (make-term 0 coeff))))))) (define (term->poly term oldvar) (mul (term-order->poly (order term) oldvar) (term-coeff->poly (coeff term)))) (cond ((eq? (variable p) newvar) p) ((empty-terms? (term-list p)) (make-polynomial newvar (make-sparse-terms '()))) ((add (term->poly (first-terms (term-list p)) (variable p)) (poly->poly (make-polynomial (variable p) (make-sparse-terms (rest-terms (term-list p)))) newvar))))) (define (number->poly n var) (make-polynomial var (make-sparse-terms (list (make-term 0 n))))) (put-coercion 'scheme-number 'polynomial number->poly) (define (install-sparse-polynomial-package) (define (add-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (add-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term t2 (add-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (add (coeff t1) (coeff t2))) (add-terms (rest-terms L1) (rest-terms L2))))))))) (define (sub-terms L1 L2) (cond ((empty-termlist? L1) L2) ((empty-termlist? L2) L1) (else (let ((t1 (first-term L1)) (t2 (first-term L2))) (cond ((> (order t1) (order t2)) (adjoin-term t1 (sub-terms (rest-terms L1) L2))) ((< (order t1) (order t2)) (adjoin-term (make-term (order t2) (- 0 (coeff t2))) (sub-terms L1 (rest-terms L2)))) (else (adjoin-term (make-term (order t1) (sub (coeff t1) (coeff t2))) (sub-terms (rest-terms L1) (rest-terms L2))))))))) (define (mul-terms L1 L2) (if (empty-termlist? L1) (the-empty-termlist) (add-terms (mul-term-by-all-terms (first-term L1) L2) (mul-terms (rest-terms L1) L2)))) (define (mul-term-by-all-terms t1 L) (if (empty-termlist? L) (the-empty-termlist) (let ((t2 (first-term L))) (adjoin-term (make-term (+ (order t1) (order t2)) (mul (coeff t1) (coeff t2))) (mul-term-by-all-terms t1 (rest-terms L)))))) (define (div-terms L1 L2) (if (empty-termlist? L1) (list (the-empty-termlist) (the-empty-termlist)) (let ((t1 (first-term L1)) (t2 (first-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)))) (if (=zero? new-c) (list (the-empty-termlist) L1) (let ((rest-of-result (div-terms (sub-terms L1 (mul-term-by-all-terms (make-term new-o new-c) L2)) L2))) (list (adjoin-term (make-term new-o new-c) (car rest-of-result)) (cadr rest-of-result)) ))))))) (define (coeff-all-zero? term-list) (if (empty-termlist? term-list) #t (if (=zero? (coeff (first-term term-list))) (coeff-all-zero? (rest-terms term-list)) #f))) (define (the-empty-termlist) '()) (define (first-term term-list) (car term-list)) (define (rest-terms term-list) (cdr term-list)) (define (empty-termlist? term-list) (null? term-list)) (define (make-term order coeff) (list order coeff)) (define (order term) (car term)) (define (coeff term) (cadr term)) (define (tag p) (attach-tag 'sparse p)) (put 'coeff-all-zero? '(sparse) (lambda (p1) (coeff-all-zero? p1))) (put 'add '(sparse sparse) (lambda (p1 p2) (tag (add-terms p1 p2)))) (put 'mul '(sparse sparse) (lambda (p1 p2) (tag (mul-terms p1 p2)))) (put 'sub '(sparse sparse) (lambda (p1 p2) (tag (sub-terms p1 p2)))) (put 'div '(sparse sparse) (lambda (p1 p2) (tag (div-terms p1 p2)))) (put 'order 'term (lambda (p) (order p))) (put 'coeff 'term (lambda (p) (coeff p))) (put 'make 'term (lambda (p t) (make-term p t))) (put 'rest-terms '(sparse) (lambda (p) (rest-terms p))) (put 'empty-terms '(sparse) (lambda (p) (empty-termlist? p))) (put 'first-terms '(sparse) (lambda (p) (first-term p))) (put 'make 'sparse (lambda (terms) (tag terms))) 'done) (define (adjoin-term term term-list) (if (=zero? (coeff term)) term-list (cons term term-list))) (define (variable x) (apply-generic 'variable x)) (define (term-list x) (apply-generic 'term-list x)) (define (order term) ((get 'order 'term) term)) (define (coeff term) ((get 'coeff 'term) term)) (define (make-term order coeff) ((get 'make 'term) order coeff)) (define (rest-terms term-list) (apply-generic 'rest-terms term-list)) (define (first-terms term-list) (apply-generic 'first-terms term-list)) (define (make-polynomial var terms) ((get 'make 'polynomial) var terms)) (define (make-sparse-terms terms) ((get 'make 'sparse) terms)) (define (empty-termlist? term-list) (null? term-list)) (define (empty-terms? terms) (apply-generic 'empty-terms terms)) (define (same-variable? v1 v2) (define (variable? x) (symbol? x)) (and (variable? v1) (variable? v2) (eq? v1 v2))) (install-scheme-number-package) (install-polynomial-package) (install-sparse-polynomial-package) (define sparse-polynumial-A (make-polynomial 'x (make-sparse-terms '((5 1) (0 -1))))) (define sparse-polynumial-B (make-polynomial 'y (make-sparse-terms '((2 1) (0 -1))))) (add sparse-polynumial-A sparse-polynumial-B) (sub sparse-polynumial-A sparse-polynumial-B) (mul sparse-polynumial-A sparse-polynumial-B)运行过程，因为除法所得到的结果是由商和余数组成，它的结构和其他几种运算不同，所以暂时未实现。下面是运行结果。
'done 'done 'done '(polynomial x sparse (5 1) (0 (polynomial y sparse (2 1) (0 -2)))) '(polynomial x sparse (5 1) (0 (polynomial y sparse (2 -1)))) '(polynomial x sparse (5 (polynomial y sparse (2 1) (0 -1))) (0 (polynomial y sparse (2 -1) (0 1))))