Function: math-factor-poly-coefs

math-factor-poly-coefs is a byte-compiled function defined in calc-poly.el.gz.

Signature

(math-factor-poly-coefs P &optional SQUARE-FREE)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-poly.el.gz
(defun math-factor-poly-coefs (p &optional square-free)    ; uses "x"
  (let (t1 t2 temp)
    (cond ((not (cdr p))
	   (or (car p) 0))

	  ;; Strip off multiples of math-fet-x.
	  ((Math-zerop (car p))
	   (let ((z 0))
	     (while (and p (Math-zerop (car p)))
	       (setq z (1+ z) p (cdr p)))
	     (if (cdr p)
		 (setq p (math-factor-poly-coefs p square-free))
	       (setq p (math-sort-terms (math-factor-expr (car p)))))
	     (math-accum-factors math-fet-x z (math-factor-protect p))))

	  ;; Factor out content.
	  ((and (not square-free)
		(not (eq 1 (setq t1 (math-mul (math-poly-gcd-list p)
					      (if (math-guess-if-neg
						   (nth (1- (length p)) p))
						  -1 1))))))
	   (math-accum-factors t1 1 (math-factor-poly-coefs
				     (math-poly-div-list p t1) 'cont)))

	  ;; Check if linear in math-fet-x.
	  ((not (cdr (cdr p)))
           (math-sort-terms
            (math-add (math-factor-protect
                       (math-sort-terms
                        (math-factor-expr (car p))))
                      (math-mul math-fet-x (math-factor-protect
                                            (math-sort-terms
                                             (math-factor-expr (nth 1 p))))))))

	  ;; If symbolic coefficients, use FactorRules.
	  ((let ((pp p))
	     (while (and pp (or (Math-ratp (car pp))
				(and (eq (car (car pp)) 'mod)
				     (Math-integerp (nth 1 (car pp)))
				     (Math-integerp (nth 2 (car pp))))))
	       (setq pp (cdr pp)))
	     pp)
	   (let ((res (math-rewrite
		       (list 'calcFunc-thecoefs math-fet-x (cons 'vec p))
		       '(var FactorRules var-FactorRules))))
	     (or (and (eq (car-safe res) 'calcFunc-thefactors)
		      (= (length res) 3)
		      (math-vectorp (nth 2 res))
		      (let ((facs 1)
			    (vec (nth 2 res)))
			(while (setq vec (cdr vec))
			  (setq facs (math-accum-factors (car vec) 1 facs)))
			facs))
		 (math-build-polynomial-expr p math-fet-x))))

	  ;; Check if rational coefficients (i.e., not modulo a prime).
	  ((eq math-poly-modulus 1)

	   ;; Check if there are any squared terms, or a content not = 1.
	   (if (or (eq square-free t)
		   (equal (setq t1 (math-poly-gcd-coefs
				    p (setq t2 (math-poly-deriv-coefs p))))
			  '(1)))

	       ;; We now have a square-free polynomial with integer coefs.
	       ;; For now, we use a kludgy method that finds linear and
	       ;; quadratic terms using floating-point root-finding.
	       (if (setq t1 (let ((calc-symbolic-mode nil))
			      (math-poly-all-roots nil p t)))
		   (let ((roots (car t1))
			 (csign (if (math-negp (nth (1- (length p)) p)) -1 1))
			 (expr 1)
			 (scale (nth 2 t1)))
		     (while roots
		       (let ((coef0 (car (car roots)))
			     (coef1 (cdr (car roots))))
			 (setq expr (math-accum-factors
				     (if coef1
					 (let ((den (math-lcm-denoms
						     coef0 coef1)))
					   (setq scale (math-div scale den))
					   (math-add
					    (math-add
					     (math-mul den (math-pow math-fet-x 2))
					     (math-mul (math-mul coef1 den)
                                                       math-fet-x))
					    (math-mul coef0 den)))
				       (let ((den (math-lcm-denoms coef0)))
					 (setq scale (math-div scale den))
					 (math-add (math-mul den math-fet-x)
						   (math-mul coef0 den))))
				     1 expr)
			       roots (cdr roots))))
		     (setq expr (math-accum-factors
				 expr 1
				 (math-mul csign
					   (math-build-polynomial-expr
					    (math-mul-list (nth 1 t1) scale)
					    math-fet-x)))))
		 (math-build-polynomial-expr p math-fet-x))   ; can't factor it.

	     ;; Separate out the squared terms (Knuth exercise 4.6.2-34).
	     ;; This step also divides out the content of the polynomial.
	     (let* ((cabs (math-poly-gcd-list p))
		    (csign (if (math-negp (nth (1- (length p)) p)) -1 1))
		    (t1s (math-mul-list t1 csign))
		    (uu nil)
		    (v (car (math-poly-div-coefs p t1s)))
		    (w (car (math-poly-div-coefs t2 t1s))))
	       (while
		   (not (math-poly-zerop
			 (setq t2 (math-poly-simplify
				   (math-poly-mix
				    w 1 (math-poly-deriv-coefs v) -1)))))
		 (setq t1 (math-poly-gcd-coefs v t2)
		       uu (cons t1 uu)
		       v (car (math-poly-div-coefs v t1))
		       w (car (math-poly-div-coefs t2 t1))))
	       (setq t1 (length uu)
		     t2 (math-accum-factors (math-factor-poly-coefs v t)
					    (1+ t1) 1))
	       (while uu
		 (setq t2 (math-accum-factors (math-factor-poly-coefs
					       (car uu) t)
					      t1 t2)
		       t1 (1- t1)
		       uu (cdr uu)))
	       (math-accum-factors (math-mul cabs csign) 1 t2))))

	  ;; Factoring modulo a prime.
	  ((and (= (length (setq temp (math-poly-gcd-coefs
				       p (math-poly-deriv-coefs p))))
		   (length p)))
	   (setq p (car temp))
	   (while (cdr temp)
	     (setq temp (nthcdr (nth 2 math-poly-modulus) temp)
		   p (cons (car temp) p)))
	   (and (setq temp (math-factor-poly-coefs p))
		(math-pow temp (nth 2 math-poly-modulus))))
	  (t
	   (math-reject-arg nil "*Modulo factorization not yet implemented")))))