Changeset 4434 for branches/f4grobner/polynomial.lisp

Timestamp:

2016-06-10T09:50:24-07:00 (8 years ago)

Author:

Marek Rychlik

Message:

 

File:

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

branches/f4grobner/polynomial.lisp

@@ -301 +301 @@
 |#
 
+
+
+
 #|
 (defun fast-add (p q order-fn add-fn)
@@ -337 +340 @@
           (t 
            (rotatef (cdr q) r q)))))))
-|#      
-
+|#
 
 ;; Getter/setter of leading coefficient
@@ -345 +347 @@
 
 (defun fast-add (p q order-fn add-fn)
-  ;; Requirement: (car p) > (car q)
-  ;; (consp (cdr p))
-  (do ((h p))
-      ((endp q) p)
-    (multiple-value-bind 
-          (greater-p equal-p)
-        (funcall order-fn (cadr h) (car q))
-      (cond
-        (greater-p                      ; (> (cadr h) (car q))
-         (setf h (cdr h))
-         )
-        (equal-p                        ; (= (cadr h)) (car q))
-         (let ((s (funcall add-fn (lc h) (lc q))))
-           (cond 
-             ((universal-zerop s)
-              (setf h (cdr h)
-                    q (cdr q)))
-             (t 
-              ;; Adjust the lc of p
-              (setf (lc h) s
-                    h (cdr h)
-                    q (cdr q))))))
-        (t                       ;(< (cadr h) (car q))                  
-         (let  ((tmp (cdr q)))
-           (setf (cdr q) (cdr p)
-                 (cdr h) q
-                 q tmp)))))))
+  (cond
+    ((endp p) p)
+    ((endp q) q)
+    (t 
+     (multiple-value-bind 
+           (greater-p equal-p)
+         (funcall order-fn (car p) (car q))
+       (cond
+         (greater-p                     ; (> (cadr h) (car q))
+          (cons (car p) (fast-add (cdr p) q order-fn add-fn))
+          )
+         (equal-p                       ; (= (cadr h)) (car q))
+          (let ((s (funcall add-fn (lc p) (lc q))))
+            (cond 
+              ((universal-zerop s)
+               (fast-add (cdr p) (cdr q) order-fn add-fn))
+              (t 
+               ;; Adjust the lc of p
+               (setf (lc p) s)
+               (cons (car p) (fast-add (cdr p) (cdr q) order-fn add-fn))
+               ))))
+         (t                    ;(< (cadr h) (car q))                    
+          (cons (car q) (fast-add p (cdr q) order-fn add-fn))
+          ))))))