src/polynomialp.lisp

   1 ;; Author Barton Willis
   2
   3 ;; University of Nebraska at Kearney
   4 ;; Copyright (C) 2004, 2005, Barton Willis
   5 ;; Brief Description: polynomial predicate function.
   6
   7 ;;  This program is free software; you can redistribute it and/or modify
   8 ;;  it under the terms of the GNU General Public License as published by
   9 ;;  the Free Software Foundation; either version 2 of the License, or
  10 ;;  (at your option) any later version.
  11
  12 ;;  This program is distributed in the hope that it will be useful,
  13 ;;  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;  GNU General Public License for more details.
  16
  17 ;;  You should have received a copy of the GNU General Public License
  18 ;;  along with this program; if not, write to the Free Software
  19 ;;  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA
  20
  21 (in-package :maxima)
  22
  23 #+nil
  24 (eval-when (:compile-toplevel :load-toplevel :execute)
  25   (if (not (functionp 'op-equalp)) ($load "linalg-utilities"))
  26   (if (not (functionp 'require-list-or-set)) ($load "nset")))
  27
  28 ;; Return true iff n is an integer and n >= 0.
  29
  30 (defmfun $nonnegintegerp (n)
  31   (and (integerp n) (>= n 0)))
  32
  33 (defmfun $polynomialp (p vars &optional (coeffp '$constantp) (exponp '$nonnegintegerp))
  34   "Returns true if P is a polynomial in the variables in the list VARS.
  35  The predicate COEFFP must be a function that evaluates to T for each
  36  coefficient, and simpilarly EXPONP must evaluate to T for all
  37  exponents of the variables in VARS."
  38   (setq vars (require-list-or-set vars %%pretty-fname))
  39   (setq vars (mapcar '$ratdisrep vars))
  40   (if (every #'(lambda (s) (or ($symbolp s) ($subvarp s))) vars)
  41       (polynomialp ($ratdisrep p) vars coeffp exponp)
  42       (merror "~M: The second argument to polynomialp must be a list of symbols: ~M"
  43               %%pretty-fname (list* '(mlist) vars))))
  44
  45 (defun polynomialp (p vars coeffp exponp)
  46   (or
  47    (mfuncall coeffp p)
  48    (if (member p vars :test #'alike1) t nil)
  49    (and (op-equalp p 'mtimes 'mplus)
  50         (every #'(lambda (s) (polynomialp s vars coeffp exponp)) (margs p)))
  51    (and (op-equalp p 'mexpt) (polynomialp (car (margs p)) vars coeffp exponp)
  52         (mfuncall exponp (cadr (margs p))))))