Changeset 4431 for branches

Timestamp:

2016-06-09T22:48:11-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

• branches/f4grobner/fast-add.lisp (modified) (2 diffs)

branches/f4grobner/fast-add.lisp

@@ +1 @@
+(load "boot")
+
+(use-package :polynomial)
+(use-package :monom)
+
+;;(shadow '(fast-add) "POLYNOMIAL")
 
 ;; Getter/setter of leading coefficient
@@ -4 +10 @@
 (defun (setf lc) (new-value x) (setf (term-coeff (car x)) new-value))
 
+(defvar order-fn #'lex>)
+(defvar add-fn #'add-to)
+
 (defun fast-add-helper (p q)
-  "It assumes that p and q are non-zero polynomials, i.e. non-empty lists of terms."
-  (multiple-value-bind 
-        (greater-p equal-p)
-      (funcall order-fn (car p) (car q))
-    (cond
-      (greater-p 
-       (fast-add-helper (cdr p) q))
-      (equal-p
-       (let ((s (funcall add-fn (lc p) (lc q))))
-         (cond 
-           ((universal-zerop s)
-            (setf p (cdr p))
-            )
-           (t 
-            (setf (lc p) s)
-            (fast-add-helper (cdr p) (cdr q)))))
-       (setf q (cdr q))
-       )
-      (t                                
-       (fast-add-helper (cdr q) p)))))
+  (do ((h p))
+      ((endp q) p)
+    (multiple-value-bind 
+          (greater-p equal-p)
+        (funcall order-fn (car h) (car q))
+      (cond
+        (greater-p                      ; (> (lm h) (lm q))
+         (setf h (cdr h))
+         )
+        (equal-p                        ; (= (lm h) (lm q))
+         (let ((s (funcall add-fn (lc h) (lc q))))
+           (cond 
+             ((universal-zerop s)
+              (cond 
+                (setf h (cdr h)
+                      q (cdr q))))
+             (t 
+              ;; Adjust the lc of p
+              (setf (lc h) s)
+              (setf h (cdr h)
+                       q (cdr q))))))
 
-(defun fast-add (p q order-fn add-fn &aux r)
-  "Add two polynomials, P and Q, represented as lists of terms.
-The operation is destructive to both polynomials, as the terms
-of both lists are combined into the result. The operation does not
-create any new instance of TERM."
-  (cond ((endp p) q)
-        ((endp q) p)
-        (t (fast-add-helper p q))))
+        (t                       ;(< (lm h) (lm q))                     
+         
 
+
+
+
+