Changeset 4432 for branches/f4grobner

Timestamp:

2016-06-09T23:12:29-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/polynomial.lisp

@@ -301 +301 @@
 |#
 
+#|
 (defun fast-add (p q order-fn add-fn)
   "Add two polynomials, P and Q, represented as lists of terms.
@@ -336 +337 @@
           (t 
            (rotatef (cdr q) r q)))))))
-      
+|#      
+
+
+;; Getter/setter of leading coefficient
+(defun lc (x) (term-coeff (car x)))
+(defun (setf lc) (new-value x) (setf (term-coeff (car x)) new-value))
+
+(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)))))))
+
+
+
 #|
 ;; NOTE: The stuff below works, but may not be worth the trouble.