aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/calc/calc-math.el332
1 files changed, 112 insertions, 220 deletions
diff --git a/lisp/calc/calc-math.el b/lisp/calc/calc-math.el
index c7b841851e1..81a2503cfb5 100644
--- a/lisp/calc/calc-math.el
+++ b/lisp/calc/calc-math.el
@@ -1,5 +1,5 @@
1;; Calculator for GNU Emacs, part II [calc-math.el] 1;; Calculator for GNU Emacs, part II [calc-math.el]
2;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. 2;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3;; Written by Dave Gillespie, daveg@synaptics.com. 3;; Written by Dave Gillespie, daveg@synaptics.com.
4 4
5;; This file is part of GNU Emacs. 5;; This file is part of GNU Emacs.
@@ -34,57 +34,49 @@
34 (calc-slow-wrapper 34 (calc-slow-wrapper
35 (if (calc-is-inverse) 35 (if (calc-is-inverse)
36 (calc-unary-op "^2" 'calcFunc-sqr arg) 36 (calc-unary-op "^2" 'calcFunc-sqr arg)
37 (calc-unary-op "sqrt" 'calcFunc-sqrt arg))) 37 (calc-unary-op "sqrt" 'calcFunc-sqrt arg))))
38)
39 38
40(defun calc-isqrt (arg) 39(defun calc-isqrt (arg)
41 (interactive "P") 40 (interactive "P")
42 (calc-slow-wrapper 41 (calc-slow-wrapper
43 (if (calc-is-inverse) 42 (if (calc-is-inverse)
44 (calc-unary-op "^2" 'calcFunc-sqr arg) 43 (calc-unary-op "^2" 'calcFunc-sqr arg)
45 (calc-unary-op "isqt" 'calcFunc-isqrt arg))) 44 (calc-unary-op "isqt" 'calcFunc-isqrt arg))))
46)
47 45
48 46
49(defun calc-hypot (arg) 47(defun calc-hypot (arg)
50 (interactive "P") 48 (interactive "P")
51 (calc-slow-wrapper 49 (calc-slow-wrapper
52 (calc-binary-op "hypt" 'calcFunc-hypot arg)) 50 (calc-binary-op "hypt" 'calcFunc-hypot arg)))
53)
54 51
55(defun calc-ln (arg) 52(defun calc-ln (arg)
56 (interactive "P") 53 (interactive "P")
57 (calc-invert-func) 54 (calc-invert-func)
58 (calc-exp arg) 55 (calc-exp arg))
59)
60 56
61(defun calc-log10 (arg) 57(defun calc-log10 (arg)
62 (interactive "P") 58 (interactive "P")
63 (calc-hyperbolic-func) 59 (calc-hyperbolic-func)
64 (calc-ln arg) 60 (calc-ln arg))
65)
66 61
67(defun calc-log (arg) 62(defun calc-log (arg)
68 (interactive "P") 63 (interactive "P")
69 (calc-slow-wrapper 64 (calc-slow-wrapper
70 (if (calc-is-inverse) 65 (if (calc-is-inverse)
71 (calc-binary-op "alog" 'calcFunc-alog arg) 66 (calc-binary-op "alog" 'calcFunc-alog arg)
72 (calc-binary-op "log" 'calcFunc-log arg))) 67 (calc-binary-op "log" 'calcFunc-log arg))))
73)
74 68
75(defun calc-ilog (arg) 69(defun calc-ilog (arg)
76 (interactive "P") 70 (interactive "P")
77 (calc-slow-wrapper 71 (calc-slow-wrapper
78 (if (calc-is-inverse) 72 (if (calc-is-inverse)
79 (calc-binary-op "alog" 'calcFunc-alog arg) 73 (calc-binary-op "alog" 'calcFunc-alog arg)
80 (calc-binary-op "ilog" 'calcFunc-ilog arg))) 74 (calc-binary-op "ilog" 'calcFunc-ilog arg))))
81)
82 75
83(defun calc-lnp1 (arg) 76(defun calc-lnp1 (arg)
84 (interactive "P") 77 (interactive "P")
85 (calc-invert-func) 78 (calc-invert-func)
86 (calc-expm1 arg) 79 (calc-expm1 arg))
87)
88 80
89(defun calc-exp (arg) 81(defun calc-exp (arg)
90 (interactive "P") 82 (interactive "P")
@@ -95,16 +87,14 @@
95 (calc-unary-op "10^" 'calcFunc-exp10 arg)) 87 (calc-unary-op "10^" 'calcFunc-exp10 arg))
96 (if (calc-is-inverse) 88 (if (calc-is-inverse)
97 (calc-unary-op "ln" 'calcFunc-ln arg) 89 (calc-unary-op "ln" 'calcFunc-ln arg)
98 (calc-unary-op "exp" 'calcFunc-exp arg)))) 90 (calc-unary-op "exp" 'calcFunc-exp arg)))))
99)
100 91
101(defun calc-expm1 (arg) 92(defun calc-expm1 (arg)
102 (interactive "P") 93 (interactive "P")
103 (calc-slow-wrapper 94 (calc-slow-wrapper
104 (if (calc-is-inverse) 95 (if (calc-is-inverse)
105 (calc-unary-op "ln+1" 'calcFunc-lnp1 arg) 96 (calc-unary-op "ln+1" 'calcFunc-lnp1 arg)
106 (calc-unary-op "ex-1" 'calcFunc-expm1 arg))) 97 (calc-unary-op "ex-1" 'calcFunc-expm1 arg))))
107)
108 98
109(defun calc-pi () 99(defun calc-pi ()
110 (interactive) 100 (interactive)
@@ -123,8 +113,7 @@
123 (calc-pop-push-record 0 "e" (math-e))) 113 (calc-pop-push-record 0 "e" (math-e)))
124 (if calc-symbolic-mode 114 (if calc-symbolic-mode
125 (calc-pop-push-record 0 "pi" '(var pi var-pi)) 115 (calc-pop-push-record 0 "pi" '(var pi var-pi))
126 (calc-pop-push-record 0 "pi" (math-pi)))))) 116 (calc-pop-push-record 0 "pi" (math-pi)))))))
127)
128 117
129(defun calc-sin (arg) 118(defun calc-sin (arg)
130 (interactive "P") 119 (interactive "P")
@@ -135,27 +124,23 @@
135 (calc-unary-op "sinh" 'calcFunc-sinh arg)) 124 (calc-unary-op "sinh" 'calcFunc-sinh arg))
136 (if (calc-is-inverse) 125 (if (calc-is-inverse)
137 (calc-unary-op "asin" 'calcFunc-arcsin arg) 126 (calc-unary-op "asin" 'calcFunc-arcsin arg)
138 (calc-unary-op "sin" 'calcFunc-sin arg)))) 127 (calc-unary-op "sin" 'calcFunc-sin arg)))))
139)
140 128
141(defun calc-arcsin (arg) 129(defun calc-arcsin (arg)
142 (interactive "P") 130 (interactive "P")
143 (calc-invert-func) 131 (calc-invert-func)
144 (calc-sin arg) 132 (calc-sin arg))
145)
146 133
147(defun calc-sinh (arg) 134(defun calc-sinh (arg)
148 (interactive "P") 135 (interactive "P")
149 (calc-hyperbolic-func) 136 (calc-hyperbolic-func)
150 (calc-sin arg) 137 (calc-sin arg))
151)
152 138
153(defun calc-arcsinh (arg) 139(defun calc-arcsinh (arg)
154 (interactive "P") 140 (interactive "P")
155 (calc-invert-func) 141 (calc-invert-func)
156 (calc-hyperbolic-func) 142 (calc-hyperbolic-func)
157 (calc-sin arg) 143 (calc-sin arg))
158)
159 144
160(defun calc-cos (arg) 145(defun calc-cos (arg)
161 (interactive "P") 146 (interactive "P")
@@ -166,35 +151,30 @@
166 (calc-unary-op "cosh" 'calcFunc-cosh arg)) 151 (calc-unary-op "cosh" 'calcFunc-cosh arg))
167 (if (calc-is-inverse) 152 (if (calc-is-inverse)
168 (calc-unary-op "acos" 'calcFunc-arccos arg) 153 (calc-unary-op "acos" 'calcFunc-arccos arg)
169 (calc-unary-op "cos" 'calcFunc-cos arg)))) 154 (calc-unary-op "cos" 'calcFunc-cos arg)))))
170)
171 155
172(defun calc-arccos (arg) 156(defun calc-arccos (arg)
173 (interactive "P") 157 (interactive "P")
174 (calc-invert-func) 158 (calc-invert-func)
175 (calc-cos arg) 159 (calc-cos arg))
176)
177 160
178(defun calc-cosh (arg) 161(defun calc-cosh (arg)
179 (interactive "P") 162 (interactive "P")
180 (calc-hyperbolic-func) 163 (calc-hyperbolic-func)
181 (calc-cos arg) 164 (calc-cos arg))
182)
183 165
184(defun calc-arccosh (arg) 166(defun calc-arccosh (arg)
185 (interactive "P") 167 (interactive "P")
186 (calc-invert-func) 168 (calc-invert-func)
187 (calc-hyperbolic-func) 169 (calc-hyperbolic-func)
188 (calc-cos arg) 170 (calc-cos arg))
189)
190 171
191(defun calc-sincos () 172(defun calc-sincos ()
192 (interactive) 173 (interactive)
193 (calc-slow-wrapper 174 (calc-slow-wrapper
194 (if (calc-is-inverse) 175 (if (calc-is-inverse)
195 (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1))) 176 (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1)))
196 (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1))))) 177 (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1))))))
197)
198 178
199(defun calc-tan (arg) 179(defun calc-tan (arg)
200 (interactive "P") 180 (interactive "P")
@@ -205,59 +185,50 @@
205 (calc-unary-op "tanh" 'calcFunc-tanh arg)) 185 (calc-unary-op "tanh" 'calcFunc-tanh arg))
206 (if (calc-is-inverse) 186 (if (calc-is-inverse)
207 (calc-unary-op "atan" 'calcFunc-arctan arg) 187 (calc-unary-op "atan" 'calcFunc-arctan arg)
208 (calc-unary-op "tan" 'calcFunc-tan arg)))) 188 (calc-unary-op "tan" 'calcFunc-tan arg)))))
209)
210 189
211(defun calc-arctan (arg) 190(defun calc-arctan (arg)
212 (interactive "P") 191 (interactive "P")
213 (calc-invert-func) 192 (calc-invert-func)
214 (calc-tan arg) 193 (calc-tan arg))
215)
216 194
217(defun calc-tanh (arg) 195(defun calc-tanh (arg)
218 (interactive "P") 196 (interactive "P")
219 (calc-hyperbolic-func) 197 (calc-hyperbolic-func)
220 (calc-tan arg) 198 (calc-tan arg))
221)
222 199
223(defun calc-arctanh (arg) 200(defun calc-arctanh (arg)
224 (interactive "P") 201 (interactive "P")
225 (calc-invert-func) 202 (calc-invert-func)
226 (calc-hyperbolic-func) 203 (calc-hyperbolic-func)
227 (calc-tan arg) 204 (calc-tan arg))
228)
229 205
230(defun calc-arctan2 () 206(defun calc-arctan2 ()
231 (interactive) 207 (interactive)
232 (calc-slow-wrapper 208 (calc-slow-wrapper
233 (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2)))) 209 (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2)))))
234)
235 210
236(defun calc-conj (arg) 211(defun calc-conj (arg)
237 (interactive "P") 212 (interactive "P")
238 (calc-wrapper 213 (calc-wrapper
239 (calc-unary-op "conj" 'calcFunc-conj arg)) 214 (calc-unary-op "conj" 'calcFunc-conj arg)))
240)
241 215
242(defun calc-imaginary () 216(defun calc-imaginary ()
243 (interactive) 217 (interactive)
244 (calc-slow-wrapper 218 (calc-slow-wrapper
245 (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))) 219 (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))))
246)
247 220
248 221
249 222
250(defun calc-to-degrees (arg) 223(defun calc-to-degrees (arg)
251 (interactive "P") 224 (interactive "P")
252 (calc-wrapper 225 (calc-wrapper
253 (calc-unary-op ">deg" 'calcFunc-deg arg)) 226 (calc-unary-op ">deg" 'calcFunc-deg arg)))
254)
255 227
256(defun calc-to-radians (arg) 228(defun calc-to-radians (arg)
257 (interactive "P") 229 (interactive "P")
258 (calc-wrapper 230 (calc-wrapper
259 (calc-unary-op ">rad" 'calcFunc-rad arg)) 231 (calc-unary-op ">rad" 'calcFunc-rad arg)))
260)
261 232
262 233
263(defun calc-degrees-mode (arg) 234(defun calc-degrees-mode (arg)
@@ -268,15 +239,13 @@
268 (message "Angles measured in degrees."))) 239 (message "Angles measured in degrees.")))
269 ((= arg 2) (calc-radians-mode)) 240 ((= arg 2) (calc-radians-mode))
270 ((= arg 3) (calc-hms-mode)) 241 ((= arg 3) (calc-hms-mode))
271 (t (error "Prefix argument out of range"))) 242 (t (error "Prefix argument out of range"))))
272)
273 243
274(defun calc-radians-mode () 244(defun calc-radians-mode ()
275 (interactive) 245 (interactive)
276 (calc-wrapper 246 (calc-wrapper
277 (calc-change-mode 'calc-angle-mode 'rad) 247 (calc-change-mode 'calc-angle-mode 'rad)
278 (message "Angles measured in radians.")) 248 (message "Angles measured in radians.")))
279)
280 249
281 250
282;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] 251;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public]
@@ -289,14 +258,12 @@
289 ((integerp a) 258 ((integerp a)
290 (math-isqrt-small a)) 259 (math-isqrt-small a))
291 (t 260 (t
292 (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))) 261 (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))))
293)
294 262
295(defun calcFunc-isqrt (a) 263(defun calcFunc-isqrt (a)
296 (if (math-realp a) 264 (if (math-realp a)
297 (math-isqrt (math-floor a)) 265 (math-isqrt (math-floor a))
298 (math-floor (math-sqrt a))) 266 (math-floor (math-sqrt a))))
299)
300 267
301 268
302;;; This returns (flag . result) where the flag is T if A is a perfect square. 269;;; This returns (flag . result) where the flag is T if A is a perfect square.
@@ -316,8 +283,7 @@
316 a 283 a
317 (math-scale-bignum-3 284 (math-scale-bignum-3
318 (list (1+ (math-isqrt-small top))) 285 (list (1+ (math-isqrt-small top)))
319 (/ len 2)))))) 286 (/ len 2)))))))
320)
321 287
322(defun math-isqrt-bignum-iter (a guess) ; [l L l] 288(defun math-isqrt-bignum-iter (a guess) ; [l L l]
323 (math-working "isqrt" (cons 'bigpos guess)) 289 (math-working "isqrt" (cons 'bigpos guess))
@@ -330,22 +296,19 @@
330 (cons (and (= comp 0) 296 (cons (and (= comp 0)
331 (math-zerop-bignum (cdr q)) 297 (math-zerop-bignum (cdr q))
332 (= (% (car s) 2) 0)) 298 (= (% (car s) 2) 0))
333 guess))) 299 guess))))
334)
335 300
336(defun math-zerop-bignum (a) 301(defun math-zerop-bignum (a)
337 (and (eq (car a) 0) 302 (and (eq (car a) 0)
338 (progn 303 (progn
339 (while (eq (car (setq a (cdr a))) 0)) 304 (while (eq (car (setq a (cdr a))) 0))
340 (null a))) 305 (null a))))
341)
342 306
343(defun math-scale-bignum-3 (a n) ; [L L S] 307(defun math-scale-bignum-3 (a n) ; [L L S]
344 (while (> n 0) 308 (while (> n 0)
345 (setq a (cons 0 a) 309 (setq a (cons 0 a)
346 n (1- n))) 310 n (1- n)))
347 a 311 a)
348)
349 312
350(defun math-isqrt-small (a) ; A > 0. [S S] 313(defun math-isqrt-small (a) ; A > 0. [S S]
351 (let ((g (cond ((>= a 10000) 1000) 314 (let ((g (cond ((>= a 10000) 1000)
@@ -354,8 +317,7 @@
354 g2) 317 g2)
355 (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) 318 (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
356 (setq g g2)) 319 (setq g g2))
357 g) 320 g))
358)
359 321
360 322
361 323
@@ -449,20 +411,17 @@
449 (math-mul (math-sqrt (math-infinite-dir a inf)) inf))) 411 (math-mul (math-sqrt (math-infinite-dir a inf)) inf)))
450 (progn 412 (progn
451 (calc-record-why 'numberp a) 413 (calc-record-why 'numberp a)
452 (list 'calcFunc-sqrt a))) 414 (list 'calcFunc-sqrt a))))
453) 415(defalias calcFunc-sqrt 'math-sqrt)
454(fset 'calcFunc-sqrt (symbol-function 'math-sqrt))
455 416
456(defun math-infinite-dir (a &optional inf) 417(defun math-infinite-dir (a &optional inf)
457 (or inf (setq inf (math-infinitep a))) 418 (or inf (setq inf (math-infinitep a)))
458 (math-normalize (math-expr-subst a inf 1)) 419 (math-normalize (math-expr-subst a inf 1)))
459)
460 420
461(defun math-sqrt-float (a &optional guess) ; [F F F] 421(defun math-sqrt-float (a &optional guess) ; [F F F]
462 (if calc-symbolic-mode 422 (if calc-symbolic-mode
463 (signal 'inexact-result nil) 423 (signal 'inexact-result nil)
464 (math-with-extra-prec 1 (math-sqrt-raw a guess))) 424 (math-with-extra-prec 1 (math-sqrt-raw a guess))))
465)
466 425
467(defun math-sqrt-raw (a &optional guess) ; [F F F] 426(defun math-sqrt-raw (a &optional guess) ; [F F F]
468 (if (not (Math-posp a)) 427 (if (not (Math-posp a))
@@ -473,8 +432,7 @@
473 (setq guess (math-make-float (math-isqrt-small 432 (setq guess (math-make-float (math-isqrt-small
474 (math-scale-int (nth 1 a) (- ldiff))) 433 (math-scale-int (nth 1 a) (- ldiff)))
475 (/ (+ (nth 2 a) ldiff) 2))))) 434 (/ (+ (nth 2 a) ldiff) 2)))))
476 (math-sqrt-float-iter a guess)) 435 (math-sqrt-float-iter a guess)))
477)
478 436
479(defun math-sqrt-float-iter (a guess) ; [F F F] 437(defun math-sqrt-float-iter (a guess) ; [F F F]
480 (math-working "sqrt" guess) 438 (math-working "sqrt" guess)
@@ -482,8 +440,7 @@
482 '(float 5 -1)))) 440 '(float 5 -1))))
483 (if (math-nearly-equal-float g2 guess) 441 (if (math-nearly-equal-float g2 guess)
484 g2 442 g2
485 (math-sqrt-float-iter a g2))) 443 (math-sqrt-float-iter a g2))))
486)
487 444
488;;; True if A and B differ only in the last digit of precision. [P F F] 445;;; True if A and B differ only in the last digit of precision. [P F F]
489(defun math-nearly-equal-float (a b) 446(defun math-nearly-equal-float (a b)
@@ -508,8 +465,7 @@
508 (and (not (consp ediff)) 465 (and (not (consp ediff))
509 (< ediff 10) 466 (< ediff 10)
510 (> ediff -10) 467 (> ediff -10)
511 (= (math-numdigs (nth 1 a)) calc-internal-prec))))) 468 (= (math-numdigs (nth 1 a)) calc-internal-prec))))))
512)
513 469
514(defun math-nearly-equal (a b) ; [P N N] [Public] 470(defun math-nearly-equal (a b) ; [P N N] [Public]
515 (setq a (math-float a)) 471 (setq a (math-float a))
@@ -529,15 +485,13 @@
529 (if (eq (car b) 'cplx) 485 (if (eq (car b) 'cplx)
530 (and (math-nearly-equal-float a (nth 1 b)) 486 (and (math-nearly-equal-float a (nth 1 b))
531 (math-nearly-zerop-float a (nth 2 b))) 487 (math-nearly-zerop-float a (nth 2 b)))
532 (math-nearly-equal-float a b))) 488 (math-nearly-equal-float a b))))
533)
534 489
535;;; True if A is nearly zero compared to B. [P F F] 490;;; True if A is nearly zero compared to B. [P F F]
536(defun math-nearly-zerop-float (a b) 491(defun math-nearly-zerop-float (a b)
537 (or (eq (nth 1 a) 0) 492 (or (eq (nth 1 a) 0)
538 (<= (+ (math-numdigs (nth 1 a)) (nth 2 a)) 493 (<= (+ (math-numdigs (nth 1 a)) (nth 2 a))
539 (1+ (- (+ (math-numdigs (nth 1 b)) (nth 2 b)) calc-internal-prec)))) 494 (1+ (- (+ (math-numdigs (nth 1 b)) (nth 2 b)) calc-internal-prec)))))
540)
541 495
542(defun math-nearly-zerop (a b) ; [P N R] [Public] 496(defun math-nearly-zerop (a b) ; [P N R] [Public]
543 (setq a (math-float a)) 497 (setq a (math-float a))
@@ -547,8 +501,7 @@
547 (math-nearly-zerop-float (nth 2 a) b)) 501 (math-nearly-zerop-float (nth 2 a) b))
548 (if (eq (car a) 'polar) 502 (if (eq (car a) 'polar)
549 (math-nearly-zerop-float (nth 1 a) b) 503 (math-nearly-zerop-float (nth 1 a) b)
550 (math-nearly-zerop-float a b))) 504 (math-nearly-zerop-float a b))))
551)
552 505
553;;; This implementation could be improved, accuracy-wise. 506;;; This implementation could be improved, accuracy-wise.
554(defun math-hypot (a b) 507(defun math-hypot (a b)
@@ -578,13 +531,11 @@
578 (math-to-hms (math-hypot (math-from-hms a 'deg) b)))) 531 (math-to-hms (math-hypot (math-from-hms a 'deg) b))))
579 ((eq (car-safe b) 'hms) 532 ((eq (car-safe b) 'hms)
580 (math-to-hms (math-hypot a (math-from-hms b 'deg)))) 533 (math-to-hms (math-hypot a (math-from-hms b 'deg))))
581 (t nil)) 534 (t nil)))
582) 535(defalias calcFunc-hypot 'math-hypot)
583(fset 'calcFunc-hypot (symbol-function 'math-hypot))
584 536
585(defun calcFunc-sqr (x) 537(defun calcFunc-sqr (x)
586 (math-pow x 2) 538 (math-pow x 2))
587)
588 539
589 540
590 541
@@ -615,8 +566,7 @@
615 ((eq (car-safe a) 'polar) 566 ((eq (car-safe a) 'polar)
616 (let ((root (math-nth-root (nth 1 a) n))) 567 (let ((root (math-nth-root (nth 1 a) n)))
617 (and root (list 'polar root (math-div (nth 2 a) n))))) 568 (and root (list 'polar root (math-div (nth 2 a) n)))))
618 (t nil)) 569 (t nil)))
619)
620 570
621(defun math-nth-root-float (a n &optional guess) 571(defun math-nth-root-float (a n &optional guess)
622 (math-inexact-result) 572 (math-inexact-result)
@@ -628,8 +578,7 @@
628 1 (/ (+ (math-numdigs (nth 1 a)) 578 1 (/ (+ (math-numdigs (nth 1 a))
629 (nth 2 a) 579 (nth 2 a)
630 (/ n 2)) 580 (/ n 2))
631 n)))))) 581 n)))))))
632)
633 582
634(defun math-nth-root-float-iter (a guess) ; uses "n", "nf", "nfm1" 583(defun math-nth-root-float-iter (a guess) ; uses "n", "nf", "nfm1"
635 (math-working "root" guess) 584 (math-working "root" guess)
@@ -639,15 +588,13 @@
639 nf))) 588 nf)))
640 (if (math-nearly-equal-float g2 guess) 589 (if (math-nearly-equal-float g2 guess)
641 g2 590 g2
642 (math-nth-root-float-iter a g2))) 591 (math-nth-root-float-iter a g2))))
643)
644 592
645(defun math-nth-root-integer (a n &optional guess) ; [I I S] 593(defun math-nth-root-integer (a n &optional guess) ; [I I S]
646 (math-nth-root-int-iter a (or guess 594 (math-nth-root-int-iter a (or guess
647 (math-scale-int 1 (/ (+ (math-numdigs a) 595 (math-scale-int 1 (/ (+ (math-numdigs a)
648 (1- n)) 596 (1- n))
649 n)))) 597 n)))))
650)
651 598
652(defun math-nth-root-int-iter (a guess) ; uses "n" 599(defun math-nth-root-int-iter (a guess) ; uses "n"
653 (math-working "root" guess) 600 (math-working "root" guess)
@@ -659,14 +606,12 @@
659 (cons (and (equal (car g2) guess) 606 (cons (and (equal (car g2) guess)
660 (eq (cdr q) 0) 607 (eq (cdr q) 0)
661 (eq (cdr g2) 0)) 608 (eq (cdr g2) 0))
662 guess))) 609 guess))))
663)
664 610
665(defun calcFunc-nroot (x n) 611(defun calcFunc-nroot (x n)
666 (calcFunc-pow x (if (integerp n) 612 (calcFunc-pow x (if (integerp n)
667 (math-make-frac 1 n) 613 (math-make-frac 1 n)
668 (math-div 1 n))) 614 (math-div 1 n))))
669)
670 615
671 616
672 617
@@ -686,8 +631,7 @@
686 (math-from-hms a 'rad)) 631 (math-from-hms a 'rad))
687 ((memq calc-angle-mode '(deg hms)) 632 ((memq calc-angle-mode '(deg hms))
688 (math-mul a (math-pi-over-180))) 633 (math-mul a (math-pi-over-180)))
689 (t a)) 634 (t a)))
690)
691 635
692(defun math-from-radians (a) ; [N N] 636(defun math-from-radians (a) ; [N N]
693 (cond ((eq calc-angle-mode 'deg) 637 (cond ((eq calc-angle-mode 'deg)
@@ -696,8 +640,7 @@
696 (list 'calcFunc-deg a))) 640 (list 'calcFunc-deg a)))
697 ((eq calc-angle-mode 'hms) 641 ((eq calc-angle-mode 'hms)
698 (math-to-hms a 'rad)) 642 (math-to-hms a 'rad))
699 (t a)) 643 (t a)))
700)
701 644
702(defun math-to-radians-2 (a) ; [N N] 645(defun math-to-radians-2 (a) ; [N N]
703 (cond ((eq (car-safe a) 'hms) 646 (cond ((eq (car-safe a) 'hms)
@@ -706,16 +649,14 @@
706 (if calc-symbolic-mode 649 (if calc-symbolic-mode
707 (math-div (math-mul a '(var pi var-pi)) 180) 650 (math-div (math-mul a '(var pi var-pi)) 180)
708 (math-mul a (math-pi-over-180)))) 651 (math-mul a (math-pi-over-180))))
709 (t a)) 652 (t a)))
710)
711 653
712(defun math-from-radians-2 (a) ; [N N] 654(defun math-from-radians-2 (a) ; [N N]
713 (cond ((memq calc-angle-mode '(deg hms)) 655 (cond ((memq calc-angle-mode '(deg hms))
714 (if calc-symbolic-mode 656 (if calc-symbolic-mode
715 (math-div (math-mul 180 a) '(var pi var-pi)) 657 (math-div (math-mul 180 a) '(var pi var-pi))
716 (math-div a (math-pi-over-180)))) 658 (math-div a (math-pi-over-180))))
717 (t a)) 659 (t a)))
718)
719 660
720 661
721 662
@@ -744,8 +685,7 @@
744 ((equal x '(var nan var-nan)) 685 ((equal x '(var nan var-nan))
745 x) 686 x)
746 (t (calc-record-why 'scalarp x) 687 (t (calc-record-why 'scalarp x)
747 (list 'calcFunc-sin x))) 688 (list 'calcFunc-sin x))))
748)
749 689
750(defun calcFunc-cos (x) ; [N N] [Public] 690(defun calcFunc-cos (x) ; [N N] [Public]
751 (cond ((and (integerp x) 691 (cond ((and (integerp x)
@@ -788,16 +728,14 @@
788 ((equal x '(var nan var-nan)) 728 ((equal x '(var nan var-nan))
789 x) 729 x)
790 (t (calc-record-why 'scalarp x) 730 (t (calc-record-why 'scalarp x)
791 (list 'calcFunc-cos x))) 731 (list 'calcFunc-cos x))))
792)
793 732
794(defun calcFunc-sincos (x) ; [V N] [Public] 733(defun calcFunc-sincos (x) ; [V N] [Public]
795 (if (Math-scalarp x) 734 (if (Math-scalarp x)
796 (math-with-extra-prec 2 735 (math-with-extra-prec 2
797 (let ((sc (math-sin-cos-raw (math-to-radians (math-float x))))) 736 (let ((sc (math-sin-cos-raw (math-to-radians (math-float x)))))
798 (list 'vec (cdr sc) (car sc)))) ; the vector [cos, sin] 737 (list 'vec (cdr sc) (car sc)))) ; the vector [cos, sin]
799 (list 'vec (calcFunc-sin x) (calcFunc-cos x))) 738 (list 'vec (calcFunc-sin x) (calcFunc-cos x))))
800)
801 739
802(defun calcFunc-tan (x) ; [N N] [Public] 740(defun calcFunc-tan (x) ; [N N] [Public]
803 (cond ((and (integerp x) 741 (cond ((and (integerp x)
@@ -840,8 +778,7 @@
840 ((equal x '(var nan var-nan)) 778 ((equal x '(var nan var-nan))
841 x) 779 x)
842 (t (calc-record-why 'scalarp x) 780 (t (calc-record-why 'scalarp x)
843 (list 'calcFunc-tan x))) 781 (list 'calcFunc-tan x))))
844)
845 782
846(defun math-sin-raw (x) ; [N N] 783(defun math-sin-raw (x) ; [N N]
847 (cond ((eq (car x) 'cplx) 784 (cond ((eq (car x) 'cplx)
@@ -861,21 +798,18 @@
861 (math-neg-float (math-sin-raw (math-neg-float x)))) 798 (math-neg-float (math-sin-raw (math-neg-float x))))
862 ((math-lessp-float '(float 7 0) x) ; avoid inf loops due to roundoff 799 ((math-lessp-float '(float 7 0) x) ; avoid inf loops due to roundoff
863 (math-sin-raw (math-mod x (math-two-pi)))) 800 (math-sin-raw (math-mod x (math-two-pi))))
864 (t (math-sin-raw-2 x x))) 801 (t (math-sin-raw-2 x x))))
865)
866 802
867(defun math-cos-raw (x) ; [N N] 803(defun math-cos-raw (x) ; [N N]
868 (if (eq (car-safe x) 'polar) 804 (if (eq (car-safe x) 'polar)
869 (math-polar (math-cos-raw (math-complex x))) 805 (math-polar (math-cos-raw (math-complex x)))
870 (math-sin-raw (math-sub (math-pi-over-2) x))) 806 (math-sin-raw (math-sub (math-pi-over-2) x))))
871)
872 807
873;;; This could use a smarter method: Reduce x as in math-sin-raw, then 808;;; This could use a smarter method: Reduce x as in math-sin-raw, then
874;;; compute either sin(x) or cos(x), whichever is smaller, and compute 809;;; compute either sin(x) or cos(x), whichever is smaller, and compute
875;;; the other using the identity sin(x)^2 + cos(x)^2 = 1. 810;;; the other using the identity sin(x)^2 + cos(x)^2 = 1.
876(defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x)) 811(defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x))
877 (cons (math-sin-raw x) (math-cos-raw x)) 812 (cons (math-sin-raw x) (math-cos-raw x)))
878)
879 813
880(defun math-tan-raw (x) ; [N N] 814(defun math-tan-raw (x) ; [N N]
881 (cond ((eq (car x) 'cplx) 815 (cond ((eq (car x) 'cplx)
@@ -898,8 +832,7 @@
898 (let ((sc (math-sin-cos-raw x))) 832 (let ((sc (math-sin-cos-raw x)))
899 (if (eq (nth 1 (cdr sc)) 0) 833 (if (eq (nth 1 (cdr sc)) 0)
900 (math-div (car sc) 0) 834 (math-div (car sc) 0)
901 (math-div-float (car sc) (cdr sc)))))) 835 (math-div-float (car sc) (cdr sc)))))))
902)
903 836
904(defun math-sin-raw-2 (x orgx) ; This avoids poss of inf recursion. [F F] 837(defun math-sin-raw-2 (x orgx) ; This avoids poss of inf recursion. [F F]
905 (let ((xmpo2 (math-sub-float (math-pi-over-2) x))) 838 (let ((xmpo2 (math-sub-float (math-pi-over-2) x)))
@@ -912,8 +845,7 @@
912 (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx))) 845 (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx)))
913 ((math-nearly-zerop-float x orgx) '(float 0 0)) 846 ((math-nearly-zerop-float x orgx) '(float 0 0))
914 (calc-symbolic-mode (signal 'inexact-result nil)) 847 (calc-symbolic-mode (signal 'inexact-result nil))
915 (t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x)))))) 848 (t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x)))))))
916)
917 849
918(defun math-cos-raw-2 (x orgx) ; [F F] 850(defun math-cos-raw-2 (x orgx) ; [F F]
919 (cond ((math-nearly-zerop-float x orgx) '(float 1 0)) 851 (cond ((math-nearly-zerop-float x orgx) '(float 1 0))
@@ -922,8 +854,7 @@
922 (math-sin-series 854 (math-sin-series
923 (math-add-float '(float 1 0) 855 (math-add-float '(float 1 0)
924 (math-mul-float xnegsqr '(float 5 -1))) 856 (math-mul-float xnegsqr '(float 5 -1)))
925 24 5 xnegsqr xnegsqr)))) 857 24 5 xnegsqr xnegsqr)))))
926)
927 858
928(defun math-sin-series (sum nfac n x xnegsqr) 859(defun math-sin-series (sum nfac n x xnegsqr)
929 (math-working "sin" sum) 860 (math-working "sin" sum)
@@ -933,8 +864,7 @@
933 (if (math-nearly-equal-float sum nextsum) 864 (if (math-nearly-equal-float sum nextsum)
934 sum 865 sum
935 (math-sin-series nextsum (math-mul nfac (* n (1+ n))) 866 (math-sin-series nextsum (math-mul nfac (* n (1+ n)))
936 (+ n 2) nextx xnegsqr))) 867 (+ n 2) nextx xnegsqr))))
937)
938 868
939 869
940;;; Inverse sine, cosine, tangent. 870;;; Inverse sine, cosine, tangent.
@@ -960,8 +890,7 @@
960 ((equal x '(var nan var-nan)) 890 ((equal x '(var nan var-nan))
961 x) 891 x)
962 (t (calc-record-why 'numberp x) 892 (t (calc-record-why 'numberp x)
963 (list 'calcFunc-arcsin x))) 893 (list 'calcFunc-arcsin x))))
964)
965 894
966(defun calcFunc-arccos (x) ; [N N] [Public] 895(defun calcFunc-arccos (x) ; [N N] [Public]
967 (cond ((eq x 1) 0) 896 (cond ((eq x 1) 0)
@@ -984,8 +913,7 @@
984 ((equal x '(var nan var-nan)) 913 ((equal x '(var nan var-nan))
985 x) 914 x)
986 (t (calc-record-why 'numberp x) 915 (t (calc-record-why 'numberp x)
987 (list 'calcFunc-arccos x))) 916 (list 'calcFunc-arccos x))))
988)
989 917
990(defun calcFunc-arctan (x) ; [N N] [Public] 918(defun calcFunc-arctan (x) ; [N N] [Public]
991 (cond ((eq x 0) 0) 919 (cond ((eq x 0) 0)
@@ -1010,8 +938,7 @@
1010 ((equal x '(var nan var-nan)) 938 ((equal x '(var nan var-nan))
1011 x) 939 x)
1012 (t (calc-record-why 'numberp x) 940 (t (calc-record-why 'numberp x)
1013 (list 'calcFunc-arctan x))) 941 (list 'calcFunc-arctan x))))
1014)
1015 942
1016(defun math-arcsin-raw (x) ; [N N] 943(defun math-arcsin-raw (x) ; [N N]
1017 (let ((a (math-sqrt-raw (math-sub '(float 1 0) (math-sqr x))))) 944 (let ((a (math-sqrt-raw (math-sub '(float 1 0) (math-sqr x)))))
@@ -1020,12 +947,10 @@
1020 (math-with-extra-prec 2 ; use extra precision for difficult case 947 (math-with-extra-prec 2 ; use extra precision for difficult case
1021 (math-mul '(cplx 0 -1) 948 (math-mul '(cplx 0 -1)
1022 (math-ln-raw (math-add (math-mul '(cplx 0 1) x) a)))) 949 (math-ln-raw (math-add (math-mul '(cplx 0 1) x) a))))
1023 (math-arctan2-raw x a))) 950 (math-arctan2-raw x a))))
1024)
1025 951
1026(defun math-arccos-raw (x) ; [N N] 952(defun math-arccos-raw (x) ; [N N]
1027 (math-sub (math-pi-over-2) (math-arcsin-raw x)) 953 (math-sub (math-pi-over-2) (math-arcsin-raw x)))
1028)
1029 954
1030(defun math-arctan-raw (x) ; [N N] 955(defun math-arctan-raw (x) ; [N N]
1031 (cond ((memq (car x) '(cplx polar)) 956 (cond ((memq (car x) '(cplx polar))
@@ -1049,8 +974,7 @@
1049 (math-sub-float '(float 1 0) x) 974 (math-sub-float '(float 1 0) x)
1050 (math-add-float '(float 1 0) 975 (math-add-float '(float 1 0)
1051 x)))))) 976 x))))))
1052 (t (math-arctan-series x 3 x (math-neg-float (math-sqr-float x))))) 977 (t (math-arctan-series x 3 x (math-neg-float (math-sqr-float x))))))
1053)
1054 978
1055(defun math-arctan-series (sum n x xnegsqr) 979(defun math-arctan-series (sum n x xnegsqr)
1056 (math-working "arctan" sum) 980 (math-working "arctan" sum)
@@ -1058,8 +982,7 @@
1058 (nextsum (math-add-float sum (math-div-float nextx (math-float n))))) 982 (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
1059 (if (math-nearly-equal-float sum nextsum) 983 (if (math-nearly-equal-float sum nextsum)
1060 sum 984 sum
1061 (math-arctan-series nextsum (+ n 2) nextx xnegsqr))) 985 (math-arctan-series nextsum (+ n 2) nextx xnegsqr))))
1062)
1063 986
1064(defun calcFunc-arctan2 (y x) ; [F R R] [Public] 987(defun calcFunc-arctan2 (y x) ; [F R R] [Public]
1065 (if (Math-anglep y) 988 (if (Math-anglep y)
@@ -1088,8 +1011,7 @@
1088 (calcFunc-arctan2 y x) 1011 (calcFunc-arctan2 y x)
1089 '(var nan var-nan))) 1012 '(var nan var-nan)))
1090 (calc-record-why 'anglep y) 1013 (calc-record-why 'anglep y)
1091 (list 'calcFunc-arctan2 y x))) 1014 (list 'calcFunc-arctan2 y x))))
1092)
1093 1015
1094(defun math-arctan2-raw (y x) ; [F R R] 1016(defun math-arctan2-raw (y x) ; [F R R]
1095 (cond ((math-zerop y) 1017 (cond ((math-zerop y)
@@ -1106,15 +1028,13 @@
1106 (math-pi))) 1028 (math-pi)))
1107 (t 1029 (t
1108 (math-sub-float (math-arctan-raw (math-div-float y x)) 1030 (math-sub-float (math-arctan-raw (math-div-float y x))
1109 (math-pi)))) 1031 (math-pi)))))
1110)
1111 1032
1112(defun calcFunc-arcsincos (x) ; [V N] [Public] 1033(defun calcFunc-arcsincos (x) ; [V N] [Public]
1113 (if (and (Math-vectorp x) 1034 (if (and (Math-vectorp x)
1114 (= (length x) 3)) 1035 (= (length x) 3))
1115 (calcFunc-arctan2 (nth 2 x) (nth 1 x)) 1036 (calcFunc-arctan2 (nth 2 x) (nth 1 x))
1116 (math-reject-arg x "*Two-element vector expected")) 1037 (math-reject-arg x "*Two-element vector expected")))
1117)
1118 1038
1119 1039
1120 1040
@@ -1139,8 +1059,7 @@
1139 ((equal x '(var nan var-nan)) 1059 ((equal x '(var nan var-nan))
1140 x) 1060 x)
1141 (t (calc-record-why 'numberp x) 1061 (t (calc-record-why 'numberp x)
1142 (list 'calcFunc-exp x))) 1062 (list 'calcFunc-exp x))))
1143)
1144 1063
1145(defun calcFunc-expm1 (x) ; [N N] [Public] 1064(defun calcFunc-expm1 (x) ; [N N] [Public]
1146 (cond ((eq x 0) 0) 1065 (cond ((eq x 0) 0)
@@ -1171,14 +1090,12 @@
1171 ((equal x '(var nan var-nan)) 1090 ((equal x '(var nan var-nan))
1172 x) 1091 x)
1173 (t (calc-record-why 'numberp x) 1092 (t (calc-record-why 'numberp x)
1174 (list 'calcFunc-expm1 x))) 1093 (list 'calcFunc-expm1 x))))
1175)
1176 1094
1177(defun calcFunc-exp10 (x) ; [N N] [Public] 1095(defun calcFunc-exp10 (x) ; [N N] [Public]
1178 (if (eq x 0) 1096 (if (eq x 0)
1179 1 1097 1
1180 (math-pow '(float 1 1) x)) 1098 (math-pow '(float 1 1) x)))
1181)
1182 1099
1183(defun math-exp-raw (x) ; [N N] 1100(defun math-exp-raw (x) ; [N N]
1184 (cond ((math-zerop x) '(float 1 0)) 1101 (cond ((math-zerop x) '(float 1 0))
@@ -1207,12 +1124,10 @@
1207 (math-mul-float (math-ipow (math-sqrt-e) hint) 1124 (math-mul-float (math-ipow (math-sqrt-e) hint)
1208 (math-add-float '(float 1 0) 1125 (math-add-float '(float 1 0)
1209 (math-exp-minus-1-raw hfrac))))) 1126 (math-exp-minus-1-raw hfrac)))))
1210 (t (math-add-float '(float 1 0) (math-exp-minus-1-raw x)))) 1127 (t (math-add-float '(float 1 0) (math-exp-minus-1-raw x)))))
1211)
1212 1128
1213(defun math-exp-minus-1-raw (x) ; [F F] 1129(defun math-exp-minus-1-raw (x) ; [F F]
1214 (math-exp-series x 2 3 x x) 1130 (math-exp-series x 2 3 x x))
1215)
1216 1131
1217(defun math-exp-series (sum nfac n xpow x) 1132(defun math-exp-series (sum nfac n xpow x)
1218 (math-working "exp" sum) 1133 (math-working "exp" sum)
@@ -1221,8 +1136,7 @@
1221 (math-float nfac))))) 1136 (math-float nfac)))))
1222 (if (math-nearly-equal-float sum nextsum) 1137 (if (math-nearly-equal-float sum nextsum)
1223 sum 1138 sum
1224 (math-exp-series nextsum (math-mul nfac n) (1+ n) nextx x))) 1139 (math-exp-series nextsum (math-mul nfac n) (1+ n) nextx x))))
1225)
1226 1140
1227 1141
1228 1142
@@ -1256,8 +1170,7 @@
1256 x 1170 x
1257 '(var inf var-inf))) 1171 '(var inf var-inf)))
1258 (t (calc-record-why 'numberp x) 1172 (t (calc-record-why 'numberp x)
1259 (list 'calcFunc-ln x))) 1173 (list 'calcFunc-ln x))))
1260)
1261 1174
1262(defun calcFunc-log10 (x) ; [N N] [Public] 1175(defun calcFunc-log10 (x) ; [N N] [Public]
1263 (cond ((math-equal-int x 1) 1176 (cond ((math-equal-int x 1)
@@ -1308,8 +1221,7 @@
1308 x 1221 x
1309 '(var inf var-inf))) 1222 '(var inf var-inf)))
1310 (t (calc-record-why 'numberp x) 1223 (t (calc-record-why 'numberp x)
1311 (list 'calcFunc-log10 x))) 1224 (list 'calcFunc-log10 x))))
1312)
1313 1225
1314(defun calcFunc-log (x &optional b) ; [N N N] [Public] 1226(defun calcFunc-log (x &optional b) ; [N N N] [Public]
1315 (cond ((or (null b) (equal b '(var e var-e))) 1227 (cond ((or (null b) (equal b '(var e var-e)))
@@ -1374,14 +1286,12 @@
1374 (t (if (Math-numberp b) 1286 (t (if (Math-numberp b)
1375 (calc-record-why 'numberp x) 1287 (calc-record-why 'numberp x)
1376 (calc-record-why 'numberp b)) 1288 (calc-record-why 'numberp b))
1377 (list 'calcFunc-log x b))) 1289 (list 'calcFunc-log x b))))
1378)
1379 1290
1380(defun calcFunc-alog (x &optional b) 1291(defun calcFunc-alog (x &optional b)
1381 (cond ((or (null b) (equal b '(var e var-e))) 1292 (cond ((or (null b) (equal b '(var e var-e)))
1382 (math-normalize (list 'calcFunc-exp x))) 1293 (math-normalize (list 'calcFunc-exp x)))
1383 (t (math-pow b x))) 1294 (t (math-pow b x))))
1384)
1385 1295
1386(defun calcFunc-ilog (x b) 1296(defun calcFunc-ilog (x b)
1387 (if (and (math-natnump x) (not (eq x 0)) 1297 (if (and (math-natnump x) (not (eq x 0))
@@ -1391,8 +1301,7 @@
1391 (if (Math-natnum-lessp x b) 1301 (if (Math-natnum-lessp x b)
1392 0 1302 0
1393 (cdr (math-integer-log x b)))) 1303 (cdr (math-integer-log x b))))
1394 (math-floor (calcFunc-log x b))) 1304 (math-floor (calcFunc-log x b))))
1395)
1396 1305
1397(defun math-integer-log (x b) 1306(defun math-integer-log (x b)
1398 (let ((pows (list b)) 1307 (let ((pows (list b))
@@ -1412,8 +1321,7 @@
1412 (or (Math-lessp x next) 1321 (or (Math-lessp x next)
1413 (setq pow next 1322 (setq pow next
1414 sum (+ sum n)))) 1323 sum (+ sum n))))
1415 (cons (equal pow x) sum)) 1324 (cons (equal pow x) sum)))
1416)
1417 1325
1418 1326
1419(defun math-log-base-raw (b) ; [N N] 1327(defun math-log-base-raw (b) ; [N N]
@@ -1421,8 +1329,7 @@
1421 (eq (nth 1 math-log-base-cache) calc-internal-prec))) 1329 (eq (nth 1 math-log-base-cache) calc-internal-prec)))
1422 (setq math-log-base-cache (list b calc-internal-prec 1330 (setq math-log-base-cache (list b calc-internal-prec
1423 (math-ln-raw (math-float b))))) 1331 (math-ln-raw (math-float b)))))
1424 (nth 2 math-log-base-cache) 1332 (nth 2 math-log-base-cache))
1425)
1426(setq math-log-base-cache nil) 1333(setq math-log-base-cache nil)
1427 1334
1428(defun calcFunc-lnp1 (x) ; [N N] [Public] 1335(defun calcFunc-lnp1 (x) ; [N N] [Public]
@@ -1454,8 +1361,7 @@
1454 x 1361 x
1455 '(var inf var-inf))) 1362 '(var inf var-inf)))
1456 (t (calc-record-why 'numberp x) 1363 (t (calc-record-why 'numberp x)
1457 (list 'calcFunc-lnp1 x))) 1364 (list 'calcFunc-lnp1 x))))
1458)
1459 1365
1460(defun math-ln-raw (x) ; [N N] --- must be float format! 1366(defun math-ln-raw (x) ; [N N] --- must be float format!
1461 (cond ((eq (car-safe x) 'cplx) 1367 (cond ((eq (car-safe x) 'cplx)
@@ -1486,8 +1392,7 @@
1486 (math-pi)))) 1392 (math-pi))))
1487 (t (list 'cplx ; negative and real 1393 (t (list 'cplx ; negative and real
1488 (math-ln-raw (math-neg-float x)) 1394 (math-ln-raw (math-neg-float x))
1489 (math-pi)))) 1395 (math-pi)))))
1490)
1491 1396
1492(defun math-ln-raw-2 (x) ; [F F] 1397(defun math-ln-raw-2 (x) ; [F F]
1493 (cond ((math-lessp-float '(float 14 -1) x) 1398 (cond ((math-lessp-float '(float 14 -1) x)
@@ -1495,13 +1400,11 @@
1495 (math-ln-2))) 1400 (math-ln-2)))
1496 (t ; now .7 < x <= 1.4 1401 (t ; now .7 < x <= 1.4
1497 (math-ln-raw-3 (math-div-float (math-sub-float x '(float 1 0)) 1402 (math-ln-raw-3 (math-div-float (math-sub-float x '(float 1 0))
1498 (math-add-float x '(float 1 0)))))) 1403 (math-add-float x '(float 1 0)))))))
1499)
1500 1404
1501(defun math-ln-raw-3 (x) ; [F F] 1405(defun math-ln-raw-3 (x) ; [F F]
1502 (math-mul-float (math-ln-raw-series x 3 x (math-sqr-float x)) 1406 (math-mul-float (math-ln-raw-series x 3 x (math-sqr-float x))
1503 '(float 2 0)) 1407 '(float 2 0)))
1504)
1505 1408
1506;;; Compute ln((1+x)/(1-x)) 1409;;; Compute ln((1+x)/(1-x))
1507(defun math-ln-raw-series (sum n x xsqr) 1410(defun math-ln-raw-series (sum n x xsqr)
@@ -1510,12 +1413,10 @@
1510 (nextsum (math-add-float sum (math-div-float nextx (math-float n))))) 1413 (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
1511 (if (math-nearly-equal-float sum nextsum) 1414 (if (math-nearly-equal-float sum nextsum)
1512 sum 1415 sum
1513 (math-ln-raw-series nextsum (+ n 2) nextx xsqr))) 1416 (math-ln-raw-series nextsum (+ n 2) nextx xsqr))))
1514)
1515 1417
1516(defun math-ln-plus-1-raw (x) 1418(defun math-ln-plus-1-raw (x)
1517 (math-lnp1-series x 2 x (math-neg x)) 1419 (math-lnp1-series x 2 x (math-neg x)))
1518)
1519 1420
1520(defun math-lnp1-series (sum n xpow x) 1421(defun math-lnp1-series (sum n xpow x)
1521 (math-working "lnp1" sum) 1422 (math-working "lnp1" sum)
@@ -1523,8 +1424,7 @@
1523 (nextsum (math-add-float sum (math-div-float nextx (math-float n))))) 1424 (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
1524 (if (math-nearly-equal-float sum nextsum) 1425 (if (math-nearly-equal-float sum nextsum)
1525 sum 1426 sum
1526 (math-lnp1-series nextsum (1+ n) nextx x))) 1427 (math-lnp1-series nextsum (1+ n) nextx x))))
1527)
1528 1428
1529(math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21) 1429(math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21)
1530 (math-ln-raw-2 '(float 1 1))) 1430 (math-ln-raw-2 '(float 1 1)))
@@ -1559,8 +1459,7 @@
1559 (equal x '(var nan var-nan))) 1459 (equal x '(var nan var-nan)))
1560 x) 1460 x)
1561 (t (calc-record-why 'numberp x) 1461 (t (calc-record-why 'numberp x)
1562 (list 'calcFunc-sinh x))) 1462 (list 'calcFunc-sinh x))))
1563)
1564(put 'calcFunc-sinh 'math-expandable t) 1463(put 'calcFunc-sinh 'math-expandable t)
1565 1464
1566(defun calcFunc-cosh (x) ; [N N] [Public] 1465(defun calcFunc-cosh (x) ; [N N] [Public]
@@ -1588,8 +1487,7 @@
1588 (equal x '(var nan var-nan))) 1487 (equal x '(var nan var-nan)))
1589 (math-abs x)) 1488 (math-abs x))
1590 (t (calc-record-why 'numberp x) 1489 (t (calc-record-why 'numberp x)
1591 (list 'calcFunc-cosh x))) 1490 (list 'calcFunc-cosh x))))
1592)
1593(put 'calcFunc-cosh 'math-expandable t) 1491(put 'calcFunc-cosh 'math-expandable t)
1594 1492
1595(defun calcFunc-tanh (x) ; [N N] [Public] 1493(defun calcFunc-tanh (x) ; [N N] [Public]
@@ -1622,8 +1520,7 @@
1622 ((equal x '(var nan var-nan)) 1520 ((equal x '(var nan var-nan))
1623 x) 1521 x)
1624 (t (calc-record-why 'numberp x) 1522 (t (calc-record-why 'numberp x)
1625 (list 'calcFunc-tanh x))) 1523 (list 'calcFunc-tanh x))))
1626)
1627(put 'calcFunc-tanh 'math-expandable t) 1524(put 'calcFunc-tanh 'math-expandable t)
1628 1525
1629(defun calcFunc-arcsinh (x) ; [N N] [Public] 1526(defun calcFunc-arcsinh (x) ; [N N] [Public]
@@ -1651,8 +1548,7 @@
1651 (equal x '(var nan var-nan))) 1548 (equal x '(var nan var-nan)))
1652 x) 1549 x)
1653 (t (calc-record-why 'numberp x) 1550 (t (calc-record-why 'numberp x)
1654 (list 'calcFunc-arcsinh x))) 1551 (list 'calcFunc-arcsinh x))))
1655)
1656(put 'calcFunc-arcsinh 'math-expandable t) 1552(put 'calcFunc-arcsinh 'math-expandable t)
1657 1553
1658(defun calcFunc-arccosh (x) ; [N N] [Public] 1554(defun calcFunc-arccosh (x) ; [N N] [Public]
@@ -1697,8 +1593,7 @@
1697 (equal x '(var nan var-nan))) 1593 (equal x '(var nan var-nan)))
1698 x) 1594 x)
1699 (t (calc-record-why 'numberp x) 1595 (t (calc-record-why 'numberp x)
1700 (list 'calcFunc-arccosh x))) 1596 (list 'calcFunc-arccosh x))))
1701)
1702(put 'calcFunc-arccosh 'math-expandable t) 1597(put 'calcFunc-arccosh 'math-expandable t)
1703 1598
1704(defun calcFunc-arctanh (x) ; [N N] [Public] 1599(defun calcFunc-arctanh (x) ; [N N] [Public]
@@ -1737,8 +1632,7 @@
1737 ((equal x '(var nan var-nan)) 1632 ((equal x '(var nan var-nan))
1738 x) 1633 x)
1739 (t (calc-record-why 'numberp x) 1634 (t (calc-record-why 'numberp x)
1740 (list 'calcFunc-arctanh x))) 1635 (list 'calcFunc-arctanh x))))
1741)
1742(put 'calcFunc-arctanh 'math-expandable t) 1636(put 'calcFunc-arctanh 'math-expandable t)
1743 1637
1744 1638
@@ -1756,8 +1650,7 @@
1756 (math-expand-formulas 1650 (math-expand-formulas
1757 (math-div (math-mul a '(var pi var-pi)) 180)) 1651 (math-div (math-mul a '(var pi var-pi)) 180))
1758 ((math-infinitep a) a) 1652 ((math-infinitep a) a)
1759 (t (list 'calcFunc-rad a))) 1653 (t (list 'calcFunc-rad a))))
1760)
1761(put 'calcFunc-rad 'math-expandable t) 1654(put 'calcFunc-rad 'math-expandable t)
1762 1655
1763;;; Convert A from HMS or radians to degrees. 1656;;; Convert A from HMS or radians to degrees.
@@ -1774,10 +1667,9 @@
1774 (math-expand-formulas 1667 (math-expand-formulas
1775 (math-div (math-mul 180 a) '(var pi var-pi))) 1668 (math-div (math-mul 180 a) '(var pi var-pi)))
1776 ((math-infinitep a) a) 1669 ((math-infinitep a) a)
1777 (t (list 'calcFunc-deg a))) 1670 (t (list 'calcFunc-deg a))))
1778)
1779(put 'calcFunc-deg 'math-expandable t) 1671(put 'calcFunc-deg 'math-expandable t)
1780 1672
1781 1673;;; calc-math.el ends here
1782 1674
1783 1675