sicp-ex-2.97

meteorgan

  
  
 ;;a 
 (define (reduce-terms n d) 
   (let ((gcdterms (gcd-terms n d))) 
         (list (car (div-terms n gcdterms)) 
               (car (div-terms d gcdterms))))) 
  
 (define (reduce-poly p1 p2) 
   (if (same-variable? (variable p1) (variable p2)) 
     (let ((result (reduce-terms (term-list p1) (term-list p2)))) 
       (list (make-poly (variable p1) (car result)) 
             (make-poly (variable p1) (cadr result)))) 
     (error "not the same variable--REDUCE-POLY" (list p1 p2)))) 
  
 ;;b. skip this, I had done such work many times, I'm tired of it.

Siki

The answer above does not follow the exercise's requirement. Before dividing n & d by gcdterms, a integerizing factor should be multiplied as stated in 2.96

master

I think that's done by gcd-terms, which presumably uses pseudoremainder-terms.

Sphinxsky

  
  
  
  
 (define (reduce-terms n d) 
     (let ((gcd-n-d (gcd-terms n d)) 
           (n-first (first-term n)) 
           (d-first (first-term d))) 
         (let ((first (first-term gcd-n-d)) 
               (n-ord (order n-first)) 
               (d-ord (order d-first))) 
             (let ((c (coeff first)) 
                   (o2 (order first)) 
                   (o1 (max n-ord d-ord))) 
                 (let ((k (expt c (add 1 (sub o1 o2))))) 
                     (let ((k-terms (adjoin-term 
                                     (make-term 0 k) 
                                     (the-empty-termlist)))) 
                         (let ((kn (mul-terms k-terms n)) 
                               (kd (mul-terms k-terms d))) 
                             (list 
                                 (car (div-terms kn gcd-n-d)) 
                                 (car (div-terms kd gcd-n-d)))))))))) 
  
  
 (define (reduce-poly p1 p2) 
         (if (same-variable? (variable p1) (variable p2)) 
             (let ((result (reduce-terms (term-list p1) (term-list p2)))) 
                 (list 
                     (make-poly (variable p1) (car result)) 
                     (make-poly (variable p1) (cadr result)))) 
             (error 
                 "Polys not in same var -- REDUCE-POLY" 
                 (list p1 p2))))

There are problems in the test examples of this question, and the results cannot be scored. It is recommended to use the example in Exercise 2.93 for testing.

Kaihao

  
  
 ;;; 
 ;;; a 
 ;;; 
  
 (define (reduce-terms n d) 
   (let ((gcd-L (gcd-terms n d))) 
     (let ((o1 (max (order (first-term n)) 
                    (order (first-term d)))) 
           (o2 (order (first-term gcd-L))) 
           (c (coeff (first-term gcd-L)))) 
       (let ((factor (expt c (+ 1 (- o1 o2))))) 
         (let ((n1 (car (div-terms (mul-term-by-all-terms (schemenumber->term factor) n) 
                                   gcd-L))) 
               (d1 (car (div-terms (mul-term-by-all-terms (schemenumber->term factor) d) 
                                   gcd-L)))) 
           (let ((gcd-coeff (apply gcd (append (termlist->coeff-list n1) 
                                               (termlist->coeff-list d1))))) 
             (let ((gcd-termlist (term->termlist (schemenumber->term gcd-coeff)))) 
               (let ((nn (car (div-terms n1 gcd-termlist))) 
                     (dd (car (div-terms d1 gcd-termlist)))) 
                 (list nn dd))))))))) 
  
 (define (schemenumber->term x) 
   (make-term 0 x)) 
 (define (term->termlist term) 
   (adjoin-term term (the-empty-termlist))) 
  
 (define (termlist->coeff-list term-list) 
   (if (empty-termlist? term-list) 
       '() 
       (cons (coeff (first-term term-list)) 
             (termlist->coeff-list (rest-terms term-list))))) 
  
  
 (define (reduce-poly p1 p2) 
   (if (same-variable? (variable p1) (variable p2)) 
       (map (lambda (term-list) 
              (make-poly (variable p1) term-list)) 
            (reduce-terms (term-list p1) (term-list p2))) 
       (error "Polys not in the same var: REDUCE-POLY" (list p1 p2)))) 
  
 ;;; 
 ;;; b 
 ;;; 
  
  
 (define (reduce n d) 
   (apply-generic 'reduce n d)) 
  
 ;; add in scheme-number package 
 (define (reduce-integers n d) 
   (let ((g (gcd n d))) 
     (list (/ n g) (/ d g)))) 
  
 (put 'reduce '(scheme-number scheme-number) reduce-integers) 
  
 ;; add in polynomial package 
 (put 'reduce '(polynomial polynomial) reduce-poly) 
  
 ;; change in rational package 
 (define (make-rat n d) 
   (let ((r (reduce n d))) 
     (cons (car r) 
           (cadr r))))

Ergomaniac

Here's a cleaned-up reduce-terms using the let* syntactic sugar and map. I also opt to not use div-terms because it's more verbose/awkward. I multiply by the reciprocal instead.

   (define (reduce-terms n d) 
     ;; 1. mul by integerizing factor 
     ;; 2. div by term GCD 
     ;; 3. div by integer GCD 
     (let* ((term-gcd (gcd-terms n d)) 
            (c (coeff(first-term term-gcd))) 
            (O1 (max (order (first-term n)) (order (first-term d)))) 
            (O2 (order (first-term term-gcd))) 
            (factor (expt c (+ 1 (- O1 O2)))) 
            (int-gcd (apply gcd (append (map cadr n) (map cadr d))))) 
       (map (lambda (terms) (mul-term-by-all-terms (make-term 0 (/ 1 int-gcd)) terms)) 
            (map (lambda (terms) (car (div-terms terms term-gcd))) 
                 (map (lambda (terms) (mul-term-by-all-terms (make-term 0 factor) terms)) 
                      (list n d))))))