Changeset 4442

Timestamp:

2016-06-10T19:45:42-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

 

Location:

branches/f4grobner

Files:

• 5am-poly.lisp (modified) (1 diff)
• buchberger.lisp (modified) (1 diff)
• polynomial.lisp (modified) (5 diffs)
• symbolic-polynomial.lisp (modified) (1 diff)
• test0.lisp (modified) (1 diff)

branches/f4grobner/5am-poly.lisp

@@ -88 +88 @@
   )
 
+(test poly-add-more
+  "More polynomial addition"
+  (is (equal (poly->alist (add-to 
+                           (alist->poly '(((0) . 1)))
+                           (alist->poly '(((1) . 2)))))
+             '(((1) . 2) ((0) . 1))))
+  (is (equal (poly->alist (add-to 
+                           (alist->poly '(((0) . 1)))
+                           (alist->poly '(((0) . 2)))))
+           '(((0) . 3))))
+  (is (equal (poly->alist (add-to 
+                           (alist->poly '(((0) . 1) ((2) . 5)))
+                           (alist->poly '(((1) . 2) ((3) . 7)))))
+             '(((3) . 7) ((2) . 5) ((1) . 2) ((0) . 1)))))
+
 (def-fixture poly-multiply-context ()
   (let ((p (make-instance 'poly))

branches/f4grobner/buchberger.lisp

@@ -64 +64 @@
         (cond
           ((criterion-1 pair) nil)
-          ((criterion-2 pair b-done f) nil)
+          ;;((criterion-2 pair b-done f) nil)
           (t 
            (let ((sp (normal-form (s-polynomial

branches/f4grobner/polynomial.lisp

@@ -46 +46 @@
            "SATURATION-EXTENSION"
            "ALIST->POLY"
+           "POLY->ALIST"
            "->INFIX"
            "UNIVERSAL-EZGCD"
@@ -140 +141 @@
 
 can be entered as
-(ALIST->POLY '(((2 3) . 3) ((0 1) . 2) ((0 0) . 7))).
+(ALIST->POLY '(((0 0) . 7) ((0 1) . 2) ((2 3) . 3) )). NOTE: the
+terms are entered in the increasing order.
 
 NOTE: The primary use is for low-level debugging of the package."
   (dolist (x alist poly)
     (poly-insert-term poly (make-instance 'term :exponents (car x) :coeff (cdr x)))))
+
+(defun poly->alist (p)
+  "Convert a polynomial P to an association list. Thus, the format of the
+returned value is  ((MONOM[0] . COEFF[0]) (MONOM[1] . COEFF[1]) ...), where
+MONOM[I] is a list of exponents in the monomial and COEFF[I] is the
+corresponding coefficient in the ring."
+  (cond
+    ((poly-p p)
+     (mapcar #'->list (poly-termlist p)))
+    ((and (consp p) (eq (car p) :[))
+     (cons :[ (mapcar #'poly->alist (cdr p))))))
+
+
 
 (defmethod update-instance-for-different-class :after ((old term) (new poly) &key)
@@ -346 +361 @@
 (defun (setf lc) (new-value x) (setf (term-coeff (car x)) new-value))
 
+
 (defun fast-add (p q order-fn add-fn)
   (cond
@@ -355 +371 @@
          (funcall order-fn (car p) (car q))
        (cond
-         (greater-p                     ; (> (cadr h) (car q))
+         (greater-p                     ; (> (car p) (car q))
           (cons (car p) (fast-add (cdr p) q order-fn add-fn))
           )
-         (equal-p                       ; (= (cadr h)) (car q))
+         (equal-p                       ; (= (car p)) (car q))
           (let ((s (funcall add-fn (lc p) (lc q))))
             (cond 
@@ -368 +384 @@
                (cons (car p) (fast-add (cdr p) (cdr q) order-fn add-fn))
                ))))
-         (t                    ;(< (cadr h) (car q))                    
+         (t                    ;(< (car p) (car q))                     
           (cons (car q) (fast-add p (cdr q) order-fn add-fn))
           ))))))
-
 
 

branches/f4grobner/symbolic-polynomial.lisp

@@ -133 +133 @@
          p-or-plist)))))
 
-(defun poly->alist (p)
-  "Convert a polynomial P to an association list. Thus, the format of the
-returned value is  ((MONOM[0] . COEFF[0]) (MONOM[1] . COEFF[1]) ...), where
-MONOM[I] is a list of exponents in the monomial and COEFF[I] is the
-corresponding coefficient in the ring."
-  (cond
-    ((poly-p p)
-     (mapcar #'->list (poly-termlist p)))
-    ((and (consp p) (eq (car p) :[))
-     (cons :[ (mapcar #'poly->alist (cdr p))))))
-
 (defun string->alist (str vars
                       &optional

branches/f4grobner/test0.lisp

@@ -1 +1 @@
 (in-package :polynomial)
+
+(proclaim '(special p r))
+
 (setf p (ADD-TO
          (make-instance 'poly :dimension 1 :termlist (list (make-instance 'term :exponents #(0) :coeff 5)) :order #'lex>)