;;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Copyright (C) 1999, 2002, 2009, 2015 Marek Rychlik ;;; ;;; This program is free software; you can redistribute it and/or modify ;;; it under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 2 of the License, or ;;; (at your option) any later version. ;;; ;;; This program is distributed in the hope that it will be useful, ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with this program; if not, write to the Free Software ;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage "SYMBOLIC-POLYNOMIAL" (:use :cl :utils :monom :polynomial :infix :infix-printer :ring) (:export "SYMBOLIC-POLY" "READ-INFIX-FORM" "STRING->POLY" "POLY->STRING" "->INFIX") (:documentation "Implements symbolic polynomials. A symbolic polynomial is polynomial which uses symbolic variables for reading and printing in standard human-readable (infix) form.")) (in-package "SYMBOLIC-POLYNOMIAL") (defclass symbolic-poly (poly) ((vars :initform nil :initarg :vars :accessor symbolic-poly-vars) ) (:default-initargs :termlist nil :vars nil)) (defmethod print-object ((self symbolic-poly) stream) (print-unreadable-object (self stream :type t :identity t) (with-accessors ((termlist poly-termlist) (order poly-term-order) (vars symbolic-poly-vars)) self (format stream "TERMLIST=~A ORDER=~A VARS=~A" termlist order vars)))) (defmethod universal-equalp ((self symbolic-poly) (other symbolic-poly)) (when (universal-equalp (symbolic-poly-vars self) (symbolic-poly-vars other)) (call-next-method))) (defmethod universal-equalp ((self symbolic-poly) (other poly)) "Compare SELF, which is an instance of SYMBOLIC-POLY, to OTHER, which is an instance of POLY. We simply ignore variables of SELF, and compare SELF and OTHER as POLY." (call-next-method)) (defmethod universal-equalp ((self symbol) (other symbol)) (eq self other)) #| (defun poly-eval-scalar (expr &aux (order #'lex>)) "Evaluate a scalar expression EXPR in ring RING." (declare (type ring ring)) (poly-lc (poly-eval expr nil ring order))) |# (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) (order #'lex>) (coefficient-class *coefficient-class*)) "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 order coefficient-class)) (defun string->poly (str vars &optional (order #'lex>) (coefficient-class *coefficient-class*)) "Converts a string STR to a polynomial in variables VARS." (with-input-from-string (s str) (let ((p-or-plist (read-poly vars :stream s :order order :coefficient-class coefficient-class))) (etypecase p-or-plist (poly (change-class p-or-plist 'symbolic-poly :vars vars)) (cons (setf (cdr p-or-plist) (mapcar #'(lambda (p) (change-class p 'symbolic-poly :vars vars)) (cdr p-or-plist))) p-or-plist))))) (defun string->alist (str vars &optional (order #'lex>) (coefficient-class *coefficient-class*)) "Convert a string STR representing a polynomial or polynomial list to an association list (... (MONOM . COEFF) ...)." (poly->alist (string->poly str vars order coefficient-class))) (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)) (defmethod ->sexp :around ((self symbolic-poly) &optional (vars (symbolic-poly-vars self))) "Convert a symbolic polynomial SELF to infix form, using variables VARS. The default value of VARS is the corresponding slot value of SELF." (call-next-method self vars)) (defgeneric poly->string (self &optional vars) (:documentation "Render polynomial SELF as a string, using symbolic variables VARS.") (:method ((self list) &optional (vars nil vars-p)) (assert (eql (car self) :[)) (cond (vars-p (format nil "[~{~a~^, ~}]" (mapcar #'(lambda (p) (poly->string p vars)) (cdr self)))) (t (format nil "[~{~a~^, ~}]" (mapcar #'(lambda (p) (poly->string p)) (cdr self)))))) (:method ((self poly) &optional (vars nil)) (infix-print-to-string (->sexp self vars))) (:method ((self symbolic-poly) &optional (vars (symbolic-poly-vars self))) (infix-print-to-string (->sexp self vars))))