Function: math-poly-integer-root

math-poly-integer-root is a byte-compiled function defined in calcalg2.el.gz.

Signature

(math-poly-integer-root X)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calcalg2.el.gz
(defun math-poly-integer-root (x)
  (and (math-lessp (calcFunc-xpon (math-abs-approx x)) calc-internal-prec)
       math-int-coefs
       (let* ((calc-prefer-frac t)
	      (xre (calcFunc-re x))
	      (xim (calcFunc-im x))
	      (xresq (math-sqr xre))
	      (ximsq (math-sqr xim)))
	 (if (math-lessp ximsq (calcFunc-scf xresq -1))
	     ;; Look for linear factor
	     (let* ((rnd (math-div (math-round (math-mul xre math-int-scale))
				   math-int-scale))
		    (icp math-int-coefs)
		    (rem (car icp))
		    (newcoef nil))
	       (while (setq icp (cdr icp))
		 (setq newcoef (cons rem newcoef)
		       rem (math-add (car icp)
				     (math-mul rem rnd))))
	       (and (math-zerop rem)
		    (progn
		      (setq math-int-coefs (nreverse newcoef)
			    math-int-factors (cons (list (math-neg rnd))
						   math-int-factors))
		      rnd)))
	   ;; Look for irreducible quadratic factor
	   (let* ((rnd1 (math-div (math-round
				   (math-mul xre (math-mul -2 math-int-scale)))
				  math-int-scale))
		  (sqscale (math-sqr math-int-scale))
		  (rnd0 (math-div (math-round (math-mul (math-add xresq ximsq)
							sqscale))
				  sqscale))
		  (rem1 (car math-int-coefs))
		  (icp (cdr math-int-coefs))
		  (rem0 (car icp))
		  (newcoef nil)
		  (found (assoc (list rnd0 rnd1 (math-posp xim))
				math-double-roots))
		  this)
	     (if found
		 (setq math-double-roots (delq found math-double-roots)
		       rem0 0 rem1 0)
	       (while (setq icp (cdr icp))
		 (setq this rem1
		       newcoef (cons rem1 newcoef)
		       rem1 (math-sub rem0 (math-mul this rnd1))
		       rem0 (math-sub (car icp) (math-mul this rnd0)))))
	     (and (math-zerop rem0)
		  (math-zerop rem1)
		  (let ((aa (math-div rnd1 -2)))
		    (or found (setq math-int-coefs (reverse newcoef)
				    math-double-roots (cons (list
							     (list
							      rnd0 rnd1
							      (math-negp xim)))
							    math-double-roots)
				    math-int-factors (cons (cons rnd0 rnd1)
							   math-int-factors)))
		    (math-add aa
			      (let ((calc-symbolic-mode math-symbolic-solve))
				(math-mul (math-sqrt (math-sub (math-sqr aa)
							       rnd0))
					  (if (math-negp xim) -1 1)))))))))))