Function: math-div-objects-fancy

math-div-objects-fancy is an autoloaded and byte-compiled function defined in calc-arith.el.gz.

Signature

(math-div-objects-fancy A B)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
(defun math-div-objects-fancy (a b)
  (cond ((and (Math-numberp a) (Math-numberp b))
	 (math-normalize
	  (cond ((math-want-polar a b)
		 (let ((a (math-polar a))
		       (b (math-polar b)))
		   (list 'polar
			 (math-div (nth 1 a) (nth 1 b))
			 (math-fix-circular (math-sub (nth 2 a)
						      (nth 2 b))))))
		((Math-realp b)
		 (setq a (math-complex a))
		 (list 'cplx (math-div (nth 1 a) b)
		       (math-div (nth 2 a) b)))
		(t
		 (setq a (math-complex a)
		       b (math-complex b))
		 (math-div
		  (list 'cplx
			(math-add (math-mul (nth 1 a) (nth 1 b))
				  (math-mul (nth 2 a) (nth 2 b)))
			(math-sub (math-mul (nth 2 a) (nth 1 b))
				  (math-mul (nth 1 a) (nth 2 b))))
		  (math-add (math-sqr (nth 1 b))
			    (math-sqr (nth 2 b))))))))
	((math-matrixp b)
	 (if (math-square-matrixp b)
	     (let ((n1 (length b)))
	       (if (Math-vectorp a)
		   (if (math-matrixp a)
		       (if (= (length a) n1)
			   (math-lud-solve (math-matrix-lud b) a b)
			 (if (= (length (nth 1 a)) n1)
			     (math-transpose
			      (math-lud-solve (math-matrix-lud
					       (math-transpose b))
					      (math-transpose a) b))
			   (math-dimension-error)))
		     (if (= (length a) n1)
			 (math-mat-col (math-lud-solve (math-matrix-lud b)
						       (math-col-matrix a) b)
				       1)
		       (math-dimension-error)))
		 (if (Math-equal-int a 1)
		     (calcFunc-inv b)
		   (math-mul a (calcFunc-inv b)))))
	   (math-reject-arg b 'square-matrixp)))
	((and (Math-vectorp a) (Math-objectp b))
	 (math-map-vec-2 'math-div a b))
	((eq (car-safe a) 'sdev)
	 (if (eq (car-safe b) 'sdev)
	     (let ((x (math-div (nth 1 a) (nth 1 b))))
	       (math-make-sdev x
			       (math-div (math-hypot (nth 2 a)
						     (math-mul (nth 2 b) x))
					 (nth 1 b))))
	   (if (or (Math-scalarp b)
		   (not (Math-objvecp b)))
	       (math-make-sdev (math-div (nth 1 a) b) (math-div (nth 2 a) b))
	     (math-reject-arg 'realp b))))
	((and (eq (car-safe b) 'sdev)
	      (or (Math-scalarp a)
		  (not (Math-objvecp a))))
	 (let ((x (math-div a (nth 1 b))))
	   (math-make-sdev x
			   (math-div (math-mul (nth 2 b) x) (nth 1 b)))))
	((and (eq (car-safe a) 'intv) (Math-anglep b))
	 (if (Math-negp b)
	     (math-neg (math-div a (math-neg b)))
	   (math-make-intv (nth 1 a)
			   (math-div (nth 2 a) b)
			   (math-div (nth 3 a) b))))
	((and (eq (car-safe b) 'intv) (Math-anglep a))
	 (if (or (Math-posp (nth 2 b))
		 (and (Math-zerop (nth 2 b)) (or (memq (nth 1 b) '(0 1))
						 calc-infinite-mode)))
	     (if (Math-negp a)
		 (math-neg (math-div (math-neg a) b))
	       (let ((calc-infinite-mode 1))
		 (math-make-intv (aref [0 2 1 3] (nth 1 b))
				 (math-div a (nth 3 b))
				 (math-div a (nth 2 b)))))
	   (if (or (Math-negp (nth 3 b))
		   (and (Math-zerop (nth 3 b)) (or (memq (nth 1 b) '(0 2))
						   calc-infinite-mode)))
	       (math-neg (math-div a (math-neg b)))
	     (if calc-infinite-mode
		 '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
	       (math-reject-arg b "*Division by zero")))))
	((and (eq (car-safe a) 'intv) (math-intv-constp a)
	      (eq (car-safe b) 'intv) (math-intv-constp b))
	 (if (or (Math-posp (nth 2 b))
		 (and (Math-zerop (nth 2 b)) (or (memq (nth 1 b) '(0 1))
						 calc-infinite-mode)))
	     (let* ((calc-infinite-mode 1)
		    (lo (math-div a (nth 2 b)))
		    (hi (math-div a (nth 3 b))))
	       (or (eq (car-safe lo) 'intv)
		   (setq lo (list 'intv (if (memq (nth 1 b) '(2 3)) 3 0)
				  lo lo)))
	       (or (eq (car-safe hi) 'intv)
		   (setq hi (list 'intv (if (memq (nth 1 b) '(1 3)) 3 0)
				  hi hi)))
	       (math-combine-intervals
		(nth 2 lo) (and (or (memq (nth 1 b) '(2 3))
				    (and (math-infinitep (nth 2 lo))
					 (not (math-zerop (nth 2 b)))))
				(memq (nth 1 lo) '(2 3)))
		(nth 3 lo) (and (or (memq (nth 1 b) '(2 3))
				    (and (math-infinitep (nth 3 lo))
					 (not (math-zerop (nth 2 b)))))
				(memq (nth 1 lo) '(1 3)))
		(nth 2 hi) (and (or (memq (nth 1 b) '(1 3))
				    (and (math-infinitep (nth 2 hi))
					 (not (math-zerop (nth 3 b)))))
				(memq (nth 1 hi) '(2 3)))
		(nth 3 hi) (and (or (memq (nth 1 b) '(1 3))
				    (and (math-infinitep (nth 3 hi))
					 (not (math-zerop (nth 3 b)))))
				(memq (nth 1 hi) '(1 3)))))
	   (if (or (Math-negp (nth 3 b))
		   (and (Math-zerop (nth 3 b)) (or (memq (nth 1 b) '(0 2))
						   calc-infinite-mode)))
	       (math-neg (math-div a (math-neg b)))
	     (if calc-infinite-mode
		 '(intv 3 (neg (var inf var-inf)) (var inf var-inf))
	       (math-reject-arg b "*Division by zero")))))
	((and (eq (car-safe a) 'mod)
	      (eq (car-safe b) 'mod)
	      (equal (nth 2 a) (nth 2 b)))
	 (math-make-mod (math-div-mod (nth 1 a) (nth 1 b) (nth 2 a))
			(nth 2 a)))
	((and (eq (car-safe a) 'mod)
	      (Math-anglep b))
	 (math-make-mod (math-div-mod (nth 1 a) b (nth 2 a)) (nth 2 a)))
	((and (eq (car-safe b) 'mod)
	      (Math-anglep a))
	 (math-make-mod (math-div-mod a (nth 1 b) (nth 2 b)) (nth 2 b)))
	((eq (car-safe a) 'hms)
	 (if (eq (car-safe b) 'hms)
	     (math-with-extra-prec 1
	       (math-div (math-from-hms a 'deg)
			 (math-from-hms b 'deg)))
	   (math-with-extra-prec 2
	     (math-to-hms (math-div (math-from-hms a 'deg) b) 'deg))))
	(t (calc-record-why "*Incompatible arguments for /" a b))))