Changeset 2002 for branches/f4grobner/pol.lisp

Timestamp:

2015-06-16T15:26:56-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/pol.lisp

@@ -136 +136 @@
 (defmethod poly-uminus ((self poly)))
 
-(defmethod poly-mul ((p poly) (poly q)))
+(defmethod poly-mul ((p poly) (q poly)))
 
 (defmethod poly-expt ((self poly) n))
@@ -148 +148 @@
 of polynomials in internal form. A similar operation in another computer
 algebra system could be called 'expand' or so."
-    (cond
-      ((null expr) (error "Empty expression"))
-      ((eql expr 0) (make-poly-zero))
-      ((member expr vars :test #'equalp)
-       (let ((pos (position expr vars :test #'equalp)))
-         (make-poly-variable ring (length vars) pos)))
-      ((atom expr)
-       (scalar->poly ring expr vars))
-      ((eq (car expr) list-marker)
-       (cons list-marker (p-eval-list (cdr expr))))
-      (t
-       (case (car expr)
-         (+ (reduce #'p-add (p-eval-list (cdr expr))))
-         (- (case (length expr)
-              (1 (make-poly-zero))
-              (2 (poly-uminus ring (p-eval (cadr expr))))
-              (3 (poly-sub ring-and-order (p-eval (cadr expr)) (p-eval (caddr expr))))
-              (otherwise (poly-sub ring-and-order (p-eval (cadr expr))
-                                   (reduce #'p-add (p-eval-list (cddr expr)))))))
-         (*
-          (if (endp (cddr expr))                ;unary
-              (p-eval (cdr expr))
-              (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (p-eval-list (cdr expr)))))
-         (/ 
-          ;; A polynomial can be divided by a scalar
-          (cond 
-            ((endp (cddr expr))
-             ;; A special case (/ ?), the inverse
-             (scalar->poly ring (apply (ring-div ring) (cdr expr)) vars))
-            (t
-             (let ((num (p-eval (cadr expr)))
-                   (denom-inverse (apply (ring-div ring)
-                                         (cons (funcall (ring-unit ring)) 
-                                               (mapcar #'p-eval-scalar (cddr expr))))))
-               (scalar-times-poly ring denom-inverse num)))))
-         (expt
-          (cond
-            ((member (cadr expr) vars :test #'equalp)
-             ;;Special handling of (expt var pow)
-             (let ((pos (position (cadr expr) vars :test #'equalp)))
-               (make-poly-variable ring (length vars) pos (caddr expr))))
-            ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
-             ;; Negative power means division in coefficient ring
-             ;; Non-integer power means non-polynomial coefficient
-             (scalar->poly ring expr vars))
-            (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr)))))
-         (otherwise
-          (scalar->poly ring expr vars)))))))
+  (cond
+    ((null expr) (error "Empty expression"))
+    ((eql expr 0) (make-poly-zero))
+    ((member expr vars :test #'equalp)
+     (let ((pos (position expr vars :test #'equalp)))
+       (make-poly-variable ring (length vars) pos)))
+    ((atom expr)
+     (scalar->poly ring expr vars))
+    ((eq (car expr) list-marker)
+     (cons list-marker (p-eval-list (cdr expr))))
+    (t
+     (case (car expr)
+       (+ (reduce #'p-add (p-eval-list (cdr expr))))
+       (- (case (length expr)
+            (1 (make-poly-zero))
+            (2 (poly-uminus ring (p-eval (cadr expr))))
+            (3 (poly-sub ring-and-order (p-eval (cadr expr)) (p-eval (caddr expr))))
+            (otherwise (poly-sub ring-and-order (p-eval (cadr expr))
+                                 (reduce #'p-add (p-eval-list (cddr expr)))))))
+       (*
+        (if (endp (cddr expr))          ;unary
+            (p-eval (cdr expr))
+            (reduce #'(lambda (p q) (poly-mul ring-and-order p q)) (p-eval-list (cdr expr)))))
+       (/ 
+        ;; A polynomial can be divided by a scalar
+        (cond 
+          ((endp (cddr expr))
+           ;; A special case (/ ?), the inverse
+           (scalar->poly ring (apply (ring-div ring) (cdr expr)) vars))
+          (t
+           (let ((num (p-eval (cadr expr)))
+                 (denom-inverse (apply (ring-div ring)
+                                       (cons (funcall (ring-unit ring)) 
+                                             (mapcar #'p-eval-scalar (cddr expr))))))
+             (scalar-times-poly ring denom-inverse num)))))
+       (expt
+        (cond
+          ((member (cadr expr) vars :test #'equalp)
+           ;;Special handling of (expt var pow)
+           (let ((pos (position (cadr expr) vars :test #'equalp)))
+             (make-poly-variable ring (length vars) pos (caddr expr))))
+          ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
+           ;; Negative power means division in coefficient ring
+           ;; Non-integer power means non-polynomial coefficient
+           (scalar->poly ring expr vars))
+          (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr)))))
+       (otherwise
+        (scalar->poly ring expr vars))))))
 
 (defun poly-eval-scalar (expr