Function: math-compare

math-compare is a byte-compiled function defined in calc-ext.el.gz.

Signature

(math-compare A B)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-ext.el.gz
;;; Return 0 if A is numerically equal to B, <0 if less, >0 if more.
;;; Arguments must be normalized!  [S N N]
(defun math-compare (a b)
  (cond ((equal a b)
	 (if (and (consp a)
		  (memq (car a) '(var neg * /))
		  (math-infinitep a))
	     2
	   0))
	((and (integerp a) (Math-integerp b))
	 (if (< a b) -1 1))
	((eq (car-safe a) 'frac)
	 (if (eq (car-safe b) 'frac)
	     (math-compare (math-mul (nth 1 a) (nth 2 b))
			   (math-mul (nth 1 b) (nth 2 a)))
	   (math-compare (nth 1 a) (math-mul b (nth 2 a)))))
	((eq (car-safe b) 'frac)
	 (math-compare (math-mul a (nth 2 b)) (nth 1 b)))
	((and (eq (car-safe a) 'float) (eq (car-safe b) 'float))
	 (if (math-lessp-float a b) -1 1))
	((and (eq (car-safe a) 'date) (eq (car-safe b) 'date))
	 (math-compare (nth 1 a) (nth 1 b)))
	((and (or (Math-anglep a)
		  (and (eq (car a) 'cplx) (eq (nth 2 a) 0)))
	      (or (Math-anglep b)
		  (and (eq (car b) 'cplx) (eq (nth 2 b) 0))))
	 (calcFunc-sign (math-add a (math-neg b))))
	((and (eq (car-safe a) 'intv)
	      (or (Math-anglep b) (eq (car-safe b) 'date)))
	 (let ((res (math-compare (nth 2 a) b)))
	   (cond ((eq res 1) 1)
		 ((and (eq res 0) (memq (nth 1 a) '(0 1))) 1)
		 ((eq (setq res (math-compare (nth 3 a) b)) -1) -1)
		 ((and (eq res 0) (memq (nth 1 a) '(0 2))) -1)
		 (t 2))))
	((and (eq (car-safe b) 'intv)
	      (or (Math-anglep a) (eq (car-safe a) 'date)))
	 (let ((res (math-compare a (nth 2 b))))
	   (cond ((eq res -1) -1)
		 ((and (eq res 0) (memq (nth 1 b) '(0 1))) -1)
		 ((eq (setq res (math-compare a (nth 3 b))) 1) 1)
		 ((and (eq res 0) (memq (nth 1 b) '(0 2))) 1)
		 (t 2))))
	((and (eq (car-safe a) 'intv) (eq (car-safe b) 'intv))
	 (let ((res (math-compare (nth 3 a) (nth 2 b))))
	   (cond ((eq res -1) -1)
		 ((and (eq res 0) (or (memq (nth 1 a) '(0 2))
				      (memq (nth 1 b) '(0 1)))) -1)
		 ((eq (setq res (math-compare (nth 2 a) (nth 3 b))) 1) 1)
		 ((and (eq res 0) (or (memq (nth 1 a) '(0 1))
				      (memq (nth 1 b) '(0 2)))) 1)
		 (t 2))))
	((math-infinitep a)
	 (if (or (equal a '(var uinf var-uinf))
		 (equal a '(var nan var-nan)))
	     2
	   (let ((dira (math-infinite-dir a)))
	     (if (math-infinitep b)
		 (if (or (equal b '(var uinf var-uinf))
			 (equal b '(var nan var-nan)))
		     2
		   (let ((dirb (math-infinite-dir b)))
		     (cond ((and (eq dira 1) (eq dirb -1)) 1)
			   ((and (eq dira -1) (eq dirb 1)) -1)
			   (t 2))))
	       (cond ((eq dira 1) 1)
		     ((eq dira -1) -1)
		     (t 2))))))
	((math-infinitep b)
	 (if (or (equal b '(var uinf var-uinf))
		 (equal b '(var nan var-nan)))
	     2
	   (let ((dirb (math-infinite-dir b)))
	     (cond ((eq dirb 1) -1)
		   ((eq dirb -1) 1)
		   (t 2)))))
	((and (eq (car-safe a) 'calcFunc-exp)
	      (eq (car-safe b) '^)
	      (equal (nth 1 b) '(var e var-e)))
	 (math-compare (nth 1 a) (nth 2 b)))
	((and (eq (car-safe b) 'calcFunc-exp)
	      (eq (car-safe a) '^)
	      (equal (nth 1 a) '(var e var-e)))
	 (math-compare (nth 2 a) (nth 1 b)))
	((or (and (eq (car-safe a) 'calcFunc-sqrt)
		  (eq (car-safe b) '^)
		  (or (equal (nth 2 b) '(frac 1 2))
		      (equal (nth 2 b) '(float 5 -1))))
	     (and (eq (car-safe b) 'calcFunc-sqrt)
		  (eq (car-safe a) '^)
		  (or (equal (nth 2 a) '(frac 1 2))
		      (equal (nth 2 a) '(float 5 -1)))))
	 (math-compare (nth 1 a) (nth 1 b)))
	((eq (car-safe a) 'var)
	 2)
	(t
	 (if (and (consp a) (consp b)
		  (eq (car a) (car b))
		  (math-compare-lists (cdr a) (cdr b)))
	     0
	   2))))