Changeset 4395 for branches

Timestamp:

2016-06-07T14:56:27-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/polynomial.lisp (modified) (2 diffs)

branches/f4grobner/polynomial.lisp

@@ -299 +299 @@
        )))
 
+(defun fast-add (p q order-fn add-fn)
+  (macrolet ((lc (x) `(term-coeff (car ,x))))
+    (do (r)
+        ((or (endp p) (endp q))
+         ;; NOTE: R contains the result in reverse order. Can it
+         ;; be more efficient to produce the terms in correct order?
+         (unless (endp q) 
+           (setf r (nreconc r q)))
+         (unless (endp p)
+           (setf r (nreconc r p)))
+         r)
+      (multiple-value-bind 
+            (greater-p equal-p)
+          (funcall order-fn (car p) (car q))
+        (cond
+          (greater-p
+           (rotatef (cdr p) r p)
+           )
+          (equal-p
+           (let ((s (funcall add-fn (lc p) (lc q))))
+             (cond 
+               ((universal-zerop s)
+                (setf p (cdr p))
+                )
+               (t 
+                (setf (lc p) s)
+                (rotatef (cdr p) r p))))
+           (setf q (cdr q))
+           )
+          (t 
+           (rotatef (cdr q) r q)))))))
+
 #|
 ;; NOTE: The stuff below works, but may not be worth the trouble.
@@ -343 +375 @@
 (defun add-termlists (p q order-fn)
   "Destructively adds two termlists P and Q ordered according to ORDER-FN."
-  (fast-add/subtract p q order-fn #'add-to nil))
+  (fast-add p q order-fn #'add-to))
 
 (defun subtract-termlists (p q order-fn)
   "Destructively subtracts two termlists P and Q ordered according to ORDER-FN."
-  (fast-add/subtract p q order-fn #'subtract-from #'unary-minus))
+  (setf q (mapc #'unary-minus q))
+  (add-termlists p q order-fn))
 
 (defmethod add-to ((self poly) (other poly) &aux (other-copy (copy-instance other)))