summaryrefslogtreecommitdiff
path: root/lisp/calc
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/calc')
-rw-r--r--lisp/calc/calc-alg.el153
-rw-r--r--lisp/calc/calc-graph.el17
-rw-r--r--lisp/calc/calc-prog.el51
-rw-r--r--lisp/calc/calc.el254
-rw-r--r--lisp/calc/calcalg2.el101
5 files changed, 310 insertions, 266 deletions
diff --git a/lisp/calc/calc-alg.el b/lisp/calc/calc-alg.el
index 9b3083f83d3..e23ed7c50ca 100644
--- a/lisp/calc/calc-alg.el
+++ b/lisp/calc/calc-alg.el
@@ -51,8 +51,17 @@
(defun calc-simplify ()
(interactive)
(calc-slow-wrapper
- (calc-with-default-simplification
- (calc-enter-result 1 "simp" (math-simplify (calc-top-n 1))))))
+ (let ((top (calc-top-n 1)))
+ (if (calc-is-inverse)
+ (setq top
+ (let ((calc-simplify-mode nil))
+ (math-normalize (math-trig-rewrite top)))))
+ (if (calc-is-hyperbolic)
+ (setq top
+ (let ((calc-simplify-mode nil))
+ (math-normalize (math-hyperbolic-trig-rewrite top)))))
+ (calc-with-default-simplification
+ (calc-enter-result 1 "simp" (math-simplify top))))))
(defun calc-simplify-extended ()
(interactive)
@@ -303,7 +312,48 @@
(defalias 'calcFunc-esimplify 'math-simplify-extended)
-;; math-top-only is local to math-simplify, but is used by
+;;; Rewrite the trig functions in a form easier to simplify.
+(defun math-trig-rewrite (fn)
+ "Rewrite trigonometric functions in terms of sines and cosines."
+ (cond
+ ((not (consp fn))
+ fn)
+ ((eq (car-safe fn) 'calcFunc-sec)
+ (list '/ 1 (cons 'calcFunc-cos (math-trig-rewrite (cdr fn)))))
+ ((eq (car-safe fn) 'calcFunc-csc)
+ (list '/ 1 (cons 'calcFunc-sin (math-trig-rewrite (cdr fn)))))
+ ((eq (car-safe fn) 'calcFunc-tan)
+ (let ((newfn (math-trig-rewrite (cdr fn))))
+ (list '/ (cons 'calcFunc-sin newfn)
+ (cons 'calcFunc-cos newfn))))
+ ((eq (car-safe fn) 'calcFunc-cot)
+ (let ((newfn (math-trig-rewrite (cdr fn))))
+ (list '/ (cons 'calcFunc-cos newfn)
+ (cons 'calcFunc-sin newfn))))
+ (t
+ (mapcar 'math-trig-rewrite fn))))
+
+(defun math-hyperbolic-trig-rewrite (fn)
+ "Rewrite hyperbolic functions in terms of sinhs and coshs."
+ (cond
+ ((not (consp fn))
+ fn)
+ ((eq (car-safe fn) 'calcFunc-sech)
+ (list '/ 1 (cons 'calcFunc-cosh (math-hyperbolic-trig-rewrite (cdr fn)))))
+ ((eq (car-safe fn) 'calcFunc-csch)
+ (list '/ 1 (cons 'calcFunc-sinh (math-hyperbolic-trig-rewrite (cdr fn)))))
+ ((eq (car-safe fn) 'calcFunc-tanh)
+ (let ((newfn (math-hyperbolic-trig-rewrite (cdr fn))))
+ (list '/ (cons 'calcFunc-sinh newfn)
+ (cons 'calcFunc-cosh newfn))))
+ ((eq (car-safe fn) 'calcFunc-coth)
+ (let ((newfn (math-hyperbolic-trig-rewrite (cdr fn))))
+ (list '/ (cons 'calcFunc-cosh newfn)
+ (cons 'calcFunc-sinh newfn))))
+ (t
+ (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.
(defvar math-top-only)
@@ -406,7 +456,7 @@
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)
- (eq (car aaa) '-)
+ (eq (car aaa) '-)
(eq (car math-simplify-expr) '-) t))
(progn
(setcar (cdr (cdr math-simplify-expr)) temp)
@@ -449,7 +499,7 @@
(setcar (cdr math-simplify-expr) (math-mul (nth 1 math-simplify-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 math-simplify-expr)
(nth 1 aaa) nil nil t))
(progn
(setcar (cdr math-simplify-expr) temp)
@@ -463,7 +513,7 @@
(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)
+ (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)))
@@ -474,18 +524,18 @@
(defun math-simplify-divide ()
(let ((np (cdr math-simplify-expr))
(nover nil)
- (nn (and (or (eq (car math-simplify-expr) '/)
+ (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))))
n op)
(if nn
(progn
- (setq n (and (or (eq (car math-simplify-expr) '/)
+ (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))))
(if (and (eq (car-safe nn) 'frac) (eq (nth 1 nn) 1) (not n))
(progn
- (setcar (cdr 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))
@@ -499,7 +549,7 @@
(setcar (cdr (cdr math-simplify-expr))
(math-cancel-common-factor (nth 2 math-simplify-expr) n))
(if (and (math-negp n)
- (setq op (assq (car math-simplify-expr)
+ (setq op (assq (car math-simplify-expr)
calc-tweak-eqn-table)))
(setcar math-simplify-expr (nth 1 op))))))))
(if (and (eq (car-safe (car np)) '/)
@@ -526,15 +576,15 @@
(defvar math-simplify-divisor-nover)
(defvar math-simplify-divisor-dover)
-(defun math-simplify-divisor (np dp math-simplify-divisor-nover
+(defun math-simplify-divisor (np dp math-simplify-divisor-nover
math-simplify-divisor-dover)
(cond ((eq (car-safe (car dp)) '/)
- (math-simplify-divisor np (cdr (car dp))
- math-simplify-divisor-nover
+ (math-simplify-divisor np (cdr (car dp))
+ math-simplify-divisor-nover
math-simplify-divisor-dover)
(and (math-known-scalarp (nth 1 (car dp)) t)
(math-simplify-divisor np (cdr (cdr (car dp)))
- math-simplify-divisor-nover
+ math-simplify-divisor-nover
(not math-simplify-divisor-dover))))
((or (or (eq (car math-simplify-expr) '/)
(let ((signs (math-possible-signs (car np))))
@@ -544,7 +594,7 @@
math-living-dangerously)))
(math-numberp (car np)))
(let (d
- (safe t)
+ (safe t)
(scalar (math-known-scalarp (car np))))
(while (and (eq (car-safe (setq d (car dp))) '*)
safe)
@@ -555,10 +605,10 @@
(math-simplify-one-divisor np dp))))))
(defun math-simplify-one-divisor (np dp)
- (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover
+ (let ((temp (math-combine-prod (car np) (car dp) math-simplify-divisor-nover
math-simplify-divisor-dover t))
op)
- (if temp
+ (if temp
(progn
(and (not (memq (car math-simplify-expr) '(/ calcFunc-eq calcFunc-neq)))
(math-known-negp (car dp))
@@ -566,7 +616,7 @@
(setcar math-simplify-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)
+ (and math-simplify-divisor-dover (not math-simplify-divisor-nover)
(eq (car math-simplify-expr) '/)
(eq (car-safe (car dp)) 'calcFunc-sqrt)
(Math-integerp (nth 1 (car dp)))
@@ -667,7 +717,7 @@
(math-simplify-add-term (cdr (cdr n)) (cdr (cdr math-simplify-expr))
(eq (car n) '-) nil)
(setq np (cdr n)))
- (math-simplify-add-term np (cdr (cdr math-simplify-expr)) nil
+ (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)))))
@@ -734,12 +784,12 @@
(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)
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr
+ (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))
(list 'calcFunc-sqrt
- (math-add 1 (math-sqr
+ (math-add 1 (math-sqr
(nth 1 (nth 1 math-simplify-expr)))))))
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
(and m (integerp (car m))
@@ -764,12 +814,12 @@
(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)
- (list 'calcFunc-sqrt
+ (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
(list 'calcFunc-sqrt
- (math-add 1
+ (math-add 1
(math-sqr (nth 1 (nth 1 math-simplify-expr)))))))
(let ((m (math-should-expand-trig (nth 1 math-simplify-expr))))
(and m (integerp (car m))
@@ -792,17 +842,17 @@
(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)
- (math-div
+ (math-div
1
- (list 'calcFunc-sqrt
+ (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-div
+ (math-div
1
(nth 1 (nth 1 math-simplify-expr))))
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arctan)
(list 'calcFunc-sqrt
- (math-add 1
+ (math-add 1
(math-sqr (nth 1 (nth 1 math-simplify-expr))))))))
(math-defsimplify calcFunc-csc
@@ -819,13 +869,13 @@
(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)
- (math-div
+ (math-div
1
- (list 'calcFunc-sqrt (math-sub 1 (math-sqr
+ (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 (list 'calcFunc-sqrt
- (math-add 1 (math-sqr
+ (math-add 1 (math-sqr
(nth 1 (nth 1 math-simplify-expr)))))
(nth 1 (nth 1 math-simplify-expr))))))
@@ -971,7 +1021,7 @@
(math-neg (list 'calcFunc-sinh (math-neg (nth 1 math-simplify-expr)))))
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
math-living-dangerously
- (list 'calcFunc-sqrt
+ (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-living-dangerously
@@ -995,7 +1045,7 @@
(list 'calcFunc-cosh (math-neg (nth 1 math-simplify-expr))))
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
math-living-dangerously
- (list 'calcFunc-sqrt
+ (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-living-dangerously
@@ -1040,9 +1090,9 @@
(list 'calcFunc-sech (math-neg (nth 1 math-simplify-expr))))
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arcsinh)
math-living-dangerously
- (math-div
+ (math-div
1
- (list 'calcFunc-sqrt
+ (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-living-dangerously
@@ -1060,9 +1110,9 @@
(math-div 1 (nth 1 (nth 1 math-simplify-expr))))
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-arccosh)
math-living-dangerously
- (math-div
+ (math-div
1
- (list 'calcFunc-sqrt
+ (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-living-dangerously
@@ -1155,7 +1205,7 @@
(defun math-simplify-sqrt ()
(or (and (eq (car-safe (nth 1 math-simplify-expr)) 'frac)
- (math-div (list 'calcFunc-sqrt
+ (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))))
@@ -1166,7 +1216,7 @@
(math-mul (math-normalize (list 'calcFunc-sqrt fac))
(math-normalize
(list 'calcFunc-sqrt
- (math-cancel-common-factor
+ (math-cancel-common-factor
(nth 1 math-simplify-expr) fac))))))
(and math-living-dangerously
(or (and (eq (car-safe (nth 1 math-simplify-expr)) '-)
@@ -1180,7 +1230,7 @@
(and (eq (car-safe (nth 1 (nth 2 (nth 1 math-simplify-expr))))
'calcFunc-cos)
(list 'calcFunc-sin
- (nth 1 (nth 1 (nth 2
+ (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)
@@ -1320,7 +1370,7 @@
(or (and (eq (car-safe (nth 1 math-simplify-expr)) '^)
(list '^
(nth 1 (nth 1 math-simplify-expr))
- (math-mul (nth 2 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)
(list '^
@@ -1328,9 +1378,9 @@
(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))
+ (list '^ (nth 1 (nth 1 math-simplify-expr))
(nth 2 math-simplify-expr))
- (list '^ (nth 2 (nth 1 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)
@@ -1339,7 +1389,7 @@
(math-simplify-exp (nth 2 math-simplify-expr)))
(and (eq (car-safe (nth 1 math-simplify-expr)) 'calcFunc-exp)
(not math-integrating)
- (list 'calcFunc-exp (math-mul (nth 1 (nth 1 math-simplify-expr))
+ (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))
(math-imaginary-i)
@@ -1353,14 +1403,14 @@
(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)
+ (math-mul (math-pow (nth 1 math-simplify-expr)
(- (nth 2 math-simplify-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)
+ (math-mul (math-pow (nth 1 math-simplify-expr)
(- (nth 2 math-simplify-expr) 2))
(math-add 1
(math-sqr
@@ -1393,14 +1443,14 @@
(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)
- (list 'calcFunc-conj
+ (list 'calcFunc-conj
(list 'calcFunc-erf (nth 1 (nth 1 math-simplify-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)
- (list 'calcFunc-conj
+ (list 'calcFunc-conj
(list 'calcFunc-erfc (nth 1 (nth 1 math-simplify-expr)))))))
@@ -1602,13 +1652,14 @@
(car p))))
;;; If expr is of the form "a + bx + cx^2 + ...", return the list (a b c ...),
-;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose),
+;;; else return nil if not in polynomial form. If "loose" (math-is-poly-loose),
;;; coefficients may contain x, e.g., sin(x) + cos(x) x^2 is a loose polynomial in x.
-;; The variables math-is-poly-degree and math-is-poly-loose are local to
-;; math-is-polynomial, but are used by math-is-poly-rec
+;; These variables are local to math-is-polynomial, but are used by
+;; math-is-poly-rec.
(defvar math-is-poly-degree)
(defvar math-is-poly-loose)
+(defvar var)
(defun math-is-polynomial (expr var &optional math-is-poly-degree math-is-poly-loose)
(let* ((math-poly-base-variable (if math-is-poly-loose
@@ -1694,7 +1745,7 @@
(let ((p2 (math-is-poly-rec (nth 2 expr) negpow)))
(and p2
(or (null math-is-poly-degree)
- (<= (- (+ (length p1) (length p2)) 2)
+ (<= (- (+ (length p1) (length p2)) 2)
math-is-poly-degree))
(math-poly-mul p1 p2))))))
((eq (car expr) '/)
diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el
index cb50cf9ab26..c2ca50ac6f7 100644
--- a/lisp/calc/calc-graph.el
+++ b/lisp/calc/calc-graph.el
@@ -227,7 +227,8 @@
(or found
(let ((varname (concat "PlotData"
(int-to-string
- (1+ (length calc-graph-var-cache))))))
+ (1+ (length calc-graph-var-cache)))))
+ var)
(setq var (list 'var (intern varname)
(intern (concat "var-" varname)))
found (cons thing var)
@@ -279,9 +280,9 @@
(defvar var-DUMMY2)
(defvar var-PlotRejects)
-;; The following variables are local to calc-graph-plot, but are
+;; The following variables are local to calc-graph-plot, but are
;; used in the functions calc-graph-compute-2d, calc-graph-refine-2d,
-;; calc-graph-recompute-2d, calc-graph-compute-3d and
+;; calc-graph-recompute-2d, calc-graph-compute-3d and
;; calc-graph-format-data, which are called by calc-graph-plot.
(defvar calc-graph-yvalue)
(defvar calc-graph-yvec)
@@ -725,7 +726,7 @@
calc-graph-yp (nconc calc-graph-yp (cons 0 (copy-sequence (cdr calc-graph-y3value))))
calc-graph-zp (nconc calc-graph-zp (cons '(skip)
(copy-sequence (cdr (car calc-graph-yvalue)))))))
- (setq calc-graph-numsteps (1- (* calc-graph-numsteps
+ (setq calc-graph-numsteps (1- (* calc-graph-numsteps
(1+ calc-graph-numsteps3)))))
(if (= (setq calc-graph-numsteps (1- (length calc-graph-yvalue))) 0)
(error "Can't plot an empty vector"))
@@ -1098,9 +1099,9 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(buffer-substring (match-beginning 1)
(match-end 1)))))))
(unless yerr
- (setq lenbl (or (equal mode "lines")
+ (setq lenbl (or (equal mode "lines")
(equal mode "linespoints"))
- penbl (or (equal mode "points")
+ penbl (or (equal mode "points")
(equal mode "linespoints")))
(if lines
(or (eq lines t)
@@ -1117,7 +1118,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(setq errform
(condition-case nil
(math-contains-sdev-p
- (eval (intern
+ (eval (intern
(concat "var-"
(save-excursion
(re-search-backward ":\\(.*\\)\\}")
@@ -1134,7 +1135,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0."
(if penbl "linespoints" "lines")
(if penbl "points" "dots"))))
(if (and pstyle (> pstyle 0))
- (insert " "
+ (insert " "
(if (and lstyle (> lstyle 0)) (int-to-string lstyle) "1")
" " (int-to-string pstyle))
(if (and lstyle (> lstyle 0))
diff --git a/lisp/calc/calc-prog.el b/lisp/calc/calc-prog.el
index 6de8613e13b..87e143c6502 100644
--- a/lisp/calc/calc-prog.el
+++ b/lisp/calc/calc-prog.el
@@ -199,7 +199,7 @@
(while
(progn
(setq cmd-base-default (concat "User-" keyname))
- (setq cmd (completing-read
+ (setq cmd (completing-read
(concat "Define M-x command name (default calc-"
cmd-base-default
"): ")
@@ -224,7 +224,7 @@
"That name conflicts with a built-in Emacs function. Replace this function? "))))))
(while
(progn
- (setq cmd-base-default
+ (setq cmd-base-default
(if cmd-base
(if (string-match
"\\`User-.+" cmd-base)
@@ -233,16 +233,16 @@
(substring cmd-base 5))
cmd-base)
(concat "User" keyname)))
- (setq func
+ (setq func
(concat "calcFunc-"
- (completing-read
+ (completing-read
(concat "Define algebraic function name (default "
cmd-base-default "): ")
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
- (lambda (x)
- (fboundp
+ (lambda (x)
+ (fboundp
(intern (concat "calcFunc-" x))))
nil)))
(setq func
@@ -270,7 +270,7 @@
(setq calc-user-formula-alist arglist)
(while
(progn
- (setq calc-user-formula-alist
+ (setq calc-user-formula-alist
(read-from-minibuffer "Function argument list: "
(if arglist
(prin1-to-string arglist)
@@ -284,7 +284,7 @@
func
(y-or-n-p
"Leave it symbolic for non-constant arguments? ")))
- (setq calc-user-formula-alist
+ (setq calc-user-formula-alist
(mapcar (function (lambda (x)
(or (cdr (assq x '((nil . arg-nil)
(t . arg-t))))
@@ -328,6 +328,7 @@
(setcdr kmap (cons (cons key cmd) (cdr kmap)))))))
(message "")))
+(defvar arglist) ; dynamically bound in all callers
(defun calc-default-formula-arglist (form)
(if (consp form)
(if (eq (car form) 'var)
@@ -382,14 +383,14 @@
(if (eq calc-language 'unform)
(error "Can't define formats for unformatted mode"))
(let* ((comp (calc-top 1))
- (func (intern
+ (func (intern
(concat "calcFunc-"
(completing-read "Define format for which function: "
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
- (lambda (x)
- (fboundp
+ (lambda (x)
+ (fboundp
(intern (concat "calcFunc-" x))))))))
(comps (get func 'math-compose-forms))
entry entry2
@@ -402,7 +403,7 @@
(setq arglist (sort arglist 'string-lessp))
(while
(progn
- (setq calc-user-formula-alist
+ (setq calc-user-formula-alist
(read-from-minibuffer "Composition argument list: "
(if arglist
(prin1-to-string arglist)
@@ -417,9 +418,9 @@
(cons (setq entry (list calc-language)) comps)))
(or (setq entry2 (assq (length calc-user-formula-alist) (cdr entry)))
(setcdr entry
- (cons (setq entry2
+ (cons (setq entry2
(list (length calc-user-formula-alist))) (cdr entry))))
- (setcdr entry2
+ (setcdr entry2
(list 'lambda calc-user-formula-alist (calc-fix-user-formula comp))))
(calc-pop-stack 1)
(calc-do-refresh))))
@@ -503,8 +504,8 @@
(switch-to-buffer calc-original-buffer))
;; The variable calc-lang is local to calc-write-parse-table, but is
-;; used by calc-write-parse-table-part which is called by
-;; calc-write-parse-table. The variable is also local to
+;; used by calc-write-parse-table-part which is called by
+;; calc-write-parse-table. The variable is also local to
;; calc-read-parse-table, but is used by calc-fix-token-name which
;; is called (indirectly) by calc-read-parse-table.
(defvar calc-lang)
@@ -691,10 +692,10 @@
(let* ((mac (elt (nth 1 (nth 3 cmd)) 1))
(str (edmacro-format-keys mac t))
(kys (nth 3 (nth 3 cmd))))
- (calc-edit-mode
+ (calc-edit-mode
(list 'calc-edit-macro-finish-edit cmdname kys)
- t (format (concat
- "Editing keyboard macro (%s, bound to %s).\n"
+ t (format (concat
+ "Editing keyboard macro (%s, bound to %s).\n"
"Original keys: %s \n")
cmdname kys (elt (nth 1 (nth 3 cmd)) 0)))
(insert str "\n")
@@ -710,7 +711,7 @@
(if (and defn (calc-valid-formula-func func))
(let ((niceexpr (math-format-nice-expr defn (frame-width))))
(calc-wrapper
- (calc-edit-mode
+ (calc-edit-mode
(list 'calc-finish-formula-edit (list 'quote func))
nil
(format (concat
@@ -792,7 +793,7 @@
(when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
- (setq line (replace-regexp-in-string "SPC" " SPC "
+ (setq line (replace-regexp-in-string "SPC" " SPC "
(replace-regexp-in-string " " "" line)))
(insert line "\t\t\t")
(if (> (current-column) 24)
@@ -817,7 +818,7 @@
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
- (when match
+ (when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string " " "" line))
@@ -844,7 +845,7 @@
(setq line (concat line curline))
(kill-line 1)
(setq curline (calc-edit-macro-command)))
- (when match
+ (when match
(kill-line 1)
(setq line (concat line (substring curline 0 match))))
(setq line (replace-regexp-in-string " " "" line))
@@ -1019,8 +1020,8 @@ Redefine the corresponding command."
(mapcar (lambda (x) (substring x 9))
(all-completions "calcFunc-"
obarray))
- (lambda (x)
- (fboundp
+ (lambda (x)
+ (fboundp
(intern (concat "calcFunc-" x))))
t)))))
(and (eq key ?\M-x)
diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el
index b291969b7f5..d38d6b7dbde 100644
--- a/lisp/calc/calc.el
+++ b/lisp/calc/calc.el
@@ -1,7 +1,7 @@
;;; calc.el --- the GNU Emacs calculator
-;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, 2005,
+;; 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Author: David Gillespie <daveg@synaptics.com>
;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com>
@@ -227,9 +227,10 @@
:tag "Calc"
:group 'applications)
-;;;###autoload
+;; Do not autoload, so it is evaluated at run-time rather than at dump time.
+;; ;;;###autoload
(defcustom calc-settings-file
- (convert-standard-filename "~/.calc.el")
+ (locate-user-emacs-file "calc.el" ".calc.el")
"File in which to record permanent settings."
:group 'calc
:type '(file))
@@ -1042,25 +1043,13 @@ Used by `calc-user-invocation'.")
map)
"The key map for Calc.")
-
-
(defvar calc-digit-map
(let ((map (make-keymap)))
- (if (featurep 'xemacs)
- (map-keymap (function
- (lambda (keys bind)
- (define-key map keys
- (if (eq bind 'undefined)
- 'undefined 'calcDigit-nondigit))))
- calc-mode-map)
- (let ((cmap (nth 1 calc-mode-map))
- (dmap (nth 1 map))
- (i 0))
- (while (< i 128)
- (aset dmap i
- (if (eq (aref cmap i) 'undefined)
- 'undefined 'calcDigit-nondigit))
- (setq i (1+ i)))))
+ (map-keymap (lambda (key bind)
+ (define-key map (vector key)
+ (if (eq bind 'undefined)
+ 'undefined 'calcDigit-nondigit)))
+ calc-mode-map)
(mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-key))
"_0123456789.e+-:n#@oh'\"mspM")
(mapc (lambda (x) (define-key map (char-to-string x) 'calcDigit-letter))
@@ -1077,15 +1066,13 @@ Used by `calc-user-invocation'.")
(define-key calc-digit-map x 'calcDigit-backspace)
(define-key calc-mode-map x 'calc-pop)
(define-key calc-mode-map
- (if (vectorp x)
- (if (featurep 'xemacs)
- (if (= (length x) 1)
- (vector (if (consp (aref x 0))
- (cons 'meta (aref x 0))
- (list 'meta (aref x 0))))
- "\e\C-d")
- (vconcat "\e" x))
- (concat "\e" x))
+ (if (and (vectorp x) (featurep 'xemacs))
+ (if (= (length x) 1)
+ (vector (if (consp (aref x 0))
+ (cons 'meta (aref x 0))
+ (list 'meta (aref x 0))))
+ "\e\C-d")
+ (vconcat "\e" x))
'calc-pop-above))
(error nil)))
(if calc-scan-for-dels
@@ -1615,11 +1602,13 @@ See calc-keypad for details."
(and (memq 'position-point calc-command-flags)
(if (eq major-mode 'calc-mode)
(progn
- (goto-line calc-final-point-line)
+ (goto-char (point-min))
+ (forward-line (1- calc-final-point-line))
(move-to-column calc-final-point-column))
(save-current-buffer
(calc-select-buffer)
- (goto-line calc-final-point-line)
+ (goto-char (point-min))
+ (forward-line (1- calc-final-point-line))
(move-to-column calc-final-point-column))))
(unless (memq 'keep-flags calc-command-flags)
(save-excursion
@@ -2019,7 +2008,8 @@ See calc-keypad for details."
(eq (marker-buffer calc-trail-pointer) calc-trail-buffer))
(save-excursion
(set-buffer calc-trail-buffer)
- (goto-line 2)
+ (goto-char (point-min))
+ (forward-line 1)
(setq calc-trail-pointer (point-marker))))
calc-trail-buffer)
@@ -2432,101 +2422,101 @@ largest Emacs integer.")
;;;; Arithmetic routines.
-;;;
-;;; An object as manipulated by one of these routines may take any of the
-;;; following forms:
-;;;
-;;; integer An integer. For normalized numbers, this format
-;;; is used only for
-;;; negative math-small-integer-size + 1 to
-;;; math-small-integer-size - 1
-;;;
-;;; (bigpos N0 N1 N2 ...) A big positive integer,
-;;; N0 + N1*math-bignum-digit-size
-;;; + N2*(math-bignum-digit-size)^2 ...
-;;; (bigneg N0 N1 N2 ...) A big negative integer,
-;;; - N0 - N1*math-bignum-digit-size ...
-;;; Each digit N is in the range
-;;; 0 ... math-bignum-digit-size -1.
-;;; Normalized, always at least three N present,
-;;; and the most significant N is nonzero.
-;;;
-;;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
-;;; Normalized, DEN > 1.
-;;;
-;;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
-;;; NUM is a small or big integer, EXP is a small int.
-;;; Normalized, NUM is not a multiple of 10, and
-;;; abs(NUM) < 10^calc-internal-prec.
-;;; Normalized zero is stored as (float 0 0).
-;;;
-;;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above.
-;;; Normalized, IMAG is nonzero.
-;;;
-;;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA
-;;; is neither zero nor 180 degrees (pi radians).
-;;;
-;;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a
-;;; vector of vectors.
-;;;
-;;; (hms H M S) Angle in hours-minutes-seconds form. All three
-;;; components have the same sign; H and M must be
-;;; numerically integers; M and S are expected to
-;;; lie in the range [0,60).
-;;;
-;;; (date N) A date or date/time object. N is an integer to
-;;; store a date only, or a fraction or float to
-;;; store a date and time.
-;;;
-;;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized,
-;;; SIGMA > 0. X is any complex number and SIGMA
-;;; is real numbers; or these may be symbolic
-;;; expressions where SIGMA is assumed real.
-;;;
-;;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[].
-;;; LO and HI are any real numbers, or symbolic
-;;; expressions which are assumed real, and LO < HI.
-;;; For [LO..HI], if LO = HI normalization produces LO,
-;;; and if LO > HI normalization produces [LO..LO).
-;;; For other intervals, if LO > HI normalization
-;;; sets HI equal to LO.
-;;;
-;;; (mod N M) Number modulo M. When normalized, 0 <= N < M.
-;;; N and M are real numbers.
-;;;
-;;; (var V S) Symbolic variable. V is a Lisp symbol which
-;;; represents the variable's visible name. S is
-;;; the symbol which actually stores the variable's
-;;; value: (var pi var-pi).
-;;;
-;;; In general, combining rational numbers in a calculation always produces
-;;; a rational result, but if either argument is a float, result is a float.
-
-;;; In the following comments, [x y z] means result is x, args must be y, z,
-;;; respectively, where the code letters are:
-;;;
-;;; O Normalized object (vector or number)
-;;; V Normalized vector
-;;; N Normalized number of any type
-;;; N Normalized complex number
-;;; R Normalized real number (float or rational)
-;;; F Normalized floating-point number
-;;; T Normalized rational number
-;;; I Normalized integer
-;;; B Normalized big integer
-;;; S Normalized small integer
-;;; D Digit (small integer, 0..999)
-;;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol)
-;;; or normalized vector element list (without "vec")
-;;; P Predicate (truth value)
-;;; X Any Lisp object
-;;; Z "nil"
-;;;
-;;; Lower-case letters signify possibly un-normalized values.
-;;; "L.D" means a cons of an L and a D.
-;;; [N N; n n] means result will be normalized if argument is.
-;;; Also, [Public] marks routines intended to be called from outside.
-;;; [This notation has been neglected in many recent routines.]
+;;
+;; An object as manipulated by one of these routines may take any of the
+;; following forms:
+;;
+;; integer An integer. For normalized numbers, this format
+;; is used only for
+;; negative math-small-integer-size + 1 to
+;; math-small-integer-size - 1
+;;
+;; (bigpos N0 N1 N2 ...) A big positive integer,
+;; N0 + N1*math-bignum-digit-size
+;; + N2*(math-bignum-digit-size)^2 ...
+;; (bigneg N0 N1 N2 ...) A big negative integer,
+;; - N0 - N1*math-bignum-digit-size ...
+;; Each digit N is in the range
+;; 0 ... math-bignum-digit-size -1.
+;; Normalized, always at least three N present,
+;; and the most significant N is nonzero.
+;;
+;; (frac NUM DEN) A fraction. NUM and DEN are small or big integers.
+;; Normalized, DEN > 1.
+;;
+;; (float NUM EXP) A floating-point number, NUM * 10^EXP;
+;; NUM is a small or big integer, EXP is a small int.
+;; Normalized, NUM is not a multiple of 10, and
+;; abs(NUM) < 10^calc-internal-prec.
+;; Normalized zero is stored as (float 0 0).
+;;
+;; (cplx REAL IMAG) A complex number; REAL and IMAG are any of above.
+;; Normalized, IMAG is nonzero.
+;;
+;; (polar R THETA) Polar complex number. Normalized, R > 0 and THETA
+;; is neither zero nor 180 degrees (pi radians).
+;;
+;; (vec A B C ...) Vector of objects A, B, C, ... A matrix is a
+;; vector of vectors.
+;;
+;; (hms H M S) Angle in hours-minutes-seconds form. All three
+;; components have the same sign; H and M must be
+;; numerically integers; M and S are expected to
+;; lie in the range [0,60).
+;;
+;; (date N) A date or date/time object. N is an integer to
+;; store a date only, or a fraction or float to
+;; store a date and time.
+;;
+;; (sdev X SIGMA) Error form, X +/- SIGMA. When normalized,
+;; SIGMA > 0. X is any complex number and SIGMA
+;; is real numbers; or these may be symbolic
+;; expressions where SIGMA is assumed real.
+;;
+;; (intv MASK LO HI) Interval form. MASK is 0=(), 1=(], 2=[), or 3=[].
+;; LO and HI are any real numbers, or symbolic
+;; expressions which are assumed real, and LO < HI.
+;; For [LO..HI], if LO = HI normalization produces LO,
+;; and if LO > HI normalization produces [LO..LO).
+;; For other intervals, if LO > HI normalization
+;; sets HI equal to LO.
+;;
+;; (mod N M) Number modulo M. When normalized, 0 <= N < M.
+;; N and M are real numbers.
+;;
+;; (var V S) Symbolic variable. V is a Lisp symbol which
+;; represents the variable's visible name. S is
+;; the symbol which actually stores the variable's
+;; value: (var pi var-pi).
+;;
+;; In general, combining rational numbers in a calculation always produces
+;; a rational result, but if either argument is a float, result is a float.
+
+;; In the following comments, [x y z] means result is x, args must be y, z,
+;; respectively, where the code letters are:
+;;
+;; O Normalized object (vector or number)
+;; V Normalized vector
+;; N Normalized number of any type
+;; N Normalized complex number
+;; R Normalized real number (float or rational)
+;; F Normalized floating-point number
+;; T Normalized rational number
+;; I Normalized integer
+;; B Normalized big integer
+;; S Normalized small integer
+;; D Digit (small integer, 0..999)
+;; L Normalized bignum digit list (without "bigpos" or "bigneg" symbol)
+;; or normalized vector element list (without "vec")
+;; P Predicate (truth value)
+;; X Any Lisp object
+;; Z "nil"
+;;
+;; Lower-case letters signify possibly un-normalized values.
+;; "L.D" means a cons of an L and a D.
+;; [N N; n n] means result will be normalized if argument is.
+;; Also, [Public] marks routines intended to be called from outside.
+;; [This notation has been neglected in many recent routines.]
(defvar math-eval-rules-cache)
(defvar math-eval-rules-cache-other)
@@ -2658,7 +2648,7 @@ largest Emacs integer.")
-;;; True if A is a floating-point real or complex number. [P x] [Public]
+;; True if A is a floating-point real or complex number. [P x] [Public]
(defun math-floatp (a)
(cond ((eq (car-safe a) 'float) t)
((memq (car-safe a) '(cplx polar mod sdev intv))
@@ -2670,7 +2660,7 @@ largest Emacs integer.")
-;;; Verify that A is a complete object and return A. [x x] [Public]
+;; Verify that A is a complete object and return A. [x x] [Public]
(defun math-check-complete (a)
(cond ((integerp a) a)
((eq (car-safe a) 'incomplete)
@@ -2680,7 +2670,7 @@ largest Emacs integer.")
-;;; Coerce integer A to be a bignum. [B S]
+;; Coerce integer A to be a bignum. [B S]
(defun math-bignum (a)
(if (>= a 0)
(cons 'bigpos (math-bignum-big a))
@@ -2693,7 +2683,7 @@ largest Emacs integer.")
(math-bignum-big (/ a math-bignum-digit-size)))))
-;;; Build a normalized floating-point number. [F I S]
+;; Build a normalized floating-point number. [F I S]
(defun math-make-float (mant exp)
(if (eq mant 0)
'(float 0 0)
diff --git a/lisp/calc/calcalg2.el b/lisp/calc/calcalg2.el
index aead48ddc01..f222360ed48 100644
--- a/lisp/calc/calcalg2.el
+++ b/lisp/calc/calcalg2.el
@@ -198,7 +198,7 @@
(prefix-numeric-value nterms))))))
-;; The following are global variables used by math-derivative and some
+;; The following are global variables used by math-derivative and some
;; related functions
(defvar math-deriv-var)
(defvar math-deriv-total)
@@ -416,7 +416,7 @@
(list 'calcFunc-sec u)))))))
(put 'calcFunc-sec\' 'math-derivative-1
- (function (lambda (u) (math-to-radians-2
+ (function (lambda (u) (math-to-radians-2
(math-mul
(math-normalize
(list 'calcFunc-sec u))
@@ -424,7 +424,7 @@
(list 'calcFunc-tan u)))))))
(put 'calcFunc-csc\' 'math-derivative-1
- (function (lambda (u) (math-neg
+ (function (lambda (u) (math-neg
(math-to-radians-2
(math-mul
(math-normalize
@@ -657,14 +657,14 @@
;; which are called (directly or indirectly) by math-try-integral.
(defvar math-integ-depth)
;; math-integ-level is a local variable for math-try-integral, but is used
-;; by math-integral, math-do-integral, math-tracing-integral,
-;; math-sub-integration, math-integrate-by-parts and
-;; math-integrate-by-substitution, which are called (directly or
+;; by math-integral, math-do-integral, math-tracing-integral,
+;; math-sub-integration, math-integrate-by-parts and
+;; math-integrate-by-substitution, which are called (directly or
;; indirectly) by math-try-integral.
(defvar math-integ-level)
;; math-integral-limit is a local variable for calcFunc-integ, but is
-;; used by math-tracing-integral, math-sub-integration and
-;; math-try-integration.
+;; used by math-tracing-integral, math-sub-integration and
+;; math-try-integration.
(defvar math-integral-limit)
(defmacro math-tracing-integral (&rest parts)
@@ -828,11 +828,11 @@
;; used by math-sub-integration.
(defvar math-old-integ)
-;; The variables math-t1, math-t2 and math-t3 are local to
+;; The variables math-t1, math-t2 and math-t3 are local to
;; math-do-integral, math-try-solve-for and math-decompose-poly, but
-;; are used by functions they call (directly or indirectly);
+;; are used by functions they call (directly or indirectly);
;; math-do-integral calls math-do-integral-methods;
-;; math-try-solve-for calls math-try-solve-prod,
+;; math-try-solve-for calls math-try-solve-prod,
;; math-solve-find-root-term and math-solve-find-root-in-prod;
;; math-decompose-poly calls math-solve-poly-funny-powers and
;; math-solve-crunch-poly.
@@ -1075,12 +1075,12 @@
(list 'calcFunc-integfailed expr)))
;; math-so-far is a local variable for math-do-integral-methods, but
-;; is used by math-integ-try-linear-substitutions and
+;; is used by math-integ-try-linear-substitutions and
;; math-integ-try-substitutions.
(defvar math-so-far)
;; math-integ-expr is a local variable for math-do-integral-methods,
-;; but is used by math-integ-try-linear-substitutions and
+;; but is used by math-integ-try-linear-substitutions and
;; math-integ-try-substitutions.
(defvar math-integ-expr)
@@ -1253,8 +1253,8 @@
temp (let (calc-next-why)
(math-simplify-extended
(math-solve-for (math-sub v temp) 0 v nil)))
- temp (if (and (eq (car-safe temp) '/)
- (math-zerop (nth 2 temp)))
+ temp (if (and (eq (car-safe temp) '/)
+ (math-zerop (nth 2 temp)))
nil temp)))))
(setcar (cdr math-cur-record) 'busy)))))
@@ -1675,7 +1675,7 @@
(math-defintegral calcFunc-sec
(and (equal u math-integ-var)
(math-from-radians-2
- (list 'calcFunc-ln
+ (list 'calcFunc-ln
(math-add
(list 'calcFunc-sec u)
(list 'calcFunc-tan u))))))
@@ -1683,7 +1683,7 @@
(math-defintegral calcFunc-csc
(and (equal u math-integ-var)
(math-from-radians-2
- (list 'calcFunc-ln
+ (list 'calcFunc-ln
(math-sub
(list 'calcFunc-csc u)
(list 'calcFunc-cot u))))))
@@ -1882,13 +1882,14 @@
(defvar math-tabulate-initial nil)
(defvar math-tabulate-function nil)
-;; The variables calc-low and calc-high are local to calcFunc-table,
-;; but are used by math-scan-for-limits.
+;; These variables are local to calcFunc-table, but are used by
+;; math-scan-for-limits.
(defvar calc-low)
(defvar calc-high)
+(defvar var)
(defun calcFunc-table (expr var &optional calc-low calc-high step)
- (or calc-low
+ (or calc-low
(setq calc-low '(neg (var inf var-inf)) calc-high '(var inf var-inf)))
(or calc-high (setq calc-high calc-low calc-low 1))
(and (or (math-infinitep calc-low) (math-infinitep calc-high))
@@ -2348,23 +2349,23 @@
(defvar math-solve-ranges nil)
(defvar math-solve-sign)
-;;; Attempt to reduce math-solve-lhs = math-solve-rhs to
+;;; Attempt to reduce math-solve-lhs = math-solve-rhs to
;;; math-solve-var = math-solve-rhs', where math-solve-var appears
-;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs';
+;;; in math-solve-lhs but not in math-solve-rhs or math-solve-rhs';
;;; return math-solve-rhs'.
;;; Uses global values: math-solve-var, math-solve-full.
(defvar math-solve-var)
(defvar math-solve-full)
-;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
-;; are local to math-try-solve-for, but are used by math-try-solve-prod.
-;; (math-solve-lhs and math-solve-rhs are is also local to
+;; The variables math-solve-lhs, math-solve-rhs and math-try-solve-sign
+;; are local to math-try-solve-for, but are used by math-try-solve-prod.
+;; (math-solve-lhs and math-solve-rhs are is also local to
;; math-decompose-poly, but used by math-solve-poly-funny-powers.)
(defvar math-solve-lhs)
(defvar math-solve-rhs)
(defvar math-try-solve-sign)
-(defun math-try-solve-for
+(defun math-try-solve-for
(math-solve-lhs math-solve-rhs &optional math-try-solve-sign no-poly)
(let (math-t1 math-t2 math-t3)
(cond ((equal math-solve-lhs math-solve-var)
@@ -2395,7 +2396,7 @@
(setq math-t2 (funcall math-t1 '(var SOLVEDUM SOLVEDUM)))
(eq (math-expr-contains-count math-t2 '(var SOLVEDUM SOLVEDUM)) 1)
(setq math-t3 (math-solve-above-dummy math-t2))
- (setq math-t1 (math-try-solve-for
+ (setq math-t1 (math-try-solve-for
(math-sub (nth 1 (nth 1 math-solve-lhs))
(math-expr-subst
math-t2 math-t3
@@ -2407,8 +2408,8 @@
(and math-try-solve-sign (- math-try-solve-sign))))
((and (not (eq math-solve-full 't)) (math-try-solve-prod)))
((and (not no-poly)
- (setq math-t2
- (math-decompose-poly math-solve-lhs
+ (setq math-t2
+ (math-decompose-poly math-solve-lhs
math-solve-var 15 math-solve-rhs)))
(setq math-t1 (cdr (nth 1 math-t2))
math-t1 (let ((math-solve-ranges math-solve-ranges))
@@ -2419,7 +2420,7 @@
((= (length math-t1) 3)
(apply 'math-solve-quadratic (car math-t2) math-t1))
((= (length math-t1) 2)
- (apply 'math-solve-linear
+ (apply 'math-solve-linear
(car math-t2) math-try-solve-sign math-t1))
(math-solve-full
(math-poly-all-roots (car math-t2) math-t1))
@@ -2474,7 +2475,7 @@
((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-sub (nth 1 math-solve-lhs) math-solve-rhs)
- (and math-try-solve-sign
+ (and math-try-solve-sign
(- math-try-solve-sign))))
((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 1 math-solve-lhs)
@@ -2488,7 +2489,7 @@
(nth 2 math-solve-lhs)))))
((eq (car math-solve-lhs) 'calcFunc-log)
(cond ((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
- (math-try-solve-for (nth 1 math-solve-lhs)
+ (math-try-solve-for (nth 1 math-solve-lhs)
(math-pow (nth 2 math-solve-lhs) math-solve-rhs)))
((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs) (math-pow
@@ -2503,7 +2504,7 @@
(and math-try-solve-sign math-t1
(if (integerp math-t1)
(* math-t1 math-try-solve-sign)
- (funcall math-t1 math-solve-lhs
+ (funcall math-t1 math-solve-lhs
math-try-solve-sign)))))
((and (symbolp (car math-solve-lhs))
(setq math-t1 (get (car math-solve-lhs) 'math-inverse-n))
@@ -2521,12 +2522,12 @@
(cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-div math-solve-rhs (nth 1 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 1 math-solve-lhs))))
((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 1 math-solve-lhs)
(math-div math-solve-rhs (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs))))
((Math-zerop math-solve-rhs)
(math-solve-prod (let ((math-solve-ranges math-solve-ranges))
@@ -2536,12 +2537,12 @@
(cond ((not (math-expr-contains (nth 1 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 2 math-solve-lhs)
(math-div (nth 1 math-solve-lhs) math-solve-rhs)
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 1 math-solve-lhs))))
((not (math-expr-contains (nth 2 math-solve-lhs) math-solve-var))
(math-try-solve-for (nth 1 math-solve-lhs)
(math-mul math-solve-rhs (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs))))
((setq math-t1 (math-try-solve-for (math-sub (nth 1 math-solve-lhs)
(math-mul (nth 2 math-solve-lhs)
@@ -2581,14 +2582,14 @@
(math-normalize math-t2)))
((math-looks-negp (nth 2 math-solve-lhs))
(math-try-solve-for
- (list '^ (nth 1 math-solve-lhs)
+ (list '^ (nth 1 math-solve-lhs)
(math-neg (nth 2 math-solve-lhs)))
(math-div 1 math-solve-rhs)))
((and (eq math-solve-full t)
(Math-integerp (nth 2 math-solve-lhs))
(math-known-realp (nth 1 math-solve-lhs)))
(setq math-t1 (math-normalize
- (list 'calcFunc-nroot math-solve-rhs
+ (list 'calcFunc-nroot math-solve-rhs
(nth 2 math-solve-lhs))))
(if (math-evenp (nth 2 math-solve-lhs))
(setq math-t1 (math-solve-get-sign math-t1)))
@@ -2596,7 +2597,7 @@
(nth 1 math-solve-lhs) math-t1
(and math-try-solve-sign
(math-oddp (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs)))))
(t (math-try-solve-for
(nth 1 math-solve-lhs)
@@ -2628,7 +2629,7 @@
(nth 2 math-solve-lhs))))
(and math-try-solve-sign
(math-oddp (nth 2 math-solve-lhs))
- (math-solve-sign math-try-solve-sign
+ (math-solve-sign math-try-solve-sign
(nth 2 math-solve-lhs)))))))))
(t nil)))
@@ -2665,7 +2666,7 @@
(setq math-t2 (math-mul (or math-poly-mult-powers 1)
(let ((calc-prefer-frac t))
(math-div 1 math-poly-frac-powers)))
- math-t1 (math-is-polynomial
+ math-t1 (math-is-polynomial
(math-simplify (calcFunc-expand math-t1)) math-solve-b 50))))
;;; This converts "a x^8 + b x^5 + c x^2" to "(a (x^3)^2 + b (x^3) + c) * x^2".
@@ -2694,7 +2695,7 @@
(setq math-t3 (cons scale (cdr math-t3))
math-t1 new-t1))))
(setq scale (1- scale)))
- (setq math-t3 (list (math-mul (car math-t3) math-t2)
+ (setq math-t3 (list (math-mul (car math-t3) math-t2)
(math-mul count math-t2)))
(<= (1- (length math-t1)) max-degree)))))
@@ -2733,7 +2734,7 @@
(and (not (equal math-solve-b math-solve-lhs))
(or (not (memq (car-safe math-solve-b) '(+ -))) sub-rhs)
(setq math-t3 '(1 0) math-t2 1
- math-t1 (math-is-polynomial math-solve-lhs
+ math-t1 (math-is-polynomial math-solve-lhs
math-solve-b 50))
(if (and (equal math-poly-neg-powers '(1))
(memq math-poly-mult-powers '(nil 1))
@@ -3217,7 +3218,7 @@
(and (not (math-expr-contains (nth 2 x) math-solve-var))
(math-solve-find-root-in-prod (nth 1 x))))))))
-;; The variable math-solve-vars is local to math-solve-system,
+;; The variable math-solve-vars is local to math-solve-system,
;; but is used by math-solve-system-rec.
(defvar math-solve-vars)
@@ -3282,7 +3283,7 @@
(while (and e2
(setq res2 (or (and (eq (car e2) eprev)
res2)
- (math-solve-for (car e2) 0
+ (math-solve-for (car e2) 0
math-solve-system-vv
math-solve-full))))
(setq eprev (car e2)
@@ -3313,8 +3314,8 @@
solns)))
(if elim
s
- (cons (cons
- math-solve-system-vv
+ (cons (cons
+ math-solve-system-vv
(apply 'append math-solve-system-res))
s)))))
(not math-solve-system-res))))
@@ -3350,9 +3351,9 @@
(lambda (r)
(if math-solve-simplifying
(math-simplify
- (math-expr-subst
+ (math-expr-subst
(car x) math-solve-system-vv r))
- (math-expr-subst
+ (math-expr-subst
(car x) math-solve-system-vv r))))
(car res2)))
x (cdr x)
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-28 00:40:50 +0000