Function: math-is-poly-rec

math-is-poly-rec is a byte-compiled function defined in calc-alg.el.gz.

Signature

(math-is-poly-rec EXPR NEGPOW)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-alg.el.gz
(defun math-is-poly-rec (expr negpow)
  (math-poly-simplify
   (or (cond ((or (equal expr math-var)
		  (eq (car-safe expr) '^))
	      (let ((pow 1)
		    (expr expr))
		(or (equal expr math-var)
		    (setq pow (nth 2 expr)
			  expr (nth 1 expr)))
		(or (eq math-poly-mult-powers 1)
		    (setq pow (let ((m (math-is-multiple pow 1)))
				(and (eq (car-safe (car m)) 'cplx)
				     (Math-zerop (nth 1 (car m)))
				     (setq m (list (nth 2 (car m))
						   (math-mul (nth 1 m)
							     '(var i var-i)))))
				(and (if math-poly-mult-powers
					 (equal math-poly-mult-powers
						(nth 1 m))
				       (setq math-poly-mult-powers (nth 1 m)))
				     (or (equal expr math-var)
					 (eq math-poly-mult-powers 1))
				     (car m)))))
		(if (consp pow)
		    (progn
		      (setq pow (math-to-simple-fraction pow))
		      (and (eq (car-safe pow) 'frac)
			   math-poly-frac-powers
			   (equal expr math-var)
			   (setq math-poly-frac-powers
				 (calcFunc-lcm math-poly-frac-powers
					       (nth 2 pow))))))
		(or (memq math-poly-frac-powers '(1 nil))
		    (setq pow (math-mul pow math-poly-frac-powers)))
		(if (integerp pow)
		    (if (and (= pow 1)
			     (equal expr math-var))
			(list 0 1)
		      (if (natnump pow)
			  (let ((p1 (if (equal expr math-var)
					(list 0 1)
				      (math-is-poly-rec expr nil)))
				(n pow)
				(accum (list 1)))
			    (and p1
				 (or (null math-is-poly-degree)
				     (<= (* (1- (length p1)) n) math-is-poly-degree))
				 (progn
				   (while (>= n 1)
				     (setq accum (math-poly-mul accum p1)
					   n (1- n)))
				   accum)))
			(and negpow
			     (math-is-poly-rec expr nil)
			     (setq math-poly-neg-powers
				   (cons (math-pow expr (- pow))
					 math-poly-neg-powers))
			     (list (list '^ expr pow))))))))
	     ((Math-objectp expr)
	      (list expr))
	     ((memq (car expr) '(+ -))
	      (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
		(and p1
		     (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
		       (and p2
			    (math-poly-mix p1 1 p2
					   (if (eq (car expr) '+) 1 -1)))))))
	     ((eq (car expr) 'neg)
	      (mapcar #'math-neg (math-is-poly-rec (nth 1 expr) negpow)))
	     ((eq (car expr) '*)
	      (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
		(and p1
		     (let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
		       (and p2
			    (or (null math-is-poly-degree)
				(<= (- (+ (length p1) (length p2)) 2)
                                    math-is-poly-degree))
			    (math-poly-mul p1 p2))))))
	     ((eq (car expr) '/)
	      (and (or (not (math-poly-depends (nth 2 expr) math-var))
		       (and negpow
			    (math-is-poly-rec (nth 2 expr) nil)
			    (setq math-poly-neg-powers
				  (cons (nth 2 expr) math-poly-neg-powers))))
		   (not (Math-zerop (nth 2 expr)))
		   (let ((p1 (math-is-poly-rec (nth 1 expr) negpow)))
                     (mapcar (lambda (x) (math-div x (nth 2 expr)))
			     p1))))
	     ((and (eq (car expr) 'calcFunc-exp)
		   (equal math-var '(var e var-e)))
	      (math-is-poly-rec (list '^ math-var (nth 1 expr)) negpow))
	     ((and (eq (car expr) 'calcFunc-sqrt)
		   math-poly-frac-powers)
	      (math-is-poly-rec (list '^ (nth 1 expr) '(frac 1 2)) negpow))
	     (t nil))
       (and (or (not (math-poly-depends expr math-var))
		math-is-poly-loose)
	    (not (eq (car expr) 'vec))
	    (list expr)))))