Mercurial > emacs
annotate lisp/calc/calc-math.el @ 107439:ed20cbe62401
Remove support for Solaris on PPC and for old versions.
* s/sol2-6.h: Add the contents of s/sol-2.3.h, s/sol-2.4.h, s/sol-2.5.h.
(LD_SWITCH_SYSTEM, USE_MMAP_FOR_BUFFERS): Remove #defines/#undef
that cancel each other.
* s/sol2-3.h:
* s/sol2-4.h:
* s/sol2-5.h: Remove.
* m/ibmrs6000.h: Remove code for USG5_4, this file is only used on AIX.
(NO_REMAP): Remove, unused.
(UNEXEC): Move definition ...
* s/aix4-2.h (UNEXEC): ... here.
* configure.in: Remove support for Solaris on PPC and for old versions.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Fri, 19 Mar 2010 22:52:55 -0700 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
rev | line source |
---|---|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
1 ;;; calc-math.el --- mathematical functions for Calc |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
2 |
64325
1db49616ce05
Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
62165
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
106815 | 4 ;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
5 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
6 ;; Author: David Gillespie <daveg@synaptics.com> |
77465
1154f082efd9
Update maintainer's address.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
76595
diff
changeset
|
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
40785 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
40785 | 15 |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
19 ;; GNU General Public License for more details. |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
20 |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
40785 | 23 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
24 ;;; Commentary: |
40785 | 25 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
26 ;;; Code: |
40785 | 27 |
28 ;; This file is autoloaded from calc-ext.el. | |
58663
7ed196c06460
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58475
diff
changeset
|
29 |
40785 | 30 (require 'calc-ext) |
31 (require 'calc-macs) | |
32 | |
82015
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
33 |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
34 ;;; Find out how many 9s in 9.9999... will give distinct Emacs floats, |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
35 ;;; then back off by one. |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
36 |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
37 (defvar math-emacs-precision |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
38 (let* ((n 1) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
39 (x 9) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
40 (xx (+ x (* 9 (expt 10 (- n)))))) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
41 (while (/= x xx) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
42 (progn |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
43 (setq n (1+ n)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
44 (setq x xx) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
45 (setq xx (+ x (* 9 (expt 10 (- n))))))) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
46 (1- n)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
47 "The number of digits in an Emacs float.") |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
48 |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
49 ;;; Find the largest power of 10 which is an Emacs float, |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
50 ;;; then back off by one so that any float d.dddd...eN |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
51 ;;; is an Emacs float, for acceptable d.dddd.... |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
52 |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
53 (defvar math-largest-emacs-expt |
84994
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
54 (let ((x 1) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
55 (pow 1e2)) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
56 ;; The following loop is for efficiency; it should stop when |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
57 ;; 10^(2x) is too large. This could be indicated by a range |
85003
155b89cb60fb
(math-largest-emacs-expt): Remove unnecessary condition check.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84994
diff
changeset
|
58 ;; error when computing 10^(2x) or an infinite value for 10^(2x). |
84994
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
59 (while (and |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
60 pow |
85003
155b89cb60fb
(math-largest-emacs-expt): Remove unnecessary condition check.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84994
diff
changeset
|
61 (< pow 1.0e+INF)) |
84994
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
62 (setq x (* 2 x)) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
63 (setq pow (condition-case nil |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
64 (expt 10.0 (* 2 x)) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
65 (error nil)))) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
66 ;; The following loop should stop when 10^(x+1) is too large. |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
67 (setq pow (condition-case nil |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
68 (expt 10.0 (1+ x)) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
69 (error nil))) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
70 (while (and |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
71 pow |
85003
155b89cb60fb
(math-largest-emacs-expt): Remove unnecessary condition check.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84994
diff
changeset
|
72 (< pow 1.0e+INF)) |
84994
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
73 (setq x (1+ x)) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
74 (setq pow (condition-case nil |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
75 (expt 10.0 (1+ x)) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
76 (error nil)))) |
39018b7044de
calc-math.el (math-largest-emacs-expt): Handle the cases when expt
Jay Belanger <jay.p.belanger@gmail.com>
parents:
84993
diff
changeset
|
77 (1- x)) |
82015
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
78 "The largest exponent which Calc will convert to an Emacs float.") |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
79 |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
80 (defvar math-smallest-emacs-expt |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
81 (let ((x -1)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
82 (while (condition-case nil |
84993
3788dd19e020
(math-smallest-emacs-expt): Make the computation more robust.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82443
diff
changeset
|
83 (> (expt 10.0 x) 0.0) |
82015
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
84 (error nil)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
85 (setq x (* 2 x))) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
86 (setq x (/ x 2)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
87 (while (condition-case nil |
84993
3788dd19e020
(math-smallest-emacs-expt): Make the computation more robust.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82443
diff
changeset
|
88 (> (expt 10.0 x) 0.0) |
82015
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
89 (error nil)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
90 (setq x (1- x))) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
91 (+ x 2)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
92 "The smallest exponent which Calc will convert to an Emacs float.") |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
93 |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
94 (defun math-use-emacs-fn (fn x) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
95 "Use the native Emacs function FN to evaluate the Calc number X. |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
96 If this can't be done, return NIL." |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
97 (and |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
98 (<= calc-internal-prec math-emacs-precision) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
99 (math-realp x) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
100 (let* ((fx (math-float x)) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
101 (xpon (+ (nth 2 x) (1- (math-numdigs (nth 1 x)))))) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
102 (and (<= math-smallest-emacs-expt xpon) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
103 (<= xpon math-largest-emacs-expt) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
104 (condition-case nil |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
105 (math-read-number |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
106 (number-to-string |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
107 (funcall fn |
102173
37b577ed82cd
(math-use-emacs-fn): Make sure that the lisp number is in decimal.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
100908
diff
changeset
|
108 (string-to-number |
103702
89a7d79690f9
(math-use-emacs-fn): Make sure that the number is formatted correctly.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
102173
diff
changeset
|
109 (let |
89a7d79690f9
(math-use-emacs-fn): Make sure that the number is formatted correctly.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
102173
diff
changeset
|
110 ((calc-number-radix 10) |
106143
50585d0e8c11
(math-use-emacs-fn): Let `calc-twos-complement-mode' be nil.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
103702
diff
changeset
|
111 (calc-twos-complement-mode nil) |
103702
89a7d79690f9
(math-use-emacs-fn): Make sure that the number is formatted correctly.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
102173
diff
changeset
|
112 (calc-float-format (list 'float calc-internal-prec)) |
89a7d79690f9
(math-use-emacs-fn): Make sure that the number is formatted correctly.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
102173
diff
changeset
|
113 (calc-group-digits nil) |
89a7d79690f9
(math-use-emacs-fn): Make sure that the number is formatted correctly.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
102173
diff
changeset
|
114 (calc-point-char ".")) |
102173
37b577ed82cd
(math-use-emacs-fn): Make sure that the lisp number is in decimal.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
100908
diff
changeset
|
115 (math-format-number (math-float x))))))) |
82015
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
116 (error nil)))))) |
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
117 |
40785 | 118 (defun calc-sqrt (arg) |
119 (interactive "P") | |
120 (calc-slow-wrapper | |
121 (if (calc-is-inverse) | |
122 (calc-unary-op "^2" 'calcFunc-sqr arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
123 (calc-unary-op "sqrt" 'calcFunc-sqrt arg)))) |
40785 | 124 |
125 (defun calc-isqrt (arg) | |
126 (interactive "P") | |
127 (calc-slow-wrapper | |
128 (if (calc-is-inverse) | |
129 (calc-unary-op "^2" 'calcFunc-sqr arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
130 (calc-unary-op "isqt" 'calcFunc-isqrt arg)))) |
40785 | 131 |
132 | |
133 (defun calc-hypot (arg) | |
134 (interactive "P") | |
135 (calc-slow-wrapper | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
136 (calc-binary-op "hypt" 'calcFunc-hypot arg))) |
40785 | 137 |
138 (defun calc-ln (arg) | |
139 (interactive "P") | |
140 (calc-invert-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
141 (calc-exp arg)) |
40785 | 142 |
143 (defun calc-log10 (arg) | |
144 (interactive "P") | |
145 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
146 (calc-ln arg)) |
40785 | 147 |
148 (defun calc-log (arg) | |
149 (interactive "P") | |
150 (calc-slow-wrapper | |
151 (if (calc-is-inverse) | |
152 (calc-binary-op "alog" 'calcFunc-alog arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
153 (calc-binary-op "log" 'calcFunc-log arg)))) |
40785 | 154 |
155 (defun calc-ilog (arg) | |
156 (interactive "P") | |
157 (calc-slow-wrapper | |
158 (if (calc-is-inverse) | |
159 (calc-binary-op "alog" 'calcFunc-alog arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
160 (calc-binary-op "ilog" 'calcFunc-ilog arg)))) |
40785 | 161 |
162 (defun calc-lnp1 (arg) | |
163 (interactive "P") | |
164 (calc-invert-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
165 (calc-expm1 arg)) |
40785 | 166 |
167 (defun calc-exp (arg) | |
168 (interactive "P") | |
169 (calc-slow-wrapper | |
170 (if (calc-is-hyperbolic) | |
171 (if (calc-is-inverse) | |
172 (calc-unary-op "lg10" 'calcFunc-log10 arg) | |
173 (calc-unary-op "10^" 'calcFunc-exp10 arg)) | |
174 (if (calc-is-inverse) | |
175 (calc-unary-op "ln" 'calcFunc-ln arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
176 (calc-unary-op "exp" 'calcFunc-exp arg))))) |
40785 | 177 |
178 (defun calc-expm1 (arg) | |
179 (interactive "P") | |
180 (calc-slow-wrapper | |
181 (if (calc-is-inverse) | |
182 (calc-unary-op "ln+1" 'calcFunc-lnp1 arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
183 (calc-unary-op "ex-1" 'calcFunc-expm1 arg)))) |
40785 | 184 |
185 (defun calc-pi () | |
186 (interactive) | |
187 (calc-slow-wrapper | |
188 (if (calc-is-inverse) | |
189 (if (calc-is-hyperbolic) | |
190 (if calc-symbolic-mode | |
191 (calc-pop-push-record 0 "phi" '(var phi var-phi)) | |
192 (calc-pop-push-record 0 "phi" (math-phi))) | |
193 (if calc-symbolic-mode | |
194 (calc-pop-push-record 0 "gmma" '(var gamma var-gamma)) | |
195 (calc-pop-push-record 0 "gmma" (math-gamma-const)))) | |
196 (if (calc-is-hyperbolic) | |
197 (if calc-symbolic-mode | |
198 (calc-pop-push-record 0 "e" '(var e var-e)) | |
199 (calc-pop-push-record 0 "e" (math-e))) | |
200 (if calc-symbolic-mode | |
201 (calc-pop-push-record 0 "pi" '(var pi var-pi)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
202 (calc-pop-push-record 0 "pi" (math-pi))))))) |
40785 | 203 |
204 (defun calc-sin (arg) | |
205 (interactive "P") | |
206 (calc-slow-wrapper | |
207 (if (calc-is-hyperbolic) | |
208 (if (calc-is-inverse) | |
209 (calc-unary-op "asnh" 'calcFunc-arcsinh arg) | |
210 (calc-unary-op "sinh" 'calcFunc-sinh arg)) | |
211 (if (calc-is-inverse) | |
212 (calc-unary-op "asin" 'calcFunc-arcsin arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
213 (calc-unary-op "sin" 'calcFunc-sin arg))))) |
40785 | 214 |
215 (defun calc-arcsin (arg) | |
216 (interactive "P") | |
217 (calc-invert-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
218 (calc-sin arg)) |
40785 | 219 |
220 (defun calc-sinh (arg) | |
221 (interactive "P") | |
222 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
223 (calc-sin arg)) |
40785 | 224 |
225 (defun calc-arcsinh (arg) | |
226 (interactive "P") | |
227 (calc-invert-func) | |
228 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
229 (calc-sin arg)) |
40785 | 230 |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
231 (defun calc-sec (arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
232 (interactive "P") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
233 (calc-slow-wrapper |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
234 (if (calc-is-hyperbolic) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
235 (calc-unary-op "sech" 'calcFunc-sech arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
236 (calc-unary-op "sec" 'calcFunc-sec arg)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
237 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
238 (defun calc-sech (arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
239 (interactive "P") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
240 (calc-hyperbolic-func) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
241 (calc-sec arg)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
242 |
40785 | 243 (defun calc-cos (arg) |
244 (interactive "P") | |
245 (calc-slow-wrapper | |
246 (if (calc-is-hyperbolic) | |
247 (if (calc-is-inverse) | |
248 (calc-unary-op "acsh" 'calcFunc-arccosh arg) | |
249 (calc-unary-op "cosh" 'calcFunc-cosh arg)) | |
250 (if (calc-is-inverse) | |
251 (calc-unary-op "acos" 'calcFunc-arccos arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
252 (calc-unary-op "cos" 'calcFunc-cos arg))))) |
40785 | 253 |
254 (defun calc-arccos (arg) | |
255 (interactive "P") | |
256 (calc-invert-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
257 (calc-cos arg)) |
40785 | 258 |
259 (defun calc-cosh (arg) | |
260 (interactive "P") | |
261 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
262 (calc-cos arg)) |
40785 | 263 |
264 (defun calc-arccosh (arg) | |
265 (interactive "P") | |
266 (calc-invert-func) | |
267 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
268 (calc-cos arg)) |
40785 | 269 |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
270 (defun calc-csc (arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
271 (interactive "P") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
272 (calc-slow-wrapper |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
273 (if (calc-is-hyperbolic) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
274 (calc-unary-op "csch" 'calcFunc-csch arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
275 (calc-unary-op "csc" 'calcFunc-csc arg)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
276 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
277 (defun calc-csch (arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
278 (interactive "P") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
279 (calc-hyperbolic-func) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
280 (calc-csc arg)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
281 |
40785 | 282 (defun calc-sincos () |
283 (interactive) | |
284 (calc-slow-wrapper | |
285 (if (calc-is-inverse) | |
286 (calc-enter-result 1 "asnc" (list 'calcFunc-arcsincos (calc-top-n 1))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
287 (calc-enter-result 1 "sncs" (list 'calcFunc-sincos (calc-top-n 1)))))) |
40785 | 288 |
289 (defun calc-tan (arg) | |
290 (interactive "P") | |
291 (calc-slow-wrapper | |
292 (if (calc-is-hyperbolic) | |
293 (if (calc-is-inverse) | |
294 (calc-unary-op "atnh" 'calcFunc-arctanh arg) | |
295 (calc-unary-op "tanh" 'calcFunc-tanh arg)) | |
296 (if (calc-is-inverse) | |
297 (calc-unary-op "atan" 'calcFunc-arctan arg) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
298 (calc-unary-op "tan" 'calcFunc-tan arg))))) |
40785 | 299 |
300 (defun calc-arctan (arg) | |
301 (interactive "P") | |
302 (calc-invert-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
303 (calc-tan arg)) |
40785 | 304 |
305 (defun calc-tanh (arg) | |
306 (interactive "P") | |
307 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
308 (calc-tan arg)) |
40785 | 309 |
310 (defun calc-arctanh (arg) | |
311 (interactive "P") | |
312 (calc-invert-func) | |
313 (calc-hyperbolic-func) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
314 (calc-tan arg)) |
40785 | 315 |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
316 (defun calc-cot (arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
317 (interactive "P") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
318 (calc-slow-wrapper |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
319 (if (calc-is-hyperbolic) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
320 (calc-unary-op "coth" 'calcFunc-coth arg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
321 (calc-unary-op "cot" 'calcFunc-cot arg)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
322 |
60164
697e2ba683cc
(calc-arctan, calc-tanh, calc-arctanh): Removed extra definitions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
60085
diff
changeset
|
323 (defun calc-coth (arg) |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
324 (interactive "P") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
325 (calc-hyperbolic-func) |
60164
697e2ba683cc
(calc-arctan, calc-tanh, calc-arctanh): Removed extra definitions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
60085
diff
changeset
|
326 (calc-cot arg)) |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
327 |
40785 | 328 (defun calc-arctan2 () |
329 (interactive) | |
330 (calc-slow-wrapper | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
331 (calc-enter-result 2 "atn2" (cons 'calcFunc-arctan2 (calc-top-list-n 2))))) |
40785 | 332 |
333 (defun calc-conj (arg) | |
334 (interactive "P") | |
335 (calc-wrapper | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
336 (calc-unary-op "conj" 'calcFunc-conj arg))) |
40785 | 337 |
338 (defun calc-imaginary () | |
339 (interactive) | |
340 (calc-slow-wrapper | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
341 (calc-pop-push-record 1 "i*" (math-imaginary (calc-top-n 1))))) |
40785 | 342 |
343 (defun calc-to-degrees (arg) | |
344 (interactive "P") | |
345 (calc-wrapper | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
346 (calc-unary-op ">deg" 'calcFunc-deg arg))) |
40785 | 347 |
348 (defun calc-to-radians (arg) | |
349 (interactive "P") | |
350 (calc-wrapper | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
351 (calc-unary-op ">rad" 'calcFunc-rad arg))) |
40785 | 352 |
353 | |
354 (defun calc-degrees-mode (arg) | |
355 (interactive "p") | |
356 (cond ((= arg 1) | |
357 (calc-wrapper | |
358 (calc-change-mode 'calc-angle-mode 'deg) | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
359 (message "Angles measured in degrees"))) |
40785 | 360 ((= arg 2) (calc-radians-mode)) |
361 ((= arg 3) (calc-hms-mode)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
362 (t (error "Prefix argument out of range")))) |
40785 | 363 |
364 (defun calc-radians-mode () | |
365 (interactive) | |
366 (calc-wrapper | |
367 (calc-change-mode 'calc-angle-mode 'rad) | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
368 (message "Angles measured in radians"))) |
40785 | 369 |
370 | |
371 ;;; Compute the integer square-root floor(sqrt(A)). A > 0. [I I] [Public] | |
372 ;;; This method takes advantage of the fact that Newton's method starting | |
373 ;;; with an overestimate always works, even using truncating integer division! | |
374 (defun math-isqrt (a) | |
375 (cond ((Math-zerop a) a) | |
376 ((not (math-natnump a)) | |
377 (math-reject-arg a 'natnump)) | |
378 ((integerp a) | |
379 (math-isqrt-small a)) | |
380 (t | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
381 (math-normalize (cons 'bigpos (cdr (math-isqrt-bignum (cdr a)))))))) |
40785 | 382 |
383 (defun calcFunc-isqrt (a) | |
384 (if (math-realp a) | |
385 (math-isqrt (math-floor a)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
386 (math-floor (math-sqrt a)))) |
40785 | 387 |
388 | |
42206 | 389 ;;; This returns (flag . result) where the flag is t if A is a perfect square. |
40785 | 390 (defun math-isqrt-bignum (a) ; [P.l L] |
391 (let ((len (length a))) | |
392 (if (= (% len 2) 0) | |
393 (let* ((top (nthcdr (- len 2) a))) | |
394 (math-isqrt-bignum-iter | |
395 a | |
81597
4894ac2fb62c
(math-scale-bignum-digit-size): Renamed from math-scale-bignum-3.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81549
diff
changeset
|
396 (math-scale-bignum-digit-size |
40785 | 397 (math-bignum-big |
398 (1+ (math-isqrt-small | |
81597
4894ac2fb62c
(math-scale-bignum-digit-size): Renamed from math-scale-bignum-3.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81549
diff
changeset
|
399 (+ (* (nth 1 top) math-bignum-digit-size) (car top))))) |
40785 | 400 (1- (/ len 2))))) |
401 (let* ((top (nth (1- len) a))) | |
402 (math-isqrt-bignum-iter | |
403 a | |
81597
4894ac2fb62c
(math-scale-bignum-digit-size): Renamed from math-scale-bignum-3.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81549
diff
changeset
|
404 (math-scale-bignum-digit-size |
40785 | 405 (list (1+ (math-isqrt-small top))) |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
406 (/ len 2))))))) |
40785 | 407 |
408 (defun math-isqrt-bignum-iter (a guess) ; [l L l] | |
409 (math-working "isqrt" (cons 'bigpos guess)) | |
410 (let* ((q (math-div-bignum a guess)) | |
411 (s (math-add-bignum (car q) guess)) | |
412 (g2 (math-div2-bignum s)) | |
413 (comp (math-compare-bignum g2 guess))) | |
414 (if (< comp 0) | |
415 (math-isqrt-bignum-iter a g2) | |
416 (cons (and (= comp 0) | |
417 (math-zerop-bignum (cdr q)) | |
418 (= (% (car s) 2) 0)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
419 guess)))) |
40785 | 420 |
421 (defun math-zerop-bignum (a) | |
422 (and (eq (car a) 0) | |
423 (progn | |
424 (while (eq (car (setq a (cdr a))) 0)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
425 (null a)))) |
40785 | 426 |
81597
4894ac2fb62c
(math-scale-bignum-digit-size): Renamed from math-scale-bignum-3.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81549
diff
changeset
|
427 (defun math-scale-bignum-digit-size (a n) ; [L L S] |
40785 | 428 (while (> n 0) |
429 (setq a (cons 0 a) | |
430 n (1- n))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
431 a) |
40785 | 432 |
433 (defun math-isqrt-small (a) ; A > 0. [S S] | |
81597
4894ac2fb62c
(math-scale-bignum-digit-size): Renamed from math-scale-bignum-3.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81549
diff
changeset
|
434 (let ((g (cond ((>= a 1000000) 10000) |
4894ac2fb62c
(math-scale-bignum-digit-size): Renamed from math-scale-bignum-3.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81549
diff
changeset
|
435 ((>= a 10000) 1000) |
40785 | 436 ((>= a 100) 100) |
437 (t 10))) | |
438 g2) | |
439 (while (< (setq g2 (/ (+ g (/ a g)) 2)) g) | |
440 (setq g g2)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
441 g)) |
40785 | 442 |
443 | |
444 | |
445 | |
446 ;;; Compute the square root of a number. | |
447 ;;; [T N] if possible, else [F N] if possible, else [C N]. [Public] | |
448 (defun math-sqrt (a) | |
449 (or | |
450 (and (Math-zerop a) a) | |
451 (and (math-known-nonposp a) | |
452 (math-imaginary (math-sqrt (math-neg a)))) | |
453 (and (integerp a) | |
454 (let ((sqrt (math-isqrt-small a))) | |
455 (if (= (* sqrt sqrt) a) | |
456 sqrt | |
457 (if calc-symbolic-mode | |
458 (list 'calcFunc-sqrt a) | |
459 (math-sqrt-float (math-float a) (math-float sqrt)))))) | |
460 (and (eq (car-safe a) 'bigpos) | |
461 (let* ((res (math-isqrt-bignum (cdr a))) | |
462 (sqrt (math-normalize (cons 'bigpos (cdr res))))) | |
463 (if (car res) | |
464 sqrt | |
465 (if calc-symbolic-mode | |
466 (list 'calcFunc-sqrt a) | |
467 (math-sqrt-float (math-float a) (math-float sqrt)))))) | |
468 (and (eq (car-safe a) 'frac) | |
469 (let* ((num-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 1 a))))) | |
470 (num-sqrt (math-normalize (cons 'bigpos (cdr num-res)))) | |
471 (den-res (math-isqrt-bignum (cdr (Math-bignum-test (nth 2 a))))) | |
472 (den-sqrt (math-normalize (cons 'bigpos (cdr den-res))))) | |
473 (if (and (car num-res) (car den-res)) | |
474 (list 'frac num-sqrt den-sqrt) | |
475 (if calc-symbolic-mode | |
476 (if (or (car num-res) (car den-res)) | |
477 (math-div (if (car num-res) | |
478 num-sqrt (list 'calcFunc-sqrt (nth 1 a))) | |
479 (if (car den-res) | |
480 den-sqrt (list 'calcFunc-sqrt (nth 2 a)))) | |
481 (list 'calcFunc-sqrt a)) | |
482 (math-sqrt-float (math-float a) | |
483 (math-div (math-float num-sqrt) den-sqrt)))))) | |
484 (and (eq (car-safe a) 'float) | |
485 (if calc-symbolic-mode | |
486 (if (= (% (nth 2 a) 2) 0) | |
487 (let ((res (math-isqrt-bignum | |
488 (cdr (Math-bignum-test (nth 1 a)))))) | |
489 (if (car res) | |
490 (math-make-float (math-normalize | |
491 (cons 'bigpos (cdr res))) | |
492 (/ (nth 2 a) 2)) | |
493 (signal 'inexact-result nil))) | |
494 (signal 'inexact-result nil)) | |
495 (math-sqrt-float a))) | |
496 (and (eq (car-safe a) 'cplx) | |
497 (math-with-extra-prec 2 | |
498 (let* ((d (math-abs a)) | |
499 (imag (math-sqrt (math-mul (math-sub d (nth 1 a)) | |
500 '(float 5 -1))))) | |
501 (list 'cplx | |
502 (math-sqrt (math-mul (math-add d (nth 1 a)) '(float 5 -1))) | |
503 (if (math-negp (nth 2 a)) (math-neg imag) imag))))) | |
504 (and (eq (car-safe a) 'polar) | |
505 (list 'polar | |
506 (math-sqrt (nth 1 a)) | |
507 (math-mul (nth 2 a) '(float 5 -1)))) | |
508 (and (eq (car-safe a) 'sdev) | |
509 (let ((sqrt (math-sqrt (nth 1 a)))) | |
510 (math-make-sdev sqrt | |
511 (math-div (nth 2 a) (math-mul sqrt 2))))) | |
512 (and (eq (car-safe a) 'intv) | |
513 (not (math-negp (nth 2 a))) | |
514 (math-make-intv (nth 1 a) (math-sqrt (nth 2 a)) (math-sqrt (nth 3 a)))) | |
515 (and (eq (car-safe a) '*) | |
516 (or (math-known-nonnegp (nth 1 a)) | |
517 (math-known-nonnegp (nth 2 a))) | |
518 (math-mul (math-sqrt (nth 1 a)) (math-sqrt (nth 2 a)))) | |
519 (and (eq (car-safe a) '/) | |
520 (or (and (math-known-nonnegp (nth 2 a)) | |
521 (math-div (math-sqrt (nth 1 a)) (math-sqrt (nth 2 a)))) | |
522 (and (math-known-nonnegp (nth 1 a)) | |
523 (not (math-equal-int (nth 1 a) 1)) | |
524 (math-mul (math-sqrt (nth 1 a)) | |
525 (math-sqrt (math-div 1 (nth 2 a))))))) | |
526 (and (eq (car-safe a) '^) | |
527 (math-known-evenp (nth 2 a)) | |
528 (math-known-realp (nth 1 a)) | |
529 (math-abs (math-pow (nth 1 a) (math-div (nth 2 a) 2)))) | |
530 (let ((inf (math-infinitep a))) | |
531 (and inf | |
532 (math-mul (math-sqrt (math-infinite-dir a inf)) inf))) | |
533 (progn | |
534 (calc-record-why 'numberp a) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
535 (list 'calcFunc-sqrt a)))) |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
536 (defalias 'calcFunc-sqrt 'math-sqrt) |
40785 | 537 |
538 (defun math-infinite-dir (a &optional inf) | |
539 (or inf (setq inf (math-infinitep a))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
540 (math-normalize (math-expr-subst a inf 1))) |
40785 | 541 |
542 (defun math-sqrt-float (a &optional guess) ; [F F F] | |
543 (if calc-symbolic-mode | |
544 (signal 'inexact-result nil) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
545 (math-with-extra-prec 1 (math-sqrt-raw a guess)))) |
40785 | 546 |
547 (defun math-sqrt-raw (a &optional guess) ; [F F F] | |
548 (if (not (Math-posp a)) | |
549 (math-sqrt a) | |
82238
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
550 (cond |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
551 ((math-use-emacs-fn 'sqrt a)) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
552 (t |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
553 (if (null guess) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
554 (let ((ldiff (- (math-numdigs (nth 1 a)) 6))) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
555 (or (= (% (+ (nth 2 a) ldiff) 2) 0) (setq ldiff (1+ ldiff))) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
556 (setq guess (math-make-float (math-isqrt-small |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
557 (math-scale-int (nth 1 a) (- ldiff))) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
558 (/ (+ (nth 2 a) ldiff) 2))))) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
559 (math-sqrt-float-iter a guess))))) |
40785 | 560 |
561 (defun math-sqrt-float-iter (a guess) ; [F F F] | |
562 (math-working "sqrt" guess) | |
563 (let ((g2 (math-mul-float (math-add-float guess (math-div-float a guess)) | |
564 '(float 5 -1)))) | |
565 (if (math-nearly-equal-float g2 guess) | |
566 g2 | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
567 (math-sqrt-float-iter a g2)))) |
40785 | 568 |
569 ;;; True if A and B differ only in the last digit of precision. [P F F] | |
570 (defun math-nearly-equal-float (a b) | |
571 (let ((ediff (- (nth 2 a) (nth 2 b)))) | |
572 (cond ((= ediff 0) ;; Expanded out for speed | |
573 (setq ediff (math-add (Math-integer-neg (nth 1 a)) (nth 1 b))) | |
574 (or (eq ediff 0) | |
575 (and (not (consp ediff)) | |
576 (< ediff 10) | |
577 (> ediff -10) | |
578 (= (math-numdigs (nth 1 a)) calc-internal-prec)))) | |
579 ((= ediff 1) | |
580 (setq ediff (math-add (Math-integer-neg (nth 1 b)) | |
581 (math-scale-int (nth 1 a) 1))) | |
582 (and (not (consp ediff)) | |
583 (< ediff 10) | |
584 (> ediff -10) | |
585 (= (math-numdigs (nth 1 b)) calc-internal-prec))) | |
586 ((= ediff -1) | |
587 (setq ediff (math-add (Math-integer-neg (nth 1 a)) | |
588 (math-scale-int (nth 1 b) 1))) | |
589 (and (not (consp ediff)) | |
590 (< ediff 10) | |
591 (> ediff -10) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
592 (= (math-numdigs (nth 1 a)) calc-internal-prec)))))) |
40785 | 593 |
594 (defun math-nearly-equal (a b) ; [P N N] [Public] | |
595 (setq a (math-float a)) | |
596 (setq b (math-float b)) | |
597 (if (eq (car a) 'polar) (setq a (math-complex a))) | |
598 (if (eq (car b) 'polar) (setq b (math-complex b))) | |
599 (if (eq (car a) 'cplx) | |
600 (if (eq (car b) 'cplx) | |
601 (and (or (math-nearly-equal-float (nth 1 a) (nth 1 b)) | |
602 (and (math-nearly-zerop-float (nth 1 a) (nth 2 a)) | |
603 (math-nearly-zerop-float (nth 1 b) (nth 2 b)))) | |
604 (or (math-nearly-equal-float (nth 2 a) (nth 2 b)) | |
605 (and (math-nearly-zerop-float (nth 2 a) (nth 1 a)) | |
606 (math-nearly-zerop-float (nth 2 b) (nth 1 b))))) | |
607 (and (math-nearly-equal-float (nth 1 a) b) | |
608 (math-nearly-zerop-float (nth 2 a) b))) | |
609 (if (eq (car b) 'cplx) | |
610 (and (math-nearly-equal-float a (nth 1 b)) | |
611 (math-nearly-zerop-float a (nth 2 b))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
612 (math-nearly-equal-float a b)))) |
40785 | 613 |
614 ;;; True if A is nearly zero compared to B. [P F F] | |
615 (defun math-nearly-zerop-float (a b) | |
616 (or (eq (nth 1 a) 0) | |
617 (<= (+ (math-numdigs (nth 1 a)) (nth 2 a)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
618 (1+ (- (+ (math-numdigs (nth 1 b)) (nth 2 b)) calc-internal-prec))))) |
40785 | 619 |
620 (defun math-nearly-zerop (a b) ; [P N R] [Public] | |
621 (setq a (math-float a)) | |
622 (setq b (math-float b)) | |
623 (if (eq (car a) 'cplx) | |
624 (and (math-nearly-zerop-float (nth 1 a) b) | |
625 (math-nearly-zerop-float (nth 2 a) b)) | |
626 (if (eq (car a) 'polar) | |
627 (math-nearly-zerop-float (nth 1 a) b) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
628 (math-nearly-zerop-float a b)))) |
40785 | 629 |
630 ;;; This implementation could be improved, accuracy-wise. | |
631 (defun math-hypot (a b) | |
632 (cond ((Math-zerop a) (math-abs b)) | |
633 ((Math-zerop b) (math-abs a)) | |
634 ((not (Math-scalarp a)) | |
635 (if (math-infinitep a) | |
636 (if (math-infinitep b) | |
637 (if (equal a b) | |
638 a | |
639 '(var nan var-nan)) | |
640 a) | |
641 (calc-record-why 'scalarp a) | |
642 (list 'calcFunc-hypot a b))) | |
643 ((not (Math-scalarp b)) | |
644 (if (math-infinitep b) | |
645 b | |
646 (calc-record-why 'scalarp b) | |
647 (list 'calcFunc-hypot a b))) | |
648 ((and (Math-numberp a) (Math-numberp b)) | |
649 (math-with-extra-prec 1 | |
650 (math-sqrt (math-add (calcFunc-abssqr a) (calcFunc-abssqr b))))) | |
651 ((eq (car-safe a) 'hms) | |
652 (if (eq (car-safe b) 'hms) ; this helps sdev's of hms forms | |
653 (math-to-hms (math-hypot (math-from-hms a 'deg) | |
654 (math-from-hms b 'deg))) | |
655 (math-to-hms (math-hypot (math-from-hms a 'deg) b)))) | |
656 ((eq (car-safe b) 'hms) | |
657 (math-to-hms (math-hypot a (math-from-hms b 'deg)))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
658 (t nil))) |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
659 (defalias 'calcFunc-hypot 'math-hypot) |
40785 | 660 |
661 (defun calcFunc-sqr (x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
662 (math-pow x 2)) |
40785 | 663 |
664 | |
665 | |
666 (defun math-nth-root (a n) | |
667 (cond ((= n 2) (math-sqrt a)) | |
668 ((Math-zerop a) a) | |
669 ((Math-negp a) nil) | |
670 ((Math-integerp a) | |
671 (let ((root (math-nth-root-integer a n))) | |
672 (if (car root) | |
673 (cdr root) | |
674 (and (not calc-symbolic-mode) | |
675 (math-nth-root-float (math-float a) n | |
676 (math-float (cdr root))))))) | |
677 ((eq (car-safe a) 'frac) | |
678 (let* ((num-root (math-nth-root-integer (nth 1 a) n)) | |
679 (den-root (math-nth-root-integer (nth 2 a) n))) | |
680 (if (and (car num-root) (car den-root)) | |
681 (list 'frac (cdr num-root) (cdr den-root)) | |
682 (and (not calc-symbolic-mode) | |
683 (math-nth-root-float | |
684 (math-float a) n | |
685 (math-div-float (math-float (cdr num-root)) | |
686 (math-float (cdr den-root)))))))) | |
687 ((eq (car-safe a) 'float) | |
688 (and (not calc-symbolic-mode) | |
689 (math-nth-root-float a n))) | |
690 ((eq (car-safe a) 'polar) | |
691 (let ((root (math-nth-root (nth 1 a) n))) | |
692 (and root (list 'polar root (math-div (nth 2 a) n))))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
693 (t nil))) |
40785 | 694 |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
695 ;; The variables math-nrf-n, math-nrf-nf and math-nrf-nfm1 are local |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
696 ;; to math-nth-root-float, but are used by math-nth-root-float-iter, |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
697 ;; which is called by math-nth-root-float. |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
698 (defvar math-nrf-n) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
699 (defvar math-nrf-nf) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
700 (defvar math-nrf-nfm1) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
701 |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
702 (defun math-nth-root-float (a math-nrf-n &optional guess) |
40785 | 703 (math-inexact-result) |
704 (math-with-extra-prec 1 | |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
705 (let ((math-nrf-nf (math-float math-nrf-n)) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
706 (math-nrf-nfm1 (math-float (1- math-nrf-n)))) |
40785 | 707 (math-nth-root-float-iter a (or guess |
708 (math-make-float | |
709 1 (/ (+ (math-numdigs (nth 1 a)) | |
710 (nth 2 a) | |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
711 (/ math-nrf-n 2)) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
712 math-nrf-n))))))) |
40785 | 713 |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
714 (defun math-nth-root-float-iter (a guess) |
40785 | 715 (math-working "root" guess) |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
716 (let ((g2 (math-div-float (math-add-float (math-mul math-nrf-nfm1 guess) |
40785 | 717 (math-div-float |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
718 a (math-ipow guess (1- math-nrf-n)))) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
719 math-nrf-nf))) |
40785 | 720 (if (math-nearly-equal-float g2 guess) |
721 g2 | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
722 (math-nth-root-float-iter a g2)))) |
40785 | 723 |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
724 ;; The variable math-nri-n is local to math-nth-root-integer, but |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
725 ;; is used by math-nth-root-int-iter, which is called by |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
726 ;; math-nth-root-int. |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
727 (defvar math-nri-n) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
728 |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
729 (defun math-nth-root-integer (a math-nri-n &optional guess) ; [I I S] |
40785 | 730 (math-nth-root-int-iter a (or guess |
731 (math-scale-int 1 (/ (+ (math-numdigs a) | |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
732 (1- math-nri-n)) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
733 math-nri-n))))) |
40785 | 734 |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
735 (defun math-nth-root-int-iter (a guess) |
40785 | 736 (math-working "root" guess) |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
737 (let* ((q (math-idivmod a (math-ipow guess (1- math-nri-n)))) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
738 (s (math-add (car q) (math-mul (1- math-nri-n) guess))) |
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
739 (g2 (math-idivmod s math-nri-n))) |
40785 | 740 (if (Math-natnum-lessp (car g2) guess) |
741 (math-nth-root-int-iter a (car g2)) | |
742 (cons (and (equal (car g2) guess) | |
743 (eq (cdr q) 0) | |
744 (eq (cdr g2) 0)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
745 guess)))) |
40785 | 746 |
747 (defun calcFunc-nroot (x n) | |
748 (calcFunc-pow x (if (integerp n) | |
749 (math-make-frac 1 n) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
750 (math-div 1 n)))) |
40785 | 751 |
752 | |
753 | |
754 | |
755 ;;;; Transcendental functions. | |
756 | |
757 ;;; All of these functions are defined on the complex plane. | |
758 ;;; (Branch cuts, etc. follow Steele's Common Lisp book.) | |
759 | |
760 ;;; Most functions increase calc-internal-prec by 2 digits, then round | |
761 ;;; down afterward. "-raw" functions use the current precision, require | |
762 ;;; their arguments to be in float (or complex float) format, and always | |
763 ;;; work in radians (where applicable). | |
764 | |
765 (defun math-to-radians (a) ; [N N] | |
766 (cond ((eq (car-safe a) 'hms) | |
767 (math-from-hms a 'rad)) | |
768 ((memq calc-angle-mode '(deg hms)) | |
769 (math-mul a (math-pi-over-180))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
770 (t a))) |
40785 | 771 |
772 (defun math-from-radians (a) ; [N N] | |
773 (cond ((eq calc-angle-mode 'deg) | |
774 (if (math-constp a) | |
775 (math-div a (math-pi-over-180)) | |
776 (list 'calcFunc-deg a))) | |
777 ((eq calc-angle-mode 'hms) | |
778 (math-to-hms a 'rad)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
779 (t a))) |
40785 | 780 |
781 (defun math-to-radians-2 (a) ; [N N] | |
782 (cond ((eq (car-safe a) 'hms) | |
783 (math-from-hms a 'rad)) | |
784 ((memq calc-angle-mode '(deg hms)) | |
785 (if calc-symbolic-mode | |
786 (math-div (math-mul a '(var pi var-pi)) 180) | |
787 (math-mul a (math-pi-over-180)))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
788 (t a))) |
40785 | 789 |
790 (defun math-from-radians-2 (a) ; [N N] | |
791 (cond ((memq calc-angle-mode '(deg hms)) | |
792 (if calc-symbolic-mode | |
793 (math-div (math-mul 180 a) '(var pi var-pi)) | |
794 (math-div a (math-pi-over-180)))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
795 (t a))) |
40785 | 796 |
797 | |
798 | |
799 ;;; Sine, cosine, and tangent. | |
800 | |
801 (defun calcFunc-sin (x) ; [N N] [Public] | |
802 (cond ((and (integerp x) | |
803 (if (eq calc-angle-mode 'deg) | |
804 (= (% x 90) 0) | |
805 (= x 0))) | |
806 (aref [0 1 0 -1] (math-mod (/ x 90) 4))) | |
807 ((Math-scalarp x) | |
808 (math-with-extra-prec 2 | |
809 (math-sin-raw (math-to-radians (math-float x))))) | |
810 ((eq (car x) 'sdev) | |
811 (if (math-constp x) | |
812 (math-with-extra-prec 2 | |
813 (let* ((xx (math-to-radians (math-float (nth 1 x)))) | |
814 (xs (math-to-radians (math-float (nth 2 x)))) | |
815 (sc (math-sin-cos-raw xx))) | |
816 (math-make-sdev (car sc) (math-mul xs (cdr sc))))) | |
817 (math-make-sdev (calcFunc-sin (nth 1 x)) | |
818 (math-mul (nth 2 x) (calcFunc-cos (nth 1 x)))))) | |
819 ((and (eq (car x) 'intv) (math-intv-constp x)) | |
820 (calcFunc-cos (math-sub x (math-quarter-circle nil)))) | |
821 ((equal x '(var nan var-nan)) | |
822 x) | |
823 (t (calc-record-why 'scalarp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
824 (list 'calcFunc-sin x)))) |
40785 | 825 |
826 (defun calcFunc-cos (x) ; [N N] [Public] | |
827 (cond ((and (integerp x) | |
828 (if (eq calc-angle-mode 'deg) | |
829 (= (% x 90) 0) | |
830 (= x 0))) | |
831 (aref [1 0 -1 0] (math-mod (/ x 90) 4))) | |
832 ((Math-scalarp x) | |
833 (math-with-extra-prec 2 | |
834 (math-cos-raw (math-to-radians (math-float x))))) | |
835 ((eq (car x) 'sdev) | |
836 (if (math-constp x) | |
837 (math-with-extra-prec 2 | |
838 (let* ((xx (math-to-radians (math-float (nth 1 x)))) | |
839 (xs (math-to-radians (math-float (nth 2 x)))) | |
840 (sc (math-sin-cos-raw xx))) | |
841 (math-make-sdev (cdr sc) (math-mul xs (car sc))))) | |
842 (math-make-sdev (calcFunc-cos (nth 1 x)) | |
843 (math-mul (nth 2 x) (calcFunc-sin (nth 1 x)))))) | |
844 ((and (eq (car x) 'intv) (math-intv-constp x)) | |
845 (math-with-extra-prec 2 | |
846 (let* ((xx (math-to-radians (math-float x))) | |
847 (na (math-floor (math-div (nth 2 xx) (math-pi)))) | |
848 (nb (math-floor (math-div (nth 3 xx) (math-pi)))) | |
849 (span (math-sub nb na))) | |
850 (if (memq span '(0 1)) | |
851 (let ((int (math-sort-intv (nth 1 x) | |
852 (math-cos-raw (nth 2 xx)) | |
853 (math-cos-raw (nth 3 xx))))) | |
854 (if (eq span 1) | |
855 (if (math-evenp na) | |
856 (math-make-intv (logior (nth 1 x) 2) | |
857 -1 | |
858 (nth 3 int)) | |
859 (math-make-intv (logior (nth 1 x) 1) | |
860 (nth 2 int) | |
861 1)) | |
862 int)) | |
863 (list 'intv 3 -1 1))))) | |
864 ((equal x '(var nan var-nan)) | |
865 x) | |
866 (t (calc-record-why 'scalarp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
867 (list 'calcFunc-cos x)))) |
40785 | 868 |
869 (defun calcFunc-sincos (x) ; [V N] [Public] | |
870 (if (Math-scalarp x) | |
871 (math-with-extra-prec 2 | |
872 (let ((sc (math-sin-cos-raw (math-to-radians (math-float x))))) | |
873 (list 'vec (cdr sc) (car sc)))) ; the vector [cos, sin] | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
874 (list 'vec (calcFunc-sin x) (calcFunc-cos x)))) |
40785 | 875 |
876 (defun calcFunc-tan (x) ; [N N] [Public] | |
877 (cond ((and (integerp x) | |
878 (if (eq calc-angle-mode 'deg) | |
879 (= (% x 180) 0) | |
880 (= x 0))) | |
881 0) | |
882 ((Math-scalarp x) | |
883 (math-with-extra-prec 2 | |
884 (math-tan-raw (math-to-radians (math-float x))))) | |
885 ((eq (car x) 'sdev) | |
886 (if (math-constp x) | |
887 (math-with-extra-prec 2 | |
888 (let* ((xx (math-to-radians (math-float (nth 1 x)))) | |
889 (xs (math-to-radians (math-float (nth 2 x)))) | |
890 (sc (math-sin-cos-raw xx))) | |
891 (if (and (math-zerop (cdr sc)) (not calc-infinite-mode)) | |
892 (progn | |
893 (calc-record-why "*Division by zero") | |
894 (list 'calcFunc-tan x)) | |
895 (math-make-sdev (math-div-float (car sc) (cdr sc)) | |
896 (math-div-float xs (math-sqr (cdr sc))))))) | |
897 (math-make-sdev (calcFunc-tan (nth 1 x)) | |
898 (math-div (nth 2 x) | |
899 (math-sqr (calcFunc-cos (nth 1 x))))))) | |
900 ((and (eq (car x) 'intv) (math-intv-constp x)) | |
901 (or (math-with-extra-prec 2 | |
902 (let* ((xx (math-to-radians (math-float x))) | |
903 (na (math-floor (math-div (math-sub (nth 2 xx) | |
904 (math-pi-over-2)) | |
905 (math-pi)))) | |
906 (nb (math-floor (math-div (math-sub (nth 3 xx) | |
907 (math-pi-over-2)) | |
908 (math-pi))))) | |
909 (and (equal na nb) | |
910 (math-sort-intv (nth 1 x) | |
911 (math-tan-raw (nth 2 xx)) | |
912 (math-tan-raw (nth 3 xx)))))) | |
913 '(intv 3 (neg (var inf var-inf)) (var inf var-inf)))) | |
914 ((equal x '(var nan var-nan)) | |
915 x) | |
916 (t (calc-record-why 'scalarp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
917 (list 'calcFunc-tan x)))) |
40785 | 918 |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
919 (defun calcFunc-sec (x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
920 (cond ((and (integerp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
921 (eq calc-angle-mode 'deg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
922 (= (% x 180) 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
923 (if (= (% x 360) 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
924 1 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
925 -1)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
926 ((and (integerp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
927 (eq calc-angle-mode 'rad) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
928 (= x 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
929 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
930 ((Math-scalarp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
931 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
932 (math-sec-raw (math-to-radians (math-float x))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
933 ((eq (car x) 'sdev) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
934 (if (math-constp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
935 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
936 (let* ((xx (math-to-radians (math-float (nth 1 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
937 (xs (math-to-radians (math-float (nth 2 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
938 (sc (math-sin-cos-raw xx))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
939 (if (and (math-zerop (cdr sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
940 (not calc-infinite-mode)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
941 (progn |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
942 (calc-record-why "*Division by zero") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
943 (list 'calcFunc-sec x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
944 (math-make-sdev (math-div-float '(float 1 0) (cdr sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
945 (math-div-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
946 (math-mul xs (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
947 (math-sqr (cdr sc))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
948 (math-make-sdev (calcFunc-sec (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
949 (math-div |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
950 (math-mul (nth 2 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
951 (calcFunc-sin (nth 1 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
952 (math-sqr (calcFunc-cos (nth 1 x))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
953 ((and (eq (car x) 'intv) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
954 (math-intv-constp x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
955 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
956 (let* ((xx (math-to-radians (math-float x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
957 (na (math-floor (math-div (math-sub (nth 2 xx) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
958 (math-pi-over-2)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
959 (math-pi)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
960 (nb (math-floor (math-div (math-sub (nth 3 xx) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
961 (math-pi-over-2)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
962 (math-pi)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
963 (naa (math-floor (math-div (nth 2 xx) (math-pi-over-2)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
964 (nbb (math-floor (math-div (nth 3 xx) (math-pi-over-2)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
965 (span (math-sub nbb naa))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
966 (if (not (equal na nb)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
967 '(intv 3 (neg (var inf var-inf)) (var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
968 (let ((int (math-sort-intv (nth 1 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
969 (math-sec-raw (nth 2 xx)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
970 (math-sec-raw (nth 3 xx))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
971 (if (eq span 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
972 (if (math-evenp (math-div (math-add naa 1) 2)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
973 (math-make-intv (logior (nth 1 int) 2) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
974 1 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
975 (nth 3 int)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
976 (math-make-intv (logior (nth 1 int) 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
977 (nth 2 int) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
978 -1)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
979 int)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
980 ((equal x '(var nan var-nan)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
981 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
982 (t (calc-record-why 'scalarp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
983 (list 'calcFunc-sec x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
984 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
985 (defun calcFunc-csc (x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
986 (cond ((and (integerp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
987 (eq calc-angle-mode 'deg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
988 (= (% (- x 90) 180) 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
989 (if (= (% (- x 90) 360) 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
990 1 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
991 -1)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
992 ((Math-scalarp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
993 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
994 (math-csc-raw (math-to-radians (math-float x))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
995 ((eq (car x) 'sdev) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
996 (if (math-constp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
997 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
998 (let* ((xx (math-to-radians (math-float (nth 1 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
999 (xs (math-to-radians (math-float (nth 2 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1000 (sc (math-sin-cos-raw xx))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1001 (if (and (math-zerop (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1002 (not calc-infinite-mode)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1003 (progn |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1004 (calc-record-why "*Division by zero") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1005 (list 'calcFunc-csc x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1006 (math-make-sdev (math-div-float '(float 1 0) (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1007 (math-div-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1008 (math-mul xs (cdr sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1009 (math-sqr (car sc))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1010 (math-make-sdev (calcFunc-csc (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1011 (math-div |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1012 (math-mul (nth 2 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1013 (calcFunc-cos (nth 1 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1014 (math-sqr (calcFunc-sin (nth 1 x))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1015 ((and (eq (car x) 'intv) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1016 (math-intv-constp x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1017 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1018 (let* ((xx (math-to-radians (math-float x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1019 (na (math-floor (math-div (nth 2 xx) (math-pi)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1020 (nb (math-floor (math-div (nth 3 xx) (math-pi)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1021 (naa (math-floor (math-div (nth 2 xx) (math-pi-over-2)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1022 (nbb (math-floor (math-div (nth 3 xx) (math-pi-over-2)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1023 (span (math-sub nbb naa))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1024 (if (not (equal na nb)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1025 '(intv 3 (neg (var inf var-inf)) (var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1026 (let ((int (math-sort-intv (nth 1 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1027 (math-csc-raw (nth 2 xx)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1028 (math-csc-raw (nth 3 xx))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1029 (if (eq span 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1030 (if (math-evenp (math-div naa 2)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1031 (math-make-intv (logior (nth 1 int) 2) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1032 1 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1033 (nth 3 int)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1034 (math-make-intv (logior (nth 1 int) 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1035 (nth 2 int) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1036 -1)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1037 int)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1038 ((equal x '(var nan var-nan)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1039 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1040 (t (calc-record-why 'scalarp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1041 (list 'calcFunc-csc x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1042 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1043 (defun calcFunc-cot (x) ; [N N] [Public] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1044 (cond ((and (integerp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1045 (if (eq calc-angle-mode 'deg) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1046 (= (% (- x 90) 180) 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1047 (= x 0))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1048 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1049 ((Math-scalarp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1050 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1051 (math-cot-raw (math-to-radians (math-float x))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1052 ((eq (car x) 'sdev) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1053 (if (math-constp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1054 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1055 (let* ((xx (math-to-radians (math-float (nth 1 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1056 (xs (math-to-radians (math-float (nth 2 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1057 (sc (math-sin-cos-raw xx))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1058 (if (and (math-zerop (car sc)) (not calc-infinite-mode)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1059 (progn |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1060 (calc-record-why "*Division by zero") |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1061 (list 'calcFunc-cot x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1062 (math-make-sdev (math-div-float (cdr sc) (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1063 (math-div-float xs (math-sqr (car sc))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1064 (math-make-sdev (calcFunc-cot (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1065 (math-div (nth 2 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1066 (math-sqr (calcFunc-sin (nth 1 x))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1067 ((and (eq (car x) 'intv) (math-intv-constp x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1068 (or (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1069 (let* ((xx (math-to-radians (math-float x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1070 (na (math-floor (math-div (nth 2 xx) (math-pi)))) |
60164
697e2ba683cc
(calc-arctan, calc-tanh, calc-arctanh): Removed extra definitions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
60085
diff
changeset
|
1071 (nb (math-floor (math-div (nth 3 xx) (math-pi))))) |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1072 (and (equal na nb) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1073 (math-sort-intv (nth 1 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1074 (math-cot-raw (nth 2 xx)) |
60164
697e2ba683cc
(calc-arctan, calc-tanh, calc-arctanh): Removed extra definitions.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
60085
diff
changeset
|
1075 (math-cot-raw (nth 3 xx)))))) |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1076 '(intv 3 (neg (var inf var-inf)) (var inf var-inf)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1077 ((equal x '(var nan var-nan)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1078 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1079 (t (calc-record-why 'scalarp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1080 (list 'calcFunc-cot x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1081 |
91997
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1082 (defun math-sin-raw (x &optional orgx) ; [N N] |
40785 | 1083 (cond ((eq (car x) 'cplx) |
1084 (let* ((expx (math-exp-raw (nth 2 x))) | |
1085 (expmx (math-div-float '(float 1 0) expx)) | |
1086 (sc (math-sin-cos-raw (nth 1 x)))) | |
1087 (list 'cplx | |
1088 (math-mul-float (car sc) | |
1089 (math-mul-float (math-add-float expx expmx) | |
1090 '(float 5 -1))) | |
1091 (math-mul-float (cdr sc) | |
1092 (math-mul-float (math-sub-float expx expmx) | |
1093 '(float 5 -1)))))) | |
1094 ((eq (car x) 'polar) | |
1095 (math-polar (math-sin-raw (math-complex x)))) | |
1096 ((Math-integer-negp (nth 1 x)) | |
91997
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1097 (math-neg-float (math-sin-raw (math-neg-float x) (if orgx orgx x)))) |
40785 | 1098 ((math-lessp-float '(float 7 0) x) ; avoid inf loops due to roundoff |
91997
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1099 (math-sin-raw (math-mod x (math-two-pi)) (if orgx orgx x))) |
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1100 (t (math-sin-raw-2 x (if orgx orgx x))))) |
40785 | 1101 |
1102 (defun math-cos-raw (x) ; [N N] | |
1103 (if (eq (car-safe x) 'polar) | |
1104 (math-polar (math-cos-raw (math-complex x))) | |
91997
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1105 (math-sin-raw (math-sub (math-pi-over-2) x) x))) |
40785 | 1106 |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1107 (defun math-sec-raw (x) ; [N N] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1108 (cond ((eq (car x) 'cplx) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1109 (let* ((x (math-mul x '(float 1 0))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1110 (expx (math-exp-raw (nth 2 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1111 (expmx (math-div-float '(float 1 0) expx)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1112 (sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1113 (ch (math-mul-float (math-add-float expx expmx) '(float 5 -1))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1114 (sc (math-sin-cos-raw (nth 1 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1115 (d (math-add-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1116 (math-mul-float (math-sqr (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1117 (math-sqr sh)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1118 (math-mul-float (math-sqr (cdr sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1119 (math-sqr ch))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1120 (and (not (eq (nth 1 d) 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1121 (list 'cplx |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1122 (math-div-float (math-mul-float (cdr sc) ch) d) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1123 (math-div-float (math-mul-float (car sc) sh) d))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1124 ((eq (car x) 'polar) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1125 (math-polar (math-sec-raw (math-complex x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1126 (t |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1127 (let ((cs (math-cos-raw x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1128 (if (eq cs 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1129 (math-div 1 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1130 (math-div-float '(float 1 0) cs)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1131 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1132 (defun math-csc-raw (x) ; [N N] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1133 (cond ((eq (car x) 'cplx) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1134 (let* ((x (math-mul x '(float 1 0))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1135 (expx (math-exp-raw (nth 2 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1136 (expmx (math-div-float '(float 1 0) expx)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1137 (sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1138 (ch (math-mul-float (math-add-float expx expmx) '(float 5 -1))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1139 (sc (math-sin-cos-raw (nth 1 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1140 (d (math-add-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1141 (math-mul-float (math-sqr (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1142 (math-sqr ch)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1143 (math-mul-float (math-sqr (cdr sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1144 (math-sqr sh))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1145 (and (not (eq (nth 1 d) 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1146 (list 'cplx |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1147 (math-div-float (math-mul-float (car sc) ch) d) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1148 (math-div-float (math-mul-float (cdr sc) sh) d))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1149 ((eq (car x) 'polar) |
60085
f91c9a606821
(math-csc-raw): Fix typo.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
60079
diff
changeset
|
1150 (math-polar (math-csc-raw (math-complex x)))) |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1151 (t |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1152 (let ((sn (math-sin-raw x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1153 (if (eq sn 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1154 (math-div 1 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1155 (math-div-float '(float 1 0) sn)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1156 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1157 (defun math-cot-raw (x) ; [N N] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1158 (cond ((eq (car x) 'cplx) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1159 (let* ((x (math-mul x '(float 1 0))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1160 (expx (math-exp-raw (nth 2 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1161 (expmx (math-div-float '(float 1 0) expx)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1162 (sh (math-mul-float (math-sub-float expx expmx) '(float 5 -1))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1163 (ch (math-mul-float (math-add-float expx expmx) '(float 5 -1))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1164 (sc (math-sin-cos-raw (nth 1 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1165 (d (math-add-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1166 (math-sqr (car sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1167 (math-sqr sh)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1168 (and (not (eq (nth 1 d) 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1169 (list 'cplx |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1170 (math-div-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1171 (math-mul-float (car sc) (cdr sc)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1172 d) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1173 (math-neg |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1174 (math-div-float |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1175 (math-mul-float sh ch) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1176 d)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1177 ((eq (car x) 'polar) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1178 (math-polar (math-cot-raw (math-complex x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1179 (t |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1180 (let ((sc (math-sin-cos-raw x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1181 (if (eq (nth 1 (car sc)) 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1182 (math-div (cdr sc) 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1183 (math-div-float (cdr sc) (car sc))))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1184 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1185 |
40785 | 1186 ;;; This could use a smarter method: Reduce x as in math-sin-raw, then |
1187 ;;; compute either sin(x) or cos(x), whichever is smaller, and compute | |
1188 ;;; the other using the identity sin(x)^2 + cos(x)^2 = 1. | |
1189 (defun math-sin-cos-raw (x) ; [F.F F] (result is (sin x . cos x)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1190 (cons (math-sin-raw x) (math-cos-raw x))) |
40785 | 1191 |
1192 (defun math-tan-raw (x) ; [N N] | |
1193 (cond ((eq (car x) 'cplx) | |
1194 (let* ((x (math-mul x '(float 2 0))) | |
1195 (expx (math-exp-raw (nth 2 x))) | |
1196 (expmx (math-div-float '(float 1 0) expx)) | |
1197 (sc (math-sin-cos-raw (nth 1 x))) | |
1198 (d (math-add-float (cdr sc) | |
1199 (math-mul-float (math-add-float expx expmx) | |
1200 '(float 5 -1))))) | |
1201 (and (not (eq (nth 1 d) 0)) | |
1202 (list 'cplx | |
1203 (math-div-float (car sc) d) | |
1204 (math-div-float (math-mul-float (math-sub-float expx | |
1205 expmx) | |
1206 '(float 5 -1)) d))))) | |
1207 ((eq (car x) 'polar) | |
1208 (math-polar (math-tan-raw (math-complex x)))) | |
1209 (t | |
1210 (let ((sc (math-sin-cos-raw x))) | |
1211 (if (eq (nth 1 (cdr sc)) 0) | |
1212 (math-div (car sc) 0) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1213 (math-div-float (car sc) (cdr sc))))))) |
40785 | 1214 |
1215 (defun math-sin-raw-2 (x orgx) ; This avoids poss of inf recursion. [F F] | |
1216 (let ((xmpo2 (math-sub-float (math-pi-over-2) x))) | |
1217 (cond ((Math-integer-negp (nth 1 xmpo2)) | |
1218 (math-neg-float (math-sin-raw-2 (math-sub-float x (math-pi)) | |
1219 orgx))) | |
1220 ((math-lessp-float (math-pi-over-4) x) | |
1221 (math-cos-raw-2 xmpo2 orgx)) | |
1222 ((math-lessp-float x (math-neg (math-pi-over-4))) | |
1223 (math-neg (math-cos-raw-2 (math-add (math-pi-over-2) x) orgx))) | |
91997
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1224 ((math-with-extra-prec -1 (math-nearly-zerop-float x orgx)) |
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1225 '(float 0 0)) |
82238
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1226 ((math-use-emacs-fn 'sin x)) |
40785 | 1227 (calc-symbolic-mode (signal 'inexact-result nil)) |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1228 (t (math-sin-series x 6 4 x (math-neg-float (math-sqr-float x))))))) |
40785 | 1229 |
1230 (defun math-cos-raw-2 (x orgx) ; [F F] | |
91997
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1231 (cond ((math-with-extra-prec -1 (math-nearly-zerop-float x orgx)) |
17b9e01fbc76
(math-sin-raw): Add optional argument to keep track of
Jay Belanger <jay.p.belanger@gmail.com>
parents:
87649
diff
changeset
|
1232 '(float 1 0)) |
82238
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1233 ((math-use-emacs-fn 'cos x)) |
40785 | 1234 (calc-symbolic-mode (signal 'inexact-result nil)) |
1235 (t (let ((xnegsqr (math-neg-float (math-sqr-float x)))) | |
1236 (math-sin-series | |
1237 (math-add-float '(float 1 0) | |
1238 (math-mul-float xnegsqr '(float 5 -1))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1239 24 5 xnegsqr xnegsqr))))) |
40785 | 1240 |
1241 (defun math-sin-series (sum nfac n x xnegsqr) | |
1242 (math-working "sin" sum) | |
1243 (let* ((nextx (math-mul-float x xnegsqr)) | |
1244 (nextsum (math-add-float sum (math-div-float nextx | |
1245 (math-float nfac))))) | |
1246 (if (math-nearly-equal-float sum nextsum) | |
1247 sum | |
1248 (math-sin-series nextsum (math-mul nfac (* n (1+ n))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1249 (+ n 2) nextx xnegsqr)))) |
40785 | 1250 |
1251 | |
1252 ;;; Inverse sine, cosine, tangent. | |
1253 | |
1254 (defun calcFunc-arcsin (x) ; [N N] [Public] | |
1255 (cond ((eq x 0) 0) | |
1256 ((and (eq x 1) (eq calc-angle-mode 'deg)) 90) | |
1257 ((and (eq x -1) (eq calc-angle-mode 'deg)) -90) | |
1258 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1259 ((Math-numberp x) | |
1260 (math-with-extra-prec 2 | |
1261 (math-from-radians (math-arcsin-raw (math-float x))))) | |
1262 ((eq (car x) 'sdev) | |
1263 (math-make-sdev (calcFunc-arcsin (nth 1 x)) | |
1264 (math-from-radians | |
1265 (math-div (nth 2 x) | |
1266 (math-sqrt | |
1267 (math-sub 1 (math-sqr (nth 1 x)))))))) | |
1268 ((eq (car x) 'intv) | |
1269 (math-sort-intv (nth 1 x) | |
1270 (calcFunc-arcsin (nth 2 x)) | |
1271 (calcFunc-arcsin (nth 3 x)))) | |
1272 ((equal x '(var nan var-nan)) | |
1273 x) | |
1274 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1275 (list 'calcFunc-arcsin x)))) |
40785 | 1276 |
1277 (defun calcFunc-arccos (x) ; [N N] [Public] | |
1278 (cond ((eq x 1) 0) | |
1279 ((and (eq x 0) (eq calc-angle-mode 'deg)) 90) | |
1280 ((and (eq x -1) (eq calc-angle-mode 'deg)) 180) | |
1281 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1282 ((Math-numberp x) | |
1283 (math-with-extra-prec 2 | |
1284 (math-from-radians (math-arccos-raw (math-float x))))) | |
1285 ((eq (car x) 'sdev) | |
1286 (math-make-sdev (calcFunc-arccos (nth 1 x)) | |
1287 (math-from-radians | |
1288 (math-div (nth 2 x) | |
1289 (math-sqrt | |
1290 (math-sub 1 (math-sqr (nth 1 x)))))))) | |
1291 ((eq (car x) 'intv) | |
1292 (math-sort-intv (nth 1 x) | |
1293 (calcFunc-arccos (nth 2 x)) | |
1294 (calcFunc-arccos (nth 3 x)))) | |
1295 ((equal x '(var nan var-nan)) | |
1296 x) | |
1297 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1298 (list 'calcFunc-arccos x)))) |
40785 | 1299 |
1300 (defun calcFunc-arctan (x) ; [N N] [Public] | |
1301 (cond ((eq x 0) 0) | |
1302 ((and (eq x 1) (eq calc-angle-mode 'deg)) 45) | |
1303 ((and (eq x -1) (eq calc-angle-mode 'deg)) -45) | |
1304 ((Math-numberp x) | |
1305 (math-with-extra-prec 2 | |
1306 (math-from-radians (math-arctan-raw (math-float x))))) | |
1307 ((eq (car x) 'sdev) | |
1308 (math-make-sdev (calcFunc-arctan (nth 1 x)) | |
1309 (math-from-radians | |
1310 (math-div (nth 2 x) | |
1311 (math-add 1 (math-sqr (nth 1 x))))))) | |
1312 ((eq (car x) 'intv) | |
1313 (math-sort-intv (nth 1 x) | |
1314 (calcFunc-arctan (nth 2 x)) | |
1315 (calcFunc-arctan (nth 3 x)))) | |
1316 ((equal x '(var inf var-inf)) | |
1317 (math-quarter-circle t)) | |
1318 ((equal x '(neg (var inf var-inf))) | |
1319 (math-neg (math-quarter-circle t))) | |
1320 ((equal x '(var nan var-nan)) | |
1321 x) | |
1322 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1323 (list 'calcFunc-arctan x)))) |
40785 | 1324 |
1325 (defun math-arcsin-raw (x) ; [N N] | |
1326 (let ((a (math-sqrt-raw (math-sub '(float 1 0) (math-sqr x))))) | |
1327 (if (or (memq (car x) '(cplx polar)) | |
1328 (memq (car a) '(cplx polar))) | |
1329 (math-with-extra-prec 2 ; use extra precision for difficult case | |
1330 (math-mul '(cplx 0 -1) | |
1331 (math-ln-raw (math-add (math-mul '(cplx 0 1) x) a)))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1332 (math-arctan2-raw x a)))) |
40785 | 1333 |
1334 (defun math-arccos-raw (x) ; [N N] | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1335 (math-sub (math-pi-over-2) (math-arcsin-raw x))) |
40785 | 1336 |
1337 (defun math-arctan-raw (x) ; [N N] | |
1338 (cond ((memq (car x) '(cplx polar)) | |
1339 (math-with-extra-prec 2 ; extra-extra | |
1340 (math-div (math-sub | |
1341 (math-ln-raw (math-add 1 (math-mul '(cplx 0 1) x))) | |
1342 (math-ln-raw (math-add 1 (math-mul '(cplx 0 -1) x)))) | |
1343 '(cplx 0 2)))) | |
1344 ((Math-integer-negp (nth 1 x)) | |
1345 (math-neg-float (math-arctan-raw (math-neg-float x)))) | |
1346 ((math-zerop x) x) | |
82238
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1347 ((math-use-emacs-fn 'atan x)) |
40785 | 1348 (calc-symbolic-mode (signal 'inexact-result nil)) |
1349 ((math-equal-int x 1) (math-pi-over-4)) | |
1350 ((math-equal-int x -1) (math-neg (math-pi-over-4))) | |
1351 ((math-lessp-float '(float 414214 -6) x) ; if x > sqrt(2) - 1, reduce | |
1352 (if (math-lessp-float '(float 1 0) x) | |
1353 (math-sub-float (math-mul-float (math-pi) '(float 5 -1)) | |
1354 (math-arctan-raw (math-div-float '(float 1 0) x))) | |
1355 (math-sub-float (math-mul-float (math-pi) '(float 25 -2)) | |
1356 (math-arctan-raw (math-div-float | |
1357 (math-sub-float '(float 1 0) x) | |
1358 (math-add-float '(float 1 0) | |
1359 x)))))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1360 (t (math-arctan-series x 3 x (math-neg-float (math-sqr-float x)))))) |
40785 | 1361 |
1362 (defun math-arctan-series (sum n x xnegsqr) | |
1363 (math-working "arctan" sum) | |
1364 (let* ((nextx (math-mul-float x xnegsqr)) | |
1365 (nextsum (math-add-float sum (math-div-float nextx (math-float n))))) | |
1366 (if (math-nearly-equal-float sum nextsum) | |
1367 sum | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1368 (math-arctan-series nextsum (+ n 2) nextx xnegsqr)))) |
40785 | 1369 |
1370 (defun calcFunc-arctan2 (y x) ; [F R R] [Public] | |
1371 (if (Math-anglep y) | |
1372 (if (Math-anglep x) | |
1373 (math-with-extra-prec 2 | |
1374 (math-from-radians (math-arctan2-raw (math-float y) | |
1375 (math-float x)))) | |
1376 (calc-record-why 'anglep x) | |
1377 (list 'calcFunc-arctan2 y x)) | |
1378 (if (and (or (math-infinitep x) (math-anglep x)) | |
1379 (or (math-infinitep y) (math-anglep y))) | |
1380 (progn | |
1381 (if (math-posp x) | |
1382 (setq x 1) | |
1383 (if (math-negp x) | |
1384 (setq x -1) | |
1385 (or (math-zerop x) | |
1386 (setq x nil)))) | |
1387 (if (math-posp y) | |
1388 (setq y 1) | |
1389 (if (math-negp y) | |
1390 (setq y -1) | |
1391 (or (math-zerop y) | |
1392 (setq y nil)))) | |
1393 (if (and y x) | |
1394 (calcFunc-arctan2 y x) | |
1395 '(var nan var-nan))) | |
1396 (calc-record-why 'anglep y) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1397 (list 'calcFunc-arctan2 y x)))) |
40785 | 1398 |
1399 (defun math-arctan2-raw (y x) ; [F R R] | |
1400 (cond ((math-zerop y) | |
1401 (if (math-negp x) (math-pi) | |
1402 (if (or (math-floatp x) (math-floatp y)) '(float 0 0) 0))) | |
1403 ((math-zerop x) | |
1404 (if (math-posp y) | |
1405 (math-pi-over-2) | |
1406 (math-neg (math-pi-over-2)))) | |
1407 ((math-posp x) | |
1408 (math-arctan-raw (math-div-float y x))) | |
1409 ((math-posp y) | |
1410 (math-add-float (math-arctan-raw (math-div-float y x)) | |
1411 (math-pi))) | |
1412 (t | |
1413 (math-sub-float (math-arctan-raw (math-div-float y x)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1414 (math-pi))))) |
40785 | 1415 |
1416 (defun calcFunc-arcsincos (x) ; [V N] [Public] | |
1417 (if (and (Math-vectorp x) | |
1418 (= (length x) 3)) | |
1419 (calcFunc-arctan2 (nth 2 x) (nth 1 x)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1420 (math-reject-arg x "*Two-element vector expected"))) |
40785 | 1421 |
1422 | |
1423 | |
1424 ;;; Exponential function. | |
1425 | |
1426 (defun calcFunc-exp (x) ; [N N] [Public] | |
1427 (cond ((eq x 0) 1) | |
1428 ((and (memq x '(1 -1)) calc-symbolic-mode) | |
1429 (if (eq x 1) '(var e var-e) (math-div 1 '(var e var-e)))) | |
1430 ((Math-numberp x) | |
1431 (math-with-extra-prec 2 (math-exp-raw (math-float x)))) | |
1432 ((eq (car-safe x) 'sdev) | |
1433 (let ((ex (calcFunc-exp (nth 1 x)))) | |
1434 (math-make-sdev ex (math-mul (nth 2 x) ex)))) | |
1435 ((eq (car-safe x) 'intv) | |
1436 (math-make-intv (nth 1 x) (calcFunc-exp (nth 2 x)) | |
1437 (calcFunc-exp (nth 3 x)))) | |
1438 ((equal x '(var inf var-inf)) | |
1439 x) | |
1440 ((equal x '(neg (var inf var-inf))) | |
1441 0) | |
1442 ((equal x '(var nan var-nan)) | |
1443 x) | |
1444 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1445 (list 'calcFunc-exp x)))) |
40785 | 1446 |
1447 (defun calcFunc-expm1 (x) ; [N N] [Public] | |
1448 (cond ((eq x 0) 0) | |
1449 ((math-zerop x) '(float 0 0)) | |
1450 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1451 ((Math-numberp x) | |
1452 (math-with-extra-prec 2 | |
1453 (let ((x (math-float x))) | |
1454 (if (and (eq (car x) 'float) | |
1455 (math-lessp-float x '(float 1 0)) | |
1456 (math-lessp-float '(float -1 0) x)) | |
1457 (math-exp-minus-1-raw x) | |
1458 (math-add (math-exp-raw x) -1))))) | |
1459 ((eq (car-safe x) 'sdev) | |
1460 (if (math-constp x) | |
1461 (let ((ex (calcFunc-expm1 (nth 1 x)))) | |
1462 (math-make-sdev ex (math-mul (nth 2 x) (math-add ex 1)))) | |
1463 (math-make-sdev (calcFunc-expm1 (nth 1 x)) | |
1464 (math-mul (nth 2 x) (calcFunc-exp (nth 1 x)))))) | |
1465 ((eq (car-safe x) 'intv) | |
1466 (math-make-intv (nth 1 x) | |
1467 (calcFunc-expm1 (nth 2 x)) | |
1468 (calcFunc-expm1 (nth 3 x)))) | |
1469 ((equal x '(var inf var-inf)) | |
1470 x) | |
1471 ((equal x '(neg (var inf var-inf))) | |
1472 -1) | |
1473 ((equal x '(var nan var-nan)) | |
1474 x) | |
1475 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1476 (list 'calcFunc-expm1 x)))) |
40785 | 1477 |
1478 (defun calcFunc-exp10 (x) ; [N N] [Public] | |
1479 (if (eq x 0) | |
1480 1 | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1481 (math-pow '(float 1 1) x))) |
40785 | 1482 |
1483 (defun math-exp-raw (x) ; [N N] | |
1484 (cond ((math-zerop x) '(float 1 0)) | |
1485 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1486 ((eq (car x) 'cplx) | |
1487 (let ((expx (math-exp-raw (nth 1 x))) | |
1488 (sc (math-sin-cos-raw (nth 2 x)))) | |
1489 (list 'cplx | |
1490 (math-mul-float expx (cdr sc)) | |
1491 (math-mul-float expx (car sc))))) | |
1492 ((eq (car x) 'polar) | |
1493 (let ((xc (math-complex x))) | |
1494 (list 'polar | |
1495 (math-exp-raw (nth 1 xc)) | |
1496 (math-from-radians (nth 2 xc))))) | |
82015
0795e1e56274
(math-emacs-precision, math-largest-emacs-expt)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81746
diff
changeset
|
1497 ((math-use-emacs-fn 'exp x)) |
40785 | 1498 ((or (math-lessp-float '(float 5 -1) x) |
1499 (math-lessp-float x '(float -5 -1))) | |
1500 (if (math-lessp-float '(float 921035 1) x) | |
1501 (math-overflow) | |
1502 (if (math-lessp-float x '(float -921035 1)) | |
1503 (math-underflow))) | |
1504 (let* ((two-x (math-mul-float x '(float 2 0))) | |
1505 (hint (math-scale-int (nth 1 two-x) (nth 2 two-x))) | |
1506 (hfrac (math-sub-float x (math-mul-float (math-float hint) | |
1507 '(float 5 -1))))) | |
1508 (math-mul-float (math-ipow (math-sqrt-e) hint) | |
1509 (math-add-float '(float 1 0) | |
1510 (math-exp-minus-1-raw hfrac))))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1511 (t (math-add-float '(float 1 0) (math-exp-minus-1-raw x))))) |
40785 | 1512 |
1513 (defun math-exp-minus-1-raw (x) ; [F F] | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1514 (math-exp-series x 2 3 x x)) |
40785 | 1515 |
1516 (defun math-exp-series (sum nfac n xpow x) | |
1517 (math-working "exp" sum) | |
1518 (let* ((nextx (math-mul-float xpow x)) | |
1519 (nextsum (math-add-float sum (math-div-float nextx | |
1520 (math-float nfac))))) | |
1521 (if (math-nearly-equal-float sum nextsum) | |
1522 sum | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1523 (math-exp-series nextsum (math-mul nfac n) (1+ n) nextx x)))) |
40785 | 1524 |
1525 | |
1526 | |
1527 ;;; Logarithms. | |
1528 | |
1529 (defun calcFunc-ln (x) ; [N N] [Public] | |
1530 (cond ((math-zerop x) | |
1531 (if calc-infinite-mode | |
1532 '(neg (var inf var-inf)) | |
1533 (math-reject-arg x "*Logarithm of zero"))) | |
1534 ((eq x 1) 0) | |
1535 ((Math-numberp x) | |
1536 (math-with-extra-prec 2 (math-ln-raw (math-float x)))) | |
1537 ((eq (car-safe x) 'sdev) | |
1538 (math-make-sdev (calcFunc-ln (nth 1 x)) | |
1539 (math-div (nth 2 x) (nth 1 x)))) | |
1540 ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x)) | |
1541 (Math-zerop (nth 2 x)) | |
1542 (not (math-intv-constp x)))) | |
1543 (let ((calc-infinite-mode t)) | |
1544 (math-make-intv (nth 1 x) (calcFunc-ln (nth 2 x)) | |
1545 (calcFunc-ln (nth 3 x))))) | |
1546 ((equal x '(var e var-e)) | |
1547 1) | |
1548 ((and (eq (car-safe x) '^) | |
1549 (equal (nth 1 x) '(var e var-e)) | |
1550 (math-known-realp (nth 2 x))) | |
1551 (nth 2 x)) | |
1552 ((math-infinitep x) | |
1553 (if (equal x '(var nan var-nan)) | |
1554 x | |
1555 '(var inf var-inf))) | |
1556 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1557 (list 'calcFunc-ln x)))) |
40785 | 1558 |
1559 (defun calcFunc-log10 (x) ; [N N] [Public] | |
1560 (cond ((math-equal-int x 1) | |
1561 (if (math-floatp x) '(float 0 0) 0)) | |
1562 ((and (Math-integerp x) | |
1563 (math-posp x) | |
1564 (let ((res (math-integer-log x 10))) | |
1565 (and (car res) | |
1566 (setq x (cdr res))))) | |
1567 x) | |
1568 ((and (eq (car-safe x) 'frac) | |
1569 (eq (nth 1 x) 1) | |
1570 (let ((res (math-integer-log (nth 2 x) 10))) | |
1571 (and (car res) | |
1572 (setq x (- (cdr res)))))) | |
1573 x) | |
1574 ((math-zerop x) | |
1575 (if calc-infinite-mode | |
1576 '(neg (var inf var-inf)) | |
1577 (math-reject-arg x "*Logarithm of zero"))) | |
1578 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1579 ((Math-numberp x) | |
1580 (math-with-extra-prec 2 | |
1581 (let ((xf (math-float x))) | |
1582 (if (eq (nth 1 xf) 0) | |
1583 (math-reject-arg x "*Logarithm of zero")) | |
1584 (if (Math-integer-posp (nth 1 xf)) | |
1585 (if (eq (nth 1 xf) 1) ; log10(1*10^n) = n | |
1586 (math-float (nth 2 xf)) | |
1587 (let ((xdigs (1- (math-numdigs (nth 1 xf))))) | |
1588 (math-add-float | |
1589 (math-div-float (math-ln-raw-2 | |
1590 (list 'float (nth 1 xf) (- xdigs))) | |
1591 (math-ln-10)) | |
1592 (math-float (+ (nth 2 xf) xdigs))))) | |
1593 (math-div (calcFunc-ln xf) (math-ln-10)))))) | |
1594 ((eq (car-safe x) 'sdev) | |
1595 (math-make-sdev (calcFunc-log10 (nth 1 x)) | |
1596 (math-div (nth 2 x) | |
1597 (math-mul (nth 1 x) (math-ln-10))))) | |
1598 ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x)) | |
1599 (not (math-intv-constp x)))) | |
1600 (math-make-intv (nth 1 x) | |
1601 (calcFunc-log10 (nth 2 x)) | |
1602 (calcFunc-log10 (nth 3 x)))) | |
1603 ((math-infinitep x) | |
1604 (if (equal x '(var nan var-nan)) | |
1605 x | |
1606 '(var inf var-inf))) | |
1607 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1608 (list 'calcFunc-log10 x)))) |
40785 | 1609 |
1610 (defun calcFunc-log (x &optional b) ; [N N N] [Public] | |
1611 (cond ((or (null b) (equal b '(var e var-e))) | |
1612 (math-normalize (list 'calcFunc-ln x))) | |
1613 ((or (eq b 10) (equal b '(float 1 1))) | |
1614 (math-normalize (list 'calcFunc-log10 x))) | |
1615 ((math-zerop x) | |
1616 (if calc-infinite-mode | |
1617 (math-div (calcFunc-ln x) (calcFunc-ln b)) | |
1618 (math-reject-arg x "*Logarithm of zero"))) | |
1619 ((math-zerop b) | |
1620 (if calc-infinite-mode | |
1621 (math-div (calcFunc-ln x) (calcFunc-ln b)) | |
1622 (math-reject-arg b "*Logarithm of zero"))) | |
1623 ((math-equal-int b 1) | |
1624 (if calc-infinite-mode | |
1625 (math-div (calcFunc-ln x) 0) | |
1626 (math-reject-arg b "*Logarithm base one"))) | |
1627 ((math-equal-int x 1) | |
58475
647b2f6dac36
(math-nrf-n, math-nrf-nf, math-nrf-nfm1): New variables.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
1628 (if (math-floatp b) '(float 0 0) 0)) |
40785 | 1629 ((and (Math-ratp x) (Math-ratp b) |
1630 (math-posp x) (math-posp b) | |
1631 (let* ((sign 1) (inv nil) | |
1632 (xx (if (Math-lessp 1 x) | |
1633 x | |
1634 (setq sign -1) | |
1635 (math-div 1 x))) | |
1636 (bb (if (Math-lessp 1 b) | |
1637 b | |
1638 (setq sign (- sign)) | |
1639 (math-div 1 b))) | |
1640 (res (if (Math-lessp xx bb) | |
1641 (setq inv (math-integer-log bb xx)) | |
1642 (math-integer-log xx bb)))) | |
1643 (and (car res) | |
1644 (setq x (if inv | |
1645 (math-div 1 (* sign (cdr res))) | |
1646 (* sign (cdr res))))))) | |
1647 x) | |
1648 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1649 ((and (Math-numberp x) (Math-numberp b)) | |
1650 (math-with-extra-prec 2 | |
1651 (math-div (math-ln-raw (math-float x)) | |
1652 (math-log-base-raw b)))) | |
1653 ((and (eq (car-safe x) 'sdev) | |
1654 (Math-numberp b)) | |
1655 (math-make-sdev (calcFunc-log (nth 1 x) b) | |
1656 (math-div (nth 2 x) | |
1657 (math-mul (nth 1 x) | |
1658 (math-log-base-raw b))))) | |
1659 ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x)) | |
1660 (not (math-intv-constp x))) | |
1661 (math-realp b)) | |
1662 (math-make-intv (nth 1 x) | |
1663 (calcFunc-log (nth 2 x) b) | |
1664 (calcFunc-log (nth 3 x) b))) | |
1665 ((or (eq (car-safe x) 'intv) (eq (car-safe b) 'intv)) | |
1666 (math-div (calcFunc-ln x) (calcFunc-ln b))) | |
1667 ((or (math-infinitep x) | |
1668 (math-infinitep b)) | |
1669 (math-div (calcFunc-ln x) (calcFunc-ln b))) | |
1670 (t (if (Math-numberp b) | |
1671 (calc-record-why 'numberp x) | |
1672 (calc-record-why 'numberp b)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1673 (list 'calcFunc-log x b)))) |
40785 | 1674 |
1675 (defun calcFunc-alog (x &optional b) | |
1676 (cond ((or (null b) (equal b '(var e var-e))) | |
1677 (math-normalize (list 'calcFunc-exp x))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1678 (t (math-pow b x)))) |
40785 | 1679 |
1680 (defun calcFunc-ilog (x b) | |
1681 (if (and (math-natnump x) (not (eq x 0)) | |
1682 (math-natnump b) (not (eq b 0))) | |
1683 (if (eq b 1) | |
1684 (math-reject-arg x "*Logarithm base one") | |
1685 (if (Math-natnum-lessp x b) | |
1686 0 | |
1687 (cdr (math-integer-log x b)))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1688 (math-floor (calcFunc-log x b)))) |
40785 | 1689 |
1690 (defun math-integer-log (x b) | |
1691 (let ((pows (list b)) | |
1692 (pow (math-sqr b)) | |
1693 next | |
1694 sum n) | |
1695 (while (not (Math-lessp x pow)) | |
1696 (setq pows (cons pow pows) | |
1697 pow (math-sqr pow))) | |
1698 (setq n (lsh 1 (1- (length pows))) | |
1699 sum n | |
1700 pow (car pows)) | |
1701 (while (and (setq pows (cdr pows)) | |
1702 (Math-lessp pow x)) | |
1703 (setq n (/ n 2) | |
1704 next (math-mul pow (car pows))) | |
1705 (or (Math-lessp x next) | |
1706 (setq pow next | |
1707 sum (+ sum n)))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1708 (cons (equal pow x) sum))) |
40785 | 1709 |
1710 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41044
diff
changeset
|
1711 (defvar math-log-base-cache nil) |
40785 | 1712 (defun math-log-base-raw (b) ; [N N] |
1713 (if (not (and (equal (car math-log-base-cache) b) | |
1714 (eq (nth 1 math-log-base-cache) calc-internal-prec))) | |
1715 (setq math-log-base-cache (list b calc-internal-prec | |
1716 (math-ln-raw (math-float b))))) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1717 (nth 2 math-log-base-cache)) |
40785 | 1718 |
1719 (defun calcFunc-lnp1 (x) ; [N N] [Public] | |
1720 (cond ((Math-equal-int x -1) | |
1721 (if calc-infinite-mode | |
1722 '(neg (var inf var-inf)) | |
1723 (math-reject-arg x "*Logarithm of zero"))) | |
1724 ((eq x 0) 0) | |
1725 ((math-zerop x) '(float 0 0)) | |
1726 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1727 ((Math-numberp x) | |
1728 (math-with-extra-prec 2 | |
1729 (let ((x (math-float x))) | |
1730 (if (and (eq (car x) 'float) | |
1731 (math-lessp-float x '(float 5 -1)) | |
1732 (math-lessp-float '(float -5 -1) x)) | |
1733 (math-ln-plus-1-raw x) | |
1734 (math-ln-raw (math-add-float x '(float 1 0))))))) | |
1735 ((eq (car-safe x) 'sdev) | |
1736 (math-make-sdev (calcFunc-lnp1 (nth 1 x)) | |
1737 (math-div (nth 2 x) (math-add (nth 1 x) 1)))) | |
1738 ((and (eq (car-safe x) 'intv) (or (Math-posp (nth 2 x)) | |
1739 (not (math-intv-constp x)))) | |
1740 (math-make-intv (nth 1 x) | |
1741 (calcFunc-lnp1 (nth 2 x)) | |
1742 (calcFunc-lnp1 (nth 3 x)))) | |
1743 ((math-infinitep x) | |
1744 (if (equal x '(var nan var-nan)) | |
1745 x | |
1746 '(var inf var-inf))) | |
1747 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1748 (list 'calcFunc-lnp1 x)))) |
40785 | 1749 |
1750 (defun math-ln-raw (x) ; [N N] --- must be float format! | |
1751 (cond ((eq (car-safe x) 'cplx) | |
1752 (list 'cplx | |
1753 (math-mul-float (math-ln-raw | |
1754 (math-add-float (math-sqr-float (nth 1 x)) | |
1755 (math-sqr-float (nth 2 x)))) | |
1756 '(float 5 -1)) | |
1757 (math-arctan2-raw (nth 2 x) (nth 1 x)))) | |
1758 ((eq (car x) 'polar) | |
1759 (math-polar (list 'cplx | |
1760 (math-ln-raw (nth 1 x)) | |
1761 (math-to-radians (nth 2 x))))) | |
1762 ((Math-equal-int x 1) | |
1763 '(float 0 0)) | |
1764 (calc-symbolic-mode (signal 'inexact-result nil)) | |
1765 ((math-posp (nth 1 x)) ; positive and real | |
82238
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1766 (cond |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1767 ((math-use-emacs-fn 'log x)) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1768 (t |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1769 (let ((xdigs (1- (math-numdigs (nth 1 x))))) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1770 (math-add-float (math-ln-raw-2 (list 'float (nth 1 x) (- xdigs))) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1771 (math-mul-float (math-float (+ (nth 2 x) xdigs)) |
78ac1f6cc5cc
(math-sqrt-raw,math-sin-raw-2,math-cos-raw-2,math-arctan-raw)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82140
diff
changeset
|
1772 (math-ln-10))))))) |
40785 | 1773 ((math-zerop x) |
1774 (math-reject-arg x "*Logarithm of zero")) | |
1775 ((eq calc-complex-mode 'polar) ; negative and real | |
1776 (math-polar | |
1777 (list 'cplx ; negative and real | |
1778 (math-ln-raw (math-neg-float x)) | |
1779 (math-pi)))) | |
1780 (t (list 'cplx ; negative and real | |
1781 (math-ln-raw (math-neg-float x)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1782 (math-pi))))) |
40785 | 1783 |
1784 (defun math-ln-raw-2 (x) ; [F F] | |
1785 (cond ((math-lessp-float '(float 14 -1) x) | |
1786 (math-add-float (math-ln-raw-2 (math-mul-float x '(float 5 -1))) | |
1787 (math-ln-2))) | |
1788 (t ; now .7 < x <= 1.4 | |
1789 (math-ln-raw-3 (math-div-float (math-sub-float x '(float 1 0)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1790 (math-add-float x '(float 1 0))))))) |
40785 | 1791 |
1792 (defun math-ln-raw-3 (x) ; [F F] | |
1793 (math-mul-float (math-ln-raw-series x 3 x (math-sqr-float x)) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1794 '(float 2 0))) |
40785 | 1795 |
1796 ;;; Compute ln((1+x)/(1-x)) | |
1797 (defun math-ln-raw-series (sum n x xsqr) | |
1798 (math-working "log" sum) | |
1799 (let* ((nextx (math-mul-float x xsqr)) | |
1800 (nextsum (math-add-float sum (math-div-float nextx (math-float n))))) | |
1801 (if (math-nearly-equal-float sum nextsum) | |
1802 sum | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1803 (math-ln-raw-series nextsum (+ n 2) nextx xsqr)))) |
40785 | 1804 |
1805 (defun math-ln-plus-1-raw (x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1806 (math-lnp1-series x 2 x (math-neg x))) |
40785 | 1807 |
1808 (defun math-lnp1-series (sum n xpow x) | |
1809 (math-working "lnp1" sum) | |
1810 (let* ((nextx (math-mul-float xpow x)) | |
1811 (nextsum (math-add-float sum (math-div-float nextx (math-float n))))) | |
1812 (if (math-nearly-equal-float sum nextsum) | |
1813 sum | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1814 (math-lnp1-series nextsum (1+ n) nextx x)))) |
40785 | 1815 |
81549
95971e0a7e98
(math-approx-ln-10, math-approx-ln-2): New variables to use in caches.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
77465
diff
changeset
|
1816 (defconst math-approx-ln-10 |
82443
5d2017af3365
(math-approx-ln-10, math-approx-ln-2): Remove `eval-when-compile's.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82238
diff
changeset
|
1817 (math-read-number-simple "2.302585092994045684018") |
81746
71ae866366dc
(math-approx-ln-10,math-approx-ln-2): Add docstrings.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81597
diff
changeset
|
1818 "An approximation for ln(10).") |
81549
95971e0a7e98
(math-approx-ln-10, math-approx-ln-2): New variables to use in caches.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
77465
diff
changeset
|
1819 |
95971e0a7e98
(math-approx-ln-10, math-approx-ln-2): New variables to use in caches.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
77465
diff
changeset
|
1820 (math-defcache math-ln-10 math-approx-ln-10 |
40785 | 1821 (math-ln-raw-2 '(float 1 1))) |
1822 | |
81549
95971e0a7e98
(math-approx-ln-10, math-approx-ln-2): New variables to use in caches.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
77465
diff
changeset
|
1823 (defconst math-approx-ln-2 |
82443
5d2017af3365
(math-approx-ln-10, math-approx-ln-2): Remove `eval-when-compile's.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
82238
diff
changeset
|
1824 (math-read-number-simple "0.693147180559945309417") |
81746
71ae866366dc
(math-approx-ln-10,math-approx-ln-2): Add docstrings.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
81597
diff
changeset
|
1825 "An approximation for ln(2).") |
81549
95971e0a7e98
(math-approx-ln-10, math-approx-ln-2): New variables to use in caches.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
77465
diff
changeset
|
1826 |
95971e0a7e98
(math-approx-ln-10, math-approx-ln-2): New variables to use in caches.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
77465
diff
changeset
|
1827 (math-defcache math-ln-2 math-approx-ln-2 |
40785 | 1828 (math-ln-raw-3 (math-float '(frac 1 3)))) |
1829 | |
1830 | |
1831 | |
1832 ;;; Hyperbolic functions. | |
1833 | |
1834 (defun calcFunc-sinh (x) ; [N N] [Public] | |
1835 (cond ((eq x 0) 0) | |
1836 (math-expand-formulas | |
1837 (math-normalize | |
1838 (list '/ (list '- (list 'calcFunc-exp x) | |
1839 (list 'calcFunc-exp (list 'neg x))) 2))) | |
1840 ((Math-numberp x) | |
1841 (if calc-symbolic-mode (signal 'inexact-result nil)) | |
1842 (math-with-extra-prec 2 | |
1843 (let ((expx (math-exp-raw (math-float x)))) | |
1844 (math-mul (math-add expx (math-div -1 expx)) '(float 5 -1))))) | |
1845 ((eq (car-safe x) 'sdev) | |
1846 (math-make-sdev (calcFunc-sinh (nth 1 x)) | |
1847 (math-mul (nth 2 x) (calcFunc-cosh (nth 1 x))))) | |
1848 ((eq (car x) 'intv) | |
1849 (math-sort-intv (nth 1 x) | |
1850 (calcFunc-sinh (nth 2 x)) | |
1851 (calcFunc-sinh (nth 3 x)))) | |
1852 ((or (equal x '(var inf var-inf)) | |
1853 (equal x '(neg (var inf var-inf))) | |
1854 (equal x '(var nan var-nan))) | |
1855 x) | |
1856 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1857 (list 'calcFunc-sinh x)))) |
40785 | 1858 (put 'calcFunc-sinh 'math-expandable t) |
1859 | |
1860 (defun calcFunc-cosh (x) ; [N N] [Public] | |
1861 (cond ((eq x 0) 1) | |
1862 (math-expand-formulas | |
1863 (math-normalize | |
1864 (list '/ (list '+ (list 'calcFunc-exp x) | |
1865 (list 'calcFunc-exp (list 'neg x))) 2))) | |
1866 ((Math-numberp x) | |
1867 (if calc-symbolic-mode (signal 'inexact-result nil)) | |
1868 (math-with-extra-prec 2 | |
1869 (let ((expx (math-exp-raw (math-float x)))) | |
1870 (math-mul (math-add expx (math-div 1 expx)) '(float 5 -1))))) | |
1871 ((eq (car-safe x) 'sdev) | |
1872 (math-make-sdev (calcFunc-cosh (nth 1 x)) | |
1873 (math-mul (nth 2 x) | |
1874 (calcFunc-sinh (nth 1 x))))) | |
1875 ((and (eq (car x) 'intv) (math-intv-constp x)) | |
1876 (setq x (math-abs x)) | |
1877 (math-sort-intv (nth 1 x) | |
1878 (calcFunc-cosh (nth 2 x)) | |
1879 (calcFunc-cosh (nth 3 x)))) | |
1880 ((or (equal x '(var inf var-inf)) | |
1881 (equal x '(neg (var inf var-inf))) | |
1882 (equal x '(var nan var-nan))) | |
1883 (math-abs x)) | |
1884 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1885 (list 'calcFunc-cosh x)))) |
40785 | 1886 (put 'calcFunc-cosh 'math-expandable t) |
1887 | |
1888 (defun calcFunc-tanh (x) ; [N N] [Public] | |
1889 (cond ((eq x 0) 0) | |
1890 (math-expand-formulas | |
1891 (math-normalize | |
1892 (let ((expx (list 'calcFunc-exp x)) | |
1893 (expmx (list 'calcFunc-exp (list 'neg x)))) | |
1894 (math-normalize | |
1895 (list '/ (list '- expx expmx) (list '+ expx expmx)))))) | |
1896 ((Math-numberp x) | |
1897 (if calc-symbolic-mode (signal 'inexact-result nil)) | |
1898 (math-with-extra-prec 2 | |
1899 (let* ((expx (calcFunc-exp (math-float x))) | |
1900 (expmx (math-div 1 expx))) | |
1901 (math-div (math-sub expx expmx) | |
1902 (math-add expx expmx))))) | |
1903 ((eq (car-safe x) 'sdev) | |
1904 (math-make-sdev (calcFunc-tanh (nth 1 x)) | |
1905 (math-div (nth 2 x) | |
1906 (math-sqr (calcFunc-cosh (nth 1 x)))))) | |
1907 ((eq (car x) 'intv) | |
1908 (math-sort-intv (nth 1 x) | |
1909 (calcFunc-tanh (nth 2 x)) | |
1910 (calcFunc-tanh (nth 3 x)))) | |
1911 ((equal x '(var inf var-inf)) | |
1912 1) | |
1913 ((equal x '(neg (var inf var-inf))) | |
1914 -1) | |
1915 ((equal x '(var nan var-nan)) | |
1916 x) | |
1917 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
1918 (list 'calcFunc-tanh x)))) |
40785 | 1919 (put 'calcFunc-tanh 'math-expandable t) |
1920 | |
60079
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1921 (defun calcFunc-sech (x) ; [N N] [Public] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1922 (cond ((eq x 0) 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1923 (math-expand-formulas |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1924 (math-normalize |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1925 (list '/ 2 (list '+ (list 'calcFunc-exp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1926 (list 'calcFunc-exp (list 'neg x)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1927 ((Math-numberp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1928 (if calc-symbolic-mode (signal 'inexact-result nil)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1929 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1930 (let ((expx (math-exp-raw (math-float x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1931 (math-div '(float 2 0) (math-add expx (math-div 1 expx)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1932 ((eq (car-safe x) 'sdev) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1933 (math-make-sdev (calcFunc-sech (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1934 (math-mul (nth 2 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1935 (math-mul (calcFunc-sech (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1936 (calcFunc-tanh (nth 1 x)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1937 ((and (eq (car x) 'intv) (math-intv-constp x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1938 (setq x (math-abs x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1939 (math-sort-intv (nth 1 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1940 (calcFunc-sech (nth 2 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1941 (calcFunc-sech (nth 3 x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1942 ((or (equal x '(var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1943 (equal x '(neg (var inf var-inf)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1944 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1945 ((equal x '(var nan var-nan)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1946 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1947 (t (calc-record-why 'numberp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1948 (list 'calcFunc-sech x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1949 (put 'calcFunc-sech 'math-expandable t) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1950 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1951 (defun calcFunc-csch (x) ; [N N] [Public] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1952 (cond ((eq x 0) (math-div 1 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1953 (math-expand-formulas |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1954 (math-normalize |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1955 (list '/ 2 (list '- (list 'calcFunc-exp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1956 (list 'calcFunc-exp (list 'neg x)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1957 ((Math-numberp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1958 (if calc-symbolic-mode (signal 'inexact-result nil)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1959 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1960 (let ((expx (math-exp-raw (math-float x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1961 (math-div '(float 2 0) (math-add expx (math-div -1 expx)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1962 ((eq (car-safe x) 'sdev) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1963 (math-make-sdev (calcFunc-csch (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1964 (math-mul (nth 2 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1965 (math-mul (calcFunc-csch (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1966 (calcFunc-coth (nth 1 x)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1967 ((eq (car x) 'intv) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1968 (if (and (Math-negp (nth 2 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1969 (Math-posp (nth 3 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1970 '(intv 3 (neg (var inf var-inf)) (var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1971 (math-sort-intv (nth 1 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1972 (calcFunc-csch (nth 2 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1973 (calcFunc-csch (nth 3 x))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1974 ((or (equal x '(var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1975 (equal x '(neg (var inf var-inf)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1976 0) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1977 ((equal x '(var nan var-nan)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1978 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1979 (t (calc-record-why 'numberp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1980 (list 'calcFunc-csch x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1981 (put 'calcFunc-csch 'math-expandable t) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1982 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1983 (defun calcFunc-coth (x) ; [N N] [Public] |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1984 (cond ((eq x 0) (math-div 1 0)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1985 (math-expand-formulas |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1986 (math-normalize |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1987 (let ((expx (list 'calcFunc-exp x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1988 (expmx (list 'calcFunc-exp (list 'neg x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1989 (math-normalize |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1990 (list '/ (list '+ expx expmx) (list '- expx expmx)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1991 ((Math-numberp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1992 (if calc-symbolic-mode (signal 'inexact-result nil)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1993 (math-with-extra-prec 2 |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1994 (let* ((expx (calcFunc-exp (math-float x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1995 (expmx (math-div 1 expx))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1996 (math-div (math-add expx expmx) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1997 (math-sub expx expmx))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1998 ((eq (car-safe x) 'sdev) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
1999 (math-make-sdev (calcFunc-coth (nth 1 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2000 (math-div (nth 2 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2001 (math-sqr (calcFunc-sinh (nth 1 x)))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2002 ((eq (car x) 'intv) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2003 (if (and (Math-negp (nth 2 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2004 (Math-posp (nth 3 x))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2005 '(intv 3 (neg (var inf var-inf)) (var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2006 (math-sort-intv (nth 1 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2007 (calcFunc-coth (nth 2 x)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2008 (calcFunc-coth (nth 3 x))))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2009 ((equal x '(var inf var-inf)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2010 1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2011 ((equal x '(neg (var inf var-inf))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2012 -1) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2013 ((equal x '(var nan var-nan)) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2014 x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2015 (t (calc-record-why 'numberp x) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2016 (list 'calcFunc-coth x)))) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2017 (put 'calcFunc-coth 'math-expandable t) |
b676ef11ff65
(calc-sec, calc-csc, calc-cot, calc-sech, calc-csch, calc-coth)
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58663
diff
changeset
|
2018 |
40785 | 2019 (defun calcFunc-arcsinh (x) ; [N N] [Public] |
2020 (cond ((eq x 0) 0) | |
2021 (math-expand-formulas | |
2022 (math-normalize | |
2023 (list 'calcFunc-ln (list '+ x (list 'calcFunc-sqrt | |
2024 (list '+ (list '^ x 2) 1)))))) | |
2025 ((Math-numberp x) | |
2026 (if calc-symbolic-mode (signal 'inexact-result nil)) | |
2027 (math-with-extra-prec 2 | |
2028 (math-ln-raw (math-add x (math-sqrt-raw (math-add (math-sqr x) | |
2029 '(float 1 0))))))) | |
2030 ((eq (car-safe x) 'sdev) | |
2031 (math-make-sdev (calcFunc-arcsinh (nth 1 x)) | |
2032 (math-div (nth 2 x) | |
2033 (math-sqrt | |
2034 (math-add (math-sqr (nth 1 x)) 1))))) | |
2035 ((eq (car x) 'intv) | |
2036 (math-sort-intv (nth 1 x) | |
2037 (calcFunc-arcsinh (nth 2 x)) | |
2038 (calcFunc-arcsinh (nth 3 x)))) | |
2039 ((or (equal x '(var inf var-inf)) | |
2040 (equal x '(neg (var inf var-inf))) | |
2041 (equal x '(var nan var-nan))) | |
2042 x) | |
2043 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
2044 (list 'calcFunc-arcsinh x)))) |
40785 | 2045 (put 'calcFunc-arcsinh 'math-expandable t) |
2046 | |
2047 (defun calcFunc-arccosh (x) ; [N N] [Public] | |
2048 (cond ((eq x 1) 0) | |
2049 ((and (eq x -1) calc-symbolic-mode) | |
2050 '(var pi var-pi)) | |
2051 ((and (eq x 0) calc-symbolic-mode) | |
2052 (math-div (math-mul '(var pi var-pi) '(var i var-i)) 2)) | |
2053 (math-expand-formulas | |
2054 (math-normalize | |
2055 (list 'calcFunc-ln (list '+ x (list 'calcFunc-sqrt | |
2056 (list '- (list '^ x 2) 1)))))) | |
2057 ((Math-numberp x) | |
2058 (if calc-symbolic-mode (signal 'inexact-result nil)) | |
2059 (if (Math-equal-int x -1) | |
2060 (math-imaginary (math-pi)) | |
2061 (math-with-extra-prec 2 | |
2062 (if (or t ; need to do this even in the real case! | |
2063 (memq (car-safe x) '(cplx polar))) | |
2064 (let ((xp1 (math-add 1 x))) ; this gets the branch cuts right | |
2065 (math-ln-raw | |
2066 (math-add x (math-mul xp1 | |
2067 (math-sqrt-raw | |
2068 (math-div (math-sub | |
2069 x | |
2070 '(float 1 0)) | |
2071 xp1)))))) | |
2072 (math-ln-raw | |
2073 (math-add x (math-sqrt-raw (math-add (math-sqr x) | |
2074 '(float -1 0))))))))) | |
2075 ((eq (car-safe x) 'sdev) | |
2076 (math-make-sdev (calcFunc-arccosh (nth 1 x)) | |
2077 (math-div (nth 2 x) | |
2078 (math-sqrt | |
2079 (math-add (math-sqr (nth 1 x)) -1))))) | |
2080 ((eq (car x) 'intv) | |
2081 (math-sort-intv (nth 1 x) | |
2082 (calcFunc-arccosh (nth 2 x)) | |
2083 (calcFunc-arccosh (nth 3 x)))) | |
2084 ((or (equal x '(var inf var-inf)) | |
2085 (equal x '(neg (var inf var-inf))) | |
2086 (equal x '(var nan var-nan))) | |
2087 x) | |
2088 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
2089 (list 'calcFunc-arccosh x)))) |
40785 | 2090 (put 'calcFunc-arccosh 'math-expandable t) |
2091 | |
2092 (defun calcFunc-arctanh (x) ; [N N] [Public] | |
2093 (cond ((eq x 0) 0) | |
2094 ((and (Math-equal-int x 1) calc-infinite-mode) | |
2095 '(var inf var-inf)) | |
2096 ((and (Math-equal-int x -1) calc-infinite-mode) | |
2097 '(neg (var inf var-inf))) | |
2098 (math-expand-formulas | |
2099 (list '/ (list '- | |
2100 (list 'calcFunc-ln (list '+ 1 x)) | |
2101 (list 'calcFunc-ln (list '- 1 x))) 2)) | |
2102 ((Math-numberp x) | |
2103 (if calc-symbolic-mode (signal 'inexact-result nil)) | |
2104 (math-with-extra-prec 2 | |
2105 (if (or (memq (car-safe x) '(cplx polar)) | |
2106 (Math-lessp 1 x)) | |
2107 (math-mul (math-sub (math-ln-raw (math-add '(float 1 0) x)) | |
2108 (math-ln-raw (math-sub '(float 1 0) x))) | |
2109 '(float 5 -1)) | |
2110 (if (and (math-equal-int x 1) calc-infinite-mode) | |
2111 '(var inf var-inf) | |
2112 (if (and (math-equal-int x -1) calc-infinite-mode) | |
2113 '(neg (var inf var-inf)) | |
2114 (math-mul (math-ln-raw (math-div (math-add '(float 1 0) x) | |
2115 (math-sub 1 x))) | |
2116 '(float 5 -1))))))) | |
2117 ((eq (car-safe x) 'sdev) | |
2118 (math-make-sdev (calcFunc-arctanh (nth 1 x)) | |
2119 (math-div (nth 2 x) | |
2120 (math-sub 1 (math-sqr (nth 1 x)))))) | |
2121 ((eq (car x) 'intv) | |
2122 (math-sort-intv (nth 1 x) | |
2123 (calcFunc-arctanh (nth 2 x)) | |
2124 (calcFunc-arctanh (nth 3 x)))) | |
2125 ((equal x '(var nan var-nan)) | |
2126 x) | |
2127 (t (calc-record-why 'numberp x) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
2128 (list 'calcFunc-arctanh x)))) |
40785 | 2129 (put 'calcFunc-arctanh 'math-expandable t) |
2130 | |
2131 | |
2132 ;;; Convert A from HMS or degrees to radians. | |
2133 (defun calcFunc-rad (a) ; [R R] [Public] | |
2134 (cond ((or (Math-numberp a) | |
2135 (eq (car a) 'intv)) | |
2136 (math-with-extra-prec 2 | |
2137 (math-mul a (math-pi-over-180)))) | |
2138 ((eq (car a) 'hms) | |
2139 (math-from-hms a 'rad)) | |
2140 ((eq (car a) 'sdev) | |
2141 (math-make-sdev (calcFunc-rad (nth 1 a)) | |
2142 (calcFunc-rad (nth 2 a)))) | |
2143 (math-expand-formulas | |
2144 (math-div (math-mul a '(var pi var-pi)) 180)) | |
2145 ((math-infinitep a) a) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
2146 (t (list 'calcFunc-rad a)))) |
40785 | 2147 (put 'calcFunc-rad 'math-expandable t) |
2148 | |
2149 ;;; Convert A from HMS or radians to degrees. | |
2150 (defun calcFunc-deg (a) ; [R R] [Public] | |
2151 (cond ((or (Math-numberp a) | |
2152 (eq (car a) 'intv)) | |
2153 (math-with-extra-prec 2 | |
2154 (math-div a (math-pi-over-180)))) | |
2155 ((eq (car a) 'hms) | |
2156 (math-from-hms a 'deg)) | |
2157 ((eq (car a) 'sdev) | |
2158 (math-make-sdev (calcFunc-deg (nth 1 a)) | |
2159 (calcFunc-deg (nth 2 a)))) | |
2160 (math-expand-formulas | |
2161 (math-div (math-mul 180 a) '(var pi var-pi))) | |
2162 ((math-infinitep a) a) | |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
2163 (t (list 'calcFunc-deg a)))) |
40785 | 2164 (put 'calcFunc-deg 'math-expandable t) |
2165 | |
58663
7ed196c06460
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58475
diff
changeset
|
2166 (provide 'calc-math) |
7ed196c06460
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
58475
diff
changeset
|
2167 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
91997
diff
changeset
|
2168 ;; arch-tag: c7367e8e-d0b8-4f70-8577-2fb3f31dbb4c |
41044
4549dec29728
(calcFunc-sqrt, calcFunc-hypot): Use `defalias' instead of `fset' and
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
2169 ;;; calc-math.el ends here |