Changeset 1207 for branches/f4grobner

Timestamp:

2015-06-11T11:24:11-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/division.lisp (modified) (1 diff)

branches/f4grobner/division.lisp

@@ -85 +85 @@
        (values (mapcar #'poly-nreverse a) (poly-nreverse r) c division-count))
     (declare (fixnum division-count))
-    (do ((fl fl (rest fl))                              ;scan list of divisors
+    (do ((fl fl (rest fl))              ;scan list of divisors
          (b a (rest b)))
         ((cond
-          ((endp fl)                                    ;no division occurred
-           (push (poly-lt p) (poly-termlist r))         ;move lt(p) to remainder
-           (setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p))))
-           (pop (poly-termlist p))                      ;remove lt(p) from p
-           t)
-          ((monom-divides-p (poly-lm (car fl)) (poly-lm p)) ;division occurred
-           (incf division-count)
-           (multiple-value-bind (gcd c1 c2)
-               (funcall (ring-ezgcd ring) (poly-lc (car fl)) (poly-lc p))
-             (declare (ignore gcd))
-             (let ((m (monom-div (poly-lm p) (poly-lm (car fl)))))
-               ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
-               (mapl #'(lambda (x)
-                         (setf (car x) (scalar-times-poly ring c1 (car x))))
-                     a)
-               (setf r (scalar-times-poly ring c1 r)
-                     c (funcall (ring-mul ring) c c1)
-                     p (grobner-op ring-and-order c2 c1 m p (car fl)))
-               (push (make-term m c2) (poly-termlist (car b))))
-             t)))))))
+           ((endp fl)                           ;no division occurred
+            (push (poly-lt p) (poly-termlist r)) ;move lt(p) to remainder
+            (setf (poly-sugar r) (max (poly-sugar r) (term-sugar (poly-lt p))))
+            (pop (poly-termlist p))     ;remove lt(p) from p
+            t)
+           ((monom-divides-p (poly-lm (car fl)) (poly-lm p)) ;division occurred
+            (incf division-count)
+            (multiple-value-bind (gcd c1 c2)
+                (funcall (ring-ezgcd ring) (poly-lc (car fl)) (poly-lc p))
+              (declare (ignore gcd))
+              (let ((m (monom-div (poly-lm p) (poly-lm (car fl)))))
+                ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
+                (mapl #'(lambda (x)
+                          (setf (car x) (scalar-times-poly ring c1 (car x))))
+                      a)
+                (setf r (scalar-times-poly ring c1 r)
+                      c (funcall (ring-mul ring) c c1)
+                      p (grobner-op ring-and-order c2 c1 m p (car fl)))
+                (push (make-term m c2) (poly-termlist (car b))))
+              t)))))))
 
 (defun poly-exact-divide (ring f g)