diff options
Diffstat (limited to 'lisp/calc')
| -rw-r--r-- | lisp/calc/calc-alg.el | 932 | ||||
| -rw-r--r-- | lisp/calc/calc-bin.el | 6 | ||||
| -rw-r--r-- | lisp/calc/calc-comb.el | 6 | ||||
| -rw-r--r-- | lisp/calc/calc-ext.el | 97 | ||||
| -rw-r--r-- | lisp/calc/calc-forms.el | 25 | ||||
| -rw-r--r-- | lisp/calc/calc-math.el | 2 | ||||
| -rw-r--r-- | lisp/calc/calc-poly.el | 122 | ||||
| -rw-r--r-- | lisp/calc/calc-units.el | 222 | ||||
| -rw-r--r-- | lisp/calc/calc.el | 163 | ||||
| -rw-r--r-- | lisp/calc/calccomp.el | 51 |
10 files changed, 811 insertions, 815 deletions
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el index 7a448d20ec2..2f23399841e 100644 --- a/lisp/calc/calc-alg.el +++ b/lisp/calc/calc-alg.el @@ -1,4 +1,4 @@ -;;; calc-alg.el --- algebraic functions for Calc +;;; calc-alg.el --- algebraic functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -308,7 +308,7 @@ (let ((math-living-dangerously t)) (math-simplify a))) -(defalias 'calcFunc-esimplify 'math-simplify-extended) +(defalias 'calcFunc-esimplify #'math-simplify-extended) ;;; Rewrite the trig functions in a form easier to simplify. (defun math-trig-rewrite (fn) @@ -329,7 +329,7 @@ (list '/ (cons 'calcFunc-cos newfn) (cons 'calcFunc-sin newfn)))) (t - (mapcar 'math-trig-rewrite fn)))) + (mapcar #'math-trig-rewrite fn)))) (defun math-hyperbolic-trig-rewrite (fn) "Rewrite hyperbolic functions in terms of sinhs and coshs." @@ -349,7 +349,7 @@ (list '/ (cons 'calcFunc-cosh newfn) (cons 'calcFunc-sinh newfn)))) (t - (mapcar 'math-hyperbolic-trig-rewrite fn)))) + (mapcar #'math-hyperbolic-trig-rewrite fn)))) ;; math-top-only is local to math-simplify, but is used by ;; math-simplify-step, which is called by math-simplify. @@ -402,11 +402,11 @@ (setq top-expr res))))) top-expr) -(defalias 'calcFunc-simplify 'math-simplify) +(defalias 'calcFunc-simplify #'math-simplify) -;;; The following has a "bug" in that if any recursive simplifications -;;; occur only the first handler will be tried; this doesn't really -;;; matter, since math-simplify-step is iterated to a fixed point anyway. +;; The following has a "bug" in that if any recursive simplifications +;; occur only the first handler will be tried; this doesn't really +;; matter, since math-simplify-step is iterated to a fixed point anyway. (defun math-simplify-step (a) (if (Math-primp a) a @@ -414,7 +414,7 @@ (memq (car a) '(calcFunc-quote calcFunc-condition calcFunc-evalto))) a - (cons (car a) (mapcar 'math-simplify-step (cdr a)))))) + (cons (car a) (mapcar #'math-simplify-step (cdr a)))))) (and (symbolp (car aa)) (let ((handler (get (car aa) 'math-simplify))) (and handler @@ -427,159 +427,155 @@ (defmacro math-defsimplify (funcs &rest code) + "Define the simplification code for functions FUNCS. +Code can refer to the expression to simplify via lexical variable `expr' +and should return the simplified expression to use (or nil)." + (declare (indent 1) (debug (sexp body))) (cons 'progn (mapcar #'(lambda (func) `(put ',func 'math-simplify (nconc (get ',func 'math-simplify) (list - #'(lambda (math-simplify-expr) ,@code))))) + #'(lambda (expr) ,@code))))) (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defsimplify 'lisp-indent-hook 1) - -;; The function created by math-defsimplify uses the variable -;; math-simplify-expr, and so is used by functions in math-defsimplify -(defvar math-simplify-expr) (math-defsimplify (+ -) - (math-simplify-plus)) - -(defun math-simplify-plus () - (cond ((and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) - (Math-numberp (nth 2 (nth 1 math-simplify-expr))) - (not (Math-numberp (nth 2 math-simplify-expr)))) - (let ((x (nth 2 math-simplify-expr)) - (op (car math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) (nth 2 (nth 1 math-simplify-expr))) - (setcar math-simplify-expr (car (nth 1 math-simplify-expr))) - (setcar (cdr (cdr (nth 1 math-simplify-expr))) x) - (setcar (nth 1 math-simplify-expr) op))) - ((and (eq (car math-simplify-expr) '+) - (Math-numberp (nth 1 math-simplify-expr)) - (not (Math-numberp (nth 2 math-simplify-expr)))) - (let ((x (nth 2 math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) - (setcar (cdr math-simplify-expr) x)))) - (let ((aa math-simplify-expr) + (cond ((and (memq (car-safe (nth 1 expr)) '(+ -)) + (Math-numberp (nth 2 (nth 1 expr))) + (not (Math-numberp (nth 2 expr)))) + (let ((x (nth 2 expr)) + (op (car expr))) + (setcar (cdr (cdr expr)) (nth 2 (nth 1 expr))) + (setcar expr (car (nth 1 expr))) + (setcar (cdr (cdr (nth 1 expr))) x) + (setcar (nth 1 expr) op))) + ((and (eq (car expr) '+) + (Math-numberp (nth 1 expr)) + (not (Math-numberp (nth 2 expr)))) + (let ((x (nth 2 expr))) + (setcar (cdr (cdr expr)) (nth 1 expr)) + (setcar (cdr expr) x)))) + (let ((aa expr) aaa temp) (while (memq (car-safe (setq aaa (nth 1 aa))) '(+ -)) - (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 math-simplify-expr) + (if (setq temp (math-combine-sum (nth 2 aaa) (nth 2 expr) (eq (car aaa) '-) - (eq (car math-simplify-expr) '-) t)) + (eq (car expr) '-) t)) (progn - (setcar (cdr (cdr math-simplify-expr)) temp) - (setcar math-simplify-expr '+) + (setcar (cdr (cdr expr)) temp) + (setcar expr '+) (setcar (cdr (cdr aaa)) 0))) (setq aa (nth 1 aa))) - (if (setq temp (math-combine-sum aaa (nth 2 math-simplify-expr) - nil (eq (car math-simplify-expr) '-) t)) + (if (setq temp (math-combine-sum aaa (nth 2 expr) + nil (eq (car expr) '-) t)) (progn - (setcar (cdr (cdr math-simplify-expr)) temp) - (setcar math-simplify-expr '+) + (setcar (cdr (cdr expr)) temp) + (setcar expr '+) (setcar (cdr aa) 0))) - math-simplify-expr)) + expr)) (math-defsimplify * - (math-simplify-times)) - -(defun math-simplify-times () - (if (eq (car-safe (nth 2 math-simplify-expr)) '*) - (and (math-beforep (nth 1 (nth 2 math-simplify-expr)) (nth 1 math-simplify-expr)) - (or (math-known-scalarp (nth 1 math-simplify-expr) t) - (math-known-scalarp (nth 1 (nth 2 math-simplify-expr)) t)) - (let ((x (nth 1 math-simplify-expr))) - (setcar (cdr math-simplify-expr) (nth 1 (nth 2 math-simplify-expr))) - (setcar (cdr (nth 2 math-simplify-expr)) x))) - (and (math-beforep (nth 2 math-simplify-expr) (nth 1 math-simplify-expr)) - (or (math-known-scalarp (nth 1 math-simplify-expr) t) - (math-known-scalarp (nth 2 math-simplify-expr) t)) - (let ((x (nth 2 math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) (nth 1 math-simplify-expr)) - (setcar (cdr math-simplify-expr) x)))) - (let ((aa math-simplify-expr) + (if (eq (car-safe (nth 2 expr)) '*) + (and (math-beforep (nth 1 (nth 2 expr)) (nth 1 expr)) + (or (math-known-scalarp (nth 1 expr) t) + (math-known-scalarp (nth 1 (nth 2 expr)) t)) + (let ((x (nth 1 expr))) + (setcar (cdr expr) (nth 1 (nth 2 expr))) + (setcar (cdr (nth 2 expr)) x))) + (and (math-beforep (nth 2 expr) (nth 1 expr)) + (or (math-known-scalarp (nth 1 expr) t) + (math-known-scalarp (nth 2 expr) t)) + (let ((x (nth 2 expr))) + (setcar (cdr (cdr expr)) (nth 1 expr)) + (setcar (cdr expr) x)))) + (let ((aa expr) aaa temp - (safe t) (scalar (math-known-scalarp (nth 1 math-simplify-expr)))) - (if (and (Math-ratp (nth 1 math-simplify-expr)) - (setq temp (math-common-constant-factor (nth 2 math-simplify-expr)))) + (safe t) (scalar (math-known-scalarp (nth 1 expr)))) + (if (and (Math-ratp (nth 1 expr)) + (setq temp (math-common-constant-factor (nth 2 expr)))) (progn - (setcar (cdr (cdr math-simplify-expr)) - (math-cancel-common-factor (nth 2 math-simplify-expr) temp)) - (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) temp)))) + (setcar (cdr (cdr expr)) + (math-cancel-common-factor (nth 2 expr) temp)) + (setcar (cdr expr) (math-mul (nth 1 expr) temp)))) (while (and (eq (car-safe (setq aaa (nth 2 aa))) '*) safe) - (if (setq temp (math-combine-prod (nth 1 math-simplify-expr) + (if (setq temp (math-combine-prod (nth 1 expr) (nth 1 aaa) nil nil t)) (progn - (setcar (cdr math-simplify-expr) temp) + (setcar (cdr expr) temp) (setcar (cdr aaa) 1))) (setq safe (or scalar (math-known-scalarp (nth 1 aaa) t)) aa (nth 2 aa))) - (if (and (setq temp (math-combine-prod aaa (nth 1 math-simplify-expr) nil nil t)) + (if (and (setq temp (math-combine-prod aaa (nth 1 expr) nil nil t)) safe) (progn - (setcar (cdr math-simplify-expr) temp) + (setcar (cdr expr) temp) (setcar (cdr (cdr aa)) 1))) - (if (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) - (memq (nth 1 (nth 1 math-simplify-expr)) '(1 -1))) - (math-div (math-mul (nth 2 math-simplify-expr) - (nth 1 (nth 1 math-simplify-expr))) - (nth 2 (nth 1 math-simplify-expr))) - math-simplify-expr))) + (if (and (eq (car-safe (nth 1 expr)) 'frac) + (memq (nth 1 (nth 1 expr)) '(1 -1))) + (math-div (math-mul (nth 2 expr) + (nth 1 (nth 1 expr))) + (nth 2 (nth 1 expr))) + expr))) (math-defsimplify / - (math-simplify-divide)) + (math-simplify-divide expr)) -(defun math-simplify-divide () - (let ((np (cdr math-simplify-expr)) +(defvar math--simplify-divide-expr) + +(defun math-simplify-divide (expr) + (let ((np (cdr expr)) (nover nil) - (nn (and (or (eq (car math-simplify-expr) '/) - (not (Math-realp (nth 2 math-simplify-expr)))) - (math-common-constant-factor (nth 2 math-simplify-expr)))) + (nn (and (or (eq (car expr) '/) + (not (Math-realp (nth 2 expr)))) + (math-common-constant-factor (nth 2 expr)))) n op) (if nn (progn - (setq n (and (or (eq (car math-simplify-expr) '/) - (not (Math-realp (nth 1 math-simplify-expr)))) - (math-common-constant-factor (nth 1 math-simplify-expr)))) + (setq n (and (or (eq (car expr) '/) + (not (Math-realp (nth 1 expr)))) + (math-common-constant-factor (nth 1 expr)))) (if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n)) - (unless (and (eq (car-safe math-simplify-expr) 'calcFunc-eq) - (eq (car-safe (nth 1 math-simplify-expr)) 'var) - (not (math-expr-contains (nth 2 math-simplify-expr) - (nth 1 math-simplify-expr)))) - (setcar (cdr math-simplify-expr) - (math-mul (nth 2 nn) (nth 1 math-simplify-expr))) - (setcar (cdr (cdr math-simplify-expr)) - (math-cancel-common-factor (nth 2 math-simplify-expr) nn)) + (unless (and (eq (car-safe expr) 'calcFunc-eq) + (eq (car-safe (nth 1 expr)) 'var) + (not (math-expr-contains (nth 2 expr) + (nth 1 expr)))) + (setcar (cdr expr) + (math-mul (nth 2 nn) (nth 1 expr))) + (setcar (cdr (cdr expr)) + (math-cancel-common-factor (nth 2 expr) nn)) (if (and (math-negp nn) - (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table))) - (setcar math-simplify-expr (nth 1 op)))) + (setq op (assq (car expr) calc-tweak-eqn-table))) + (setcar expr (nth 1 op)))) (if (and n (not (eq (setq n (math-frac-gcd n nn)) 1))) (progn - (setcar (cdr math-simplify-expr) - (math-cancel-common-factor (nth 1 math-simplify-expr) n)) - (setcar (cdr (cdr math-simplify-expr)) - (math-cancel-common-factor (nth 2 math-simplify-expr) n)) + (setcar (cdr expr) + (math-cancel-common-factor (nth 1 expr) n)) + (setcar (cdr (cdr expr)) + (math-cancel-common-factor (nth 2 expr) n)) (if (and (math-negp n) - (setq op (assq (car math-simplify-expr) + (setq op (assq (car expr) calc-tweak-eqn-table))) - (setcar math-simplify-expr (nth 1 op)))))))) - (if (and (eq (car-safe (car np)) '/) - (math-known-scalarp (nth 2 math-simplify-expr) t)) - (progn - (setq np (cdr (nth 1 math-simplify-expr))) - (while (eq (car-safe (setq n (car np))) '*) - (and (math-known-scalarp (nth 2 n) t) - (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nil t)) - (setq np (cdr (cdr n)))) - (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nil t) - (setq nover t - np (cdr (cdr (nth 1 math-simplify-expr)))))) - (while (eq (car-safe (setq n (car np))) '*) - (and (math-known-scalarp (nth 2 n) t) - (math-simplify-divisor (cdr n) (cdr (cdr math-simplify-expr)) nover t)) - (setq np (cdr (cdr n)))) - (math-simplify-divisor np (cdr (cdr math-simplify-expr)) nover t) - math-simplify-expr)) + (setcar expr (nth 1 op)))))))) + (let ((math--simplify-divide-expr expr)) ;For use in math-simplify-divisor + (if (and (eq (car-safe (car np)) '/) + (math-known-scalarp (nth 2 expr) t)) + (progn + (setq np (cdr (nth 1 expr))) + (while (eq (car-safe (setq n (car np))) '*) + (and (math-known-scalarp (nth 2 n) t) + (math-simplify-divisor (cdr n) (cdr (cdr expr)) nil t)) + (setq np (cdr (cdr n)))) + (math-simplify-divisor np (cdr (cdr expr)) nil t) + (setq nover t + np (cdr (cdr (nth 1 expr)))))) + (while (eq (car-safe (setq n (car np))) '*) + (and (math-known-scalarp (nth 2 n) t) + (math-simplify-divisor (cdr n) (cdr (cdr expr)) nover t)) + (setq np (cdr (cdr n)))) + (math-simplify-divisor np (cdr (cdr expr)) nover t) + expr))) ;; The variables math-simplify-divisor-nover and math-simplify-divisor-dover ;; are local variables for math-simplify-divisor, but are used by @@ -587,25 +583,25 @@ (defvar math-simplify-divisor-nover) (defvar math-simplify-divisor-dover) -(defun math-simplify-divisor (np dp math-simplify-divisor-nover - math-simplify-divisor-dover) +(defun math-simplify-divisor (np dp nover dover) (cond ((eq (car-safe (car dp)) '/) (math-simplify-divisor np (cdr (car dp)) - math-simplify-divisor-nover - math-simplify-divisor-dover) + nover dover) (and (math-known-scalarp (nth 1 (car dp)) t) (math-simplify-divisor np (cdr (cdr (car dp))) - math-simplify-divisor-nover - (not math-simplify-divisor-dover)))) - ((or (or (eq (car math-simplify-expr) '/) + nover (not dover)))) + ((or (or (eq (car math--simplify-divide-expr) '/) (let ((signs (math-possible-signs (car np)))) (or (memq signs '(1 4)) - (and (memq (car math-simplify-expr) '(calcFunc-eq calcFunc-neq)) + (and (memq (car math--simplify-divide-expr) + '(calcFunc-eq calcFunc-neq)) (eq signs 5)) math-living-dangerously))) (math-numberp (car np))) (let (d (safe t) + (math-simplify-divisor-nover nover) + (math-simplify-divisor-dover dover) (scalar (math-known-scalarp (car np)))) (while (and (eq (car-safe (setq d (car dp))) '*) safe) @@ -621,14 +617,16 @@ op) (if temp (progn - (and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq))) + (and (not (memq (car math--simplify-divide-expr) + '(/ calcFunc-eq calcFunc-neq))) (math-known-negp (car dp)) - (setq op (assq (car math-simplify-expr) calc-tweak-eqn-table)) - (setcar math-simplify-expr (nth 1 op))) + (setq op (assq (car math--simplify-divide-expr) + calc-tweak-eqn-table)) + (setcar math--simplify-divide-expr (nth 1 op))) (setcar np (if math-simplify-divisor-nover (math-div 1 temp) temp)) (setcar dp 1)) (and math-simplify-divisor-dover (not math-simplify-divisor-nover) - (eq (car math-simplify-expr) '/) + (eq (car math--simplify-divide-expr) '/) (eq (car-safe (car dp)) 'calcFunc-sqrt) (Math-integerp (nth 1 (car dp))) (progn @@ -680,26 +678,23 @@ (math-gcd (nth 2 a) (nth 2 b))))))) (math-defsimplify % - (math-simplify-mod)) - -(defun math-simplify-mod () - (and (Math-realp (nth 2 math-simplify-expr)) - (Math-posp (nth 2 math-simplify-expr)) - (let ((lin (math-is-linear (nth 1 math-simplify-expr))) - t1 t2 t3) + (and (Math-realp (nth 2 expr)) + (Math-posp (nth 2 expr)) + (let ((lin (math-is-linear (nth 1 expr))) + t1) (or (and lin (or (math-negp (car lin)) - (not (Math-lessp (car lin) (nth 2 math-simplify-expr)))) + (not (Math-lessp (car lin) (nth 2 expr)))) (list '% (list '+ (math-mul (nth 1 lin) (nth 2 lin)) - (math-mod (car lin) (nth 2 math-simplify-expr))) - (nth 2 math-simplify-expr))) + (math-mod (car lin) (nth 2 expr))) + (nth 2 expr))) (and lin (not (math-equal-int (nth 1 lin) 1)) (math-num-integerp (nth 1 lin)) - (math-num-integerp (nth 2 math-simplify-expr)) - (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 math-simplify-expr))) + (math-num-integerp (nth 2 expr)) + (setq t1 (calcFunc-gcd (nth 1 lin) (nth 2 expr))) (not (math-equal-int t1 1)) (list '* t1 @@ -709,53 +704,53 @@ (nth 2 lin)) (let ((calc-prefer-frac t)) (math-div (car lin) t1))) - (math-div (nth 2 math-simplify-expr) t1)))) - (and (math-equal-int (nth 2 math-simplify-expr) 1) + (math-div (nth 2 expr) t1)))) + (and (math-equal-int (nth 2 expr) 1) (math-known-integerp (if lin (math-mul (nth 1 lin) (nth 2 lin)) - (nth 1 math-simplify-expr))) + (nth 1 expr))) (if lin (math-mod (car lin) 1) 0)))))) (math-defsimplify (calcFunc-eq calcFunc-neq calcFunc-lt calcFunc-gt calcFunc-leq calcFunc-geq) - (if (= (length math-simplify-expr) 3) - (math-simplify-ineq))) + (if (= (length expr) 3) + (math-simplify-ineq expr))) -(defun math-simplify-ineq () - (let ((np (cdr math-simplify-expr)) +(defun math-simplify-ineq (expr) + (let ((np (cdr expr)) n) (while (memq (car-safe (setq n (car np))) '(+ -)) - (math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr)) + (math-simplify-add-term (cdr (cdr n)) (cdr (cdr expr)) (eq (car n) '-) nil) (setq np (cdr n))) - (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil - (eq np (cdr math-simplify-expr))) - (math-simplify-divide) - (let ((signs (math-possible-signs (cons '- (cdr math-simplify-expr))))) - (or (cond ((eq (car math-simplify-expr) 'calcFunc-eq) + (math-simplify-add-term np (cdr (cdr expr)) nil + (eq np (cdr expr))) + (math-simplify-divide expr) + (let ((signs (math-possible-signs (cons '- (cdr expr))))) + (or (cond ((eq (car expr) 'calcFunc-eq) (or (and (eq signs 2) 1) (and (memq signs '(1 4 5)) 0))) - ((eq (car math-simplify-expr) 'calcFunc-neq) + ((eq (car expr) 'calcFunc-neq) (or (and (eq signs 2) 0) (and (memq signs '(1 4 5)) 1))) - ((eq (car math-simplify-expr) 'calcFunc-lt) + ((eq (car expr) 'calcFunc-lt) (or (and (eq signs 1) 1) (and (memq signs '(2 4 6)) 0))) - ((eq (car math-simplify-expr) 'calcFunc-gt) + ((eq (car expr) 'calcFunc-gt) (or (and (eq signs 4) 1) (and (memq signs '(1 2 3)) 0))) - ((eq (car math-simplify-expr) 'calcFunc-leq) + ((eq (car expr) 'calcFunc-leq) (or (and (eq signs 4) 0) (and (memq signs '(1 2 3)) 1))) - ((eq (car math-simplify-expr) 'calcFunc-geq) + ((eq (car expr) 'calcFunc-geq) (or (and (eq signs 1) 0) (and (memq signs '(2 4 6)) 1)))) - math-simplify-expr)))) + expr)))) (defun math-simplify-add-term (np dp minus lplain) (or (math-vectorp (car np)) (let ((rplain t) - n d dd temp) + n d temp) (while (memq (car-safe (setq n (car np) d (car dp))) '(+ -)) (setq rplain nil) (if (setq temp (math-combine-sum n (nth 2 d) @@ -782,27 +777,27 @@ (setcar dp (setq n (math-neg temp))))))))) (math-defsimplify calcFunc-sin - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-sin (math-neg (nth 1 math-simplify-expr))))) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-sin (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-known-sin (car n) (nth 1 n) 120 0)))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (list 'calcFunc-sqrt (math-sub 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr)))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) - (math-div (nth 1 (nth 1 math-simplify-expr)) + (nth 1 (nth 1 expr)))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt (math-add 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) + (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr)))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (list '+ @@ -812,27 +807,27 @@ (list 'calcFunc-sin a)))))))) (math-defsimplify calcFunc-cos - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-cos (math-neg (nth 1 math-simplify-expr)))) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-cos (math-neg (nth 1 expr)))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-known-sin (car n) (nth 1 n) 120 300)))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) (math-div 1 (list 'calcFunc-sqrt (math-add 1 - (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) + (math-sqr (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr)))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (list '- @@ -842,53 +837,53 @@ (list 'calcFunc-sin a)))))))) (math-defsimplify calcFunc-sec - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-sec (math-neg (nth 1 math-simplify-expr)))) + (or (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-sec (math-neg (nth 1 expr)))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) 120 300))))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 300))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) (math-div 1 (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (math-div 1 - (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) + (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) (list 'calcFunc-sqrt (math-add 1 - (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))) + (math-sqr (nth 1 (nth 1 expr)))))))) (math-defsimplify calcFunc-csc - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-csc (math-neg (nth 1 math-simplify-expr))))) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-csc (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) 120 0))))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-div 1 (math-known-sin (car n) (nth 1 n) '(frac 2 3) 0))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) + (math-div 1 (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (math-div 1 (list 'calcFunc-sqrt (math-sub 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) + (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) (math-div (list 'calcFunc-sqrt (math-add 1 (math-sqr - (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))))) + (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))))) (defun math-should-expand-trig (x &optional hyperbolic) (let ((m (math-is-multiple x))) @@ -943,55 +938,55 @@ (t nil)))))) (math-defsimplify calcFunc-tan - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-tan (math-neg (nth 1 math-simplify-expr))))) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-tan (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-known-tan (car n) (nth 1 n) 120)))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-known-tan (car n) (nth 1 n) '(frac 2 3))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) - (math-div (nth 1 (nth 1 math-simplify-expr)) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) (math-div (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr)))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))) + (let ((m (math-should-expand-trig (nth 1 expr)))) (and m (if (equal (car m) '(frac 1 2)) (math-div (math-sub 1 (list 'calcFunc-cos (nth 1 m))) (list 'calcFunc-sin (nth 1 m))) - (math-div (list 'calcFunc-sin (nth 1 math-simplify-expr)) - (list 'calcFunc-cos (nth 1 math-simplify-expr)))))))) + (math-div (list 'calcFunc-sin (nth 1 expr)) + (list 'calcFunc-cos (nth 1 expr)))))))) (math-defsimplify calcFunc-cot - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-cot (math-neg (nth 1 math-simplify-expr))))) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-cot (math-neg (nth 1 expr))))) (and (eq calc-angle-mode 'rad) - (let ((n (math-linear-in (nth 1 math-simplify-expr) '(var pi var-pi)))) + (let ((n (math-linear-in (nth 1 expr) '(var pi var-pi)))) (and n (math-div 1 (math-known-tan (car n) (nth 1 n) 120))))) (and (eq calc-angle-mode 'deg) - (let ((n (math-integer-plus (nth 1 math-simplify-expr)))) + (let ((n (math-integer-plus (nth 1 expr)))) (and n (math-div 1 (math-known-tan (car n) (nth 1 n) '(frac 2 3)))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsin) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsin) (math-div (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccos) - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccos) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan) - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctan) + (math-div 1 (nth 1 (nth 1 expr)))))) (defun math-known-tan (plus n mul) (setq n (math-mul n mul)) @@ -1026,20 +1021,20 @@ (t nil)))))) (math-defsimplify calcFunc-sinh - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-sinh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr) t))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (if (> n 1) @@ -1050,20 +1045,20 @@ (list 'calcFunc-sinh a))))))))) (math-defsimplify calcFunc-cosh - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-cosh (math-neg (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously (math-div 1 (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))))) + (let ((m (math-should-expand-trig (nth 1 expr) t))) (and m (integerp (car m)) (let ((n (car m)) (a (nth 1 m))) (if (> n 1) @@ -1074,188 +1069,188 @@ (list 'calcFunc-sinh a))))))))) (math-defsimplify calcFunc-tanh - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) - (nth 1 (nth 1 math-simplify-expr))) - (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-tanh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) + (nth 1 (nth 1 expr))) + (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-tanh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously (math-div (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)) - (nth 1 (nth 1 math-simplify-expr)))) - (let ((m (math-should-expand-trig (nth 1 math-simplify-expr) t))) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)) + (nth 1 (nth 1 expr)))) + (let ((m (math-should-expand-trig (nth 1 expr) t))) (and m (if (equal (car m) '(frac 1 2)) (math-div (math-sub (list 'calcFunc-cosh (nth 1 m)) 1) (list 'calcFunc-sinh (nth 1 m))) - (math-div (list 'calcFunc-sinh (nth 1 math-simplify-expr)) - (list 'calcFunc-cosh (nth 1 math-simplify-expr)))))))) + (math-div (list 'calcFunc-sinh (nth 1 expr)) + (list 'calcFunc-cosh (nth 1 expr)))))))) (math-defsimplify calcFunc-sech - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (math-looks-negp (nth 1 expr)) + (list 'calcFunc-sech (math-neg (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously (math-div 1 (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously - (math-div 1 (nth 1 (nth 1 math-simplify-expr))) 1) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-div 1 (nth 1 (nth 1 expr))) 1) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr)))))))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr)))))))) (math-defsimplify calcFunc-csch - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-csch (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-csch (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-div 1 (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously (math-div 1 (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously (math-div (list 'calcFunc-sqrt - (math-sub 1 (math-sqr (nth 1 (nth 1 math-simplify-expr))))) - (nth 1 (nth 1 math-simplify-expr)))))) + (math-sub 1 (math-sqr (nth 1 (nth 1 expr))))) + (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-coth - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-coth (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-coth (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arcsinh) math-living-dangerously (math-div (list 'calcFunc-sqrt - (math-add (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)) - (nth 1 (nth 1 math-simplify-expr)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh) + (math-add (math-sqr (nth 1 (nth 1 expr))) 1)) + (nth 1 (nth 1 expr)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arccosh) math-living-dangerously - (math-div (nth 1 (nth 1 math-simplify-expr)) + (math-div (nth 1 (nth 1 expr)) (list 'calcFunc-sqrt - (math-sub (math-sqr (nth 1 (nth 1 math-simplify-expr))) 1)))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctanh) + (math-sub (math-sqr (nth 1 (nth 1 expr))) 1)))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-arctanh) math-living-dangerously - (math-div 1 (nth 1 (nth 1 math-simplify-expr)))))) + (math-div 1 (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-arcsin - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 math-simplify-expr))))) - (and (eq (nth 1 math-simplify-expr) 1) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arcsin (math-neg (nth 1 expr))))) + (and (eq (nth 1 expr) 1) (math-quarter-circle t)) - (and (equal (nth 1 math-simplify-expr) '(frac 1 2)) + (and (equal (nth 1 expr) '(frac 1 2)) (math-div (math-half-circle t) 6)) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) - (nth 1 (nth 1 math-simplify-expr))) + (eq (car-safe (nth 1 expr)) 'calcFunc-sin) + (nth 1 (nth 1 expr))) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) + (eq (car-safe (nth 1 expr)) 'calcFunc-cos) (math-sub (math-quarter-circle t) - (nth 1 (nth 1 math-simplify-expr)))))) + (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-arccos - (or (and (eq (nth 1 math-simplify-expr) 0) + (or (and (eq (nth 1 expr) 0) (math-quarter-circle t)) - (and (eq (nth 1 math-simplify-expr) -1) + (and (eq (nth 1 expr) -1) (math-half-circle t)) - (and (equal (nth 1 math-simplify-expr) '(frac 1 2)) + (and (equal (nth 1 expr) '(frac 1 2)) (math-div (math-half-circle t) 3)) - (and (equal (nth 1 math-simplify-expr) '(frac -1 2)) + (and (equal (nth 1 expr) '(frac -1 2)) (math-div (math-mul (math-half-circle t) 2) 3)) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) - (nth 1 (nth 1 math-simplify-expr))) + (eq (car-safe (nth 1 expr)) 'calcFunc-cos) + (nth 1 (nth 1 expr))) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sin) + (eq (car-safe (nth 1 expr)) 'calcFunc-sin) (math-sub (math-quarter-circle t) - (nth 1 (nth 1 math-simplify-expr)))))) + (nth 1 (nth 1 expr)))))) (math-defsimplify calcFunc-arctan - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arctan (math-neg (nth 1 math-simplify-expr))))) - (and (eq (nth 1 math-simplify-expr) 1) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arctan (math-neg (nth 1 expr))))) + (and (eq (nth 1 expr) 1) (math-div (math-half-circle t) 4)) (and math-living-dangerously - (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tan) - (nth 1 (nth 1 math-simplify-expr))))) + (eq (car-safe (nth 1 expr)) 'calcFunc-tan) + (nth 1 (nth 1 expr))))) (math-defsimplify calcFunc-arcsinh - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sinh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arcsinh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-sinh) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr))))) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr))))) (math-defsimplify calcFunc-arccosh - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr)))) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr)))) (math-defsimplify calcFunc-arctanh - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-tanh) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-arctanh (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-tanh) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr))))) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr))))) (math-defsimplify calcFunc-sqrt - (math-simplify-sqrt)) + (math-simplify-sqrt expr)) -(defun math-simplify-sqrt () - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac) +(defun math-simplify-sqrt (expr) + (or (and (eq (car-safe (nth 1 expr)) 'frac) (math-div (list 'calcFunc-sqrt - (math-mul (nth 1 (nth 1 math-simplify-expr)) - (nth 2 (nth 1 math-simplify-expr)))) - (nth 2 (nth 1 math-simplify-expr)))) - (let ((fac (if (math-objectp (nth 1 math-simplify-expr)) - (math-squared-factor (nth 1 math-simplify-expr)) - (math-common-constant-factor (nth 1 math-simplify-expr))))) + (math-mul (nth 1 (nth 1 expr)) + (nth 2 (nth 1 expr)))) + (nth 2 (nth 1 expr)))) + (let ((fac (if (math-objectp (nth 1 expr)) + (math-squared-factor (nth 1 expr)) + (math-common-constant-factor (nth 1 expr))))) (and fac (not (eq fac 1)) (math-mul (math-normalize (list 'calcFunc-sqrt fac)) (math-normalize (list 'calcFunc-sqrt (math-cancel-common-factor - (nth 1 math-simplify-expr) fac)))))) + (nth 1 expr) fac)))))) (and math-living-dangerously - (or (and (eq (car-safe (nth 1 math-simplify-expr)) '-) - (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 1) - (eq (car-safe (nth 2 (nth 1 math-simplify-expr))) '^) - (math-equal-int (nth 2 (nth 2 (nth 1 math-simplify-expr))) 2) - (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) + (or (and (eq (car-safe (nth 1 expr)) '-) + (math-equal-int (nth 1 (nth 1 expr)) 1) + (eq (car-safe (nth 2 (nth 1 expr))) '^) + (math-equal-int (nth 2 (nth 2 (nth 1 expr))) 2) + (or (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) 'calcFunc-sin) (list 'calcFunc-cos - (nth 1 (nth 1 (nth 2 (nth 1 math-simplify-expr)))))) - (and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr)))) + (nth 1 (nth 1 (nth 2 (nth 1 expr)))))) + (and (eq (car-safe (nth 1 (nth 2 (nth 1 expr)))) 'calcFunc-cos) (list 'calcFunc-sin (nth 1 (nth 1 (nth 2 - (nth 1 math-simplify-expr)))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '-) - (math-equal-int (nth 2 (nth 1 math-simplify-expr)) 1) - (eq (car-safe (nth 1 (nth 1 math-simplify-expr))) '^) - (math-equal-int (nth 2 (nth 1 (nth 1 math-simplify-expr))) 2) - (and (eq (car-safe (nth 1 (nth 1 (nth 1 math-simplify-expr)))) + (nth 1 expr)))))))) + (and (eq (car-safe (nth 1 expr)) '-) + (math-equal-int (nth 2 (nth 1 expr)) 1) + (eq (car-safe (nth 1 (nth 1 expr))) '^) + (math-equal-int (nth 2 (nth 1 (nth 1 expr))) 2) + (and (eq (car-safe (nth 1 (nth 1 (nth 1 expr)))) 'calcFunc-cosh) (list 'calcFunc-sinh - (nth 1 (nth 1 (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '+) - (let ((a (nth 1 (nth 1 math-simplify-expr))) - (b (nth 2 (nth 1 math-simplify-expr)))) + (nth 1 (nth 1 (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) '+) + (let ((a (nth 1 (nth 1 expr))) + (b (nth 2 (nth 1 expr)))) (and (or (and (math-equal-int a 1) - (setq a b b (nth 1 (nth 1 math-simplify-expr)))) + (setq a b b (nth 1 (nth 1 expr)))) (math-equal-int b 1)) (eq (car-safe a) '^) (math-equal-int (nth 2 a) 2) @@ -1269,20 +1264,20 @@ (and (eq (car-safe (nth 1 a)) 'calcFunc-cot) (list '/ 1 (list 'calcFunc-sin (nth 1 (nth 1 a))))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '^) + (and (eq (car-safe (nth 1 expr)) '^) (list '^ - (nth 1 (nth 1 math-simplify-expr)) - (math-div (nth 2 (nth 1 math-simplify-expr)) 2))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) - (list '^ (nth 1 (nth 1 math-simplify-expr)) (math-div 1 4))) - (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) - (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr))))) - (and (memq (car-safe (nth 1 math-simplify-expr)) '(+ -)) - (not (math-any-floats (nth 1 math-simplify-expr))) + (nth 1 (nth 1 expr)) + (math-div (nth 2 (nth 1 expr)) 2))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) + (list '^ (nth 1 (nth 1 expr)) (math-div 1 4))) + (and (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list 'calcFunc-sqrt (nth 1 (nth 1 expr))) + (list 'calcFunc-sqrt (nth 2 (nth 1 expr))))) + (and (memq (car-safe (nth 1 expr)) '(+ -)) + (not (math-any-floats (nth 1 expr))) (let ((f (calcFunc-factors (calcFunc-expand - (nth 1 math-simplify-expr))))) + (nth 1 expr))))) (and (math-vectorp f) (or (> (length f) 2) (> (nth 2 (nth 1 f)) 1)) @@ -1318,7 +1313,7 @@ fac))) (math-defsimplify calcFunc-exp - (math-simplify-exp (nth 1 math-simplify-expr))) + (math-simplify-exp (nth 1 expr))) (defun math-simplify-exp (x) (or (and (eq (car-safe x) 'calcFunc-ln) @@ -1349,22 +1344,22 @@ (list '+ c (list '* s '(var i var-i)))))))) (math-defsimplify calcFunc-ln - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) (or math-living-dangerously - (math-known-realp (nth 1 (nth 1 math-simplify-expr)))) - (nth 1 (nth 1 math-simplify-expr))) - (and (eq (car-safe (nth 1 math-simplify-expr)) '^) - (equal (nth 1 (nth 1 math-simplify-expr)) '(var e var-e)) + (math-known-realp (nth 1 (nth 1 expr)))) + (nth 1 (nth 1 expr))) + (and (eq (car-safe (nth 1 expr)) '^) + (equal (nth 1 (nth 1 expr)) '(var e var-e)) (or math-living-dangerously - (math-known-realp (nth 2 (nth 1 math-simplify-expr)))) - (nth 2 (nth 1 math-simplify-expr))) + (math-known-realp (nth 2 (nth 1 expr)))) + (nth 2 (nth 1 expr))) (and calc-symbolic-mode - (math-known-negp (nth 1 math-simplify-expr)) - (math-add (list 'calcFunc-ln (math-neg (nth 1 math-simplify-expr))) + (math-known-negp (nth 1 expr)) + (math-add (list 'calcFunc-ln (math-neg (nth 1 expr))) '(* (var pi var-pi) (var i var-i)))) (and calc-symbolic-mode - (math-known-imagp (nth 1 math-simplify-expr)) - (let* ((ip (calcFunc-im (nth 1 math-simplify-expr))) + (math-known-imagp (nth 1 expr)) + (let* ((ip (calcFunc-im (nth 1 expr))) (ips (math-possible-signs ip))) (or (and (memq ips '(4 6)) (math-add (list 'calcFunc-ln ip) @@ -1374,95 +1369,92 @@ '(/ (* (var pi var-pi) (var i var-i)) 2)))))))) (math-defsimplify ^ - (math-simplify-pow)) - -(defun math-simplify-pow () (or (and math-living-dangerously - (or (and (eq (car-safe (nth 1 math-simplify-expr)) '^) + (or (and (eq (car-safe (nth 1 expr)) '^) (list '^ - (nth 1 (nth 1 math-simplify-expr)) - (math-mul (nth 2 math-simplify-expr) - (nth 2 (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-sqrt) + (nth 1 (nth 1 expr)) + (math-mul (nth 2 expr) + (nth 2 (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-sqrt) (list '^ - (nth 1 (nth 1 math-simplify-expr)) - (math-div (nth 2 math-simplify-expr) 2))) - (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list '^ (nth 1 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)) - (list '^ (nth 2 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)))))) - (and (math-equal-int (nth 1 math-simplify-expr) 10) - (eq (car-safe (nth 2 math-simplify-expr)) 'calcFunc-log10) - (nth 1 (nth 2 math-simplify-expr))) - (and (equal (nth 1 math-simplify-expr) '(var e var-e)) - (math-simplify-exp (nth 2 math-simplify-expr))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp) + (nth 1 (nth 1 expr)) + (math-div (nth 2 expr) 2))) + (and (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list '^ (nth 1 (nth 1 expr)) + (nth 2 expr)) + (list '^ (nth 2 (nth 1 expr)) + (nth 2 expr)))))) + (and (math-equal-int (nth 1 expr) 10) + (eq (car-safe (nth 2 expr)) 'calcFunc-log10) + (nth 1 (nth 2 expr))) + (and (equal (nth 1 expr) '(var e var-e)) + (math-simplify-exp (nth 2 expr))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-exp) (not math-integrating) - (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)))) - (and (equal (nth 1 math-simplify-expr) '(var i var-i)) + (list 'calcFunc-exp (math-mul (nth 1 (nth 1 expr)) + (nth 2 expr)))) + (and (equal (nth 1 expr) '(var i var-i)) (math-imaginary-i) - (math-num-integerp (nth 2 math-simplify-expr)) - (let ((x (math-mod (math-trunc (nth 2 math-simplify-expr)) 4))) + (math-num-integerp (nth 2 expr)) + (let ((x (math-mod (math-trunc (nth 2 expr)) 4))) (cond ((eq x 0) 1) - ((eq x 1) (nth 1 math-simplify-expr)) + ((eq x 1) (nth 1 expr)) ((eq x 2) -1) - ((eq x 3) (math-neg (nth 1 math-simplify-expr)))))) + ((eq x 3) (math-neg (nth 1 expr)))))) (and math-integrating - (integerp (nth 2 math-simplify-expr)) - (>= (nth 2 math-simplify-expr) 2) - (or (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cos) - (math-mul (math-pow (nth 1 math-simplify-expr) - (- (nth 2 math-simplify-expr) 2)) + (integerp (nth 2 expr)) + (>= (nth 2 expr) 2) + (or (and (eq (car-safe (nth 1 expr)) 'calcFunc-cos) + (math-mul (math-pow (nth 1 expr) + (- (nth 2 expr) 2)) (math-sub 1 (math-sqr (list 'calcFunc-sin - (nth 1 (nth 1 math-simplify-expr))))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-cosh) - (math-mul (math-pow (nth 1 math-simplify-expr) - (- (nth 2 math-simplify-expr) 2)) + (nth 1 (nth 1 expr))))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-cosh) + (math-mul (math-pow (nth 1 expr) + (- (nth 2 expr) 2)) (math-add 1 (math-sqr (list 'calcFunc-sinh - (nth 1 (nth 1 math-simplify-expr))))))))) - (and (eq (car-safe (nth 2 math-simplify-expr)) 'frac) - (Math-ratp (nth 1 math-simplify-expr)) - (Math-posp (nth 1 math-simplify-expr)) - (if (equal (nth 2 math-simplify-expr) '(frac 1 2)) - (list 'calcFunc-sqrt (nth 1 math-simplify-expr)) - (let ((flr (math-floor (nth 2 math-simplify-expr)))) + (nth 1 (nth 1 expr))))))))) + (and (eq (car-safe (nth 2 expr)) 'frac) + (Math-ratp (nth 1 expr)) + (Math-posp (nth 1 expr)) + (if (equal (nth 2 expr) '(frac 1 2)) + (list 'calcFunc-sqrt (nth 1 expr)) + (let ((flr (math-floor (nth 2 expr)))) (and (not (Math-zerop flr)) - (list '* (list '^ (nth 1 math-simplify-expr) flr) - (list '^ (nth 1 math-simplify-expr) - (math-sub (nth 2 math-simplify-expr) flr))))))) - (and (eq (math-quarter-integer (nth 2 math-simplify-expr)) 2) - (let ((temp (math-simplify-sqrt))) + (list '* (list '^ (nth 1 expr) flr) + (list '^ (nth 1 expr) + (math-sub (nth 2 expr) flr))))))) + (and (eq (math-quarter-integer (nth 2 expr)) 2) + (let ((temp (math-simplify-sqrt expr))) (and temp - (list '^ temp (math-mul (nth 2 math-simplify-expr) 2))))))) + (list '^ temp (math-mul (nth 2 expr) 2))))))) (math-defsimplify calcFunc-log10 - (and (eq (car-safe (nth 1 math-simplify-expr)) '^) - (math-equal-int (nth 1 (nth 1 math-simplify-expr)) 10) + (and (eq (car-safe (nth 1 expr)) '^) + (math-equal-int (nth 1 (nth 1 expr)) 10) (or math-living-dangerously - (math-known-realp (nth 2 (nth 1 math-simplify-expr)))) - (nth 2 (nth 1 math-simplify-expr)))) + (math-known-realp (nth 2 (nth 1 expr)))) + (nth 2 (nth 1 expr)))) (math-defsimplify calcFunc-erf - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-neg (list 'calcFunc-erf (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) + (or (and (math-looks-negp (nth 1 expr)) + (math-neg (list 'calcFunc-erf (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) (list 'calcFunc-conj - (list 'calcFunc-erf (nth 1 (nth 1 math-simplify-expr))))))) + (list 'calcFunc-erf (nth 1 (nth 1 expr))))))) (math-defsimplify calcFunc-erfc - (or (and (math-looks-negp (nth 1 math-simplify-expr)) - (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 math-simplify-expr))))) - (and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-conj) + (or (and (math-looks-negp (nth 1 expr)) + (math-sub 2 (list 'calcFunc-erfc (math-neg (nth 1 expr))))) + (and (eq (car-safe (nth 1 expr)) 'calcFunc-conj) (list 'calcFunc-conj - (list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr))))))) + (list 'calcFunc-erfc (nth 1 (nth 1 expr))))))) (defun math-linear-in (expr term &optional always) @@ -1614,10 +1606,12 @@ (defvar math-expr-subst-old) (defvar math-expr-subst-new) -(defun math-expr-subst (expr math-expr-subst-old math-expr-subst-new) - (math-expr-subst-rec expr)) +(defun math-expr-subst (expr old new) + (let ((math-expr-subst-old old) + (math-expr-subst-new new)) + (math-expr-subst-rec expr))) -(defalias 'calcFunc-subst 'math-expr-subst) +(defalias 'calcFunc-subst #'math-expr-subst) (defun math-expr-subst-rec (expr) (cond ((equal expr math-expr-subst-old) math-expr-subst-new) @@ -1632,7 +1626,7 @@ (math-expr-subst-rec (nth 2 expr))))) (t (cons (car expr) - (mapcar 'math-expr-subst-rec (cdr expr)))))) + (mapcar #'math-expr-subst-rec (cdr expr)))))) ;;; Various measures of the size of an expression. (defun math-expr-weight (expr) @@ -1659,7 +1653,7 @@ (defun calcFunc-collect (expr base) (let ((p (math-is-polynomial expr base 50 t))) (if (cdr p) - (math-build-polynomial-expr (mapcar 'math-normalize p) base) + (math-build-polynomial-expr (mapcar #'math-normalize p) base) (car p)))) ;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...), @@ -1672,13 +1666,16 @@ (defvar math-is-poly-loose) (defvar math-var) -(defun math-is-polynomial (expr math-var &optional math-is-poly-degree math-is-poly-loose) - (let* ((math-poly-base-variable (if math-is-poly-loose - (if (eq math-is-poly-loose 'gen) math-var '(var XXX XXX)) +(defun math-is-polynomial (expr var &optional degree loose) + (let* ((math-poly-base-variable (if loose + (if (eq loose 'gen) var '(var XXX XXX)) math-poly-base-variable)) + (math-var var) + (math-is-poly-loose loose) + (math-is-poly-degree degree) (poly (math-is-poly-rec expr math-poly-neg-powers))) - (and (or (null math-is-poly-degree) - (<= (length poly) (1+ math-is-poly-degree))) + (and (or (null degree) + (<= (length poly) (1+ degree))) poly))) (defun math-is-poly-rec (expr negpow) @@ -1749,7 +1746,7 @@ (math-poly-mix p1 1 p2 (if (eq (car expr) '+) 1 -1))))))) ((eq (car expr) 'neg) - (mapcar 'math-neg (math-is-poly-rec (nth 1 expr) negpow))) + (mapcar #'math-neg (math-is-poly-rec (nth 1 expr) negpow))) ((eq (car expr) '*) (let ((p1 (math-is-poly-rec (nth 1 expr) negpow))) (and p1 @@ -1812,24 +1809,20 @@ (math-expr-contains expr math-poly-base-variable) (math-expr-depends expr var))) -;;; Find the variable (or sub-expression) which is the base of polynomial expr. ;; The variables math-poly-base-const-ok and math-poly-base-pred are ;; local to math-polynomial-base, but are used by math-polynomial-base-rec. (defvar math-poly-base-const-ok) (defvar math-poly-base-pred) -;; The variable math-poly-base-top-expr is local to math-polynomial-base, -;; but is used by math-polynomial-p1 in calc-poly.el, which is called -;; by math-polynomial-base. - -(defun math-polynomial-base (math-poly-base-top-expr &optional math-poly-base-pred) - (or math-poly-base-pred - (setq math-poly-base-pred (function (lambda (base) (math-polynomial-p - math-poly-base-top-expr base))))) +(defun math-polynomial-base (top-expr &optional pred) + "Find the variable (or sub-expression) which is the base of polynomial expr." + (let ((math-poly-base-pred + (or pred (function (lambda (base) (math-polynomial-p + top-expr base)))))) (or (let ((math-poly-base-const-ok nil)) - (math-polynomial-base-rec math-poly-base-top-expr)) + (math-polynomial-base-rec top-expr)) (let ((math-poly-base-const-ok t)) - (math-polynomial-base-rec math-poly-base-top-expr)))) + (math-polynomial-base-rec top-expr))))) (defun math-polynomial-base-rec (mpb-expr) (and (not (Math-objvecp mpb-expr)) @@ -1846,8 +1839,8 @@ (funcall math-poly-base-pred mpb-expr) mpb-expr)))) -;;; Return non-nil if expr refers to any variables. (defun math-expr-contains-vars (expr) + "Return non-nil if expr refers to any variables." (or (eq (car-safe expr) 'var) (and (not (Math-primp expr)) (progn @@ -1855,9 +1848,9 @@ (not (math-expr-contains-vars (car expr))))) expr)))) -;;; Simplify a polynomial in list form by stripping off high-end zeros. -;;; This always leaves the constant part, i.e., nil->nil and non-nil->non-nil. (defun math-poly-simplify (p) + "Simplify a polynomial in list form by stripping off high-end zeros. +This always leaves the constant part, i.e., nil->nil and non-nil->non-nil." (and p (if (Math-zerop (nth (1- (length p)) p)) (let ((pp (copy-sequence p))) @@ -1879,14 +1872,14 @@ (or (null a) (and (null (cdr a)) (Math-zerop (car a))))) -;;; Multiply two polynomials in list form. (defun math-poly-mul (a b) + "Multiply two polynomials in list form." (and a b (math-poly-mix b (car a) (math-poly-mul (cdr a) (cons 0 b)) 1))) -;;; Build an expression from a polynomial list. (defun math-build-polynomial-expr (p var) + "Build an expression from a polynomial list." (if p (if (Math-numberp var) (math-with-extra-prec 1 @@ -1897,8 +1890,7 @@ accum)) (let* ((rp (reverse p)) (n (1- (length rp))) - (accum (math-mul (car rp) (math-pow var n))) - term) + (accum (math-mul (car rp) (math-pow var n)))) (while (setq rp (cdr rp)) (setq n (1- n)) (or (math-zerop (car rp)) diff --git a/lisp/calc/calc-bin.el b/lisp/calc/calc-bin.el index c05a71a2d7f..a61cecf357c 100644 --- a/lisp/calc/calc-bin.el +++ b/lisp/calc/calc-bin.el @@ -420,7 +420,7 @@ the size of a Calc bignum digit.") (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (if (<= w math-bignum-logb-digit-size) (list (logand (lognot (cdr q)) - (1- (lsh 1 w)))) + (1- (ash 1 w)))) (math-mul-bignum-digit (math-not-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two @@ -529,7 +529,7 @@ the size of a Calc bignum digit.") ((and (integerp a) (< a math-small-integer-size)) (if (> w (logb math-small-integer-size)) a - (logand a (1- (lsh 1 w))))) + (logand a (1- (ash 1 w))))) (t (math-normalize (cons 'bigpos @@ -542,7 +542,7 @@ the size of a Calc bignum digit.") (let ((q (math-div-bignum-digit a math-bignum-digit-power-of-two))) (if (<= w math-bignum-logb-digit-size) (list (logand (cdr q) - (1- (lsh 1 w)))) + (1- (ash 1 w)))) (math-mul-bignum-digit (math-clip-bignum (math-norm-bignum (car q)) (- w math-bignum-logb-digit-size)) math-bignum-digit-power-of-two diff --git a/lisp/calc/calc-comb.el b/lisp/calc/calc-comb.el index 7c88230f86a..f1d3daeed93 100644 --- a/lisp/calc/calc-comb.el +++ b/lisp/calc/calc-comb.el @@ -580,7 +580,7 @@ ;; deduce a better value for RAND_MAX. (let ((i 0)) (while (< (setq i (1+ i)) 30) - (if (> (lsh (math-abs (random)) math-random-shift) 4095) + (if (> (ash (math-abs (random)) math-random-shift) 4095) (setq math-random-shift (1- math-random-shift)))))) (setq math-last-RandSeed var-RandSeed math-gaussian-cache nil)) @@ -592,11 +592,11 @@ (cdr math-random-table)) math-random-ptr2 (or (cdr math-random-ptr2) (cdr math-random-table))) - (logand (lsh (setcar math-random-ptr1 + (logand (ash (setcar math-random-ptr1 (logand (- (car math-random-ptr1) (car math-random-ptr2)) 524287)) -6) 1023)) - (logand (lsh (random) math-random-shift) 1023))) + (logand (ash (random) math-random-shift) 1023))) ;;; Produce a random digit in the range 0..999. diff --git a/lisp/calc/calc-ext.el b/lisp/calc/calc-ext.el index 5feff23f72d..761eb97a816 100644 --- a/lisp/calc/calc-ext.el +++ b/lisp/calc/calc-ext.el @@ -1,4 +1,4 @@ -;;; calc-ext.el --- various extension functions for Calc +;;; calc-ext.el --- various extension functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -88,7 +88,7 @@ (defvar calc-alg-map) (defvar calc-alg-esc-map) -;;; The following was made a function so that it could be byte-compiled. +;; The following was made a function so that it could be byte-compiled. (defun calc-init-extensions () (define-key calc-mode-map ":" 'calc-fdiv) @@ -714,8 +714,8 @@ ;;;; (Autoloads here) (mapc (function (lambda (x) - (mapcar (function (lambda (func) - (autoload func (car x)))) (cdr x)))) + (mapcar (function (lambda (func) (autoload func (car x)))) + (cdr x)))) '( ("calc-alg" calc-has-rules math-defsimplify @@ -894,8 +894,8 @@ calcFunc-pcont calcFunc-pdeg calcFunc-pdiv calcFunc-pdivide calcFunc-pdivrem calcFunc-pgcd calcFunc-plead calcFunc-pprim calcFunc-prem math-accum-factors math-atomic-factorp math-div-poly-const math-div-thru math-expand-power math-expand-term -math-factor-contains math-factor-expr math-factor-expr-part -math-factor-expr-try math-factor-finish math-factor-poly-coefs +math-factor-contains math-factor-expr +math-factor-finish math-factor-protect math-mul-thru math-padded-polynomial math-partial-fractions math-poly-degree math-poly-deriv-coefs math-poly-gcd-frac-list math-poly-modulus-rec math-ratpoly-p @@ -984,8 +984,8 @@ calc-force-refresh calc-locate-cursor-element calc-show-edit-buffer) )) (mapcar (function (lambda (x) - (mapcar (function (lambda (cmd) - (autoload cmd (car x) nil t))) (cdr x)))) + (mapcar (function (lambda (cmd) (autoload cmd (car x) nil t))) + (cdr x)))) '( ("calc-alg" calc-alg-evaluate calc-apart calc-collect calc-expand @@ -1307,8 +1307,9 @@ calc-kill calc-kill-region calc-yank)))) (message "%s" (if msg (concat group ": " msg ":" (make-string - (- (apply 'max (mapcar 'length msgs)) - (length msg)) 32) + (- (apply #'max (mapcar #'length msgs)) + (length msg)) + ?\s) " [MORE]" (if key (concat " " (char-to-string key) @@ -1334,6 +1335,8 @@ calc-kill calc-kill-region calc-yank)))) ;;; General. +(defvar calc-embedded-quiet) + (defun calc-reset (arg) (interactive "P") (setq arg (if arg (prefix-numeric-value arg) nil)) @@ -1398,7 +1401,7 @@ calc-kill calc-kill-region calc-yank)))) (defun calc-scroll-up (n) (interactive "P") - (condition-case err + (condition-case nil (scroll-up (or n (/ (window-height) 2))) (error nil)) (if (pos-visible-in-window-p (max 1 (- (point-max) 2))) @@ -1657,7 +1660,7 @@ calc-kill calc-kill-region calc-yank)))) (let ((entries (calc-top-list n 1 'entry)) (calc-undo-list nil) (calc-redo-list nil)) (calc-pop-stack n 1 t) - (calc-push-list (mapcar 'car entries) + (calc-push-list (mapcar #'car entries) 1 (mapcar (function (lambda (x) (nth 2 x))) entries))))))) @@ -1707,7 +1710,7 @@ calc-kill calc-kill-region calc-yank)))) (calc-pop-push-record-list 1 "eval" (math-evaluate-expr (calc-top (- n))) (- n)) - (calc-pop-push-record-list n "eval" (mapcar 'math-evaluate-expr + (calc-pop-push-record-list n "eval" (mapcar #'math-evaluate-expr (calc-top-list n))))) (calc-handle-whys))) @@ -1928,7 +1931,7 @@ calc-kill calc-kill-region calc-yank)))) (calc-z-prefix-buf "") (kmap (sort (copy-sequence (calc-user-key-map)) (function (lambda (x y) (< (car x) (car y)))))) - (flags (apply 'logior + (flags (apply #'logior (mapcar (function (lambda (k) (calc-user-function-classify (car k)))) @@ -2003,12 +2006,13 @@ calc-kill calc-kill-region calc-yank)))) ;;;; Caches. (defmacro math-defcache (name init form) + (declare (indent 2) (debug (symbolp sexp form))) (let ((cache-prec (intern (concat (symbol-name name) "-cache-prec"))) (cache-val (intern (concat (symbol-name name) "-cache"))) (last-prec (intern (concat (symbol-name name) "-last-prec"))) (last-val (intern (concat (symbol-name name) "-last")))) `(progn -; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) + ;; (defvar ,cache-prec ,(if init (math-numdigs (nth 1 init)) -100)) (defvar ,cache-prec (cond ((consp ,init) (math-numdigs (nth 1 ,init))) (,init @@ -2037,7 +2041,6 @@ calc-kill calc-kill-region calc-yank)))) ,cache-val)) ,last-prec calc-internal-prec)) ,last-val)))) -(put 'math-defcache 'lisp-indent-hook 2) ;;; Betcha didn't know that pi = 16 atan(1/5) - 4 atan(1/239). [F] [Public] (defconst math-approx-pi @@ -2294,14 +2297,14 @@ calc-kill calc-kill-region calc-yank)))) (let ((a (math-trunc a))) (if (integerp a) a - (if (or (Math-lessp (lsh -1 -1) a) - (Math-lessp a (- (lsh -1 -1)))) + (if (or (Math-lessp most-positive-fixnum a) + (Math-lessp a (- most-positive-fixnum))) (math-reject-arg a 'fixnump) (math-fixnum a))))) ((and allow-inf (equal a '(var inf var-inf))) - (lsh -1 -1)) + most-positive-fixnum) ((and allow-inf (equal a '(neg (var inf var-inf)))) - (- (lsh -1 -1))) + (- most-positive-fixnum)) (t (math-reject-arg a 'fixnump)))) ;;; Verify that A is an integer >= 0 and return A in integer form. [I N; - x] @@ -2400,7 +2403,7 @@ If X is not an error form, return 1." (list 'calcFunc-intv mask lo hi) (math-make-intv mask lo hi)))) ((eq (car a) 'vec) - (cons 'vec (mapcar 'math-normalize (cdr a)))) + (cons 'vec (mapcar #'math-normalize (cdr a)))) ((eq (car a) 'quote) (math-normalize (nth 1 a))) ((eq (car a) 'special-const) @@ -2412,7 +2415,7 @@ If X is not an error form, return 1." (math-normalize-logical-op a)) ((memq (car a) '(calcFunc-lambda calcFunc-quote calcFunc-condition)) (let ((calc-simplify-mode 'none)) - (cons (car a) (mapcar 'math-normalize (cdr a))))) + (cons (car a) (mapcar #'math-normalize (cdr a))))) ((eq (car a) 'calcFunc-evalto) (setq a (or (nth 1 a) 0)) (or calc-refreshing-evaltos @@ -2435,27 +2438,25 @@ If X is not an error form, return 1." ;; The variable math-normalize-a is local to math-normalize in calc.el, ;; but is used by math-normalize-nonstandard, which is called by ;; math-normalize. -(defvar math-normalize-a) - -(defun math-normalize-nonstandard () +(defun math-normalize-nonstandard (a) (if (consp calc-simplify-mode) (progn (setq calc-simplify-mode 'none - math-simplify-only (car-safe (cdr-safe math-normalize-a))) + math-simplify-only (car-safe (cdr-safe a))) nil) - (and (symbolp (car math-normalize-a)) + (and (symbolp (car a)) (or (eq calc-simplify-mode 'none) (and (eq calc-simplify-mode 'num) - (let ((aptr (setq math-normalize-a + (let ((aptr (setq a (cons - (car math-normalize-a) - (mapcar 'math-normalize - (cdr math-normalize-a)))))) + (car a) + (mapcar #'math-normalize + (cdr a)))))) (while (and aptr (math-constp (car aptr))) (setq aptr (cdr aptr))) aptr))) - (cons (car math-normalize-a) - (mapcar 'math-normalize (cdr math-normalize-a)))))) + (cons (car a) + (mapcar #'math-normalize (cdr a)))))) ;;; Normalize a bignum digit list by trimming high-end zeros. [L l] @@ -2808,7 +2809,7 @@ If X is not an error form, return 1." x) (if (Math-primp x) x - (cons (car x) (mapcar 'math-evaluate-expr-rec (cdr x)))))) + (cons (car x) (mapcar #'math-evaluate-expr-rec (cdr x)))))) x)) (defun math-any-floats (expr) @@ -2822,9 +2823,10 @@ If X is not an error form, return 1." (defvar math-mt-many nil) (defvar math-mt-func nil) -(defun math-map-tree (math-mt-func mmt-expr &optional math-mt-many) - (or math-mt-many (setq math-mt-many 1000000)) - (math-map-tree-rec mmt-expr)) +(defun math-map-tree (func mmt-expr &optional many) + (let ((math-mt-func func) + (math-mt-many (or many 1000000))) + (math-map-tree-rec mmt-expr))) (defun math-map-tree-rec (mmt-expr) (or (= math-mt-many 0) @@ -2842,7 +2844,7 @@ If X is not an error form, return 1." (<= math-mt-many 0)) (setq mmt-done t) (setq mmt-nextval (cons (car mmt-expr) - (mapcar 'math-map-tree-rec + (mapcar #'math-map-tree-rec (cdr mmt-expr)))) (if (equal mmt-nextval mmt-expr) (setq mmt-done t) @@ -2867,6 +2869,7 @@ If X is not an error form, return 1." (defvar math-integral-cache) (defmacro math-defintegral (funcs &rest code) + (declare (indent 1) (debug (sexp body))) (setq math-integral-cache nil) (cons 'progn (mapcar #'(lambda (func) @@ -2876,9 +2879,9 @@ If X is not an error form, return 1." (list #'(lambda (u) ,@code))))) (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defintegral 'lisp-indent-hook 1) (defmacro math-defintegral-2 (funcs &rest code) + (declare (indent 1) (debug (sexp body))) (setq math-integral-cache nil) (cons 'progn (mapcar #'(lambda (func) @@ -2887,7 +2890,6 @@ If X is not an error form, return 1." (get ',func 'math-integral-2) (list #'(lambda (u v) ,@code))))) (if (symbolp funcs) (list funcs) funcs)))) -(put 'math-defintegral-2 'lisp-indent-hook 1) (defvar var-IntegAfterRules 'calc-IntegAfterRules) @@ -3097,9 +3099,16 @@ If X is not an error form, return 1." ;;; Expression parsing. (defvar math-expr-data) +(defvar math-exp-pos) +(defvar math-exp-old-pos) +(defvar math-exp-keep-spaces) +(defvar math-exp-token) +(defvar math-expr-data) +(defvar math-exp-str) -(defun math-read-expr (math-exp-str) +(defun math-read-expr (str) (let ((math-exp-pos 0) + (math-exp-str str) (math-exp-old-pos 0) (math-exp-keep-spaces nil) math-exp-token math-expr-data) @@ -3138,6 +3147,10 @@ If X is not an error form, return 1." ;;; They said it couldn't be done... +(defvar math-read-big-baseline) +(defvar math-read-big-h2) +(defvar math-read-big-err-msg) + (defun math-read-big-expr (str) (and (> (length calc-left-label) 0) (string-match (concat "^" (regexp-quote calc-left-label)) str) @@ -3179,6 +3192,8 @@ If X is not an error form, return 1." '(error 0 "Syntax error")) (math-read-expr str))))) +(defvar math-rb-h2) + (defun math-read-big-bigp (math-read-big-lines) (and (cdr math-read-big-lines) (let ((matrix nil) diff --git a/lisp/calc/calc-forms.el b/lisp/calc/calc-forms.el index f7586288ca2..ccd52d370d1 100644 --- a/lisp/calc/calc-forms.el +++ b/lisp/calc/calc-forms.el @@ -37,13 +37,11 @@ (defun calc-time () (interactive) (calc-wrapper - (let ((time (current-time-string))) + (let ((time (decode-time))) (calc-enter-result 0 "time" (list 'mod (list 'hms - (string-to-number (substring time 11 13)) - (string-to-number (substring time 14 16)) - (string-to-number (substring time 17 19))) + (nth 2 time) (nth 1 time) (nth 0 time)) (list 'hms 24 0 0)))))) (defun calc-to-hms (arg) @@ -1341,16 +1339,15 @@ as measured in the integer number of days before December 31, 1 BC (Gregorian)." (math-parse-iso-date-validate isoyear isoweek isoweekday hour minute second))))) (defun calcFunc-now (&optional zone) - (let ((date (let ((calc-date-format nil)) - (math-parse-date (current-time-string))))) - (if (consp date) - (if zone - (math-add date (math-div (math-sub (calcFunc-tzone nil date) - (calcFunc-tzone zone date)) - '(float 864 2))) - date) - (calc-record-why "*Unable to interpret current date from system") - (append (list 'calcFunc-now) (and zone (list zone)))))) + (let ((date (let ((now (decode-time))) + (list 'date (math-dt-to-date + (list (nth 5 now) (nth 4 now) (nth 3 now) + (nth 2 now) (nth 1 now) (nth 0 now))))))) + (if zone + (math-add date (math-div (math-sub (calcFunc-tzone nil date) + (calcFunc-tzone zone date)) + '(float 864 2))) + date))) (defun calcFunc-year (date) (car (math-date-to-dt date))) diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el index 4b8abbf4f85..483907a325d 100644 --- a/lisp/calc/calc-math.el +++ b/lisp/calc/calc-math.el @@ -1697,7 +1697,7 @@ If this can't be done, return NIL." (while (not (Math-lessp x pow)) (setq pows (cons pow pows) pow (math-sqr pow))) - (setq n (lsh 1 (1- (length pows))) + (setq n (ash 1 (1- (length pows))) sum n pow (car pows)) (while (and (setq pows (cdr pows)) diff --git a/lisp/calc/calc-poly.el b/lisp/calc/calc-poly.el index 64f221e7a00..41083b77480 100644 --- a/lisp/calc/calc-poly.el +++ b/lisp/calc/calc-poly.el @@ -1,4 +1,4 @@ -;;; calc-poly.el --- polynomial functions for Calc +;;; calc-poly.el --- polynomial functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -177,8 +177,8 @@ (math-add (car res) (math-div (cdr res) pd)))) -;;; Multiply two terms, expanding out products of sums. (defun math-mul-thru (lhs rhs) + "Multiply two terms, expanding out products of sums." (if (memq (car-safe lhs) '(+ -)) (list (car lhs) (math-mul-thru (nth 1 lhs) rhs) @@ -197,8 +197,8 @@ (math-div num den))) -;;; Sort the terms of a sum into canonical order. (defun math-sort-terms (expr) + "Sort the terms of a sum into canonical order." (if (memq (car-safe expr) '(+ -)) (math-list-to-sum (sort (math-sum-to-list expr) @@ -223,8 +223,8 @@ (math-sum-to-list (nth 2 tree) (not neg)))) (t (list (cons tree neg))))) -;;; Check if the polynomial coefficients are modulo forms. (defun math-poly-modulus (expr &optional expr2) + "Check if the polynomial coefficients are modulo forms." (or (math-poly-modulus-rec expr) (and expr2 (math-poly-modulus-rec expr2)) 1)) @@ -237,12 +237,13 @@ (math-poly-modulus-rec (nth 2 expr)))))) -;;; Divide two polynomials. Return (quotient . remainder). (defvar math-poly-div-base nil) -(defun math-poly-div (u v &optional math-poly-div-base) - (if math-poly-div-base - (math-do-poly-div u v) - (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v)))) +(defun math-poly-div (u v &optional div-base) + "Divide two polynomials. Return (quotient . remainder)." + (let ((math-poly-div-base div-base)) + (if div-base + (math-do-poly-div u v) + (math-do-poly-div (calcFunc-expand u) (calcFunc-expand v))))) (defun math-poly-div-exact (u v &optional base) (let ((res (math-poly-div u v base))) @@ -308,8 +309,8 @@ (math-div (math-build-polynomial-expr (cdr res) base) v))))))) -;;; Divide two polynomials in coefficient-list form. Return (quot . rem). (defun math-poly-div-coefs (u v) + "Divide two polynomials in coefficient-list form. Return (quot . rem)." (cond ((null v) (math-reject-arg nil "Division by zero")) ((< (length u) (length v)) (cons nil u)) ((cdr u) @@ -334,9 +335,9 @@ (cons (list (math-poly-div-rec (car u) (car v))) nil)))) -;;; Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) -;;; This returns only the remainder from the pseudo-division. (defun math-poly-pseudo-div (u v) + "Perform a pseudo-division of polynomials. (See Knuth section 4.6.1.) +This returns only the remainder from the pseudo-division." (cond ((null v) nil) ((< (length u) (length v)) u) ((or (cdr u) (cdr v)) @@ -359,8 +360,8 @@ (nreverse (mapcar 'math-simplify urev)))) (t nil))) -;;; Compute the GCD of two multivariate polynomials. (defun math-poly-gcd (u v) + "Compute the GCD of two multivariate polynomials." (cond ((Math-equal u v) u) ((math-constp u) (if (Math-zerop u) @@ -423,7 +424,7 @@ (defun math-poly-gcd-coefs (u v) (let ((d (math-poly-gcd (math-poly-gcd-list u) (math-poly-gcd-list v))) - (g 1) (h 1) (z 0) hh r delta ghd) + (g 1) (h 1) (z 0) r delta) (while (and u v (Math-zerop (car u)) (Math-zerop (car v))) (setq u (cdr u) v (cdr v) z (1+ z))) (or (eq d 1) @@ -452,8 +453,8 @@ v)) -;;; Return true if is a factor containing no sums or quotients. (defun math-atomic-factorp (expr) + "Return true if is a factor containing no sums or quotients." (cond ((eq (car-safe expr) '*) (and (math-atomic-factorp (nth 1 expr)) (math-atomic-factorp (nth 2 expr)))) @@ -463,14 +464,13 @@ (math-atomic-factorp (nth 1 expr))) (t t))) -;;; Find a suitable base for dividing a by b. -;;; The base must exist in both expressions. -;;; The degree in the numerator must be higher or equal than the -;;; degree in the denominator. -;;; If the above conditions are not met the quotient is just a remainder. -;;; Return nil if this is the case. - (defun math-poly-div-base (a b) + "Find a suitable base for dividing a by b. +The base must exist in both expressions. +The degree in the numerator must be higher or equal than the +degree in the denominator. +If the above conditions are not met the quotient is just a remainder. +Return nil if this is the case." (let (a-base b-base) (and (setq a-base (math-total-polynomial-base a)) (setq b-base (math-total-polynomial-base b)) @@ -482,12 +482,11 @@ (throw 'return (car (car a-base)))))) (setq a-base (cdr a-base))))))) -;;; Same as above but for gcd algorithm. -;;; Here there is no requirement that degree(a) > degree(b). -;;; Take the base that has the highest degree considering both a and b. -;;; ("a^20+b^21+x^3+a+b", "a+b^2+x^5+a^22+b^10") --> (a 22) - (defun math-poly-gcd-base (a b) + "Same as `math-poly-div-base' but for gcd algorithm. +Here there is no requirement that degree(a) > degree(b). +Take the base that has the highest degree considering both a and b. + (\"a^20+b^21+x^3+a+b\", \"a+b^2+x^5+a^22+b^10\") --> (a 22)" (let (a-base b-base) (and (setq a-base (math-total-polynomial-base a)) (setq b-base (math-total-polynomial-base b)) @@ -501,8 +500,8 @@ (throw 'return (car (car b-base))) (setq b-base (cdr b-base))))))))) -;;; Sort a list of polynomial bases. (defun math-sort-poly-base-list (lst) + "Sort a list of polynomial bases." (sort lst (function (lambda (a b) (or (> (nth 1 a) (nth 1 b)) (and (= (nth 1 a) (nth 1 b)) @@ -511,21 +510,18 @@ ;;; Given an expression find all variables that are polynomial bases. ;;; Return list in the form '( (var1 degree1) (var2 degree2) ... ). -;; The variable math-poly-base-total-base is local to -;; math-total-polynomial-base, but is used by math-polynomial-p1, -;; which is called by math-total-polynomial-base. +;; The variable math-poly-base-total-base and math-poly-base-top-expr are local +;; to math-total-polynomial-base, but used by math-polynomial-p1, which is +;; called by math-total-polynomial-base. (defvar math-poly-base-total-base) +(defvar math-poly-base-top-expr) (defun math-total-polynomial-base (expr) - (let ((math-poly-base-total-base nil)) - (math-polynomial-base expr 'math-polynomial-p1) + (let ((math-poly-base-total-base nil) + (math-poly-base-top-expr expr)) + (math-polynomial-base expr #'math-polynomial-p1) (math-sort-poly-base-list math-poly-base-total-base))) -;; The variable math-poly-base-top-expr is local to math-polynomial-base -;; in calc-alg.el, but is used by math-polynomial-p1 which is called -;; by math-polynomial-base. -(defvar math-poly-base-top-expr) - (defun math-polynomial-p1 (subexpr) (or (assoc subexpr math-poly-base-total-base) (memq (car subexpr) '(+ - * / neg)) @@ -554,28 +550,30 @@ ;; called (indirectly) by calcFunc-factors and calcFunc-factor. (defvar math-to-list) -(defun calcFunc-factors (math-fact-expr &optional var) +(defun calcFunc-factors (expr &optional var) (let ((math-factored-vars (if var t nil)) (math-to-list t) (calc-prefer-frac t)) (or var - (setq var (math-polynomial-base math-fact-expr))) + (setq var (math-polynomial-base expr))) (let ((res (math-factor-finish - (or (catch 'factor (math-factor-expr-try var)) - math-fact-expr)))) + (or (catch 'factor + (let ((math-fact-expr expr)) (math-factor-expr-try var))) + expr)))) (math-simplify (if (math-vectorp res) res (list 'vec (list 'vec res 1))))))) -(defun calcFunc-factor (math-fact-expr &optional var) +(defun calcFunc-factor (expr &optional var) (let ((math-factored-vars nil) (math-to-list nil) (calc-prefer-frac t)) (math-simplify (math-factor-finish (if var - (let ((math-factored-vars t)) - (or (catch 'factor (math-factor-expr-try var)) math-fact-expr)) - (math-factor-expr math-fact-expr)))))) + (let ((math-factored-vars t) + (math-fact-expr expr)) + (or (catch 'factor (math-factor-expr-try var)) expr)) + (math-factor-expr expr)))))) (defun math-factor-finish (x) (if (Math-primp x) @@ -589,18 +587,19 @@ (list 'calcFunc-Fac-Prot x) x)) -(defun math-factor-expr (math-fact-expr) - (cond ((eq math-factored-vars t) math-fact-expr) - ((or (memq (car-safe math-fact-expr) '(* / ^ neg)) - (assq (car-safe math-fact-expr) calc-tweak-eqn-table)) - (cons (car math-fact-expr) (mapcar 'math-factor-expr (cdr math-fact-expr)))) - ((memq (car-safe math-fact-expr) '(+ -)) +(defun math-factor-expr (expr) + (cond ((eq math-factored-vars t) expr) + ((or (memq (car-safe expr) '(* / ^ neg)) + (assq (car-safe expr) calc-tweak-eqn-table)) + (cons (car expr) (mapcar 'math-factor-expr (cdr expr)))) + ((memq (car-safe expr) '(+ -)) (let* ((math-factored-vars math-factored-vars) - (y (catch 'factor (math-factor-expr-part math-fact-expr)))) + (y (catch 'factor (let ((math-fact-expr expr)) + (math-factor-expr-part expr))))) (if y (math-factor-expr y) - math-fact-expr))) - (t math-fact-expr))) + expr))) + (t expr))) (defun math-factor-expr-part (x) ; uses "expr" (if (memq (car-safe x) '(+ - * / ^ neg)) @@ -616,20 +615,20 @@ ;; used by math-factor-poly-coefs, which is called by math-factor-expr-try. (defvar math-fet-x) -(defun math-factor-expr-try (math-fet-x) +(defun math-factor-expr-try (x) (if (eq (car-safe math-fact-expr) '*) (let ((res1 (catch 'factor (let ((math-fact-expr (nth 1 math-fact-expr))) - (math-factor-expr-try math-fet-x)))) + (math-factor-expr-try x)))) (res2 (catch 'factor (let ((math-fact-expr (nth 2 math-fact-expr))) - (math-factor-expr-try math-fet-x))))) + (math-factor-expr-try x))))) (and (or res1 res2) (throw 'factor (math-accum-factors (or res1 (nth 1 math-fact-expr)) 1 (or res2 (nth 2 math-fact-expr)))))) - (let* ((p (math-is-polynomial math-fact-expr math-fet-x 30 'gen)) + (let* ((p (math-is-polynomial math-fact-expr x 30 'gen)) (math-poly-modulus (math-poly-modulus math-fact-expr)) res) (and (cdr p) - (setq res (math-factor-poly-coefs p)) + (setq res (let ((math-fet-x x)) (math-factor-poly-coefs p))) (throw 'factor res))))) (defun math-accum-factors (fac pow facs) @@ -735,7 +734,6 @@ (let ((roots (car t1)) (csign (if (math-negp (nth (1- (length p)) p)) -1 1)) (expr 1) - (unfac (nth 1 t1)) (scale (nth 2 t1))) (while roots (let ((coef0 (car (car roots))) @@ -1108,7 +1106,7 @@ If no partial fraction representation can be found, return nil." (t expr))) (defun calcFunc-expand (expr &optional many) - (math-normalize (math-map-tree 'math-expand-term expr many))) + (math-normalize (math-map-tree #'math-expand-term expr many))) (defun math-expand-power (x n &optional var else-nil) (or (and (natnump n) diff --git a/lisp/calc/calc-units.el b/lisp/calc/calc-units.el index 17d16acee0e..6e58eaf225f 100644 --- a/lisp/calc/calc-units.el +++ b/lisp/calc/calc-units.el @@ -1,4 +1,4 @@ -;;; calc-units.el --- unit conversion functions for Calc +;;; calc-units.el --- unit conversion functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -455,7 +455,6 @@ If COMP or STD is non-nil, put that in the units table instead." (uoldname nil) (unitscancel nil) (nouold nil) - unew units defunits) (if (or (not (math-units-in-expr-p expr t)) @@ -672,8 +671,8 @@ If COMP or STD is non-nil, put that in the units table instead." (substring name (1+ pos))))) (setq name (concat "(" name ")")))) (or (eq (nth 1 expr) (car u)) - (setq name (concat (nth 2 (assq (aref (symbol-name - (nth 1 expr)) 0) + (setq name (concat (nth 2 (assq (aref (symbol-name (nth 1 expr)) + 0) math-unit-prefixes)) (if (and (string-match "[^a-zA-Zα-ωΑ-Ω0-9']" name) (not (memq (car u) '(mHg gf)))) @@ -857,7 +856,7 @@ If COMP or STD is non-nil, put that in the units table instead." (or math-units-table (let* ((combined-units (append math-additional-units math-standard-units)) - (math-cu-unit-list (mapcar 'car combined-units)) + (math-cu-unit-list (mapcar #'car combined-units)) tab) (message "Building units table...") (setq math-units-table-buffer-valid nil) @@ -880,7 +879,7 @@ If COMP or STD is non-nil, put that in the units table instead." (nth 4 x)))) combined-units)) (let ((math-units-table tab)) - (mapc 'math-find-base-units tab)) + (mapc #'math-find-base-units tab)) (message "Building units table...done") (setq math-units-table tab)))) @@ -890,15 +889,16 @@ If COMP or STD is non-nil, put that in the units table instead." (defvar math-fbu-base) (defvar math-fbu-entry) -(defun math-find-base-units (math-fbu-entry) - (if (eq (nth 4 math-fbu-entry) 'boom) - (error "Circular definition involving unit %s" (car math-fbu-entry))) - (or (nth 4 math-fbu-entry) - (let (math-fbu-base) - (setcar (nthcdr 4 math-fbu-entry) 'boom) - (math-find-base-units-rec (nth 1 math-fbu-entry) 1) +(defun math-find-base-units (entry) + (if (eq (nth 4 entry) 'boom) + (error "Circular definition involving unit %s" (car entry))) + (or (nth 4 entry) + (let (math-fbu-base + (math-fbu-entry entry)) + (setcar (nthcdr 4 entry) 'boom) + (math-find-base-units-rec (nth 1 entry) 1) '(or math-fbu-base - (error "Dimensionless definition for unit %s" (car math-fbu-entry))) + (error "Dimensionless definition for unit %s" (car entry))) (while (eq (cdr (car math-fbu-base)) 0) (setq math-fbu-base (cdr math-fbu-base))) (let ((b math-fbu-base)) @@ -907,7 +907,7 @@ If COMP or STD is non-nil, put that in the units table instead." (setcdr b (cdr (cdr b))) (setq b (cdr b))))) (setq math-fbu-base (sort math-fbu-base 'math-compare-unit-names)) - (setcar (nthcdr 4 math-fbu-entry) math-fbu-base) + (setcar (nthcdr 4 entry) math-fbu-base) math-fbu-base))) (defun math-compare-unit-names (a b) @@ -942,7 +942,8 @@ If COMP or STD is non-nil, put that in the units table instead." (error "Unknown name %s in defining expression for unit %s" (nth 1 expr) (car math-fbu-entry)))) ((equal expr '(calcFunc-ln 10))) - (t (error "Malformed defining expression for unit %s" (car math-fbu-entry)))))) + (t (error "Malformed defining expression for unit %s" + (car math-fbu-entry)))))) (defun math-units-in-expr-p (expr sub-exprs) @@ -1018,8 +1019,9 @@ If COMP or STD is non-nil, put that in the units table instead." ;; math-to-standard-units. (defvar math-which-standard) -(defun math-to-standard-units (expr math-which-standard) - (math-to-standard-rec expr)) +(defun math-to-standard-units (expr which-standard) + (let ((math-which-standard which-standard)) + (math-to-standard-rec expr))) (defun math-to-standard-rec (expr) (if (eq (car-safe expr) 'var) @@ -1052,7 +1054,7 @@ If COMP or STD is non-nil, put that in the units table instead." (eq (car-safe (nth 1 expr)) 'var))) expr (cons (car expr) - (mapcar 'math-to-standard-rec (cdr expr)))))) + (mapcar #'math-to-standard-rec (cdr expr)))))) (defun math-apply-units (expr units ulist &optional pure) (setq expr (math-simplify-units expr)) @@ -1085,8 +1087,7 @@ If COMP or STD is non-nil, put that in the units table instead." (let ((entry (list units calc-internal-prec calc-prefer-frac))) (or (equal entry (car math-decompose-units-cache)) (let ((ulist nil) - (utemp units) - qty unit) + (utemp units)) (while (eq (car-safe utemp) '+) (setq ulist (cons (math-decompose-unit-part (nth 2 utemp)) ulist) @@ -1144,15 +1145,15 @@ If COMP or STD is non-nil, put that in the units table instead." (defvar math-cu-new-units) (defvar math-cu-pure) -(defun math-convert-units (expr math-cu-new-units &optional math-cu-pure) - (if (eq (car-safe math-cu-new-units) 'var) - (let ((unew (assq (nth 1 math-cu-new-units) +(defun math-convert-units (expr new-units &optional pure) + (if (eq (car-safe new-units) 'var) + (let ((unew (assq (nth 1 new-units) (math-build-units-table)))) (if (eq (car-safe (nth 1 unew)) '+) - (setq math-cu-new-units (nth 1 unew))))) + (setq new-units (nth 1 unew))))) (math-with-extra-prec 2 - (let ((compat (and (not math-cu-pure) - (math-find-compatible-unit expr math-cu-new-units))) + (let ((compat (and (not pure) + (math-find-compatible-unit expr new-units))) (math-cu-unit-list nil) (math-combining-units nil)) (if compat @@ -1160,21 +1161,23 @@ If COMP or STD is non-nil, put that in the units table instead." (math-mul (math-mul (math-simplify-units (math-div expr (math-pow (car compat) (cdr compat)))) - (math-pow math-cu-new-units (cdr compat))) + (math-pow new-units (cdr compat))) (math-simplify-units (math-to-standard-units - (math-pow (math-div (car compat) math-cu-new-units) + (math-pow (math-div (car compat) new-units) (cdr compat)) nil)))) - (when (setq math-cu-unit-list (math-decompose-units math-cu-new-units)) - (setq math-cu-new-units (nth 2 (car math-cu-unit-list)))) + (when (setq math-cu-unit-list (math-decompose-units new-units)) + (setq new-units (nth 2 (car math-cu-unit-list)))) (when (eq (car-safe expr) '+) (setq expr (math-simplify-units expr))) (if (math-units-in-expr-p expr t) - (math-convert-units-rec expr) + (let ((math-cu-new-units new-units) + (math-cu-pure pure)) + (math-convert-units-rec expr)) (math-apply-units (math-to-standard-units - (list '/ expr math-cu-new-units) nil) - math-cu-new-units math-cu-unit-list math-cu-pure)))))) + (list '/ expr new-units) nil) + new-units math-cu-unit-list pure)))))) (defun math-convert-units-rec (expr) (if (math-units-in-expr-p expr nil) @@ -1184,7 +1187,7 @@ If COMP or STD is non-nil, put that in the units table instead." (if (Math-primp expr) expr (cons (car expr) - (mapcar 'math-convert-units-rec (cdr expr)))))) + (mapcar #'math-convert-units-rec (cdr expr)))))) (defun math-convert-temperature (expr old new &optional pure) (let* ((units (math-single-units-in-expr-p expr)) @@ -1228,37 +1231,34 @@ If COMP or STD is non-nil, put that in the units table instead." (math-simplify a))) (defalias 'calcFunc-usimplify 'math-simplify-units) -;; The function created by math-defsimplify uses the variable -;; math-simplify-expr, and so is used by functions in math-defsimplify -(defvar math-simplify-expr) - +;; The function created by math-defsimplify uses the variable `expr'. (math-defsimplify (+ -) (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) - (let* ((units (math-extract-units (nth 1 math-simplify-expr))) + (math-units-in-expr-p (nth 1 expr) nil) + (let* ((units (math-extract-units (nth 1 expr))) (ratio (math-simplify (math-to-standard-units - (list '/ (nth 2 math-simplify-expr) units) nil)))) + (list '/ (nth 2 expr) units) nil)))) (if (math-units-in-expr-p ratio nil) (progn - (calc-record-why "*Inconsistent units" math-simplify-expr) - math-simplify-expr) - (list '* (math-add (math-remove-units (nth 1 math-simplify-expr)) - (if (eq (car math-simplify-expr) '-) + (calc-record-why "*Inconsistent units" expr) + expr) + (list '* (math-add (math-remove-units (nth 1 expr)) + (if (eq (car expr) '-) (math-neg ratio) ratio)) units))))) (math-defsimplify * - (math-simplify-units-prod)) + (math-simplify-units-prod expr)) -(defun math-simplify-units-prod () +(defun math-simplify-units-prod (expr) (and math-simplifying-units calc-autorange-units - (Math-realp (nth 1 math-simplify-expr)) - (let* ((num (math-float (nth 1 math-simplify-expr))) + (Math-realp (nth 1 expr)) + (let* ((num (math-float (nth 1 expr))) (xpon (calcFunc-xpon num)) - (unitp (cdr (cdr math-simplify-expr))) + (unitp (cdr (cdr expr))) (unit (car unitp)) - (pow (if (eq (car math-simplify-expr) '*) 1 -1)) + (pow (if (eq (car expr) '*) 1 -1)) u) (and (eq (car-safe unit) '*) (setq unitp (cdr unit) @@ -1308,46 +1308,46 @@ If COMP or STD is non-nil, put that in the units table instead." (or (not (eq p pref)) (< xpon (+ pxpon (* (math-abs pow) 3)))) (progn - (setcar (cdr math-simplify-expr) + (setcar (cdr expr) (let ((calc-prefer-frac nil)) - (calcFunc-scf (nth 1 math-simplify-expr) + (calcFunc-scf (nth 1 expr) (- uxpon pxpon)))) (setcar unitp pname) - math-simplify-expr))))))) + expr))))))) (defvar math-try-cancel-units) (math-defsimplify / (and math-simplifying-units - (let ((np (cdr math-simplify-expr)) + (let ((np (cdr expr)) (math-try-cancel-units 0) - n nn) - (setq n (if (eq (car-safe (nth 2 math-simplify-expr)) '*) - (cdr (nth 2 math-simplify-expr)) - (nthcdr 2 math-simplify-expr))) + n) + (setq n (if (eq (car-safe (nth 2 expr)) '*) + (cdr (nth 2 expr)) + (nthcdr 2 expr))) (if (math-realp (car n)) (progn - (setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-expr) + (setcar (cdr expr) (math-mul (nth 1 expr) (let ((calc-prefer-frac nil)) (math-div 1 (car n))))) (setcar n 1))) (while (eq (car-safe (setq n (car np))) '*) - (math-simplify-units-divisor (cdr n) (cdr (cdr math-simplify-expr))) + (math-simplify-units-divisor (cdr n) (cdr (cdr expr))) (setq np (cdr (cdr n)))) - (math-simplify-units-divisor np (cdr (cdr math-simplify-expr))) + (math-simplify-units-divisor np (cdr (cdr expr))) (if (eq math-try-cancel-units 0) (let* ((math-simplifying-units nil) (base (math-simplify - (math-to-standard-units math-simplify-expr nil)))) + (math-to-standard-units expr nil)))) (if (Math-numberp base) - (setq math-simplify-expr base)))) - (if (eq (car-safe math-simplify-expr) '/) - (math-simplify-units-prod)) - math-simplify-expr))) + (setq expr base)))) + (if (eq (car-safe expr) '/) + (math-simplify-units-prod expr)) + expr))) (defun math-simplify-units-divisor (np dp) (let ((n (car np)) - d dd temp) + d temp) (while (eq (car-safe (setq d (car dp))) '*) (when (setq temp (math-simplify-units-quotient n (nth 1 d))) (setcar np (setq n temp)) @@ -1387,23 +1387,23 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify ^ (and math-simplifying-units - (math-realp (nth 2 math-simplify-expr)) - (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list '^ (nth 1 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr)) - (list '^ (nth 2 (nth 1 math-simplify-expr)) - (nth 2 math-simplify-expr))) - (math-simplify-units-pow (nth 1 math-simplify-expr) - (nth 2 math-simplify-expr))))) + (math-realp (nth 2 expr)) + (if (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list '^ (nth 1 (nth 1 expr)) + (nth 2 expr)) + (list '^ (nth 2 (nth 1 expr)) + (nth 2 expr))) + (math-simplify-units-pow (nth 1 expr) + (nth 2 expr))))) (math-defsimplify calcFunc-sqrt (and math-simplifying-units - (if (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) - (list (car (nth 1 math-simplify-expr)) - (list 'calcFunc-sqrt (nth 1 (nth 1 math-simplify-expr))) - (list 'calcFunc-sqrt (nth 2 (nth 1 math-simplify-expr)))) - (math-simplify-units-pow (nth 1 math-simplify-expr) '(frac 1 2))))) + (if (memq (car-safe (nth 1 expr)) '(* /)) + (list (car (nth 1 expr)) + (list 'calcFunc-sqrt (nth 1 (nth 1 expr))) + (list 'calcFunc-sqrt (nth 2 (nth 1 expr)))) + (math-simplify-units-pow (nth 1 expr) '(frac 1 2))))) (math-defsimplify (calcFunc-floor calcFunc-ceil @@ -1416,21 +1416,21 @@ If COMP or STD is non-nil, put that in the units table instead." calcFunc-abs calcFunc-clean) (and math-simplifying-units - (= (length math-simplify-expr) 2) - (if (math-only-units-in-expr-p (nth 1 math-simplify-expr)) - (nth 1 math-simplify-expr) - (if (and (memq (car-safe (nth 1 math-simplify-expr)) '(* /)) + (= (length expr) 2) + (if (math-only-units-in-expr-p (nth 1 expr)) + (nth 1 expr) + (if (and (memq (car-safe (nth 1 expr)) '(* /)) (or (math-only-units-in-expr-p - (nth 1 (nth 1 math-simplify-expr))) + (nth 1 (nth 1 expr))) (math-only-units-in-expr-p - (nth 2 (nth 1 math-simplify-expr))))) - (list (car (nth 1 math-simplify-expr)) - (cons (car math-simplify-expr) - (cons (nth 1 (nth 1 math-simplify-expr)) - (cdr (cdr math-simplify-expr)))) - (cons (car math-simplify-expr) - (cons (nth 2 (nth 1 math-simplify-expr)) - (cdr (cdr math-simplify-expr))))))))) + (nth 2 (nth 1 expr))))) + (list (car (nth 1 expr)) + (cons (car expr) + (cons (nth 1 (nth 1 expr)) + (cdr (cdr expr)))) + (cons (car expr) + (cons (nth 2 (nth 1 expr)) + (cdr (cdr expr))))))))) (defun math-simplify-units-pow (a pow) (if (and (eq (car-safe a) '^) @@ -1453,10 +1453,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-sin (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1466,10 +1466,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-cos (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1479,10 +1479,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-tan (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1492,10 +1492,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-sec (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1505,10 +1505,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-csc (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1518,10 +1518,10 @@ If COMP or STD is non-nil, put that in the units table instead." (math-defsimplify calcFunc-cot (and math-simplifying-units - (math-units-in-expr-p (nth 1 math-simplify-expr) nil) + (math-units-in-expr-p (nth 1 expr) nil) (let ((rad (math-simplify-units (math-evaluate-expr - (math-to-standard-units (nth 1 math-simplify-expr) nil)))) + (math-to-standard-units (nth 1 expr) nil)))) (calc-angle-mode 'rad)) (and (eq (car-safe rad) '*) (math-realp (nth 1 rad)) @@ -1536,13 +1536,13 @@ If COMP or STD is non-nil, put that in the units table instead." (if (Math-primp expr) expr (cons (car expr) - (mapcar 'math-remove-units (cdr expr)))))) + (mapcar #'math-remove-units (cdr expr)))))) (defun math-extract-units (expr) (cond ((memq (car-safe expr) '(* /)) (cons (car expr) - (mapcar 'math-extract-units (cdr expr)))) + (mapcar #'math-extract-units (cdr expr)))) ((eq (car-safe expr) 'neg) (math-extract-units (nth 1 expr))) ((eq (car-safe expr) '^) @@ -1669,7 +1669,7 @@ In symbolic mode, return the list (^ a b)." (defun math-extract-logunits (expr) (if (memq (car-safe expr) '(* /)) (cons (car expr) - (mapcar 'math-extract-logunits (cdr expr))) + (mapcar #'math-extract-logunits (cdr expr))) (if (memq (car-safe expr) '(^)) (list '^ (math-extract-logunits (nth 1 expr)) (nth 2 expr)) (if (member expr math-logunits) expr 1)))) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 871e65a2cba..f155b8283b7 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -1,4 +1,4 @@ -;;; calc.el --- the GNU Emacs calculator +;;; calc.el --- the GNU Emacs calculator -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -178,7 +178,7 @@ (declare-function math-read-radix-digit "calc-misc" (dig)) (declare-function calc-digit-dots "calc-incom" ()) (declare-function math-normalize-fancy "calc-ext" (a)) -(declare-function math-normalize-nonstandard "calc-ext" ()) +(declare-function math-normalize-nonstandard "calc-ext" (a)) (declare-function math-recompile-eval-rules "calc-alg" ()) (declare-function math-apply-rewrites "calc-rewr" (expr rules &optional heads math-apply-rw-ruleset)) (declare-function calc-record-why "calc-misc" (&rest stuff)) @@ -203,7 +203,7 @@ (declare-function math-compose-expr "calccomp" (a prec &optional div)) (declare-function math-comp-width "calccomp" (c)) (declare-function math-composition-to-string "calccomp" (c &optional width)) -(declare-function math-stack-value-offset-fancy "calccomp" ()) +(declare-function math-stack-value-offset-fancy "calccomp" (c)) (declare-function math-format-flat-expr-fancy "calc-ext" (a prec)) (declare-function math-adjust-fraction "calc-ext" (a)) (declare-function math-format-binary "calc-bin" (a)) @@ -1331,16 +1331,17 @@ Notations: 3.14e6 3.14 * 10^6 " (interactive) (mapc (function ;FIXME: Why (set-default v (symbol-value v)) ?!?!? - (lambda (v) (set-default v (symbol-value v)))) calc-local-var-list) + (lambda (v) (set-default v (symbol-value v)))) + calc-local-var-list) (kill-all-local-variables) (use-local-map (if (eq calc-algebraic-mode 'total) (progn (require 'calc-ext) calc-alg-map) calc-mode-map)) (mapc #'make-local-variable calc-local-var-list) (make-local-variable 'overlay-arrow-position) (make-local-variable 'overlay-arrow-string) - (add-hook 'change-major-mode-hook 'font-lock-defontify nil t) + (add-hook 'change-major-mode-hook #'font-lock-defontify nil t) (add-hook 'kill-buffer-query-functions - 'calc-kill-stack-buffer + #'calc-kill-stack-buffer t t) (setq truncate-lines t) (setq buffer-read-only t) @@ -1795,7 +1796,7 @@ See calc-keypad for details." (if calc-hyperbolic-flag "Hyp " "") (if calc-keep-args-flag "Keep " "") (if (/= calc-stack-top 1) "Narrow " "") - (apply 'concat calc-other-modes))))) + (apply #'concat calc-other-modes))))) (if (equal new-mode-string mode-line-buffer-identification) nil (setq mode-line-buffer-identification new-mode-string) @@ -1869,7 +1870,7 @@ See calc-keypad for details." (if (and (consp vals) (or (integerp (car vals)) (consp (car vals)))) - (setq vals (mapcar 'calc-normalize vals)) + (setq vals (mapcar #'calc-normalize vals)) (setq vals (calc-normalize vals))) (or (and (consp vals) (or (integerp (car vals)) @@ -1952,8 +1953,8 @@ See calc-keypad for details." (mapcar (lambda (x) (calc-get-stack-element x sel-mode)) top))))) (defun calc-top-list-n (&optional n m sel-mode) - (mapcar 'math-check-complete - (mapcar 'calc-normalize (calc-top-list n m sel-mode)))) + (mapcar #'math-check-complete + (mapcar #'calc-normalize (calc-top-list n m sel-mode)))) (defun calc-renumber-stack () @@ -2207,7 +2208,7 @@ the United States." (setq calc-aborted-prefix name) (if (null arg) (calc-enter-result 2 name (cons (or func2 func) - (mapcar 'math-check-complete + (mapcar #'math-check-complete (calc-top-list 2)))) (require 'calc-ext) (calc-binary-op-fancy name func arg ident unary))) @@ -2619,78 +2620,78 @@ largest Emacs integer.") (defvar math-eval-rules-cache-other) ;;; Reduce an object to canonical (normalized) form. [O o; Z Z] [Public] -(defvar math-normalize-a) (defvar math-normalize-error nil "Non-nil if the last call the `math-normalize' returned an error.") -(defun math-normalize (math-normalize-a) +(defun math-normalize (a) (setq math-normalize-error nil) (cond - ((not (consp math-normalize-a)) - (if (integerp math-normalize-a) - (if (or (>= math-normalize-a math-small-integer-size) - (<= math-normalize-a (- math-small-integer-size))) - (math-bignum math-normalize-a) - math-normalize-a) - math-normalize-a)) - ((eq (car math-normalize-a) 'bigpos) - (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) - (let* ((last (setq math-normalize-a - (copy-sequence math-normalize-a))) (digs math-normalize-a)) + ((not (consp a)) + (if (integerp a) + (if (or (>= a math-small-integer-size) + (<= a (- math-small-integer-size))) + (math-bignum a) + a) + a)) + ((eq (car a) 'bigpos) + (if (eq (nth (1- (length a)) a) 0) + (let* ((last (setq a + (copy-sequence a))) + (digs a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr math-normalize-a))) - math-normalize-a + (if (cdr (cdr (cdr a))) + a (cond - ((cdr (cdr math-normalize-a)) (+ (nth 1 math-normalize-a) - (* (nth 2 math-normalize-a) + ((cdr (cdr a)) (+ (nth 1 a) + (* (nth 2 a) math-bignum-digit-size))) - ((cdr math-normalize-a) (nth 1 math-normalize-a)) + ((cdr a) (nth 1 a)) (t 0)))) - ((eq (car math-normalize-a) 'bigneg) - (if (eq (nth (1- (length math-normalize-a)) math-normalize-a) 0) - (let* ((last (setq math-normalize-a (copy-sequence math-normalize-a))) - (digs math-normalize-a)) + ((eq (car a) 'bigneg) + (if (eq (nth (1- (length a)) a) 0) + (let* ((last (setq a (copy-sequence a))) + (digs a)) (while (setq digs (cdr digs)) (or (eq (car digs) 0) (setq last digs))) (setcdr last nil))) - (if (cdr (cdr (cdr math-normalize-a))) - math-normalize-a + (if (cdr (cdr (cdr a))) + a (cond - ((cdr (cdr math-normalize-a)) (- (+ (nth 1 math-normalize-a) - (* (nth 2 math-normalize-a) + ((cdr (cdr a)) (- (+ (nth 1 a) + (* (nth 2 a) math-bignum-digit-size)))) - ((cdr math-normalize-a) (- (nth 1 math-normalize-a))) + ((cdr a) (- (nth 1 a))) (t 0)))) - ((eq (car math-normalize-a) 'float) - (math-make-float (math-normalize (nth 1 math-normalize-a)) - (nth 2 math-normalize-a))) - ((or (memq (car math-normalize-a) + ((eq (car a) 'float) + (math-make-float (math-normalize (nth 1 a)) + (nth 2 a))) + ((or (memq (car a) '(frac cplx polar hms date mod sdev intv vec var quote special-const calcFunc-if calcFunc-lambda calcFunc-quote calcFunc-condition calcFunc-evalto)) - (integerp (car math-normalize-a)) - (and (consp (car math-normalize-a)) - (not (eq (car (car math-normalize-a)) 'lambda)))) + (integerp (car a)) + (and (consp (car a)) + (not (eq (car (car a)) 'lambda)))) (require 'calc-ext) - (math-normalize-fancy math-normalize-a)) + (math-normalize-fancy a)) (t (or (and calc-simplify-mode (require 'calc-ext) - (math-normalize-nonstandard)) - (let ((args (mapcar 'math-normalize (cdr math-normalize-a)))) + (math-normalize-nonstandard a)) + (let ((args (mapcar #'math-normalize (cdr a)))) (or (condition-case err (let ((func - (assq (car math-normalize-a) '( ( + . math-add ) - ( - . math-sub ) - ( * . math-mul ) - ( / . math-div ) - ( % . math-mod ) - ( ^ . math-pow ) - ( neg . math-neg ) - ( | . math-concat ) )))) + (assq (car a) '( ( + . math-add ) + ( - . math-sub ) + ( * . math-mul ) + ( / . math-div ) + ( % . math-mod ) + ( ^ . math-pow ) + ( neg . math-neg ) + ( | . math-concat ) )))) (or (and var-EvalRules (progn (or (eq var-EvalRules math-eval-rules-cache-tag) @@ -2698,59 +2699,59 @@ largest Emacs integer.") (require 'calc-ext) (math-recompile-eval-rules))) (and (or math-eval-rules-cache-other - (assq (car math-normalize-a) + (assq (car a) math-eval-rules-cache)) (math-apply-rewrites - (cons (car math-normalize-a) args) + (cons (car a) args) (cdr math-eval-rules-cache) nil math-eval-rules-cache)))) (if func (apply (cdr func) args) - (and (or (consp (car math-normalize-a)) - (fboundp (car math-normalize-a)) + (and (or (consp (car a)) + (fboundp (car a)) (and (not (featurep 'calc-ext)) (require 'calc-ext) - (fboundp (car math-normalize-a)))) - (apply (car math-normalize-a) args))))) + (fboundp (car a)))) + (apply (car a) args))))) (wrong-number-of-arguments (setq math-normalize-error t) (calc-record-why "*Wrong number of arguments" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (wrong-type-argument (or calc-next-why (calc-record-why "Wrong type of argument" - (cons (car math-normalize-a) args))) + (cons (car a) args))) nil) (args-out-of-range (setq math-normalize-error t) (calc-record-why "*Argument out of range" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (inexact-result (calc-record-why "No exact representation for result" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (math-overflow (setq math-normalize-error t) (calc-record-why "*Floating-point overflow occurred" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (math-underflow (setq math-normalize-error t) (calc-record-why "*Floating-point underflow occurred" - (cons (car math-normalize-a) args)) + (cons (car a) args)) nil) (void-variable (setq math-normalize-error t) (if (eq (nth 1 err) 'var-EvalRules) (progn (setq var-EvalRules nil) - (math-normalize (cons (car math-normalize-a) args))) + (math-normalize (cons (car a) args))) (calc-record-why "*Variable is void" (nth 1 err))))) - (if (consp (car math-normalize-a)) + (if (consp (car a)) (math-dimension-error) - (cons (car math-normalize-a) args)))))))) + (cons (car a) args)))))))) @@ -2781,13 +2782,6 @@ largest Emacs integer.") (cond ((>= a 0) (cons 'bigpos (math-bignum-big a))) - ((= a most-negative-fixnum) - ;; Note: cannot get the negation directly because - ;; (- most-negative-fixnum) is most-negative-fixnum. - ;; - ;; most-negative-fixnum := -most-positive-fixnum - 1 - (math-sub (cons 'bigneg (math-bignum-big most-positive-fixnum)) - 1)) (t (cons 'bigneg (math-bignum-big (- a)))))) @@ -2841,7 +2835,7 @@ largest Emacs integer.") ((eq (car a) 'frac) (math-div (math-float (nth 1 a)) (nth 2 a))) ((eq (car a) 'float) a) ((memq (car a) '(cplx polar vec hms date sdev mod)) - (cons (car a) (mapcar 'math-float (cdr a)))) + (cons (car a) (mapcar #'math-float (cdr a)))) (t (math-float-fancy a)))) @@ -2852,7 +2846,7 @@ largest Emacs integer.") ((memq (car a) '(frac float)) (list (car a) (Math-integer-neg (nth 1 a)) (nth 2 a))) ((memq (car a) '(cplx vec hms date calcFunc-idn)) - (cons (car a) (mapcar 'math-neg (cdr a)))) + (cons (car a) (mapcar #'math-neg (cdr a)))) (t (math-neg-fancy a)))) @@ -3432,22 +3426,21 @@ largest Emacs integer.") (setcar (cdr entry) (calc-count-lines s)) s)) -;; The variables math-svo-c, math-svo-wid and math-svo-off are local +;; The variables math-svo-wid and math-svo-off are local ;; to math-stack-value-offset, but are used by math-stack-value-offset-fancy ;; in calccomp.el. -(defvar math-svo-c) (defvar math-svo-wid) (defvar math-svo-off) -(defun math-stack-value-offset (math-svo-c) +(defun math-stack-value-offset (c) (let* ((num (if calc-line-numbering 4 0)) (math-svo-wid (calc-window-width)) math-svo-off) (if calc-display-just (progn (require 'calc-ext) - (math-stack-value-offset-fancy)) + (math-stack-value-offset-fancy c)) (setq math-svo-off (or calc-display-origin 0)) (when (integerp calc-line-breaking) (setq math-svo-wid calc-line-breaking))) @@ -3880,7 +3873,7 @@ The prefix `calcFunc-' is added to the specified name to get the actual Lisp function name. See Info node `(calc)Defining Functions'." - (declare (doc-string 3)) + (declare (doc-string 3)) ;; FIXME: Edebug spec? (require 'calc-ext) (math-do-defmath func args body)) diff --git a/lisp/calc/calccomp.el b/lisp/calc/calccomp.el index 858343aae93..75c7adc59ec 100644 --- a/lisp/calc/calccomp.el +++ b/lisp/calc/calccomp.el @@ -1,4 +1,4 @@ -;;; calccomp.el --- composition functions for Calc +;;; calccomp.el --- composition functions for Calc -*- lexical-binding:t -*- ;; Copyright (C) 1990-1993, 2001-2018 Free Software Foundation, Inc. @@ -121,7 +121,8 @@ calc-lang-slash-idiv) (math-float (nth 1 aa)) (nth 1 aa)) - (nth 2 aa)) prec)) + (nth 2 aa)) + prec)) (if (and (eq calc-language 'big) (= (length (car calc-frac-format)) 1)) (let* ((aa (math-adjust-fraction a)) @@ -202,8 +203,9 @@ (math-comp-comma-spc (or calc-vector-commas " ")) (math-comp-comma (or calc-vector-commas "")) (math-comp-vector-prec (if (or (and calc-vector-commas - (math-vector-no-parens a)) - (memq 'P calc-matrix-brackets)) 0 1000)) + (math-vector-no-parens a)) + (memq 'P calc-matrix-brackets)) + 0 1000)) (math-comp-just (cond ((eq calc-matrix-just 'right) 'vright) ((eq calc-matrix-just 'center) 'vcent) (t 'vleft))) @@ -803,8 +805,7 @@ ( % . calcFunc-mod ) ( ^ . calcFunc-pow ) ( neg . calcFunc-neg ) - ( | . calcFunc-vconcat )))) - left right args) + ( | . calcFunc-vconcat ))))) (if func2 (setq func (cdr func2))) (if (setq func2 (rassq func math-expr-function-mapping)) @@ -858,7 +859,7 @@ (or (cdr (cdr a)) (not (eq (car-safe (nth 1 a)) '*)))) -(defun math-compose-matrix (a col cols base) +(defun math-compose-matrix (a _col cols base) (let ((col 0) (res nil)) (while (<= (setq col (1+ col)) cols) @@ -968,8 +969,8 @@ (and (memq (car a) '(^ calcFunc-subscr)) (math-tex-expr-is-flat (nth 1 a))))) -(put 'calcFunc-log 'math-compose-big 'math-compose-log) -(defun math-compose-log (a prec) +(put 'calcFunc-log 'math-compose-big #'math-compose-log) +(defun math-compose-log (a _prec) (and (= (length a) 3) (list 'horiz (list 'subscr "log" @@ -979,8 +980,8 @@ (math-compose-expr (nth 1 a) 1000) ")"))) -(put 'calcFunc-log10 'math-compose-big 'math-compose-log10) -(defun math-compose-log10 (a prec) +(put 'calcFunc-log10 'math-compose-big #'math-compose-log10) +(defun math-compose-log10 (a _prec) (and (= (length a) 2) (list 'horiz (list 'subscr "log" "10") @@ -988,8 +989,8 @@ (math-compose-expr (nth 1 a) 1000) ")"))) -(put 'calcFunc-deriv 'math-compose-big 'math-compose-deriv) -(put 'calcFunc-tderiv 'math-compose-big 'math-compose-deriv) +(put 'calcFunc-deriv 'math-compose-big #'math-compose-deriv) +(put 'calcFunc-tderiv 'math-compose-big #'math-compose-deriv) (defun math-compose-deriv (a prec) (when (= (length a) 3) (math-compose-expr (list '/ @@ -1003,8 +1004,8 @@ (nth 2 a)))) prec))) -(put 'calcFunc-sqrt 'math-compose-big 'math-compose-sqrt) -(defun math-compose-sqrt (a prec) +(put 'calcFunc-sqrt 'math-compose-big #'math-compose-sqrt) +(defun math-compose-sqrt (a _prec) (when (= (length a) 2) (let* ((c (math-compose-expr (nth 1 a) 0)) (a (math-comp-ascent c)) @@ -1024,8 +1025,8 @@ " " c))))) -(put 'calcFunc-choose 'math-compose-big 'math-compose-choose) -(defun math-compose-choose (a prec) +(put 'calcFunc-choose 'math-compose-big #'math-compose-choose) +(defun math-compose-choose (a _prec) (let ((a1 (math-compose-expr (nth 1 a) 0)) (a2 (math-compose-expr (nth 2 a) 0))) (list 'horiz @@ -1035,7 +1036,7 @@ a1 " " a2) ")"))) -(put 'calcFunc-integ 'math-compose-big 'math-compose-integ) +(put 'calcFunc-integ 'math-compose-big #'math-compose-integ) (defun math-compose-integ (a prec) (and (memq (length a) '(3 5)) (eq (car-safe (nth 2 a)) 'var) @@ -1072,7 +1073,7 @@ (list 'horiz " d" var)) (if parens ")" ""))))) -(put 'calcFunc-sum 'math-compose-big 'math-compose-sum) +(put 'calcFunc-sum 'math-compose-big #'math-compose-sum) (defun math-compose-sum (a prec) (and (memq (length a) '(3 5 6)) (let* ((expr (math-compose-expr (nth 1 a) 185)) @@ -1097,7 +1098,7 @@ expr (if (memq prec '(180 201)) ")" ""))))) -(put 'calcFunc-prod 'math-compose-big 'math-compose-prod) +(put 'calcFunc-prod 'math-compose-big #'math-compose-prod) (defun math-compose-prod (a prec) (and (memq (length a) '(3 5 6)) (let* ((expr (math-compose-expr (nth 1 a) 198)) @@ -1124,12 +1125,11 @@ ;; The variables math-svo-c, math-svo-wid and math-svo-off are local ;; to math-stack-value-offset in calc.el, but are used by ;; math-stack-value-offset-fancy, which is called by math-stack-value-offset.. -(defvar math-svo-c) (defvar math-svo-wid) (defvar math-svo-off) -(defun math-stack-value-offset-fancy () - (let ((cwid (+ (math-comp-width math-svo-c)))) +(defun math-stack-value-offset-fancy (c) + (let ((cwid (+ (math-comp-width c)))) (cond ((eq calc-display-just 'right) (if calc-display-origin (setq math-svo-wid (max calc-display-origin 5)) @@ -1215,7 +1215,7 @@ ;; which are called by math-comp-to-string-flat. (defvar math-comp-pos) -(defun math-comp-to-string-flat (c math-comp-full-width) +(defun math-comp-to-string-flat (c full-width) (if math-comp-sel-hpos (let ((math-comp-pos 0)) (math-comp-sel-flat-term c)) @@ -1224,6 +1224,7 @@ (math-comp-pos 0) (math-comp-margin 0) (math-comp-highlight (and math-comp-selected calc-show-selections)) + (math-comp-full-width full-width) (math-comp-level -1)) (math-comp-to-string-flat-term '(set -1 0)) (math-comp-to-string-flat-term c) @@ -1387,7 +1388,7 @@ (defvar math-comp-hpos) (defvar math-comp-vpos) -(defun math-comp-simplify (c full-width) +(defun math-comp-simplify (c _full-width) (let ((math-comp-buf (list "")) (math-comp-base 0) (math-comp-hgt 1) |