Changeset 3123 for branches/f4grobner

Timestamp:

2015-06-22T09:57:51-07:00 (9 years ago)

Author:

Marek Rychlik

Message:

* empty log message *

File:

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

branches/f4grobner/polynomial.lisp

@@ -367 +367 @@
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Evaluation of polynomial (prefix) expressions
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun coerce-coeff (ring expr vars)
-  "Coerce an element of the coefficient ring to a constant polynomial."
-  ;; Modular arithmetic handler by rat
-  (declare (type ring ring))
-  (make-poly-from-termlist (list (make-term :monom (make-monom :dimension (length vars))
-                                            :coeff (funcall (ring-parse ring) expr)))
-                           0))
-
-(defun poly-eval (expr vars 
-                  &optional 
-                    (ring +ring-of-integers+) 
-                    (order #'lex>)
-                    (list-marker :[)
-                  &aux 
-                    (ring-and-order (make-ring-and-order :ring ring :order order)))
-  "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in
-variables VARS. Return the resulting polynomial or list of
-polynomials.  Standard arithmetical operators in form EXPR are
-replaced with their analogues in the ring of polynomials, and the
-resulting expression is evaluated, resulting in a polynomial or a list
-of polynomials in internal form. A similar operation in another computer
-algebra system could be called 'expand' or so."
-  (declare (type ring ring))
-  (labels ((p-eval (arg) (poly-eval arg vars ring order))
-           (p-eval-scalar (arg) (poly-eval-scalar arg))
-           (p-eval-list (args) (mapcar #'p-eval args))
-           (p-add (x y) (poly-add ring-and-order x y)))
-    (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)
-       (coerce-coeff 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
-             (coerce-coeff 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
-             (coerce-coeff ring expr vars))
-            (t (poly-expt ring-and-order (p-eval (cadr expr)) (caddr expr)))))
-         (otherwise
-          (coerce-coeff ring expr vars)))))))
-
-(defun poly-eval-scalar (expr 
-                         &optional
-                           (ring +ring-of-integers+)
-                         &aux 
-                           (order #'lex>))
-  "Evaluate a scalar expression EXPR in ring RING."
-  (declare (type ring ring))
-  (poly-lc (poly-eval expr nil ring order)))
+
 
 (defun spoly (ring-and-order f g
@@ -498 +409 @@
   (reduce (ring-gcd ring) (mapcar #'term-coeff (rest (poly-termlist p))) :initial-value (poly-lc p)))
 
-(defun read-infix-form (&key (stream t))
-  "Parser of infix expressions with integer/rational coefficients
-The parser will recognize two kinds of polynomial expressions:
-
-- polynomials in fully expanded forms with coefficients
-  written in front of symbolic expressions; constants can be optionally
-  enclosed in (); for example, the infix form
-        X^2-Y^2+(-4/3)*U^2*W^3-5
-  parses to
-        (+ (- (EXPT X 2) (EXPT Y 2)) (* (- (/ 4 3)) (EXPT U 2) (EXPT W 3)) (- 5))
-
-- lists of polynomials; for example
-        [X-Y, X^2+3*Z]          
-  parses to
-          (:[ (- X Y) (+ (EXPT X 2) (* 3 Z)))
-  where the first symbol [ marks a list of polynomials.
-
--other infix expressions, for example
-        [(X-Y)*(X+Y)/Z,(X+1)^2]
-parses to:
-        (:[ (/ (* (- X Y) (+ X Y)) Z) (EXPT (+ X 1) 2))
-Currently this function is implemented using M. Kantrowitz's INFIX package."
-  (read-from-string
-   (concatenate 'string
-                "#I(" 
-                (with-output-to-string (s)
-                  (loop
-                     (multiple-value-bind (line eof)
-                         (read-line stream t)
-                       (format s "~A" line)
-                       (when eof (return)))))
-                ")")))
-
-(defun read-poly (vars &key
-                         (stream t) 
-                         (ring +ring-of-integers+) 
-                         (order #'lex>))
-  "Reads an expression in prefix form from a stream STREAM.
-The expression read from the strem should represent a polynomial or a
-list of polynomials in variables VARS, over the ring RING.  The
-polynomial or list of polynomials is returned, with terms in each
-polynomial ordered according to monomial order ORDER."
-  (poly-eval (read-infix-form :stream stream) vars ring order))
-
-(defun string->poly (str vars 
-                     &optional
-                       (ring +ring-of-integers+) 
-                       (order #'lex>))
-  "Converts a string STR to a polynomial in variables VARS."
-  (with-input-from-string (s str)
-    (read-poly vars :stream s :ring ring :order order)))
-
-(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 #'term->cons (poly-termlist p)))
-    ((and (consp p) (eq (car p) :[))
-     (cons :[ (mapcar #'poly->alist (cdr p))))))
-
-(defun string->alist (str vars
-                      &optional
-                        (ring +ring-of-integers+) 
-                        (order #'lex>))
-  "Convert a string STR representing a polynomial or polynomial list to
-an association list (... (MONOM . COEFF) ...)."
-  (poly->alist (string->poly str vars ring order)))
-
-(defun poly-equal-no-sugar-p (p q)
-  "Compare polynomials for equality, ignoring sugar."
-  (declare (type poly p q))
-  (equalp (poly-termlist p) (poly-termlist q)))
-
-(defun poly-set-equal-no-sugar-p (p q)
-  "Compare polynomial sets P and Q for equality, ignoring sugar."
-  (null (set-exclusive-or  p q :test #'poly-equal-no-sugar-p )))
-
-(defun poly-list-equal-no-sugar-p (p q)
-  "Compare polynomial lists P and Q for equality, ignoring sugar."
-  (every #'poly-equal-no-sugar-p p q))
 |#