sicp-ex-2.96

  
 ;; a 
 (define (pseudoremainder-terms a b) 
   (let* ((o1 (order (first-term a))) 
          (o2 (order (first-term b))) 
          (c (coeff (first-term b))) 
          (divident (mul-terms (make-term 0  
                                          (expt c (+ 1 (- o1 o2)))) 
                               a))) 
     (cadr (div-terms divident b)))) 
  
 (define (gcd-terms a b) 
   (if (empty-termlist? b) 
     a 
     (gcd-terms b (pseudoremainder-terms a b)))) 
  
 ;; b 
 (define (gcd-terms a b) 
   (if (empty-termlist? b) 
     (let* ((coeff-list (map cadr a)) 
            (gcd-coeff (apply gcd coeff-list))) 
       (div-terms a (make-term 0  gcd-coeff))) 
     (gcd-terms b (pseudoremainder-terms a b)))) 
          

  
  
 (define (pseudo-remainder-terms L1 L2) 
     (let ((f1 (first-term L1)) 
           (f2 (first-term L2))) 
         (let ((o1 (order f1)) 
               (o2 (order f2)) 
               (c (coeff f2))) 
             (let ((k (expt c (add 1 (sub o1 o2))))) 
                 (let ((k-terms (adjoin-term 
                                     (make-term 0 k) 
                                     (the-empty-termlist)))) 
                     (cadr (div-terms (mul-terms k-terms L1) L2))))))) 
  
  
 (define (gcd-coeff terms) 
  
     (define (coeff-list terms) 
         (if (empty-termlist? terms) 
             '() 
             (cons 
                 (coeff (first-term terms)) 
                 (coeff-list (rest-terms terms))))) 
     (apply gcd (coeff-list terms))) 
  
  
 (define (gcd-terms L1 L2) 
     (if (empty-termlist? L2) 
         (let ((coeff-terms (adjoin-term 
                                 (make-term 0 (gcd-coeff L1)) 
                                 (the-empty-termlist)))) 
             (car (div-terms L1 coeff-terms))) 
         (gcd-terms L2 (pseudo-remainder-terms L1 L2))))