Function: math-pow-fancy
math-pow-fancy is an autoloaded and byte-compiled function defined in
calc-arith.el.gz.
Signature
(math-pow-fancy A B)
Source Code
;; Defined in /usr/src/emacs/lisp/calc/calc-arith.el.gz
(defun math-pow-fancy (a b)
(cond ((and (Math-numberp a) (Math-numberp b))
(or (if (memq (math-quarter-integer b) '(1 2 3))
(let ((sqrt (math-sqrt (if (math-floatp b)
(math-float a) a))))
(and (Math-numberp sqrt)
(math-pow sqrt (math-mul 2 b))))
(and (eq (car b) 'frac)
(integerp (nth 2 b))
(<= (nth 2 b) 10)
(let ((root (math-nth-root a (nth 2 b))))
(and root (math-ipow root (nth 1 b))))))
(and (or (eq a 10) (equal a '(float 1 1)))
(math-num-integerp b)
(calcFunc-scf '(float 1 0) b))
(and calc-symbolic-mode
(list '^ a b))
(math-with-extra-prec 2
(math-exp-raw
(math-float (math-mul b (math-ln-raw (math-float a))))))))
((or (not (Math-objvecp a))
(not (Math-objectp b)))
(let (temp)
(cond ((and math-simplify-only
(not (equal a math-simplify-only)))
(list '^ a b))
((and (eq (car-safe a) '*)
(or
(and
(math-known-matrixp (nth 1 a))
(math-known-matrixp (nth 2 a)))
(and
calc-matrix-mode
(not (eq calc-matrix-mode 'scalar))
(and (not (math-known-scalarp (nth 1 a)))
(not (math-known-scalarp (nth 2 a)))))))
(if (and (= b -1)
(math-known-square-matrixp (nth 1 a))
(math-known-square-matrixp (nth 2 a)))
(math-mul (math-pow-fancy (nth 2 a) -1)
(math-pow-fancy (nth 1 a) -1))
(list '^ a b)))
((and (eq (car-safe a) '*)
(or (math-known-num-integerp b)
(math-known-nonnegp (nth 1 a))
(math-known-nonnegp (nth 2 a))))
(math-mul (math-pow (nth 1 a) b)
(math-pow (nth 2 a) b)))
((and (eq (car-safe a) '/)
(or (math-known-num-integerp b)
(math-known-nonnegp (nth 2 a))))
(math-div (math-pow (nth 1 a) b)
(math-pow (nth 2 a) b)))
((and (eq (car-safe a) '/)
(math-known-nonnegp (nth 1 a))
(not (math-equal-int (nth 1 a) 1)))
(math-mul (math-pow (nth 1 a) b)
(math-pow (math-div 1 (nth 2 a)) b)))
((and (eq (car-safe a) '^)
(or (math-known-num-integerp b)
(math-known-nonnegp (nth 1 a))))
(math-pow (nth 1 a) (math-mul (nth 2 a) b)))
((and (eq (car-safe a) 'calcFunc-sqrt)
(or (math-known-num-integerp b)
(math-known-nonnegp (nth 1 a))))
(math-pow (nth 1 a) (math-div b 2)))
((and (eq (car-safe a) '^)
(math-known-evenp (nth 2 a))
(memq (math-quarter-integer b) '(1 2 3))
(math-known-realp (nth 1 a)))
(math-abs (math-pow (nth 1 a) (math-mul (nth 2 a) b))))
((and (math-looks-negp a)
(math-known-integerp b)
(setq temp (or (and (math-known-evenp b)
(math-pow (math-neg a) b))
(and (math-known-oddp b)
(math-neg (math-pow (math-neg a)
b))))))
temp)
((and (eq (car-safe a) 'calcFunc-abs)
(math-known-realp (nth 1 a))
(math-known-evenp b))
(math-pow (nth 1 a) b))
((math-infinitep a)
(cond ((equal a '(var nan var-nan))
a)
((eq (car a) 'neg)
(math-mul (math-pow -1 b) (math-pow (nth 1 a) b)))
((math-posp b)
a)
((math-negp b)
(if (math-floatp b) '(float 0 0) 0))
((and (eq (car-safe b) 'intv)
(math-intv-constp b))
'(intv 3 0 (var inf var-inf)))
(t
'(var nan var-nan))))
((math-infinitep b)
(let (scale)
(cond ((math-negp b)
(math-pow (math-div 1 a) (math-neg b)))
((not (math-posp b))
'(var nan var-nan))
((math-equal-int (setq scale (calcFunc-abssqr a)) 1)
'(var nan var-nan))
((Math-lessp scale 1)
(if (math-floatp a) '(float 0 0) 0))
((Math-lessp 1 a)
b)
((Math-lessp a -1)
'(var uinf var-uinf))
((and (eq (car a) 'intv)
(math-intv-constp a))
(if (Math-lessp -1 a)
(if (math-equal-int (nth 3 a) 1)
'(intv 3 0 1)
'(intv 3 0 (var inf var-inf)))
'(intv 3 (neg (var inf var-inf))
(var inf var-inf))))
(t (list '^ a b)))))
((and (eq (car-safe a) 'calcFunc-idn)
(= (length a) 2)
(math-known-num-integerp b))
(list 'calcFunc-idn (math-pow (nth 1 a) b)))
(t (if (Math-objectp a)
(calc-record-why 'objectp b)
(calc-record-why 'objectp a))
(list '^ a b)))))
((and (eq (car-safe a) 'sdev) (eq (car-safe b) 'sdev))
(if (and (math-constp a) (math-constp b))
(math-with-extra-prec 2
(let* ((ln (math-ln-raw (math-float (nth 1 a))))
(pow (math-exp-raw
(math-float (math-mul (nth 1 b) ln)))))
(math-make-sdev
pow
(math-mul
pow
(math-hypot (math-mul (nth 2 a)
(math-div (nth 1 b) (nth 1 a)))
(math-mul (nth 2 b) ln))))))
(let ((pow (math-pow (nth 1 a) (nth 1 b))))
(math-make-sdev
pow
(math-mul pow
(math-hypot (math-mul (nth 2 a)
(math-div (nth 1 b) (nth 1 a)))
(math-mul (nth 2 b) (calcFunc-ln
(nth 1 a)))))))))
((and (eq (car-safe a) 'sdev) (Math-numberp b))
(if (math-constp a)
(math-with-extra-prec 2
(let ((pow (math-pow (nth 1 a) (math-sub b 1))))
(math-make-sdev (math-mul pow (nth 1 a))
(math-mul pow (math-mul (nth 2 a) b)))))
(math-make-sdev (math-pow (nth 1 a) b)
(math-mul (math-pow (nth 1 a) (math-add b -1))
(math-mul (nth 2 a) b)))))
((and (eq (car-safe b) 'sdev) (Math-numberp a))
(math-with-extra-prec 2
(let* ((ln (math-ln-raw (math-float a)))
(pow (calcFunc-exp (math-mul (nth 1 b) ln))))
(math-make-sdev pow (math-mul pow (math-mul (nth 2 b) ln))))))
((and (eq (car-safe a) 'intv) (math-intv-constp a)
(Math-realp b)
(or (Math-natnump b)
(Math-posp (nth 2 a))
(and (math-zerop (nth 2 a))
(or (Math-posp b)
(and (Math-integerp b) calc-infinite-mode)))
(Math-negp (nth 3 a))
(and (math-zerop (nth 3 a))
(or (Math-posp b)
(and (Math-integerp b) calc-infinite-mode)))))
(if (math-evenp b)
(setq a (math-abs a)))
(let ((calc-infinite-mode (if (math-zerop (nth 3 a)) -1 1)))
(math-sort-intv (nth 1 a)
(math-pow (nth 2 a) b)
(math-pow (nth 3 a) b))))
((and (eq (car-safe b) 'intv) (math-intv-constp b)
(Math-realp a) (Math-posp a))
(math-sort-intv (nth 1 b)
(math-pow a (nth 2 b))
(math-pow a (nth 3 b))))
((and (eq (car-safe a) 'intv) (math-intv-constp a)
(eq (car-safe b) 'intv) (math-intv-constp b)
(or (and (not (Math-negp (nth 2 a)))
(not (Math-negp (nth 2 b))))
(and (Math-posp (nth 2 a))
(not (Math-posp (nth 3 b))))))
(let ((lo (math-pow a (nth 2 b)))
(hi (math-pow 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))
(math-infinitep (nth 2 lo)))
(memq (nth 1 lo) '(2 3)))
(nth 3 lo) (and (or (memq (nth 1 b) '(2 3))
(math-infinitep (nth 3 lo)))
(memq (nth 1 lo) '(1 3)))
(nth 2 hi) (and (or (memq (nth 1 b) '(1 3))
(math-infinitep (nth 2 hi)))
(memq (nth 1 hi) '(2 3)))
(nth 3 hi) (and (or (memq (nth 1 b) '(1 3))
(math-infinitep (nth 3 hi)))
(memq (nth 1 hi) '(1 3))))))
((and (eq (car-safe a) 'mod) (eq (car-safe b) 'mod)
(equal (nth 2 a) (nth 2 b)))
(math-make-mod (math-pow-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-pow-mod (nth 1 a) b (nth 2 a)) (nth 2 a)))
((and (eq (car-safe b) 'mod) (Math-anglep a))
(math-make-mod (math-pow-mod a (nth 1 b) (nth 2 b)) (nth 2 b)))
((not (Math-numberp a))
(math-reject-arg a 'numberp))
(t
(math-reject-arg b 'numberp))))