Function: math-prod-rec

math-prod-rec is an autoloaded and byte-compiled function defined in calcalg2.el.gz.

Signature

(math-prod-rec EXPR VAR &optional LOW HIGH STEP)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calcalg2.el.gz
(defun math-prod-rec (expr var &optional low high step)
  (or low (setq low '(neg (var inf var-inf)) high '(var inf var-inf)))
  (and low (not high) (setq high '(var inf var-inf)))
  (let (t1 t2 t3 val)
    (setq val
	  (cond
	   ((not (math-expr-contains expr var))
	    (math-pow expr (math-add (math-div (math-sub high low) (or step 1))
				     1)))
	   ((and step (not (math-equal-int step 1)))
	    (if (math-negp step)
		(math-prod-rec expr var high low (math-neg step))
	      (let ((lo (math-simplify (math-div low step))))
		(if (math-known-num-integerp lo)
		    (math-prod-rec (math-normalize
				    (math-expr-subst expr var
						     (math-mul step var)))
				   var lo (math-simplify (math-div high step)))
		  (math-prod-rec (math-normalize
				  (math-expr-subst expr var
						   (math-add (math-mul step
								       var)
							     low)))
				 var 0
				 (math-simplify (math-div (math-sub high low)
							  step)))))))
	   ((and (memq (car expr) '(* /))
		 (setq t1 (math-prod-rec (nth 1 expr) var low high)
		       t2 (math-prod-rec (nth 2 expr) var low high))
		 (not (and (math-expr-calls t1 '(calcFunc-prod))
			   (math-expr-calls t2 '(calcFunc-prod)))))
	    (list (car expr) t1 t2))
	   ((and (eq (car expr) '^)
		 (not (math-expr-contains (nth 2 expr) var)))
	    (math-pow (math-prod-rec (nth 1 expr) var low high)
		      (nth 2 expr)))
	   ((and (eq (car expr) '^)
		 (not (math-expr-contains (nth 1 expr) var)))
	    (math-pow (nth 1 expr)
		      (calcFunc-sum (nth 2 expr) var low high)))
	   ((eq (car expr) 'sqrt)
	    (math-normalize (list 'calcFunc-sqrt
				  (list 'calcFunc-prod (nth 1 expr)
					var low high))))
	   ((eq (car expr) 'neg)
	    (math-mul (math-pow -1 (math-add (math-sub high low) 1))
		      (math-prod-rec (nth 1 expr) var low high)))
	   ((eq (car expr) 'calcFunc-exp)
	    (list 'calcFunc-exp (calcFunc-sum (nth 1 expr) var low high)))
	   ((and (setq t1 (math-is-polynomial expr var 1))
		 (setq t2
		       (cond
			((or (and (math-equal-int (nth 1 t1) 1)
				  (setq low (math-simplify
					     (math-add low (car t1)))
					high (math-simplify
					      (math-add high (car t1)))))
			     (and (math-equal-int (nth 1 t1) -1)
				  (setq t2 low
					low (math-simplify
					     (math-sub (car t1) high))
					high (math-simplify
					      (math-sub (car t1) t2)))))
			 (if (or (math-zerop low) (math-zerop high))
			     0
			   (if (and (or (math-negp low) (math-negp high))
				    (or (math-num-integerp low)
					(math-num-integerp high)))
			       (if (math-posp high)
				   0
				 (math-mul (math-pow -1
						     (math-add
						      (math-add low high) 1))
					   (list '/
						 (list 'calcFunc-fact
						       (math-neg low))
						 (list 'calcFunc-fact
						       (math-sub -1 high)))))
			     (list '/
				   (list 'calcFunc-fact high)
				   (list 'calcFunc-fact (math-sub low 1))))))
			((and (or (and (math-equal-int (nth 1 t1) 2)
				       (setq t2 (math-simplify
						 (math-add (math-mul low 2)
							   (car t1)))
					     t3 (math-simplify
						 (math-add (math-mul high 2)
							   (car t1)))))
				  (and (math-equal-int (nth 1 t1) -2)
				       (setq t2 (math-simplify
						 (math-sub (car t1)
							   (math-mul high 2)))
					     t3 (math-simplify
						 (math-sub (car t1)
							   (math-mul low
								     2))))))
			      (or (math-integerp t2)
				  (and (math-messy-integerp t2)
				       (setq t2 (math-trunc t2)))
				  (math-integerp t3)
				  (and (math-messy-integerp t3)
				       (setq t3 (math-trunc t3)))))
			 (if (or (math-zerop t2) (math-zerop t3))
			     0
			   (if (or (math-evenp t2) (math-evenp t3))
			       (if (or (math-negp t2) (math-negp t3))
				   (if (math-posp high)
				       0
				     (list '/
					   (list 'calcFunc-dfact
						 (math-neg t2))
					   (list 'calcFunc-dfact
						 (math-sub -2 t3))))
				 (list '/
				       (list 'calcFunc-dfact t3)
				       (list 'calcFunc-dfact
					     (math-sub t2 2))))
			     (if (math-negp t3)
				 (list '*
				       (list '^ -1
					     (list '/ (list '- (list '- t2 t3)
							    2)
						   2))
				       (list '/
					     (list 'calcFunc-dfact
						   (math-neg t2))
					     (list 'calcFunc-dfact
						   (math-sub -2 t3))))
			       (if (math-posp t2)
				   (list '/
					 (list 'calcFunc-dfact t3)
					 (list 'calcFunc-dfact
					       (math-sub t2 2)))
				 nil))))))))
	    t2)))
    (if (equal val '(var nan var-nan)) (setq val nil))
    (or val
	(let* ((math-tabulate-initial 1)
	       (math-tabulate-function 'calcFunc-prod))
	  (calcFunc-table expr var low high)))))