close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 1207 for branches/f4grobner


Ignore:
Timestamp:
2015-06-11T11:24:11-07:00 (9 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/division.lisp

    r1206 r1207  
    8585       (values (mapcar #'poly-nreverse a) (poly-nreverse r) c division-count))
    8686    (declare (fixnum division-count))
    87     (do ((fl fl (rest fl))                              ;scan list of divisors
     87    (do ((fl fl (rest fl))              ;scan list of divisors
    8888         (b a (rest b)))
    8989        ((cond
    90           ((endp fl)                                    ;no division occurred
    91            (push (poly-lt p) (poly-termlist r))         ;move lt(p) to remainder
    92            (setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p))))
    93            (pop (poly-termlist p))                      ;remove lt(p) from p
    94            t)
    95           ((monom-divides-p (poly-lm (car fl)) (poly-lm p)) ;division occurred
    96            (incf division-count)
    97            (multiple-value-bind (gcd c1 c2)
    98                (funcall (ring-ezgcd ring) (poly-lc (car fl)) (poly-lc p))
    99              (declare (ignore gcd))
    100              (let ((m (monom-div (poly-lm p) (poly-lm (car fl)))))
    101                ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
    102                (mapl #'(lambda (x)
    103                          (setf (car x) (scalar-times-poly ring c1 (car x))))
    104                      a)
    105                (setf r (scalar-times-poly ring c1 r)
    106                      c (funcall (ring-mul ring) c c1)
    107                      p (grobner-op ring-and-order c2 c1 m p (car fl)))
    108                (push (make-term m c2) (poly-termlist (car b))))
    109              t)))))))
     90           ((endp fl)                           ;no division occurred
     91            (push (poly-lt p) (poly-termlist r)) ;move lt(p) to remainder
     92            (setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p))))
     93            (pop (poly-termlist p))     ;remove lt(p) from p
     94            t)
     95           ((monom-divides-p (poly-lm (car fl)) (poly-lm p)) ;division occurred
     96            (incf division-count)
     97            (multiple-value-bind (gcd c1 c2)
     98                (funcall (ring-ezgcd ring) (poly-lc (car fl)) (poly-lc p))
     99              (declare (ignore gcd))
     100              (let ((m (monom-div (poly-lm p) (poly-lm (car fl)))))
     101                ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
     102                (mapl #'(lambda (x)
     103                          (setf (car x) (scalar-times-poly ring c1 (car x))))
     104                      a)
     105                (setf r (scalar-times-poly ring c1 r)
     106                      c (funcall (ring-mul ring) c c1)
     107                      p (grobner-op ring-and-order c2 c1 m p (car fl)))
     108                (push (make-term m c2) (poly-termlist (car b))))
     109              t)))))))
    110110
    111111(defun poly-exact-divide (ring f g)
Note: See TracChangeset for help on using the changeset viewer.