Function: math-to-ratpoly-rec

math-to-ratpoly-rec is an autoloaded and byte-compiled function defined in calc-poly.el.gz.

Signature

(math-to-ratpoly-rec EXPR)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-poly.el.gz
(defun math-to-ratpoly-rec (expr)
  (cond ((Math-primp expr)
	 (cons expr 1))
	((memq (car expr) '(+ -))
	 (let ((r1 (math-to-ratpoly-rec (nth 1 expr)))
	       (r2 (math-to-ratpoly-rec (nth 2 expr))))
	   (if (equal (cdr r1) (cdr r2))
	       (cons (list (car expr) (car r1) (car r2)) (cdr r1))
	     (if (eq (cdr r1) 1)
		 (cons (list (car expr)
			     (math-mul (car r1) (cdr r2))
			     (car r2))
		       (cdr r2))
	       (if (eq (cdr r2) 1)
		   (cons (list (car expr)
			       (car r1)
			       (math-mul (car r2) (cdr r1)))
			 (cdr r1))
		 (let ((g (math-poly-gcd (cdr r1) (cdr r2))))
		   (let ((d1 (and (not (eq g 1)) (math-poly-div (cdr r1) g)))
			 (d2 (and (not (eq g 1)) (math-poly-div
						  (math-mul (car r1) (cdr r2))
						  g))))
		     (if (and (eq (cdr d1) 0) (eq (cdr d2) 0))
			 (cons (list (car expr) (car d2)
				     (math-mul (car r2) (car d1)))
			       (math-mul (car d1) (cdr r2)))
		       (cons (list (car expr)
				   (math-mul (car r1) (cdr r2))
				   (math-mul (car r2) (cdr r1)))
			     (math-mul (cdr r1) (cdr r2)))))))))))
	((eq (car expr) '*)
	 (let* ((r1 (math-to-ratpoly-rec (nth 1 expr)))
		(r2 (math-to-ratpoly-rec (nth 2 expr)))
		(g (math-mul (math-poly-gcd (car r1) (cdr r2))
			     (math-poly-gcd (cdr r1) (car r2)))))
	   (if (eq g 1)
	       (cons (math-mul (car r1) (car r2))
		     (math-mul (cdr r1) (cdr r2)))
	     (cons (math-poly-div-exact (math-mul (car r1) (car r2)) g)
		   (math-poly-div-exact (math-mul (cdr r1) (cdr r2)) g)))))
	((eq (car expr) '/)
	 (let* ((r1 (math-to-ratpoly-rec (nth 1 expr)))
		(r2 (math-to-ratpoly-rec (nth 2 expr))))
	   (if (and (eq (cdr r1) 1) (eq (cdr r2) 1))
	       (cons (car r1) (car r2))
	     (let ((g (math-mul (math-poly-gcd (car r1) (car r2))
				(math-poly-gcd (cdr r1) (cdr r2)))))
	       (if (eq g 1)
		   (cons (math-mul (car r1) (cdr r2))
			 (math-mul (cdr r1) (car r2)))
		 (cons (math-poly-div-exact (math-mul (car r1) (cdr r2)) g)
		       (math-poly-div-exact (math-mul (cdr r1) (car r2))
					    g)))))))
	((and (eq (car expr) '^) (integerp (nth 2 expr)))
	 (let ((r1 (math-to-ratpoly-rec (nth 1 expr))))
	   (if (> (nth 2 expr) 0)
	       (cons (math-pow (car r1) (nth 2 expr))
		     (math-pow (cdr r1) (nth 2 expr)))
	     (cons (math-pow (cdr r1) (- (nth 2 expr)))
		   (math-pow (car r1) (- (nth 2 expr)))))))
	((eq (car expr) 'neg)
	 (let ((r1 (math-to-ratpoly-rec (nth 1 expr))))
	   (cons (math-neg (car r1)) (cdr r1))))
	(t (cons expr 1))))