Function: math-mul-symb-fancy

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

Signature

(math-mul-symb-fancy A B)

Source Code

;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
(defun math-mul-symb-fancy (a b)
  (or (and math-simplify-only
	   (not (equal a math-simplify-only))
	   (list '* a b))
      (and (Math-equal-int a 1)
	   b)
      (and (Math-equal-int a -1)
	   (math-neg b))
      (and (or (and (Math-vectorp a) (math-known-scalarp b))
	       (and (Math-vectorp b) (math-known-scalarp a)))
	   (math-map-vec-2 'math-mul a b))
      (and (Math-objectp b) (not (Math-objectp a))
	   (math-mul b a))
      (and (eq (car-safe a) 'neg)
	   (math-neg (math-mul (nth 1 a) b)))
      (and (eq (car-safe b) 'neg)
	   (math-neg (math-mul a (nth 1 b))))
      (and (eq (car-safe a) '*)
	   (math-mul (nth 1 a)
		     (math-mul (nth 2 a) b)))
      (and (eq (car-safe a) '^)
	   (Math-looks-negp (nth 2 a))
	   (not (and (eq (car-safe b) '^) (Math-looks-negp (nth 2 b))))
	   (math-known-scalarp b t)
	   (math-div b (math-normalize
			(list '^ (nth 1 a) (math-neg (nth 2 a))))))
      (and (eq (car-safe b) '^)
	   (Math-looks-negp (nth 2 b))
	   (not (and (eq (car-safe a) '^) (Math-looks-negp (nth 2 a))))
           (not (math-known-matrixp (nth 1 b)))
	   (math-div a (math-normalize
			(list '^ (nth 1 b) (math-neg (nth 2 b))))))
      (and (eq (car-safe a) '/)
	   (or (math-known-scalarp a t) (math-known-scalarp b t))
	   (let ((temp (math-combine-prod (nth 2 a) b t nil t)))
	     (if temp
		 (math-mul (nth 1 a) temp)
	       (math-div (math-mul (nth 1 a) b) (nth 2 a)))))
      (and (eq (car-safe b) '/)
	   (math-div (math-mul a (nth 1 b)) (nth 2 b)))
      (and (eq (car-safe b) '+)
	   (Math-numberp a)
	   (or (Math-numberp (nth 1 b))
	       (Math-numberp (nth 2 b)))
	   (math-add (math-mul a (nth 1 b))
		     (math-mul a (nth 2 b))))
      (and (eq (car-safe b) '-)
	   (Math-numberp a)
	   (or (Math-numberp (nth 1 b))
	       (Math-numberp (nth 2 b)))
	   (math-sub (math-mul a (nth 1 b))
		     (math-mul a (nth 2 b))))
      (and (eq (car-safe b) '*)
	   (Math-numberp (nth 1 b))
	   (not (Math-numberp a))
	   (math-mul (nth 1 b) (math-mul a (nth 2 b))))
      (and (eq (car-safe a) 'calcFunc-idn)
	   (= (length a) 2)
	   (or (and (eq (car-safe b) 'calcFunc-idn)
		    (= (length b) 2)
		    (list 'calcFunc-idn (math-mul (nth 1 a) (nth 1 b))))
	       (and (math-known-scalarp b)
		    (list 'calcFunc-idn (math-mul (nth 1 a) b)))
	       (and (math-known-matrixp b)
		    (math-mul (nth 1 a) b))))
      (and (eq (car-safe b) 'calcFunc-idn)
	   (= (length b) 2)
	   (or (and (math-known-scalarp a)
		    (list 'calcFunc-idn (math-mul a (nth 1 b))))
	       (and (math-known-matrixp a)
		    (math-mul a (nth 1 b)))))
      (and (math-identity-matrix-p a t)
           (or (and (eq (car-safe b) 'calcFunc-idn)
                    (= (length b) 2)
                    (list 'calcFunc-idn (math-mul
                                         (nth 1 (nth 1 a))
                                         (nth 1 b))
                          (1- (length a))))
               (and (math-known-scalarp b)
                    (list 'calcFunc-idn (math-mul
                                         (nth 1 (nth 1 a)) b)
                          (1- (length a))))
               (and (math-known-matrixp b)
                    (math-mul (nth 1 (nth 1 a)) b))))
      (and (math-identity-matrix-p b t)
           (or (and (eq (car-safe a) 'calcFunc-idn)
                    (= (length a) 2)
                    (list 'calcFunc-idn (math-mul (nth 1 a)
                                                  (nth 1 (nth 1 b)))
                          (1- (length b))))
               (and (math-known-scalarp a)
                    (list 'calcFunc-idn (math-mul a (nth 1 (nth 1 b)))
                          (1- (length b))))
               (and (math-known-matrixp a)
                    (math-mul a (nth 1 (nth 1 b))))))
      (and (math-looks-negp b)
	   (math-mul (math-neg a) (math-neg b)))
      (and (eq (car-safe b) '-)
	   (math-looks-negp a)
	   (math-mul (math-neg a) (math-neg b)))
      (cond
       ((eq (car-safe b) '*)
	(let ((temp (math-combine-prod a (nth 1 b) nil nil t)))
	  (and temp
	       (math-mul temp (nth 2 b)))))
       (t
	(math-combine-prod a b nil nil nil)))
      (and (equal a '(var nan var-nan))
	   a)
      (and (equal b '(var nan var-nan))
	   b)
      (and (equal a '(var uinf var-uinf))
	   a)
      (and (equal b '(var uinf var-uinf))
	   b)
      (and (equal b '(var inf var-inf))
	   (let ((s1 (math-possible-signs a)))
	     (cond ((eq s1 4)
		    b)
		   ((eq s1 6)
		    '(intv 3 0 (var inf var-inf)))
		   ((eq s1 1)
		    (math-neg b))
		   ((eq s1 3)
		    '(intv 3 (neg (var inf var-inf)) 0))
		   ((and (eq (car a) 'intv) (math-intv-constp a))
		    '(intv 3 (neg (var inf var-inf)) (var inf var-inf)))
		   ((and (eq (car a) 'cplx)
			 (math-zerop (nth 1 a)))
		    (list '* (list 'cplx 0 (calcFunc-sign (nth 2 a))) b))
		   ((eq (car a) 'polar)
		    (list '* (list 'polar 1 (nth 2 a)) b)))))
      (and (equal a '(var inf var-inf))
	   (math-mul b a))
      (list '* a b)))