Don't quote lambdas in calc/calcalg{2,3}.el
* lisp/calc/calcalg2.el (calcFunc-inv\', calcFunc-sqrt\') (calcFunc-deg\', calcFunc-rad\', calcFunc-ln\') (calcFunc-log10\', calcFunc-lnp1\', calcFunc-log\') (calcFunc-log\'2, calcFunc-exp\', calcFunc-expm1\') (calcFunc-sin\', calcFunc-cos\', calcFunc-tan\', calcFunc-sec\') (calcFunc-csc\', calcFunc-cot\', calcFunc-arcsin\') (calcFunc-arccos\', calcFunc-arctan\', calcFunc-sinh\') (calcFunc-cosh\', calcFunc-tanh\', calcFunc-sech\') (calcFunc-csch\', calcFunc-coth\', calcFunc-arcsinh\') (calcFunc-arccosh\', calcFunc-arctanh\', calcFunc-bern\'2) (calcFunc-euler\'2, calcFunc-gammag\'2, calcFunc-gammaG\'2) (calcFunc-gammaP\'2, calcFunc-gammaQ\'2, calcFunc-betaB\') (calcFunc-betaI\', calcFunc-erf\', calcFunc-erfc\') (calcFunc-besJ\'2, calcFunc-besY\'2, calcFunc-sum) (calcFunc-prod, calcFunc-integ, calcFunc-if, calcFunc-subscr) (math-do-integral, calcFunc-integ, math-decompose-poly) (math-solve-system-rec, math-solve-system-subst, math-solve-for) (calcFunc-inv, calcFunc-sqrt, calcFunc-conj, calcFunc-abs) (calcFunc-deg, calcFunc-rad, calcFunc-ln, calcFunc-log10) (calcFunc-lnp1, calcFunc-exp, calcFunc-expm1, calcFunc-sin) (calcFunc-cos, calcFunc-tan, calcFunc-arcsin, calcFunc-arccos) (calcFunc-arctan, calcFunc-sinh, calcFunc-cosh, calcFunc-tanh) (calcFunc-arcsinh, calcFunc-arccosh, calcFunc-arctanh): * lisp/calc/calcalg3.el (calc-get-fit-variables) (calcFunc-polint, calcFunc-ratint, math-all-vars-but): Don't quote lambdas.
This commit is contained in:
Stefan Kangas
parent
238261db95
commit
82d0b88720
2 changed files with 294 additions and 305 deletions
|
|
@ -361,175 +361,175 @@
|
|||
res))))
|
||||
|
||||
(put 'calcFunc-inv\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg (math-div 1 (math-sqr u))))))
|
||||
(lambda (u) (math-neg (math-div 1 (math-sqr u)))))
|
||||
|
||||
(put 'calcFunc-sqrt\' 'math-derivative-1
|
||||
(function (lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u))))))
|
||||
(lambda (u) (math-div 1 (math-mul 2 (list 'calcFunc-sqrt u)))))
|
||||
|
||||
(put 'calcFunc-deg\' 'math-derivative-1
|
||||
(function (lambda (_) (math-div-float '(float 18 1) (math-pi)))))
|
||||
(lambda (_) (math-div-float '(float 18 1) (math-pi))))
|
||||
|
||||
(put 'calcFunc-rad\' 'math-derivative-1
|
||||
(function (lambda (_) (math-pi-over-180))))
|
||||
(lambda (_) (math-pi-over-180)))
|
||||
|
||||
(put 'calcFunc-ln\' 'math-derivative-1
|
||||
(function (lambda (u) (math-div 1 u))))
|
||||
(lambda (u) (math-div 1 u)))
|
||||
|
||||
(put 'calcFunc-log10\' 'math-derivative-1
|
||||
(function (lambda (u)
|
||||
(math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
|
||||
u))))
|
||||
(lambda (u)
|
||||
(math-div (math-div 1 (math-normalize '(calcFunc-ln 10)))
|
||||
u)))
|
||||
|
||||
(put 'calcFunc-lnp1\' 'math-derivative-1
|
||||
(function (lambda (u) (math-div 1 (math-add u 1)))))
|
||||
(lambda (u) (math-div 1 (math-add u 1))))
|
||||
|
||||
(put 'calcFunc-log\' 'math-derivative-2
|
||||
(function (lambda (x b)
|
||||
(and (not (Math-zerop b))
|
||||
(let ((lnv (math-normalize
|
||||
(list 'calcFunc-ln b))))
|
||||
(math-div 1 (math-mul lnv x)))))))
|
||||
(lambda (x b)
|
||||
(and (not (Math-zerop b))
|
||||
(let ((lnv (math-normalize
|
||||
(list 'calcFunc-ln b))))
|
||||
(math-div 1 (math-mul lnv x))))))
|
||||
|
||||
(put 'calcFunc-log\'2 'math-derivative-2
|
||||
(function (lambda (x b)
|
||||
(let ((lnv (list 'calcFunc-ln b)))
|
||||
(math-neg (math-div (list 'calcFunc-log x b)
|
||||
(math-mul lnv b)))))))
|
||||
(lambda (x b)
|
||||
(let ((lnv (list 'calcFunc-ln b)))
|
||||
(math-neg (math-div (list 'calcFunc-log x b)
|
||||
(math-mul lnv b))))))
|
||||
|
||||
(put 'calcFunc-exp\' 'math-derivative-1
|
||||
(function (lambda (u) (math-normalize (list 'calcFunc-exp u)))))
|
||||
(lambda (u) (math-normalize (list 'calcFunc-exp u))))
|
||||
|
||||
(put 'calcFunc-expm1\' 'math-derivative-1
|
||||
(function (lambda (u) (math-normalize (list 'calcFunc-expm1 u)))))
|
||||
(lambda (u) (math-normalize (list 'calcFunc-expm1 u))))
|
||||
|
||||
(put 'calcFunc-sin\' 'math-derivative-1
|
||||
(function (lambda (u) (math-to-radians-2 (math-normalize
|
||||
(list 'calcFunc-cos u)) t))))
|
||||
(lambda (u) (math-to-radians-2 (math-normalize
|
||||
(list 'calcFunc-cos u)) t)))
|
||||
|
||||
(put 'calcFunc-cos\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg (math-to-radians-2
|
||||
(math-normalize
|
||||
(list 'calcFunc-sin u)) t)))))
|
||||
(lambda (u) (math-neg (math-to-radians-2
|
||||
(math-normalize
|
||||
(list 'calcFunc-sin u)) t))))
|
||||
|
||||
(put 'calcFunc-tan\' 'math-derivative-1
|
||||
(function (lambda (u) (math-to-radians-2
|
||||
(math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-sec u))) t))))
|
||||
(lambda (u) (math-to-radians-2
|
||||
(math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-sec u))) t)))
|
||||
|
||||
(put 'calcFunc-sec\' 'math-derivative-1
|
||||
(function (lambda (u) (math-to-radians-2
|
||||
(math-mul
|
||||
(math-normalize
|
||||
(list 'calcFunc-sec u))
|
||||
(math-normalize
|
||||
(list 'calcFunc-tan u))) t))))
|
||||
(lambda (u) (math-to-radians-2
|
||||
(math-mul
|
||||
(math-normalize
|
||||
(list 'calcFunc-sec u))
|
||||
(math-normalize
|
||||
(list 'calcFunc-tan u))) t)))
|
||||
|
||||
(put 'calcFunc-csc\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg
|
||||
(math-to-radians-2
|
||||
(math-mul
|
||||
(math-normalize
|
||||
(list 'calcFunc-csc u))
|
||||
(math-normalize
|
||||
(list 'calcFunc-cot u))) t)))))
|
||||
(lambda (u) (math-neg
|
||||
(math-to-radians-2
|
||||
(math-mul
|
||||
(math-normalize
|
||||
(list 'calcFunc-csc u))
|
||||
(math-normalize
|
||||
(list 'calcFunc-cot u))) t))))
|
||||
|
||||
(put 'calcFunc-cot\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg
|
||||
(math-to-radians-2
|
||||
(math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-csc u))) t)))))
|
||||
(lambda (u) (math-neg
|
||||
(math-to-radians-2
|
||||
(math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-csc u))) t))))
|
||||
|
||||
(put 'calcFunc-arcsin\' 'math-derivative-1
|
||||
(function (lambda (u)
|
||||
(math-from-radians-2
|
||||
(math-div 1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-sub 1 (math-sqr u))))) t))))
|
||||
(lambda (u)
|
||||
(math-from-radians-2
|
||||
(math-div 1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-sub 1 (math-sqr u))))) t)))
|
||||
|
||||
(put 'calcFunc-arccos\' 'math-derivative-1
|
||||
(function (lambda (u)
|
||||
(math-from-radians-2
|
||||
(math-div -1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-sub 1 (math-sqr u))))) t))))
|
||||
(lambda (u)
|
||||
(math-from-radians-2
|
||||
(math-div -1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-sub 1 (math-sqr u))))) t)))
|
||||
|
||||
(put 'calcFunc-arctan\' 'math-derivative-1
|
||||
(function (lambda (u) (math-from-radians-2
|
||||
(math-div 1 (math-add 1 (math-sqr u))) t))))
|
||||
(lambda (u) (math-from-radians-2
|
||||
(math-div 1 (math-add 1 (math-sqr u))) t)))
|
||||
|
||||
(put 'calcFunc-sinh\' 'math-derivative-1
|
||||
(function (lambda (u) (math-normalize (list 'calcFunc-cosh u)))))
|
||||
(lambda (u) (math-normalize (list 'calcFunc-cosh u))))
|
||||
|
||||
(put 'calcFunc-cosh\' 'math-derivative-1
|
||||
(function (lambda (u) (math-normalize (list 'calcFunc-sinh u)))))
|
||||
(lambda (u) (math-normalize (list 'calcFunc-sinh u))))
|
||||
|
||||
(put 'calcFunc-tanh\' 'math-derivative-1
|
||||
(function (lambda (u) (math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-sech u))))))
|
||||
(lambda (u) (math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-sech u)))))
|
||||
|
||||
(put 'calcFunc-sech\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg
|
||||
(math-mul
|
||||
(math-normalize (list 'calcFunc-sech u))
|
||||
(math-normalize (list 'calcFunc-tanh u)))))))
|
||||
(lambda (u) (math-neg
|
||||
(math-mul
|
||||
(math-normalize (list 'calcFunc-sech u))
|
||||
(math-normalize (list 'calcFunc-tanh u))))))
|
||||
|
||||
(put 'calcFunc-csch\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg
|
||||
(math-mul
|
||||
(math-normalize (list 'calcFunc-csch u))
|
||||
(math-normalize (list 'calcFunc-coth u)))))))
|
||||
(lambda (u) (math-neg
|
||||
(math-mul
|
||||
(math-normalize (list 'calcFunc-csch u))
|
||||
(math-normalize (list 'calcFunc-coth u))))))
|
||||
|
||||
(put 'calcFunc-coth\' 'math-derivative-1
|
||||
(function (lambda (u) (math-neg
|
||||
(math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-csch u)))))))
|
||||
(lambda (u) (math-neg
|
||||
(math-sqr
|
||||
(math-normalize
|
||||
(list 'calcFunc-csch u))))))
|
||||
|
||||
(put 'calcFunc-arcsinh\' 'math-derivative-1
|
||||
(function (lambda (u)
|
||||
(math-div 1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-add (math-sqr u) 1)))))))
|
||||
(lambda (u)
|
||||
(math-div 1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-add (math-sqr u) 1))))))
|
||||
|
||||
(put 'calcFunc-arccosh\' 'math-derivative-1
|
||||
(function (lambda (u)
|
||||
(math-div 1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-add (math-sqr u) -1)))))))
|
||||
(lambda (u)
|
||||
(math-div 1 (math-normalize
|
||||
(list 'calcFunc-sqrt
|
||||
(math-add (math-sqr u) -1))))))
|
||||
|
||||
(put 'calcFunc-arctanh\' 'math-derivative-1
|
||||
(function (lambda (u) (math-div 1 (math-sub 1 (math-sqr u))))))
|
||||
(lambda (u) (math-div 1 (math-sub 1 (math-sqr u)))))
|
||||
|
||||
(put 'calcFunc-bern\'2 'math-derivative-2
|
||||
(function (lambda (n x)
|
||||
(math-mul n (list 'calcFunc-bern (math-add n -1) x)))))
|
||||
(lambda (n x)
|
||||
(math-mul n (list 'calcFunc-bern (math-add n -1) x))))
|
||||
|
||||
(put 'calcFunc-euler\'2 'math-derivative-2
|
||||
(function (lambda (n x)
|
||||
(math-mul n (list 'calcFunc-euler (math-add n -1) x)))))
|
||||
(lambda (n x)
|
||||
(math-mul n (list 'calcFunc-euler (math-add n -1) x))))
|
||||
|
||||
(put 'calcFunc-gammag\'2 'math-derivative-2
|
||||
(function (lambda (a x) (math-deriv-gamma a x 1))))
|
||||
(lambda (a x) (math-deriv-gamma a x 1)))
|
||||
|
||||
(put 'calcFunc-gammaG\'2 'math-derivative-2
|
||||
(function (lambda (a x) (math-deriv-gamma a x -1))))
|
||||
(lambda (a x) (math-deriv-gamma a x -1)))
|
||||
|
||||
(put 'calcFunc-gammaP\'2 'math-derivative-2
|
||||
(function (lambda (a x) (math-deriv-gamma a x
|
||||
(math-div
|
||||
1 (math-normalize
|
||||
(list 'calcFunc-gamma
|
||||
a)))))))
|
||||
(lambda (a x) (math-deriv-gamma a x
|
||||
(math-div
|
||||
1 (math-normalize
|
||||
(list 'calcFunc-gamma
|
||||
a))))))
|
||||
|
||||
(put 'calcFunc-gammaQ\'2 'math-derivative-2
|
||||
(function (lambda (a x) (math-deriv-gamma a x
|
||||
(math-div
|
||||
-1 (math-normalize
|
||||
(list 'calcFunc-gamma
|
||||
a)))))))
|
||||
(lambda (a x) (math-deriv-gamma a x
|
||||
(math-div
|
||||
-1 (math-normalize
|
||||
(list 'calcFunc-gamma
|
||||
a))))))
|
||||
|
||||
(defun math-deriv-gamma (a x scale)
|
||||
(math-mul scale
|
||||
|
|
@ -537,13 +537,13 @@
|
|||
(list 'calcFunc-exp (math-neg x)))))
|
||||
|
||||
(put 'calcFunc-betaB\' 'math-derivative-3
|
||||
(function (lambda (x a b) (math-deriv-beta x a b 1))))
|
||||
(lambda (x a b) (math-deriv-beta x a b 1)))
|
||||
|
||||
(put 'calcFunc-betaI\' 'math-derivative-3
|
||||
(function (lambda (x a b) (math-deriv-beta x a b
|
||||
(math-div
|
||||
1 (list 'calcFunc-beta
|
||||
a b))))))
|
||||
(lambda (x a b) (math-deriv-beta x a b
|
||||
(math-div
|
||||
1 (list 'calcFunc-beta
|
||||
a b)))))
|
||||
|
||||
(defun math-deriv-beta (x a b scale)
|
||||
(math-mul (math-mul (math-pow x (math-add a -1))
|
||||
|
|
@ -551,101 +551,96 @@
|
|||
scale))
|
||||
|
||||
(put 'calcFunc-erf\' 'math-derivative-1
|
||||
(function (lambda (x) (math-div 2
|
||||
(math-mul (list 'calcFunc-exp
|
||||
(math-sqr x))
|
||||
(if calc-symbolic-mode
|
||||
'(calcFunc-sqrt
|
||||
(var pi var-pi))
|
||||
(math-sqrt-pi)))))))
|
||||
(lambda (x) (math-div 2
|
||||
(math-mul (list 'calcFunc-exp
|
||||
(math-sqr x))
|
||||
(if calc-symbolic-mode
|
||||
'(calcFunc-sqrt
|
||||
(var pi var-pi))
|
||||
(math-sqrt-pi))))))
|
||||
|
||||
(put 'calcFunc-erfc\' 'math-derivative-1
|
||||
(function (lambda (x) (math-div -2
|
||||
(math-mul (list 'calcFunc-exp
|
||||
(math-sqr x))
|
||||
(if calc-symbolic-mode
|
||||
'(calcFunc-sqrt
|
||||
(var pi var-pi))
|
||||
(math-sqrt-pi)))))))
|
||||
(lambda (x) (math-div -2
|
||||
(math-mul (list 'calcFunc-exp
|
||||
(math-sqr x))
|
||||
(if calc-symbolic-mode
|
||||
'(calcFunc-sqrt
|
||||
(var pi var-pi))
|
||||
(math-sqrt-pi))))))
|
||||
|
||||
(put 'calcFunc-besJ\'2 'math-derivative-2
|
||||
(function (lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
|
||||
(math-add v -1)
|
||||
z)
|
||||
(list 'calcFunc-besJ
|
||||
(math-add v 1)
|
||||
z))
|
||||
2))))
|
||||
(lambda (v z) (math-div (math-sub (list 'calcFunc-besJ
|
||||
(math-add v -1)
|
||||
z)
|
||||
(list 'calcFunc-besJ
|
||||
(math-add v 1)
|
||||
z))
|
||||
2)))
|
||||
|
||||
(put 'calcFunc-besY\'2 'math-derivative-2
|
||||
(function (lambda (v z) (math-div (math-sub (list 'calcFunc-besY
|
||||
(math-add v -1)
|
||||
z)
|
||||
(list 'calcFunc-besY
|
||||
(math-add v 1)
|
||||
z))
|
||||
2))))
|
||||
(lambda (v z) (math-div (math-sub (list 'calcFunc-besY
|
||||
(math-add v -1)
|
||||
z)
|
||||
(list 'calcFunc-besY
|
||||
(math-add v 1)
|
||||
z))
|
||||
2)))
|
||||
|
||||
(put 'calcFunc-sum 'math-derivative-n
|
||||
(function
|
||||
(lambda (expr)
|
||||
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
|
||||
(throw 'math-deriv nil)
|
||||
(cons 'calcFunc-sum
|
||||
(cons (math-derivative (nth 1 expr))
|
||||
(cdr (cdr expr))))))))
|
||||
(lambda (expr)
|
||||
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
|
||||
(throw 'math-deriv nil)
|
||||
(cons 'calcFunc-sum
|
||||
(cons (math-derivative (nth 1 expr))
|
||||
(cdr (cdr expr)))))))
|
||||
|
||||
(put 'calcFunc-prod 'math-derivative-n
|
||||
(function
|
||||
(lambda (expr)
|
||||
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
|
||||
(throw 'math-deriv nil)
|
||||
(math-mul expr
|
||||
(cons 'calcFunc-sum
|
||||
(cons (math-div (math-derivative (nth 1 expr))
|
||||
(nth 1 expr))
|
||||
(cdr (cdr expr)))))))))
|
||||
(lambda (expr)
|
||||
(if (math-expr-contains (cons 'vec (cdr (cdr expr))) math-deriv-var)
|
||||
(throw 'math-deriv nil)
|
||||
(math-mul expr
|
||||
(cons 'calcFunc-sum
|
||||
(cons (math-div (math-derivative (nth 1 expr))
|
||||
(nth 1 expr))
|
||||
(cdr (cdr expr))))))))
|
||||
|
||||
(put 'calcFunc-integ 'math-derivative-n
|
||||
(function
|
||||
(lambda (expr)
|
||||
(if (= (length expr) 3)
|
||||
(if (equal (nth 2 expr) math-deriv-var)
|
||||
(nth 1 expr)
|
||||
(math-normalize
|
||||
(list 'calcFunc-integ
|
||||
(math-derivative (nth 1 expr))
|
||||
(nth 2 expr))))
|
||||
(if (= (length expr) 5)
|
||||
(let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
|
||||
(nth 3 expr)))
|
||||
(upper (math-expr-subst (nth 1 expr) (nth 2 expr)
|
||||
(nth 4 expr))))
|
||||
(math-add (math-sub (math-mul upper
|
||||
(math-derivative (nth 4 expr)))
|
||||
(math-mul lower
|
||||
(math-derivative (nth 3 expr))))
|
||||
(if (equal (nth 2 expr) math-deriv-var)
|
||||
0
|
||||
(math-normalize
|
||||
(list 'calcFunc-integ
|
||||
(math-derivative (nth 1 expr)) (nth 2 expr)
|
||||
(nth 3 expr) (nth 4 expr)))))))))))
|
||||
(lambda (expr)
|
||||
(if (= (length expr) 3)
|
||||
(if (equal (nth 2 expr) math-deriv-var)
|
||||
(nth 1 expr)
|
||||
(math-normalize
|
||||
(list 'calcFunc-integ
|
||||
(math-derivative (nth 1 expr))
|
||||
(nth 2 expr))))
|
||||
(if (= (length expr) 5)
|
||||
(let ((lower (math-expr-subst (nth 1 expr) (nth 2 expr)
|
||||
(nth 3 expr)))
|
||||
(upper (math-expr-subst (nth 1 expr) (nth 2 expr)
|
||||
(nth 4 expr))))
|
||||
(math-add (math-sub (math-mul upper
|
||||
(math-derivative (nth 4 expr)))
|
||||
(math-mul lower
|
||||
(math-derivative (nth 3 expr))))
|
||||
(if (equal (nth 2 expr) math-deriv-var)
|
||||
0
|
||||
(math-normalize
|
||||
(list 'calcFunc-integ
|
||||
(math-derivative (nth 1 expr)) (nth 2 expr)
|
||||
(nth 3 expr) (nth 4 expr))))))))))
|
||||
|
||||
(put 'calcFunc-if 'math-derivative-n
|
||||
(function
|
||||
(lambda (expr)
|
||||
(and (= (length expr) 4)
|
||||
(list 'calcFunc-if (nth 1 expr)
|
||||
(math-derivative (nth 2 expr))
|
||||
(math-derivative (nth 3 expr)))))))
|
||||
(lambda (expr)
|
||||
(and (= (length expr) 4)
|
||||
(list 'calcFunc-if (nth 1 expr)
|
||||
(math-derivative (nth 2 expr))
|
||||
(math-derivative (nth 3 expr))))))
|
||||
|
||||
(put 'calcFunc-subscr 'math-derivative-n
|
||||
(function
|
||||
(lambda (expr)
|
||||
(and (= (length expr) 3)
|
||||
(list 'calcFunc-subscr (nth 1 expr)
|
||||
(math-derivative (nth 2 expr)))))))
|
||||
(lambda (expr)
|
||||
(and (= (length expr) 3)
|
||||
(list 'calcFunc-subscr (nth 1 expr)
|
||||
(math-derivative (nth 2 expr))))))
|
||||
|
||||
|
||||
(defvar math-integ-var '(var X ---))
|
||||
|
|
@ -1015,11 +1010,10 @@
|
|||
res '(calcFunc-integsubst)))
|
||||
(and (memq (length part) '(3 4 5))
|
||||
(let ((parts (mapcar
|
||||
(function
|
||||
(lambda (x)
|
||||
(math-expr-subst
|
||||
x (nth 2 part)
|
||||
math-integ-var)))
|
||||
(lambda (x)
|
||||
(math-expr-subst
|
||||
x (nth 2 part)
|
||||
math-integ-var))
|
||||
(cdr part))))
|
||||
(math-integrate-by-substitution
|
||||
expr (car parts) t
|
||||
|
|
@ -1516,7 +1510,7 @@
|
|||
var low high)
|
||||
(nth 2 (nth 2 expr))))
|
||||
((eq (car-safe expr) 'vec)
|
||||
(cons 'vec (mapcar (function (lambda (x) (calcFunc-integ x var low high)))
|
||||
(cons 'vec (mapcar (lambda (x) (calcFunc-integ x var low high))
|
||||
(cdr expr))))
|
||||
(t
|
||||
(let ((state (list calc-angle-mode
|
||||
|
|
@ -2742,28 +2736,27 @@
|
|||
math-t1 math-t2 math-t3)
|
||||
(setq math-t2 (math-polynomial-base
|
||||
math-solve-lhs
|
||||
(function
|
||||
(lambda (solve-b)
|
||||
(let ((math-solve-b solve-b)
|
||||
(math-poly-neg-powers '(1))
|
||||
(math-poly-mult-powers nil)
|
||||
(math-poly-frac-powers 1)
|
||||
(math-poly-exp-base t))
|
||||
(and (not (equal math-solve-b math-solve-lhs))
|
||||
(or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
|
||||
(setq math-t3 '(1 0) math-t2 1
|
||||
math-t1 (math-is-polynomial math-solve-lhs
|
||||
math-solve-b 50))
|
||||
(if (and (equal math-poly-neg-powers '(1))
|
||||
(memq math-poly-mult-powers '(nil 1))
|
||||
(eq math-poly-frac-powers 1)
|
||||
sub-rhs)
|
||||
(setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
|
||||
(cdr math-t1)))
|
||||
(math-solve-poly-funny-powers sub-rhs))
|
||||
(math-solve-crunch-poly degree)
|
||||
(or (math-expr-contains math-solve-b math-solve-var)
|
||||
(math-expr-contains (car math-t3) math-solve-var))))))))
|
||||
(lambda (solve-b)
|
||||
(let ((math-solve-b solve-b)
|
||||
(math-poly-neg-powers '(1))
|
||||
(math-poly-mult-powers nil)
|
||||
(math-poly-frac-powers 1)
|
||||
(math-poly-exp-base t))
|
||||
(and (not (equal math-solve-b math-solve-lhs))
|
||||
(or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
|
||||
(setq math-t3 '(1 0) math-t2 1
|
||||
math-t1 (math-is-polynomial math-solve-lhs
|
||||
math-solve-b 50))
|
||||
(if (and (equal math-poly-neg-powers '(1))
|
||||
(memq math-poly-mult-powers '(nil 1))
|
||||
(eq math-poly-frac-powers 1)
|
||||
sub-rhs)
|
||||
(setq math-t1 (cons (math-sub (car math-t1) math-solve-rhs)
|
||||
(cdr math-t1)))
|
||||
(math-solve-poly-funny-powers sub-rhs))
|
||||
(math-solve-crunch-poly degree)
|
||||
(or (math-expr-contains math-solve-b math-solve-var)
|
||||
(math-expr-contains (car math-t3) math-solve-var)))))))
|
||||
(if math-t2
|
||||
(list (math-pow math-t2 (car math-t3))
|
||||
(cons 'vec math-t1)
|
||||
|
|
@ -3326,12 +3319,11 @@
|
|||
(delq (car v) (copy-sequence var-list))
|
||||
(let ((math-solve-simplifying nil)
|
||||
(s (mapcar
|
||||
(function
|
||||
(lambda (x)
|
||||
(cons
|
||||
(car x)
|
||||
(math-solve-system-subst
|
||||
(cdr x)))))
|
||||
(lambda (x)
|
||||
(cons
|
||||
(car x)
|
||||
(math-solve-system-subst
|
||||
(cdr x))))
|
||||
solns)))
|
||||
(if elim
|
||||
s
|
||||
|
|
@ -3347,35 +3339,33 @@
|
|||
|
||||
;; Eliminated all variables, so now put solution into the proper format.
|
||||
(setq solns (sort solns
|
||||
(function
|
||||
(lambda (x y)
|
||||
(not (memq (car x) (memq (car y) math-solve-vars)))))))
|
||||
(lambda (x y)
|
||||
(not (memq (car x) (memq (car y) math-solve-vars))))))
|
||||
(if (eq math-solve-full 'all)
|
||||
(math-transpose
|
||||
(math-normalize
|
||||
(cons 'vec
|
||||
(if solns
|
||||
(mapcar (function (lambda (x) (cons 'vec (cdr x)))) solns)
|
||||
(mapcar (function (lambda (x) (cons 'vec x))) eqn-list)))))
|
||||
(mapcar (lambda (x) (cons 'vec (cdr x))) solns)
|
||||
(mapcar (lambda (x) (cons 'vec x)) eqn-list)))))
|
||||
(math-normalize
|
||||
(cons 'vec
|
||||
(if solns
|
||||
(mapcar (function (lambda (x) (cons 'calcFunc-eq x))) solns)
|
||||
(mapcar 'car eqn-list)))))))
|
||||
(mapcar (lambda (x) (cons 'calcFunc-eq x)) solns)
|
||||
(mapcar #'car eqn-list)))))))
|
||||
|
||||
(defun math-solve-system-subst (x) ; uses "res" and "v"
|
||||
(let ((accum nil)
|
||||
(res2 math-solve-system-res))
|
||||
(while x
|
||||
(setq accum (nconc accum
|
||||
(mapcar (function
|
||||
(lambda (r)
|
||||
(if math-solve-simplifying
|
||||
(math-simplify
|
||||
(math-expr-subst
|
||||
(car x) math-solve-system-vv r))
|
||||
(math-expr-subst
|
||||
(car x) math-solve-system-vv r))))
|
||||
(mapcar (lambda (r)
|
||||
(if math-solve-simplifying
|
||||
(math-simplify
|
||||
(math-expr-subst
|
||||
(car x) math-solve-system-vv r))
|
||||
(math-expr-subst
|
||||
(car x) math-solve-system-vv r)))
|
||||
(car res2)))
|
||||
x (cdr x)
|
||||
res2 (cdr res2)))
|
||||
|
|
@ -3471,11 +3461,10 @@
|
|||
(let ((old-len (length res))
|
||||
new-len)
|
||||
(setq res (delq nil
|
||||
(mapcar (function
|
||||
(lambda (x)
|
||||
(and (not (memq (car-safe x)
|
||||
'(cplx polar)))
|
||||
x)))
|
||||
(mapcar (lambda (x)
|
||||
(and (not (memq (car-safe x)
|
||||
'(cplx polar)))
|
||||
x))
|
||||
res))
|
||||
new-len (length res))
|
||||
(if (< new-len old-len)
|
||||
|
|
@ -3545,119 +3534,119 @@
|
|||
|
||||
|
||||
(put 'calcFunc-inv 'math-inverse
|
||||
(function (lambda (x) (math-div 1 x))))
|
||||
(lambda (x) (math-div 1 x)))
|
||||
(put 'calcFunc-inv 'math-inverse-sign -1)
|
||||
|
||||
(put 'calcFunc-sqrt 'math-inverse
|
||||
(function (lambda (x) (math-sqr x))))
|
||||
(lambda (x) (math-sqr x)))
|
||||
|
||||
(put 'calcFunc-conj 'math-inverse
|
||||
(function (lambda (x) (list 'calcFunc-conj x))))
|
||||
(lambda (x) (list 'calcFunc-conj x)))
|
||||
|
||||
(put 'calcFunc-abs 'math-inverse
|
||||
(function (lambda (x) (math-solve-get-sign x))))
|
||||
(lambda (x) (math-solve-get-sign x)))
|
||||
|
||||
(put 'calcFunc-deg 'math-inverse
|
||||
(function (lambda (x) (list 'calcFunc-rad x))))
|
||||
(lambda (x) (list 'calcFunc-rad x)))
|
||||
(put 'calcFunc-deg 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-rad 'math-inverse
|
||||
(function (lambda (x) (list 'calcFunc-deg x))))
|
||||
(lambda (x) (list 'calcFunc-deg x)))
|
||||
(put 'calcFunc-rad 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-ln 'math-inverse
|
||||
(function (lambda (x) (list 'calcFunc-exp x))))
|
||||
(lambda (x) (list 'calcFunc-exp x)))
|
||||
(put 'calcFunc-ln 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-log10 'math-inverse
|
||||
(function (lambda (x) (list 'calcFunc-exp10 x))))
|
||||
(lambda (x) (list 'calcFunc-exp10 x)))
|
||||
(put 'calcFunc-log10 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-lnp1 'math-inverse
|
||||
(function (lambda (x) (list 'calcFunc-expm1 x))))
|
||||
(lambda (x) (list 'calcFunc-expm1 x)))
|
||||
(put 'calcFunc-lnp1 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-exp 'math-inverse
|
||||
(function (lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
|
||||
(math-mul 2
|
||||
(math-mul '(var pi var-pi)
|
||||
(math-solve-get-int
|
||||
'(var i var-i))))))))
|
||||
(lambda (x) (math-add (math-normalize (list 'calcFunc-ln x))
|
||||
(math-mul 2
|
||||
(math-mul '(var pi var-pi)
|
||||
(math-solve-get-int
|
||||
'(var i var-i)))))))
|
||||
(put 'calcFunc-exp 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-expm1 'math-inverse
|
||||
(function (lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
|
||||
(math-mul 2
|
||||
(math-mul '(var pi var-pi)
|
||||
(math-solve-get-int
|
||||
'(var i var-i))))))))
|
||||
(lambda (x) (math-add (math-normalize (list 'calcFunc-lnp1 x))
|
||||
(math-mul 2
|
||||
(math-mul '(var pi var-pi)
|
||||
(math-solve-get-int
|
||||
'(var i var-i)))))))
|
||||
(put 'calcFunc-expm1 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-sin 'math-inverse
|
||||
(function (lambda (x) (let ((n (math-solve-get-int 1)))
|
||||
(math-add (math-mul (math-normalize
|
||||
(list 'calcFunc-arcsin x))
|
||||
(math-pow -1 n))
|
||||
(math-mul (math-half-circle t)
|
||||
n))))))
|
||||
(lambda (x) (let ((n (math-solve-get-int 1)))
|
||||
(math-add (math-mul (math-normalize
|
||||
(list 'calcFunc-arcsin x))
|
||||
(math-pow -1 n))
|
||||
(math-mul (math-half-circle t)
|
||||
n)))))
|
||||
|
||||
(put 'calcFunc-cos 'math-inverse
|
||||
(function (lambda (x) (math-add (math-solve-get-sign
|
||||
(math-normalize
|
||||
(list 'calcFunc-arccos x)))
|
||||
(math-solve-get-int
|
||||
(math-full-circle t))))))
|
||||
(lambda (x) (math-add (math-solve-get-sign
|
||||
(math-normalize
|
||||
(list 'calcFunc-arccos x)))
|
||||
(math-solve-get-int
|
||||
(math-full-circle t)))))
|
||||
|
||||
(put 'calcFunc-tan 'math-inverse
|
||||
(function (lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
|
||||
(math-solve-get-int
|
||||
(math-half-circle t))))))
|
||||
(lambda (x) (math-add (math-normalize (list 'calcFunc-arctan x))
|
||||
(math-solve-get-int
|
||||
(math-half-circle t)))))
|
||||
|
||||
(put 'calcFunc-arcsin 'math-inverse
|
||||
(function (lambda (x) (math-normalize (list 'calcFunc-sin x)))))
|
||||
(lambda (x) (math-normalize (list 'calcFunc-sin x))))
|
||||
|
||||
(put 'calcFunc-arccos 'math-inverse
|
||||
(function (lambda (x) (math-normalize (list 'calcFunc-cos x)))))
|
||||
(lambda (x) (math-normalize (list 'calcFunc-cos x))))
|
||||
|
||||
(put 'calcFunc-arctan 'math-inverse
|
||||
(function (lambda (x) (math-normalize (list 'calcFunc-tan x)))))
|
||||
(lambda (x) (math-normalize (list 'calcFunc-tan x))))
|
||||
|
||||
(put 'calcFunc-sinh 'math-inverse
|
||||
(function (lambda (x) (let ((n (math-solve-get-int 1)))
|
||||
(math-add (math-mul (math-normalize
|
||||
(list 'calcFunc-arcsinh x))
|
||||
(math-pow -1 n))
|
||||
(math-mul (math-half-circle t)
|
||||
(math-mul
|
||||
'(var i var-i)
|
||||
n)))))))
|
||||
(lambda (x) (let ((n (math-solve-get-int 1)))
|
||||
(math-add (math-mul (math-normalize
|
||||
(list 'calcFunc-arcsinh x))
|
||||
(math-pow -1 n))
|
||||
(math-mul (math-half-circle t)
|
||||
(math-mul
|
||||
'(var i var-i)
|
||||
n))))))
|
||||
(put 'calcFunc-sinh 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-cosh 'math-inverse
|
||||
(function (lambda (x) (math-add (math-solve-get-sign
|
||||
(math-normalize
|
||||
(list 'calcFunc-arccosh x)))
|
||||
(math-mul (math-full-circle t)
|
||||
(math-solve-get-int
|
||||
'(var i var-i)))))))
|
||||
(lambda (x) (math-add (math-solve-get-sign
|
||||
(math-normalize
|
||||
(list 'calcFunc-arccosh x)))
|
||||
(math-mul (math-full-circle t)
|
||||
(math-solve-get-int
|
||||
'(var i var-i))))))
|
||||
|
||||
(put 'calcFunc-tanh 'math-inverse
|
||||
(function (lambda (x) (math-add (math-normalize
|
||||
(list 'calcFunc-arctanh x))
|
||||
(math-mul (math-half-circle t)
|
||||
(math-solve-get-int
|
||||
'(var i var-i)))))))
|
||||
(lambda (x) (math-add (math-normalize
|
||||
(list 'calcFunc-arctanh x))
|
||||
(math-mul (math-half-circle t)
|
||||
(math-solve-get-int
|
||||
'(var i var-i))))))
|
||||
(put 'calcFunc-tanh 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-arcsinh 'math-inverse
|
||||
(function (lambda (x) (math-normalize (list 'calcFunc-sinh x)))))
|
||||
(lambda (x) (math-normalize (list 'calcFunc-sinh x))))
|
||||
(put 'calcFunc-arcsinh 'math-inverse-sign 1)
|
||||
|
||||
(put 'calcFunc-arccosh 'math-inverse
|
||||
(function (lambda (x) (math-normalize (list 'calcFunc-cosh x)))))
|
||||
(lambda (x) (math-normalize (list 'calcFunc-cosh x))))
|
||||
|
||||
(put 'calcFunc-arctanh 'math-inverse
|
||||
(function (lambda (x) (math-normalize (list 'calcFunc-tanh x)))))
|
||||
(lambda (x) (math-normalize (list 'calcFunc-tanh x))))
|
||||
(put 'calcFunc-arctanh 'math-inverse-sign 1)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -480,13 +480,13 @@
|
|||
"Fitting variables"
|
||||
(format "%s; %s"
|
||||
(mapconcat 'symbol-name
|
||||
(mapcar (function (lambda (v)
|
||||
(nth 1 v)))
|
||||
(mapcar (lambda (v)
|
||||
(nth 1 v))
|
||||
defv)
|
||||
",")
|
||||
(mapconcat 'symbol-name
|
||||
(mapcar (function (lambda (v)
|
||||
(nth 1 v)))
|
||||
(mapcar (lambda (v)
|
||||
(nth 1 v))
|
||||
defc)
|
||||
",")))))
|
||||
(coefs nil))
|
||||
|
|
@ -1336,7 +1336,7 @@
|
|||
(or (> (length (nth 1 data)) 2)
|
||||
(math-reject-arg data "*Too few data points"))
|
||||
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
|
||||
(cons 'vec (mapcar (function (lambda (x) (calcFunc-polint data x)))
|
||||
(cons 'vec (mapcar (lambda (x) (calcFunc-polint data x))
|
||||
(cdr x)))
|
||||
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
|
||||
(math-with-extra-prec 2
|
||||
|
|
@ -1352,7 +1352,7 @@
|
|||
(or (> (length (nth 1 data)) 2)
|
||||
(math-reject-arg data "*Too few data points"))
|
||||
(if (and (math-vectorp x) (or (math-constp x) math-expand-formulas))
|
||||
(cons 'vec (mapcar (function (lambda (x) (calcFunc-ratint data x)))
|
||||
(cons 'vec (mapcar (lambda (x) (calcFunc-ratint data x))
|
||||
(cdr x)))
|
||||
(or (math-objectp x) math-expand-formulas (math-reject-arg x 'objectp))
|
||||
(math-with-extra-prec 2
|
||||
|
|
@ -1910,8 +1910,8 @@
|
|||
(while p
|
||||
(setq vars (delq (assoc (car-safe p) vars) vars)
|
||||
p (cdr p)))
|
||||
(sort (mapcar 'car vars)
|
||||
(function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))))
|
||||
(sort (mapcar #'car vars)
|
||||
(lambda (x y) (string< (nth 1 x) (nth 1 y))))))
|
||||
|
||||
;; The variables math-all-vars-vars (the vars for math-all-vars) and
|
||||
;; math-all-vars-found are local to math-all-vars-in, but are used by
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue