Changeset 4070 for branches

Timestamp:

2016-05-31T19:22:21-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/division.lisp (modified) (6 diffs)

branches/f4grobner/division.lisp

@@ -61 +61 @@
   ;; terms are dropped.
   (subtract
-   (multiply c2 f)
-   (multiply c1 (multiply m g))))
+   (multiply f c2)
+   (multiply (multiply m g) c1)))
 
 (defun check-loop-invariant (c f a fl r p
@@ -83 +83 @@
   |#
   (let* ((prod (inner-product a fl add multiply p-zero))
-         (succeeded-p (universal-zerop (subtract (multiply c f) (add prod r p)))))
+         (succeeded-p (universal-zerop (subtract (multiply f c) (add prod r p)))))
     (unless succeeded-p 
       (error "#### Polynomial division Loop invariant failed ####:~%C=~A~%F=~A~%A=~A~%FL=~A~%R=~A~%P=~A~%" 
@@ -111 +111 @@
        (when (universal-zerop r) (debug-cgb " ---> 0"))
        ;; We obtained the terms in reverse order, so must fix that
-       (setf a (mapcar #'poly-nreverse a)
-             r (poly-nreverse r))
+       (setf a (mapcar #'poly-reverse a)
+             r (poly-reverse r))
        ;; Initialize the sugar of the quotients
        ;; (mapc #'poly-reset-sugar a) ;; TODO: Sugar is currently unimplemented
@@ -135 +135 @@
                 ;; Multiply the equation c*f=sum ai*fi+r+p by c1.
                 (mapl #'(lambda (x)
-                          (setf (car x) (multiply c1 (car x))))
+                          (setf (car x) (multiply (car x) c1)))
                       a)
-                (setf r (multiply c1 r)
+                (setf r (multiply r c1)
                       c (multiply c c1)
                       p (grobner-op c2 c1 m p (car fl)))
-                (push (change-class m 'term :coeff c2) (poly-termlist (car b))))
+                (push (change-class m 'term :coeff c2)
+                      (poly-termlist (car b))))
               t))))
       )))
@@ -176 +177 @@
       (let ((m (divide (leading-monomial p) (leading-monomial g))))
         ;; Multiply the equation c*f=sum ai*fi+r+p by cg.
-        (setf r (multiply cg r)
+        (setf r (multiply r cg)
               c (multiply c cg)
               ;; p := cg*p-cp*m*g
@@ -227 +228 @@
       (declare (ignore c))
       (subtract
-       (multiply cg (multiply mf f))
-       (multiply cf (multiply mg g))))))
+       (multiply (multiply mf f) cg)
+       (multiply (multiply mg g) cf)))))
 
 (defun buchberger-criterion (g)