Changeset 4447 for branches

Timestamp:

2016-06-11T08:36:52-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

 

Location:

branches/f4grobner

Files:

• 5am-division.lisp (modified) (1 diff)
• fast-add.lisp (modified) (2 diffs)
• polynomial.lisp (modified) (3 diffs)
• ring.lisp (modified) (1 diff)
• test3.lisp (added)
• test4.lisp (added)
• test6.lisp (added)
• test7.lisp (added)
• test8.lisp (added)

branches/f4grobner/5am-division.lisp

@@ -190 +190 @@
               for j from (1+ i) below (length gb)
               do
-                (is (universal-zerop (second (multiple-value-list (poly-pseudo-divide (s-polynomial (elt gb i) (elt gb j)) gb))))
+                (is (universal-zerop (second (multiple-value-list (poly-pseudo-divide (s-polynomial (elt gb i) (elt gb j)) gb-copy))))
                     "Failed with I=~S, J=~S~%" I J)))
       (is (universal-equalp fl fl-copy))

branches/f4grobner/fast-add.lisp

@@ -1 +1 @@
 (in-package "POLYNOMIAL")
 
-(defun fast-add (p q order-fn add-fn &aux result result-last)
-  (assert (not (eq p q)))
+(defun fast-and-risky-add (p q order-fn add-fn &aux result result-last)
+  (when (and p q (eq p q)) (warn "FAST-AND-RISKY-ADD: ~S is EQ to ~S" p q))
   (flet ((add-to-result (x)
            (assert (consp x))
@@ -44 +44 @@
                  (setf q tmp))
                ))))))))
+
+(defun fast-add (p q order-fn add-fn)
+  (let ((r1 (slow-add p q order-fn add-fn))
+        (r2 (fast-and-risky-add p q order-fn add-fn)))
+    (unless (every #'universal-equalp r1 r2)
+      (format t "~&Error in addition of ~%~A~% and~%~A~% should be:~%" (mapcar #'->list p) (mapcar #'->list q))
+      (princ (mapcar #'->list r1))
+      (format t "~&Actually is:~%")
+      (princ (mapcar #'->list r2))
+      )
+    r2))
+        
+    
+

branches/f4grobner/polynomial.lisp

@@ -362 +362 @@
 
 
-(defun fast-add (p q order-fn add-fn)
+(defun slow-add (p q order-fn add-fn)
   (cond
     ((endp p) q)
@@ -372 +372 @@
        (cond
          (greater-p                     ; (> (car p) (car q))
-          (cons (car p) (fast-add (cdr p) q order-fn add-fn))
+          (cons (car p) (slow-add (cdr p) q order-fn add-fn))
           )
          (equal-p                       ; (= (car p)) (car q))
@@ -378 +378 @@
             (cond 
               ((universal-zerop s)
-               (fast-add (cdr p) (cdr q) order-fn add-fn))
+               (slow-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))
+               (cons (car p) (slow-add (cdr p) (cdr q) order-fn add-fn))
                ))))
          (t                    ;(< (car p) (car q))                     
-          (cons (car q) (fast-add p (cdr q) order-fn add-fn))
+          (cons (car q) (slow-add p (cdr q) order-fn add-fn))
           ))))))
 
+
+(defun fast-add (p q order-fn add-fn)
+  "This version calls SLOW-ADD and is bullet-proof."
+  (slow-add p q order-fn add-fn))
 
 #|

branches/f4grobner/ring.lisp

@@ -86 +86 @@
 (defgeneric universal-equalp (self other)
   (:documentation "Return T if objects SELF and OTHER are equal, NIL otherwise.")
+  (:method ((object1 null) (object2 null)) t)
   (:method ((object1 cons) (object2 cons)) (every #'universal-equalp object1 object2))
   (:method ((self number) (other number)) (= self other)))