close Warning: Can't synchronize with repository "(default)" (The repository directory has changed, you should resynchronize the repository with: trac-admin $ENV repository resync '(default)'). Look in the Trac log for more information.

Changeset 3902 for branches/f4grobner


Ignore:
Timestamp:
2016-05-29T14:30:37-07:00 (8 years ago)
Author:
Marek Rychlik
Message:

* empty log message *

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/f4grobner/symbolic-polynomial.lisp

    r3898 r3902  
    2222(defpackage "SYMBOLIC-POLYNOMIAL"
    2323  (:use :cl :utils :monom :polynomial :infix :infix-printer)
    24   (:export "SYMBOLIC-POLY" "READ-INFIX-FORM" "STRING->POLY" "POLY->STRING" "->INFIX" "+LIST-MARKER+")
     24  (:export "SYMBOLIC-POLY" "READ-INFIX-FORM" "STRING->POLY" "POLY->STRING" "->INFIX")
    2525  (:documentation "Implements symbolic polynomials. A symbolic
    2626polynomial is polynomial which uses symbolic variables for reading and
     
    2828
    2929(in-package :symbolic-polynomial)
    30 
    31 (defparameter +list-marker+ :[
    32   "A sexp with this head is considered a list of polynomials.")
    3330
    3431(defclass symbolic-poly (poly)
     
    6259  (assert (= (length (symbolic-poly-vars new)) (poly-dimension new))))
    6360
    64 (defun poly-eval (expr vars order)
    65   "Evaluate Lisp form EXPR to a polynomial or a list of polynomials in
    66 variables VARS. Return the resulting polynomial or list of
    67 polynomials.  Standard arithmetical operators in form EXPR are
    68 replaced with their analogues in the ring of polynomials, and the
    69 resulting expression is evaluated, resulting in a polynomial or a list
    70 of polynomials in internal form. A similar operation in another computer
    71 algebra system could be called 'expand' or so."
    72   (labels ((p-eval (p) (poly-eval p vars order))
    73            (p-eval-scalar (p) (poly-eval p '() order))
    74            (p-eval-list (plist) (mapcar #'p-eval plist)))
    75     (cond
    76       ((eq expr 0)
    77        (make-instance 'poly :dimension (length vars)))
    78       ((member expr vars :test #'equalp)
    79        (let ((pos (position expr vars :test #'equalp)))
    80          (make-poly-variable (length vars) pos)))
    81       ((atom expr)
    82        expr)
    83       ((eq (car expr) +list-marker+)
    84        (cons +list-marker+ (p-eval-list (cdr expr))))
    85       (t
    86        (case (car expr)
    87          (+ (reduce #'add (p-eval-list (cdr expr))))
    88          (- (apply #'subtract (p-eval-list (cdr expr))))
    89          (*
    90           (if (endp (cddr expr))        ;unary
    91               (p-eval (cadr expr))
    92               (reduce #'multiply (p-eval-list (cdr expr)))))
    93          (/
    94           ;; A polynomial can be divided by a scalar
    95           (cond
    96             ((endp (cddr expr))
    97              ;; A special case (/ ?), the inverse
    98              (divide (cadr expr)))
    99             (t
    100              (let ((num (p-eval (cadr expr)))
    101                    (denom-inverse (apply #'divide (mapcar #'p-eval-scalar (cddr expr)))))
    102                (multiply denom-inverse num)))))
    103          (expt
    104           (cond
    105             ((member (cadr expr) vars :test #'equalp)
    106              ;;Special handling of (expt var pow)
    107              (let ((pos (position (cadr expr) vars :test #'equalp)))
    108                (make-poly-variable (length vars) pos (caddr expr))))
    109             ((not (and (integerp (caddr expr)) (plusp (caddr expr))))
    110              ;; Negative power means division in coefficient ring
    111              ;; Non-integer power means non-polynomial coefficient
    112              expr)
    113             (t (universal-expt (p-eval (cadr expr)) (caddr expr)))))
    114          (otherwise
    115           expr))))))
    11661
    11762#|
Note: See TracChangeset for help on using the changeset viewer.