/[emacs]/emacs/lisp/calc/calc-math.el
ViewVC logotype

Diff of /emacs/lisp/calc/calc-math.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:05:36 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-math.el]  ;; Calculator for GNU Emacs, part II [calc-math.el]
2  ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.  ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc.
3  ;; Written by Dave Gillespie, daveg@synaptics.com.  ;; Written by Dave Gillespie, daveg@synaptics.com.
4    
5  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 34  Line 34 
34    (calc-slow-wrapper    (calc-slow-wrapper
35     (if (calc-is-inverse)     (if (calc-is-inverse)
36         (calc-unary-op "^2" 'calcFunc-sqr arg)         (calc-unary-op "^2" 'calcFunc-sqr arg)
37       (calc-unary-op "sqrt" 'calcFunc-sqrt arg)))       (calc-unary-op "sqrt" 'calcFunc-sqrt arg))))
 )  
38    
39  (defun calc-isqrt (arg)  (defun calc-isqrt (arg)
40    (interactive "P")    (interactive "P")
41    (calc-slow-wrapper    (calc-slow-wrapper
42     (if (calc-is-inverse)     (if (calc-is-inverse)
43         (calc-unary-op "^2" 'calcFunc-sqr arg)         (calc-unary-op "^2" 'calcFunc-sqr arg)
44       (calc-unary-op "isqt" 'calcFunc-isqrt arg)))       (calc-unary-op "isqt" 'calcFunc-isqrt arg))))
 )  
45    
46    
47  (defun calc-hypot (arg)  (defun calc-hypot (arg)
48    (interactive "P")    (interactive "P")
49    (calc-slow-wrapper    (calc-slow-wrapper
50     (calc-binary-op "hypt" 'calcFunc-hypot arg))     (calc-binary-op "hypt" 'calcFunc-hypot arg)))
 )  
51    
52  (defun calc-ln (arg)  (defun calc-ln (arg)
53    (interactive "P")    (interactive "P")
54    (calc-invert-func)    (calc-invert-func)
55    (calc-exp arg)    (calc-exp arg))
 )  
56    
57  (defun calc-log10 (arg)  (defun calc-log10 (arg)
58    (interactive "P")    (interactive "P")
59    (calc-hyperbolic-func)    (calc-hyperbolic-func)
60    (calc-ln arg)    (calc-ln arg))
 )  
61    
62  (defun calc-log (arg)  (defun calc-log (arg)
63    (interactive "P")    (interactive "P")
64    (calc-slow-wrapper    (calc-slow-wrapper
65     (if (calc-is-inverse)     (if (calc-is-inverse)
66         (calc-binary-op "alog" 'calcFunc-alog arg)         (calc-binary-op "alog" 'calcFunc-alog arg)
67       (calc-binary-op "log" 'calcFunc-log arg)))       (calc-binary-op "log" 'calcFunc-log arg))))
 )  
68    
69  (defun calc-ilog (arg)  (defun calc-ilog (arg)
70    (interactive "P")    (interactive "P")
71    (calc-slow-wrapper    (calc-slow-wrapper
72     (if (calc-is-inverse)     (if (calc-is-inverse)
73         (calc-binary-op "alog" 'calcFunc-alog arg)         (calc-binary-op "alog" 'calcFunc-alog arg)
74       (calc-binary-op "ilog" 'calcFunc-ilog arg)))       (calc-binary-op "ilog" 'calcFunc-ilog arg))))
 )  
75    
76  (defun calc-lnp1 (arg)  (defun calc-lnp1 (arg)
77    (interactive "P")    (interactive "P")
78    (calc-invert-func)    (calc-invert-func)
79    (calc-expm1 arg)    (calc-expm1 arg))
 )  
80    
81  (defun calc-exp (arg)  (defun calc-exp (arg)
82    (interactive "P")    (interactive "P")
# Line 95  Line 87 
87           (calc-unary-op "10^" 'calcFunc-exp10 arg))           (calc-unary-op "10^" 'calcFunc-exp10 arg))
88       (if (calc-is-inverse)       (if (calc-is-inverse)
89           (calc-unary-op "ln" 'calcFunc-ln arg)           (calc-unary-op "ln" 'calcFunc-ln arg)
90         (calc-unary-op "exp" 'calcFunc-exp arg))))         (calc-unary-op "exp" 'calcFunc-exp arg)))))
 )  
91    
92  (defun calc-expm1 (arg)  (defun calc-expm1 (arg)
93    (interactive "P")    (interactive "P")
94    (calc-slow-wrapper    (calc-slow-wrapper
95     (if (calc-is-inverse)     (if (calc-is-inverse)
96         (calc-unary-op "ln+1" 'calcFunc-lnp1 arg)         (calc-unary-op "ln+1" 'calcFunc-lnp1 arg)
97       (calc-unary-op "ex-1" 'calcFunc-expm1 arg)))       (calc-unary-op "ex-1" 'calcFunc-expm1 arg))))
 )  
98    
99  (defun calc-pi ()  (defun calc-pi ()
100    (interactive)    (interactive)
# Line 123  Line 113 
113             (calc-pop-push-record 0 "e" (math-e)))             (calc-pop-push-record 0 "e" (math-e)))
114         (if calc-symbolic-mode         (if calc-symbolic-mode
115             (calc-pop-push-record 0 "pi" '(var pi var-pi))             (calc-pop-push-record 0 "pi" '(var pi var-pi))
116           (calc-pop-push-record 0 "pi" (math-pi))))))           (calc-pop-push-record 0 "pi" (math-pi)))))))
 )  
117    
118  (defun calc-sin (arg)  (defun calc-sin (arg)
119    (interactive "P")    (interactive "P")
# Line 135  Line 124 
124           (calc-unary-op "sinh" 'calcFunc-sinh arg))           (calc-unary-op "sinh" 'calcFunc-sinh arg))
125       (if (calc-is-inverse)       (if (calc-is-inverse)
126           (calc-unary-op "asin" 'calcFunc-arcsin arg)           (calc-unary-op "asin" 'calcFunc-arcsin arg)
127         (calc-unary-op "sin" 'calcFunc-sin arg))))         (calc-unary-op "sin" 'calcFunc-sin arg)))))
 )  
128    
129  (defun calc-arcsin (arg)  (defun calc-arcsin (arg)
130    (interactive "P")    (interactive "P")
131    (calc-invert-func)    (calc-invert-func)
132    (calc-sin arg)    (calc-sin arg))
 )  
133    
134  (defun calc-sinh (arg)  (defun calc-sinh (arg)
135    (interactive "P")    (interactive "P")
136    (calc-hyperbolic-func)    (calc-hyperbolic-func)
137    (calc-sin arg)    (calc-sin arg))
 )  
138    
139  (defun calc-arcsinh (arg)  (defun calc-arcsinh (arg)
140    (interactive "P")    (interactive "P")
141    (calc-invert-func)    (calc-invert-func)
142    (calc-hyperbolic-func)    (calc-hyperbolic-func)
143    (calc-sin arg)    (calc-sin arg))
 )  
144    
145  (defun calc-cos (arg)  (defun calc-cos (arg)
146    (interactive "P")    (interactive "P")
# Line 166  Line 151 
151           (calc-unary-op "cosh" 'calcFunc-cosh arg))           (calc-unary-op "cosh" 'calcFunc-cosh arg))
152       (if (calc-is-inverse)       (if (calc-is-inverse)
153           (calc-unary-op "acos" 'calcFunc-arccos arg)           (calc-unary-op "acos" 'calcFunc-arccos arg)
154         (calc-unary-op "cos" 'calcFunc-cos arg))))         (calc-unary-op "cos" 'calcFunc-cos arg)))))
 )  
155    
156  (defun calc-arccos (arg)  (defun calc-arccos (arg)
157    (interactive "P")    (interactive "P")
158    (calc-invert-func)    (calc-invert-func)
159    (calc-cos arg)    (calc-cos arg))
 )  
160    
161  (defun calc-cosh (arg)  (defun calc-cosh (arg)
162    (interactive "P")    (interactive "P")
163    (calc-hyperbolic-func)    (calc-hyperbolic-func)
164    (calc-cos arg)    (calc-cos arg))
 )  
165    
166  (defun calc-arccosh (arg)  (defun calc-arccosh (arg)
167    (interactive "P")    (interactive "P")
168    (calc-invert-func)    (calc-invert-func)
169    (calc-hyperbolic-func)    (calc-hyperbolic-func)
170    (calc-cos arg)    (calc-cos arg))
 )  
171    
172  (defun calc-sincos ()  (defun calc-sincos ()
173    (interactive)    (interactive)
174    (calc-slow-wrapper    (calc-slow-wrapper
175     (if (calc-is-inverse)     (if (calc-is-inverse)
176         (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1)))         (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1)))
177       (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1)))))       (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1))))))
 )  
178    
179  (defun calc-tan (arg)  (defun calc-tan (arg)
180    (interactive "P")    (interactive "P")
# Line 205  Line 185 
185           (calc-unary-op "tanh" 'calcFunc-tanh arg))           (calc-unary-op "tanh" 'calcFunc-tanh arg))
186       (if (calc-is-inverse)       (if (calc-is-inverse)
187           (calc-unary-op "atan" 'calcFunc-arctan arg)           (calc-unary-op "atan" 'calcFunc-arctan arg)
188         (calc-unary-op "tan" 'calcFunc-tan arg))))         (calc-unary-op "tan" 'calcFunc-tan arg)))))
 )  
189    
190  (defun calc-arctan (arg)  (defun calc-arctan (arg)
191    (interactive "P")    (interactive "P")
192    (calc-invert-func)    (calc-invert-func)
193    (calc-tan arg)    (calc-tan arg))
 )  
194    
195  (defun calc-tanh (arg)  (defun calc-tanh (arg)
196    (interactive "P")    (interactive "P")
197    (calc-hyperbolic-func)    (calc-hyperbolic-func)
198    (calc-tan arg)    (calc-tan arg))
 )  
199    
200  (defun calc-arctanh (arg)  (defun calc-arctanh (arg)
201    (interactive "P")    (interactive "P")
202    (calc-invert-func)    (calc-invert-func)
203    (calc-hyperbolic-func)    (calc-hyperbolic-func)
204    (calc-tan arg)    (calc-tan arg))
 )  
205    
206  (defun calc-arctan2 ()  (defun calc-arctan2 ()
207    (interactive)    (interactive)
208    (calc-slow-wrapper    (calc-slow-wrapper
209     (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2))))     (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2)))))
 )  
210    
211  (defun calc-conj (arg)  (defun calc-conj (arg)
212    (interactive "P")    (interactive "P")
213    (calc-wrapper    (calc-wrapper
214     (calc-unary-op "conj" 'calcFunc-conj arg))     (calc-unary-op "conj" 'calcFunc-conj arg)))
 )  
215    
216  (defun calc-imaginary ()  (defun calc-imaginary ()
217    (interactive)    (interactive)
218    (calc-slow-wrapper    (calc-slow-wrapper
219     (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1))))     (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1)))))
 )  
220    
221    
222    
223  (defun calc-to-degrees (arg)  (defun calc-to-degrees (arg)
224    (interactive "P")    (interactive "P")
225    (calc-wrapper    (calc-wrapper
226     (calc-unary-op ">deg" 'calcFunc-deg arg))     (calc-unary-op ">deg" 'calcFunc-deg arg)))
 )  
227    
228  (defun calc-to-radians (arg)  (defun calc-to-radians (arg)
229    (interactive "P")    (interactive "P")
230    (calc-wrapper    (calc-wrapper
231     (calc-unary-op ">rad" 'calcFunc-rad arg))     (calc-unary-op ">rad" 'calcFunc-rad arg)))
 )  
232    
233    
234  (defun calc-degrees-mode (arg)  (defun calc-degrees-mode (arg)
# Line 268  Line 239 
239            (message "Angles measured in degrees.")))            (message "Angles measured in degrees.")))
240          ((= arg 2) (calc-radians-mode))          ((= arg 2) (calc-radians-mode))
241          ((= arg 3) (calc-hms-mode))          ((= arg 3) (calc-hms-mode))
242          (t (error "Prefix argument out of range")))          (t (error "Prefix argument out of range"))))
 )  
243    
244  (defun calc-radians-mode ()  (defun calc-radians-mode ()
245    (interactive)    (interactive)
246    (calc-wrapper    (calc-wrapper
247     (calc-change-mode 'calc-angle-mode 'rad)     (calc-change-mode 'calc-angle-mode 'rad)
248     (message "Angles measured in radians."))     (message "Angles measured in radians.")))
 )  
249    
250    
251  ;;; Compute the integer square-root floor(sqrt(A)).  A > 0.  [I I] [Public]  ;;; Compute the integer square-root floor(sqrt(A)).  A > 0.  [I I] [Public]
# Line 289  Line 258 
258          ((integerp a)          ((integerp a)
259           (math-isqrt-small a))           (math-isqrt-small a))
260          (t          (t
261           (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a)))))))           (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a))))))))
 )  
262    
263  (defun calcFunc-isqrt (a)  (defun calcFunc-isqrt (a)
264    (if (math-realp a)    (if (math-realp a)
265        (math-isqrt (math-floor a))        (math-isqrt (math-floor a))
266      (math-floor (math-sqrt a)))      (math-floor (math-sqrt a))))
 )  
267    
268    
269  ;;; This returns (flag . result) where the flag is T if A is a perfect square.  ;;; This returns (flag . result) where the flag is T if A is a perfect square.
# Line 316  Line 283 
283           a           a
284           (math-scale-bignum-3           (math-scale-bignum-3
285            (list (1+ (math-isqrt-small top)))            (list (1+ (math-isqrt-small top)))
286            (/ len 2))))))            (/ len 2)))))))
 )  
287    
288  (defun math-isqrt-bignum-iter (a guess)   ; [l L l]  (defun math-isqrt-bignum-iter (a guess)   ; [l L l]
289    (math-working "isqrt" (cons 'bigpos guess))    (math-working "isqrt" (cons 'bigpos guess))
# Line 330  Line 296 
296        (cons (and (= comp 0)        (cons (and (= comp 0)
297                   (math-zerop-bignum (cdr q))                   (math-zerop-bignum (cdr q))
298                   (= (% (car s) 2) 0))                   (= (% (car s) 2) 0))
299              guess)))              guess))))
 )  
300    
301  (defun math-zerop-bignum (a)  (defun math-zerop-bignum (a)
302    (and (eq (car a) 0)    (and (eq (car a) 0)
303         (progn         (progn
304           (while (eq (car (setq a (cdr a))) 0))           (while (eq (car (setq a (cdr a))) 0))
305           (null a)))           (null a))))
 )  
306    
307  (defun math-scale-bignum-3 (a n)   ; [L L S]  (defun math-scale-bignum-3 (a n)   ; [L L S]
308    (while (> n 0)    (while (> n 0)
309      (setq a (cons 0 a)      (setq a (cons 0 a)
310            n (1- n)))            n (1- n)))
311    a    a)
 )  
312    
313  (defun math-isqrt-small (a)   ; A > 0.  [S S]  (defun math-isqrt-small (a)   ; A > 0.  [S S]
314    (let ((g (cond ((>= a 10000) 1000)    (let ((g (cond ((>= a 10000) 1000)
# Line 354  Line 317 
317          g2)          g2)
318      (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)      (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
319        (setq g g2))        (setq g g2))
320      g)      g))
 )  
321    
322    
323    
# Line 449  Line 411 
411            (math-mul (math-sqrt (math-infinite-dir a inf)) inf)))            (math-mul (math-sqrt (math-infinite-dir a inf)) inf)))
412     (progn     (progn
413       (calc-record-why 'numberp a)       (calc-record-why 'numberp a)
414       (list 'calcFunc-sqrt a)))       (list 'calcFunc-sqrt a))))
415  )  (defalias calcFunc-sqrt 'math-sqrt)
 (fset 'calcFunc-sqrt (symbol-function 'math-sqrt))  
416    
417  (defun math-infinite-dir (a &optional inf)  (defun math-infinite-dir (a &optional inf)
418    (or inf (setq inf (math-infinitep a)))    (or inf (setq inf (math-infinitep a)))
419    (math-normalize (math-expr-subst a inf 1))    (math-normalize (math-expr-subst a inf 1)))
 )  
420    
421  (defun math-sqrt-float (a &optional guess)   ; [F F F]  (defun math-sqrt-float (a &optional guess)   ; [F F F]
422    (if calc-symbolic-mode    (if calc-symbolic-mode
423        (signal 'inexact-result nil)        (signal 'inexact-result nil)
424      (math-with-extra-prec 1 (math-sqrt-raw a guess)))      (math-with-extra-prec 1 (math-sqrt-raw a guess))))
 )  
425    
426  (defun math-sqrt-raw (a &optional guess)   ; [F F F]  (defun math-sqrt-raw (a &optional guess)   ; [F F F]
427    (if (not (Math-posp a))    (if (not (Math-posp a))
# Line 473  Line 432 
432            (setq guess (math-make-float (math-isqrt-small            (setq guess (math-make-float (math-isqrt-small
433                                          (math-scale-int (nth 1 a) (- ldiff)))                                          (math-scale-int (nth 1 a) (- ldiff)))
434                                         (/ (+ (nth 2 a) ldiff) 2)))))                                         (/ (+ (nth 2 a) ldiff) 2)))))
435      (math-sqrt-float-iter a guess))      (math-sqrt-float-iter a guess)))
 )  
436    
437  (defun math-sqrt-float-iter (a guess)   ; [F F F]  (defun math-sqrt-float-iter (a guess)   ; [F F F]
438    (math-working "sqrt" guess)    (math-working "sqrt" guess)
# Line 482  Line 440 
440                              '(float 5 -1))))                              '(float 5 -1))))
441       (if (math-nearly-equal-float g2 guess)       (if (math-nearly-equal-float g2 guess)
442           g2           g2
443         (math-sqrt-float-iter a g2)))         (math-sqrt-float-iter a g2))))
 )  
444    
445  ;;; True if A and B differ only in the last digit of precision.  [P F F]  ;;; True if A and B differ only in the last digit of precision.  [P F F]
446  (defun math-nearly-equal-float (a b)  (defun math-nearly-equal-float (a b)
# Line 508  Line 465 
465             (and (not (consp ediff))             (and (not (consp ediff))
466                  (< ediff 10)                  (< ediff 10)
467                  (> ediff -10)                  (> ediff -10)
468                  (= (math-numdigs (nth 1 a)) calc-internal-prec)))))                  (= (math-numdigs (nth 1 a)) calc-internal-prec))))))
 )  
469    
470  (defun math-nearly-equal (a b)   ;  [P N N] [Public]  (defun math-nearly-equal (a b)   ;  [P N N] [Public]
471    (setq a (math-float a))    (setq a (math-float a))
# Line 529  Line 485 
485        (if (eq (car b) 'cplx)        (if (eq (car b) 'cplx)
486            (and (math-nearly-equal-float a (nth 1 b))            (and (math-nearly-equal-float a (nth 1 b))
487                 (math-nearly-zerop-float a (nth 2 b)))                 (math-nearly-zerop-float a (nth 2 b)))
488          (math-nearly-equal-float a b)))          (math-nearly-equal-float a b))))
 )  
489    
490  ;;; True if A is nearly zero compared to B.  [P F F]  ;;; True if A is nearly zero compared to B.  [P F F]
491  (defun math-nearly-zerop-float (a b)  (defun math-nearly-zerop-float (a b)
492    (or (eq (nth 1 a) 0)    (or (eq (nth 1 a) 0)
493        (<= (+ (math-numdigs (nth 1 a)) (nth 2 a))        (<= (+ (math-numdigs (nth 1 a)) (nth 2 a))
494            (1+ (- (+ (math-numdigs (nth 1 b)) (nth 2 b)) calc-internal-prec))))            (1+ (- (+ (math-numdigs (nth 1 b)) (nth 2 b)) calc-internal-prec)))))
 )  
495    
496  (defun math-nearly-zerop (a b)   ; [P N R] [Public]  (defun math-nearly-zerop (a b)   ; [P N R] [Public]
497    (setq a (math-float a))    (setq a (math-float a))
# Line 547  Line 501 
501             (math-nearly-zerop-float (nth 2 a) b))             (math-nearly-zerop-float (nth 2 a) b))
502      (if (eq (car a) 'polar)      (if (eq (car a) 'polar)
503          (math-nearly-zerop-float (nth 1 a) b)          (math-nearly-zerop-float (nth 1 a) b)
504        (math-nearly-zerop-float a b)))        (math-nearly-zerop-float a b))))
 )  
505    
506  ;;; This implementation could be improved, accuracy-wise.  ;;; This implementation could be improved, accuracy-wise.
507  (defun math-hypot (a b)  (defun math-hypot (a b)
# Line 578  Line 531 
531             (math-to-hms (math-hypot (math-from-hms a 'deg) b))))             (math-to-hms (math-hypot (math-from-hms a 'deg) b))))
532          ((eq (car-safe b) 'hms)          ((eq (car-safe b) 'hms)
533           (math-to-hms (math-hypot a (math-from-hms b 'deg))))           (math-to-hms (math-hypot a (math-from-hms b 'deg))))
534          (t nil))          (t nil)))
535  )  (defalias calcFunc-hypot 'math-hypot)
 (fset 'calcFunc-hypot (symbol-function 'math-hypot))  
536    
537  (defun calcFunc-sqr (x)  (defun calcFunc-sqr (x)
538    (math-pow x 2)    (math-pow x 2))
 )  
539    
540    
541    
# Line 615  Line 566 
566          ((eq (car-safe a) 'polar)          ((eq (car-safe a) 'polar)
567           (let ((root (math-nth-root (nth 1 a) n)))           (let ((root (math-nth-root (nth 1 a) n)))
568             (and root (list 'polar root (math-div (nth 2 a) n)))))             (and root (list 'polar root (math-div (nth 2 a) n)))))
569          (t nil))          (t nil)))
 )  
570    
571  (defun math-nth-root-float (a n &optional guess)  (defun math-nth-root-float (a n &optional guess)
572    (math-inexact-result)    (math-inexact-result)
# Line 628  Line 578 
578                                         1 (/ (+ (math-numdigs (nth 1 a))                                         1 (/ (+ (math-numdigs (nth 1 a))
579                                                 (nth 2 a)                                                 (nth 2 a)
580                                                 (/ n 2))                                                 (/ n 2))
581                                              n))))))                                              n)))))))
 )  
582    
583  (defun math-nth-root-float-iter (a guess)   ; uses "n", "nf", "nfm1"  (defun math-nth-root-float-iter (a guess)   ; uses "n", "nf", "nfm1"
584    (math-working "root" guess)    (math-working "root" guess)
# Line 639  Line 588 
588                              nf)))                              nf)))
589      (if (math-nearly-equal-float g2 guess)      (if (math-nearly-equal-float g2 guess)
590          g2          g2
591        (math-nth-root-float-iter a g2)))        (math-nth-root-float-iter a g2))))
 )  
592    
593  (defun math-nth-root-integer (a n &optional guess)   ; [I I S]  (defun math-nth-root-integer (a n &optional guess)   ; [I I S]
594    (math-nth-root-int-iter a (or guess    (math-nth-root-int-iter a (or guess
595                                  (math-scale-int 1 (/ (+ (math-numdigs a)                                  (math-scale-int 1 (/ (+ (math-numdigs a)
596                                                          (1- n))                                                          (1- n))
597                                                       n))))                                                       n)))))
 )  
598    
599  (defun math-nth-root-int-iter (a guess)   ; uses "n"  (defun math-nth-root-int-iter (a guess)   ; uses "n"
600    (math-working "root" guess)    (math-working "root" guess)
# Line 659  Line 606 
606        (cons (and (equal (car g2) guess)        (cons (and (equal (car g2) guess)
607                   (eq (cdr q) 0)                   (eq (cdr q) 0)
608                   (eq (cdr g2) 0))                   (eq (cdr g2) 0))
609              guess)))              guess))))
 )  
610    
611  (defun calcFunc-nroot (x n)  (defun calcFunc-nroot (x n)
612    (calcFunc-pow x (if (integerp n)    (calcFunc-pow x (if (integerp n)
613                        (math-make-frac 1 n)                        (math-make-frac 1 n)
614                      (math-div 1 n)))                      (math-div 1 n))))
 )  
615    
616    
617    
# Line 686  Line 631 
631           (math-from-hms a 'rad))           (math-from-hms a 'rad))
632          ((memq calc-angle-mode '(deg hms))          ((memq calc-angle-mode '(deg hms))
633           (math-mul a (math-pi-over-180)))           (math-mul a (math-pi-over-180)))
634          (t a))          (t a)))
 )  
635    
636  (defun math-from-radians (a)   ; [N N]  (defun math-from-radians (a)   ; [N N]
637    (cond ((eq calc-angle-mode 'deg)    (cond ((eq calc-angle-mode 'deg)
# Line 696  Line 640 
640             (list 'calcFunc-deg a)))             (list 'calcFunc-deg a)))
641          ((eq calc-angle-mode 'hms)          ((eq calc-angle-mode 'hms)
642           (math-to-hms a 'rad))           (math-to-hms a 'rad))
643          (t a))          (t a)))
 )  
644    
645  (defun math-to-radians-2 (a)   ; [N N]  (defun math-to-radians-2 (a)   ; [N N]
646    (cond ((eq (car-safe a) 'hms)    (cond ((eq (car-safe a) 'hms)
# Line 706  Line 649 
649           (if calc-symbolic-mode           (if calc-symbolic-mode
650               (math-div (math-mul a '(var pi var-pi)) 180)               (math-div (math-mul a '(var pi var-pi)) 180)
651             (math-mul a (math-pi-over-180))))             (math-mul a (math-pi-over-180))))
652          (t a))          (t a)))
 )  
653    
654  (defun math-from-radians-2 (a)   ; [N N]  (defun math-from-radians-2 (a)   ; [N N]
655    (cond ((memq calc-angle-mode '(deg hms))    (cond ((memq calc-angle-mode '(deg hms))
656           (if calc-symbolic-mode           (if calc-symbolic-mode
657               (math-div (math-mul 180 a) '(var pi var-pi))               (math-div (math-mul 180 a) '(var pi var-pi))
658             (math-div a (math-pi-over-180))))             (math-div a (math-pi-over-180))))
659          (t a))          (t a)))
 )  
660    
661    
662    
# Line 744  Line 685 
685          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
686           x)           x)
687          (t (calc-record-why 'scalarp x)          (t (calc-record-why 'scalarp x)
688             (list 'calcFunc-sin x)))             (list 'calcFunc-sin x))))
 )  
689    
690  (defun calcFunc-cos (x)   ; [N N] [Public]  (defun calcFunc-cos (x)   ; [N N] [Public]
691    (cond ((and (integerp x)    (cond ((and (integerp x)
# Line 788  Line 728 
728          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
729           x)           x)
730          (t (calc-record-why 'scalarp x)          (t (calc-record-why 'scalarp x)
731             (list 'calcFunc-cos x)))             (list 'calcFunc-cos x))))
 )  
732    
733  (defun calcFunc-sincos (x)   ; [V N] [Public]  (defun calcFunc-sincos (x)   ; [V N] [Public]
734    (if (Math-scalarp x)    (if (Math-scalarp x)
735        (math-with-extra-prec 2        (math-with-extra-prec 2
736          (let ((sc (math-sin-cos-raw (math-to-radians (math-float x)))))          (let ((sc (math-sin-cos-raw (math-to-radians (math-float x)))))
737            (list 'vec (cdr sc) (car sc))))    ; the vector [cos, sin]            (list 'vec (cdr sc) (car sc))))    ; the vector [cos, sin]
738      (list 'vec (calcFunc-sin x) (calcFunc-cos x)))      (list 'vec (calcFunc-sin x) (calcFunc-cos x))))
 )  
739    
740  (defun calcFunc-tan (x)   ; [N N] [Public]  (defun calcFunc-tan (x)   ; [N N] [Public]
741    (cond ((and (integerp x)    (cond ((and (integerp x)
# Line 840  Line 778 
778          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
779           x)           x)
780          (t (calc-record-why 'scalarp x)          (t (calc-record-why 'scalarp x)
781             (list 'calcFunc-tan x)))             (list 'calcFunc-tan x))))
 )  
782    
783  (defun math-sin-raw (x)   ; [N N]  (defun math-sin-raw (x)   ; [N N]
784    (cond ((eq (car x) 'cplx)    (cond ((eq (car x) 'cplx)
# Line 861  Line 798 
798           (math-neg-float (math-sin-raw (math-neg-float x))))           (math-neg-float (math-sin-raw (math-neg-float x))))
799          ((math-lessp-float '(float 7 0) x)  ; avoid inf loops due to roundoff          ((math-lessp-float '(float 7 0) x)  ; avoid inf loops due to roundoff
800           (math-sin-raw (math-mod x (math-two-pi))))           (math-sin-raw (math-mod x (math-two-pi))))
801          (t (math-sin-raw-2 x x)))          (t (math-sin-raw-2 x x))))
 )  
802    
803  (defun math-cos-raw (x)   ; [N N]  (defun math-cos-raw (x)   ; [N N]
804    (if (eq (car-safe x) 'polar)    (if (eq (car-safe x) 'polar)
805        (math-polar (math-cos-raw (math-complex x)))        (math-polar (math-cos-raw (math-complex x)))
806      (math-sin-raw (math-sub (math-pi-over-2) x)))      (math-sin-raw (math-sub (math-pi-over-2) x))))
 )  
807    
808  ;;; This could use a smarter method:  Reduce x as in math-sin-raw, then  ;;; This could use a smarter method:  Reduce x as in math-sin-raw, then
809  ;;;   compute either sin(x) or cos(x), whichever is smaller, and compute  ;;;   compute either sin(x) or cos(x), whichever is smaller, and compute
810  ;;;   the other using the identity sin(x)^2 + cos(x)^2 = 1.  ;;;   the other using the identity sin(x)^2 + cos(x)^2 = 1.
811  (defun math-sin-cos-raw (x)   ; [F.F F]  (result is (sin x . cos x))  (defun math-sin-cos-raw (x)   ; [F.F F]  (result is (sin x . cos x))
812    (cons (math-sin-raw x) (math-cos-raw x))    (cons (math-sin-raw x) (math-cos-raw x)))
 )  
813    
814  (defun math-tan-raw (x)   ; [N N]  (defun math-tan-raw (x)   ; [N N]
815    (cond ((eq (car x) 'cplx)    (cond ((eq (car x) 'cplx)
# Line 898  Line 832 
832           (let ((sc (math-sin-cos-raw x)))           (let ((sc (math-sin-cos-raw x)))
833             (if (eq (nth 1 (cdr sc)) 0)             (if (eq (nth 1 (cdr sc)) 0)
834                 (math-div (car sc) 0)                 (math-div (car sc) 0)
835               (math-div-float (car sc) (cdr sc))))))               (math-div-float (car sc) (cdr sc)))))))
 )  
836    
837  (defun math-sin-raw-2 (x orgx)   ; This avoids poss of inf recursion.  [F F]  (defun math-sin-raw-2 (x orgx)   ; This avoids poss of inf recursion.  [F F]
838    (let ((xmpo2 (math-sub-float (math-pi-over-2) x)))    (let ((xmpo2 (math-sub-float (math-pi-over-2) x)))
# Line 912  Line 845 
845             (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx)))             (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx)))
846            ((math-nearly-zerop-float x orgx) '(float 0 0))            ((math-nearly-zerop-float x orgx) '(float 0 0))
847            (calc-symbolic-mode (signal 'inexact-result nil))            (calc-symbolic-mode (signal 'inexact-result nil))
848            (t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x))))))            (t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x)))))))
 )  
849    
850  (defun math-cos-raw-2 (x orgx)   ; [F F]  (defun math-cos-raw-2 (x orgx)   ; [F F]
851    (cond ((math-nearly-zerop-float x orgx) '(float 1 0))    (cond ((math-nearly-zerop-float x orgx) '(float 1 0))
# Line 922  Line 854 
854               (math-sin-series               (math-sin-series
855                (math-add-float '(float 1 0)                (math-add-float '(float 1 0)
856                                (math-mul-float xnegsqr '(float 5 -1)))                                (math-mul-float xnegsqr '(float 5 -1)))
857                24 5 xnegsqr xnegsqr))))                24 5 xnegsqr xnegsqr)))))
 )  
858    
859  (defun math-sin-series (sum nfac n x xnegsqr)  (defun math-sin-series (sum nfac n x xnegsqr)
860    (math-working "sin" sum)    (math-working "sin" sum)
# Line 933  Line 864 
864      (if (math-nearly-equal-float sum nextsum)      (if (math-nearly-equal-float sum nextsum)
865          sum          sum
866        (math-sin-series nextsum (math-mul nfac (* n (1+ n)))        (math-sin-series nextsum (math-mul nfac (* n (1+ n)))
867                         (+ n 2) nextx xnegsqr)))                         (+ n 2) nextx xnegsqr))))
 )  
868    
869    
870  ;;; Inverse sine, cosine, tangent.  ;;; Inverse sine, cosine, tangent.
# Line 960  Line 890 
890          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
891           x)           x)
892          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
893             (list 'calcFunc-arcsin x)))             (list 'calcFunc-arcsin x))))
 )  
894    
895  (defun calcFunc-arccos (x)   ; [N N] [Public]  (defun calcFunc-arccos (x)   ; [N N] [Public]
896    (cond ((eq x 1) 0)    (cond ((eq x 1) 0)
# Line 984  Line 913 
913          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
914           x)           x)
915          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
916             (list 'calcFunc-arccos x)))             (list 'calcFunc-arccos x))))
 )  
917    
918  (defun calcFunc-arctan (x)   ; [N N] [Public]  (defun calcFunc-arctan (x)   ; [N N] [Public]
919    (cond ((eq x 0) 0)    (cond ((eq x 0) 0)
# Line 1010  Line 938 
938          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
939           x)           x)
940          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
941             (list 'calcFunc-arctan x)))             (list 'calcFunc-arctan x))))
 )  
942    
943  (defun math-arcsin-raw (x)   ; [N N]  (defun math-arcsin-raw (x)   ; [N N]
944    (let ((a (math-sqrt-raw (math-sub '(float 1 0) (math-sqr x)))))    (let ((a (math-sqrt-raw (math-sub '(float 1 0) (math-sqr x)))))
# Line 1020  Line 947 
947          (math-with-extra-prec 2   ; use extra precision for difficult case          (math-with-extra-prec 2   ; use extra precision for difficult case
948            (math-mul '(cplx 0 -1)            (math-mul '(cplx 0 -1)
949                      (math-ln-raw (math-add (math-mul '(cplx 0 1) x) a))))                      (math-ln-raw (math-add (math-mul '(cplx 0 1) x) a))))
950        (math-arctan2-raw x a)))        (math-arctan2-raw x a))))
 )  
951    
952  (defun math-arccos-raw (x)   ; [N N]  (defun math-arccos-raw (x)   ; [N N]
953    (math-sub (math-pi-over-2) (math-arcsin-raw x))    (math-sub (math-pi-over-2) (math-arcsin-raw x)))
 )  
954    
955  (defun math-arctan-raw (x)   ; [N N]  (defun math-arctan-raw (x)   ; [N N]
956    (cond ((memq (car x) '(cplx polar))    (cond ((memq (car x) '(cplx polar))
# Line 1049  Line 974 
974                                               (math-sub-float '(float 1 0) x)                                               (math-sub-float '(float 1 0) x)
975                                               (math-add-float '(float 1 0)                                               (math-add-float '(float 1 0)
976                                                               x))))))                                                               x))))))
977          (t (math-arctan-series x 3 x (math-neg-float (math-sqr-float x)))))          (t (math-arctan-series x 3 x (math-neg-float (math-sqr-float x))))))
 )  
978    
979  (defun math-arctan-series (sum n x xnegsqr)  (defun math-arctan-series (sum n x xnegsqr)
980    (math-working "arctan" sum)    (math-working "arctan" sum)
# Line 1058  Line 982 
982           (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))           (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
983      (if (math-nearly-equal-float sum nextsum)      (if (math-nearly-equal-float sum nextsum)
984          sum          sum
985        (math-arctan-series nextsum (+ n 2) nextx xnegsqr)))        (math-arctan-series nextsum (+ n 2) nextx xnegsqr))))
 )  
986    
987  (defun calcFunc-arctan2 (y x)   ; [F R R] [Public]  (defun calcFunc-arctan2 (y x)   ; [F R R] [Public]
988    (if (Math-anglep y)    (if (Math-anglep y)
# Line 1088  Line 1011 
1011                (calcFunc-arctan2 y x)                (calcFunc-arctan2 y x)
1012              '(var nan var-nan)))              '(var nan var-nan)))
1013        (calc-record-why 'anglep y)        (calc-record-why 'anglep y)
1014        (list 'calcFunc-arctan2 y x)))        (list 'calcFunc-arctan2 y x))))
 )  
1015    
1016  (defun math-arctan2-raw (y x)   ; [F R R]  (defun math-arctan2-raw (y x)   ; [F R R]
1017    (cond ((math-zerop y)    (cond ((math-zerop y)
# Line 1106  Line 1028 
1028                           (math-pi)))                           (math-pi)))
1029          (t          (t
1030           (math-sub-float (math-arctan-raw (math-div-float y x))           (math-sub-float (math-arctan-raw (math-div-float y x))
1031                           (math-pi))))                           (math-pi)))))
 )  
1032    
1033  (defun calcFunc-arcsincos (x)   ; [V N] [Public]  (defun calcFunc-arcsincos (x)   ; [V N] [Public]
1034    (if (and (Math-vectorp x)    (if (and (Math-vectorp x)
1035             (= (length x) 3))             (= (length x) 3))
1036        (calcFunc-arctan2 (nth 2 x) (nth 1 x))        (calcFunc-arctan2 (nth 2 x) (nth 1 x))
1037      (math-reject-arg x "*Two-element vector expected"))      (math-reject-arg x "*Two-element vector expected")))
 )  
1038    
1039    
1040    
# Line 1139  Line 1059 
1059          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
1060           x)           x)
1061          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1062             (list 'calcFunc-exp x)))             (list 'calcFunc-exp x))))
 )  
1063    
1064  (defun calcFunc-expm1 (x)   ; [N N] [Public]  (defun calcFunc-expm1 (x)   ; [N N] [Public]
1065    (cond ((eq x 0) 0)    (cond ((eq x 0) 0)
# Line 1171  Line 1090 
1090          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
1091           x)           x)
1092          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1093             (list 'calcFunc-expm1 x)))             (list 'calcFunc-expm1 x))))
 )  
1094    
1095  (defun calcFunc-exp10 (x)   ; [N N] [Public]  (defun calcFunc-exp10 (x)   ; [N N] [Public]
1096    (if (eq x 0)    (if (eq x 0)
1097        1        1
1098      (math-pow '(float 1 1) x))      (math-pow '(float 1 1) x)))
 )  
1099    
1100  (defun math-exp-raw (x)   ; [N N]  (defun math-exp-raw (x)   ; [N N]
1101    (cond ((math-zerop x) '(float 1 0))    (cond ((math-zerop x) '(float 1 0))
# Line 1207  Line 1124 
1124             (math-mul-float (math-ipow (math-sqrt-e) hint)             (math-mul-float (math-ipow (math-sqrt-e) hint)
1125                             (math-add-float '(float 1 0)                             (math-add-float '(float 1 0)
1126                                             (math-exp-minus-1-raw hfrac)))))                                             (math-exp-minus-1-raw hfrac)))))
1127          (t (math-add-float '(float 1 0) (math-exp-minus-1-raw x))))          (t (math-add-float '(float 1 0) (math-exp-minus-1-raw x)))))
 )  
1128    
1129  (defun math-exp-minus-1-raw (x)   ; [F F]  (defun math-exp-minus-1-raw (x)   ; [F F]
1130    (math-exp-series x 2 3 x x)    (math-exp-series x 2 3 x x))
 )  
1131    
1132  (defun math-exp-series (sum nfac n xpow x)  (defun math-exp-series (sum nfac n xpow x)
1133    (math-working "exp" sum)    (math-working "exp" sum)
# Line 1221  Line 1136 
1136                                                        (math-float nfac)))))                                                        (math-float nfac)))))
1137      (if (math-nearly-equal-float sum nextsum)      (if (math-nearly-equal-float sum nextsum)
1138          sum          sum
1139        (math-exp-series nextsum (math-mul nfac n) (1+ n) nextx x)))        (math-exp-series nextsum (math-mul nfac n) (1+ n) nextx x))))
 )  
1140    
1141    
1142    
# Line 1256  Line 1170 
1170               x               x
1171             '(var inf var-inf)))             '(var inf var-inf)))
1172          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1173             (list 'calcFunc-ln x)))             (list 'calcFunc-ln x))))
 )  
1174    
1175  (defun calcFunc-log10 (x)   ; [N N] [Public]  (defun calcFunc-log10 (x)   ; [N N] [Public]
1176    (cond ((math-equal-int x 1)    (cond ((math-equal-int x 1)
# Line 1308  Line 1221 
1221               x               x
1222             '(var inf var-inf)))             '(var inf var-inf)))
1223          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1224             (list 'calcFunc-log10 x)))             (list 'calcFunc-log10 x))))
 )  
1225    
1226  (defun calcFunc-log (x &optional b)   ; [N N N] [Public]  (defun calcFunc-log (x &optional b)   ; [N N N] [Public]
1227    (cond ((or (null b) (equal b '(var e var-e)))    (cond ((or (null b) (equal b '(var e var-e)))
# Line 1374  Line 1286 
1286          (t (if (Math-numberp b)          (t (if (Math-numberp b)
1287                 (calc-record-why 'numberp x)                 (calc-record-why 'numberp x)
1288               (calc-record-why 'numberp b))               (calc-record-why 'numberp b))
1289             (list 'calcFunc-log x b)))             (list 'calcFunc-log x b))))
 )  
1290    
1291  (defun calcFunc-alog (x &optional b)  (defun calcFunc-alog (x &optional b)
1292    (cond ((or (null b) (equal b '(var e var-e)))    (cond ((or (null b) (equal b '(var e var-e)))
1293           (math-normalize (list 'calcFunc-exp x)))           (math-normalize (list 'calcFunc-exp x)))
1294          (t (math-pow b x)))          (t (math-pow b x))))
 )  
1295    
1296  (defun calcFunc-ilog (x b)  (defun calcFunc-ilog (x b)
1297    (if (and (math-natnump x) (not (eq x 0))    (if (and (math-natnump x) (not (eq x 0))
# Line 1391  Line 1301 
1301          (if (Math-natnum-lessp x b)          (if (Math-natnum-lessp x b)
1302              0              0
1303            (cdr (math-integer-log x b))))            (cdr (math-integer-log x b))))
1304      (math-floor (calcFunc-log x b)))      (math-floor (calcFunc-log x b))))
 )  
1305    
1306  (defun math-integer-log (x b)  (defun math-integer-log (x b)
1307    (let ((pows (list b))    (let ((pows (list b))
# Line 1412  Line 1321 
1321        (or (Math-lessp x next)        (or (Math-lessp x next)
1322            (setq pow next            (setq pow next
1323                  sum (+ sum n))))                  sum (+ sum n))))
1324      (cons (equal pow x) sum))      (cons (equal pow x) sum)))
 )  
1325    
1326    
1327  (defun math-log-base-raw (b)   ; [N N]  (defun math-log-base-raw (b)   ; [N N]
# Line 1421  Line 1329 
1329                  (eq (nth 1 math-log-base-cache) calc-internal-prec)))                  (eq (nth 1 math-log-base-cache) calc-internal-prec)))
1330        (setq math-log-base-cache (list b calc-internal-prec        (setq math-log-base-cache (list b calc-internal-prec
1331                                        (math-ln-raw (math-float b)))))                                        (math-ln-raw (math-float b)))))
1332    (nth 2 math-log-base-cache)    (nth 2 math-log-base-cache))
 )  
1333  (setq math-log-base-cache nil)  (setq math-log-base-cache nil)
1334    
1335  (defun calcFunc-lnp1 (x)   ; [N N] [Public]  (defun calcFunc-lnp1 (x)   ; [N N] [Public]
# Line 1454  Line 1361 
1361               x               x
1362             '(var inf var-inf)))             '(var inf var-inf)))
1363          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1364             (list 'calcFunc-lnp1 x)))             (list 'calcFunc-lnp1 x))))
 )  
1365    
1366  (defun math-ln-raw (x)    ; [N N] --- must be float format!  (defun math-ln-raw (x)    ; [N N] --- must be float format!
1367    (cond ((eq (car-safe x) 'cplx)    (cond ((eq (car-safe x) 'cplx)
# Line 1486  Line 1392 
1392                  (math-pi))))                  (math-pi))))
1393          (t (list 'cplx   ; negative and real          (t (list 'cplx   ; negative and real
1394                   (math-ln-raw (math-neg-float x))                   (math-ln-raw (math-neg-float x))
1395                   (math-pi))))                   (math-pi)))))
 )  
1396    
1397  (defun math-ln-raw-2 (x)    ; [F F]  (defun math-ln-raw-2 (x)    ; [F F]
1398    (cond ((math-lessp-float '(float 14 -1) x)    (cond ((math-lessp-float '(float 14 -1) x)
# Line 1495  Line 1400 
1400                           (math-ln-2)))                           (math-ln-2)))
1401          (t    ; now .7 < x <= 1.4          (t    ; now .7 < x <= 1.4
1402           (math-ln-raw-3 (math-div-float (math-sub-float x '(float 1 0))           (math-ln-raw-3 (math-div-float (math-sub-float x '(float 1 0))
1403                                          (math-add-float x '(float 1 0))))))                                          (math-add-float x '(float 1 0)))))))
 )  
1404    
1405  (defun math-ln-raw-3 (x)   ; [F F]  (defun math-ln-raw-3 (x)   ; [F F]
1406    (math-mul-float (math-ln-raw-series x 3 x (math-sqr-float x))    (math-mul-float (math-ln-raw-series x 3 x (math-sqr-float x))
1407                    '(float 2 0))                    '(float 2 0)))
 )  
1408    
1409  ;;; Compute ln((1+x)/(1-x))  ;;; Compute ln((1+x)/(1-x))
1410  (defun math-ln-raw-series (sum n x xsqr)  (defun math-ln-raw-series (sum n x xsqr)
# Line 1510  Line 1413 
1413           (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))           (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
1414      (if (math-nearly-equal-float sum nextsum)      (if (math-nearly-equal-float sum nextsum)
1415          sum          sum
1416        (math-ln-raw-series nextsum (+ n 2) nextx xsqr)))        (math-ln-raw-series nextsum (+ n 2) nextx xsqr))))
 )  
1417    
1418  (defun math-ln-plus-1-raw (x)  (defun math-ln-plus-1-raw (x)
1419    (math-lnp1-series x 2 x (math-neg x))    (math-lnp1-series x 2 x (math-neg x)))
 )  
1420    
1421  (defun math-lnp1-series (sum n xpow x)  (defun math-lnp1-series (sum n xpow x)
1422    (math-working "lnp1" sum)    (math-working "lnp1" sum)
# Line 1523  Line 1424 
1424           (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))           (nextsum (math-add-float sum (math-div-float nextx (math-float n)))))
1425      (if (math-nearly-equal-float sum nextsum)      (if (math-nearly-equal-float sum nextsum)
1426          sum          sum
1427        (math-lnp1-series nextsum (1+ n) nextx x)))        (math-lnp1-series nextsum (1+ n) nextx x))))
 )  
1428    
1429  (math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21)  (math-defcache math-ln-10 (float (bigpos 018 684 045 994 092 585 302 2) -21)
1430    (math-ln-raw-2 '(float 1 1)))    (math-ln-raw-2 '(float 1 1)))
# Line 1559  Line 1459 
1459               (equal x '(var nan var-nan)))               (equal x '(var nan var-nan)))
1460           x)           x)
1461          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1462             (list 'calcFunc-sinh x)))             (list 'calcFunc-sinh x))))
 )  
1463  (put 'calcFunc-sinh 'math-expandable t)  (put 'calcFunc-sinh 'math-expandable t)
1464    
1465  (defun calcFunc-cosh (x)   ; [N N] [Public]  (defun calcFunc-cosh (x)   ; [N N] [Public]
# Line 1588  Line 1487 
1487               (equal x '(var nan var-nan)))               (equal x '(var nan var-nan)))
1488           (math-abs x))           (math-abs x))
1489          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1490             (list 'calcFunc-cosh x)))             (list 'calcFunc-cosh x))))
 )  
1491  (put 'calcFunc-cosh 'math-expandable t)  (put 'calcFunc-cosh 'math-expandable t)
1492    
1493  (defun calcFunc-tanh (x)   ; [N N] [Public]  (defun calcFunc-tanh (x)   ; [N N] [Public]
# Line 1622  Line 1520 
1520          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
1521           x)           x)
1522          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1523             (list 'calcFunc-tanh x)))             (list 'calcFunc-tanh x))))
 )  
1524  (put 'calcFunc-tanh 'math-expandable t)  (put 'calcFunc-tanh 'math-expandable t)
1525    
1526  (defun calcFunc-arcsinh (x)   ; [N N] [Public]  (defun calcFunc-arcsinh (x)   ; [N N] [Public]
# Line 1651  Line 1548 
1548               (equal x '(var nan var-nan)))               (equal x '(var nan var-nan)))
1549           x)           x)
1550          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1551             (list 'calcFunc-arcsinh x)))             (list 'calcFunc-arcsinh x))))
 )  
1552  (put 'calcFunc-arcsinh 'math-expandable t)  (put 'calcFunc-arcsinh 'math-expandable t)
1553    
1554  (defun calcFunc-arccosh (x)   ; [N N] [Public]  (defun calcFunc-arccosh (x)   ; [N N] [Public]
# Line 1697  Line 1593 
1593               (equal x '(var nan var-nan)))               (equal x '(var nan var-nan)))
1594           x)           x)
1595          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1596             (list 'calcFunc-arccosh x)))             (list 'calcFunc-arccosh x))))
 )  
1597  (put 'calcFunc-arccosh 'math-expandable t)  (put 'calcFunc-arccosh 'math-expandable t)
1598    
1599  (defun calcFunc-arctanh (x)   ; [N N] [Public]  (defun calcFunc-arctanh (x)   ; [N N] [Public]
# Line 1737  Line 1632 
1632          ((equal x '(var nan var-nan))          ((equal x '(var nan var-nan))
1633           x)           x)
1634          (t (calc-record-why 'numberp x)          (t (calc-record-why 'numberp x)
1635             (list 'calcFunc-arctanh x)))             (list 'calcFunc-arctanh x))))
 )  
1636  (put 'calcFunc-arctanh 'math-expandable t)  (put 'calcFunc-arctanh 'math-expandable t)
1637    
1638    
# Line 1756  Line 1650 
1650          (math-expand-formulas          (math-expand-formulas
1651           (math-div (math-mul a '(var pi var-pi)) 180))           (math-div (math-mul a '(var pi var-pi)) 180))
1652          ((math-infinitep a) a)          ((math-infinitep a) a)
1653          (t (list 'calcFunc-rad a)))          (t (list 'calcFunc-rad a))))
 )  
1654  (put 'calcFunc-rad 'math-expandable t)  (put 'calcFunc-rad 'math-expandable t)
1655    
1656  ;;; Convert A from HMS or radians to degrees.  ;;; Convert A from HMS or radians to degrees.
# Line 1774  Line 1667 
1667          (math-expand-formulas          (math-expand-formulas
1668           (math-div (math-mul 180 a) '(var pi var-pi)))           (math-div (math-mul 180 a) '(var pi var-pi)))
1669          ((math-infinitep a) a)          ((math-infinitep a) a)
1670          (t (list 'calcFunc-deg a)))          (t (list 'calcFunc-deg a))))
 )  
1671  (put 'calcFunc-deg 'math-expandable t)  (put 'calcFunc-deg 'math-expandable t)
1672    
1673    ;;; calc-math.el ends here
1674    
1675    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26