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 ($put '$polynomialp 1 '$version)
  29
  30 ;; Return true iff n is an integer and n >= 0.
  31
  32 (defmfun $nonnegintegerp (n)
  33   (and (integerp n) (>= n 0)))
  34
  35 (defmfun $polynomialp (p vars &optional (coeffp '$constantp) (exponp '$nonnegintegerp))
  36   "Returns true if P is a polynomial in the variables in the list VARS.
  37  The predicate COEFFP must be a function that evaluates to T for each
  38  coefficient, and simpilarly EXPONP must evaluate to T for all
  39  exponents of the variables in VARS."
  40   (setq vars (require-list-or-set vars %%pretty-fname))
  41   (setq vars (mapcar '$ratdisrep vars))
  42   (if (every #'(lambda (s) (or ($symbolp s) ($subvarp s))) vars)
  43       (polynomialp ($ratdisrep p) vars coeffp exponp)
  44       (merror "~M: The second argument to polynomialp must be a list of symbols: ~M"
  45               %%pretty-fname (list* '(mlist) vars))))
  46
  47 (defun polynomialp (p vars coeffp exponp)
  48   (or
  49    (mfuncall coeffp p)
  50    (if (member p vars :test #'alike1) t nil)
  51    (and (op-equalp p 'mtimes 'mplus)
  52         (every #'(lambda (s) (polynomialp s vars coeffp exponp)) (margs p)))
  53    (and (op-equalp p 'mexpt) (polynomialp (car (margs p)) vars coeffp exponp)
  54         (mfuncall exponp (cadr (margs p))))))