Mercurial > emacs
comparison lisp/calc/calc-cplx.el @ 41047:73f364fd8aaa
Style cleanup; don't put closing parens on their
own line, add "foo.el ends here" to each file, and update
copyright date.
author | Colin Walters <walters@gnu.org> |
---|---|
date | Wed, 14 Nov 2001 09:09:09 +0000 |
parents | 2fb9d407ae73 |
children | fcd507927105 |
comparison
equal
deleted
inserted
replaced
41046:14b73d89514a | 41047:73f364fd8aaa |
---|---|
1 ;; Calculator for GNU Emacs, part II [calc-cplx.el] | 1 ;; Calculator for GNU Emacs, part II [calc-cplx.el] |
2 ;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. | 2 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 ;; Written by Dave Gillespie, daveg@synaptics.com. | 3 ;; Written by Dave Gillespie, daveg@synaptics.com. |
4 | 4 |
5 ;; This file is part of GNU Emacs. | 5 ;; This file is part of GNU Emacs. |
6 | 6 |
7 ;; GNU Emacs is distributed in the hope that it will be useful, | 7 ;; GNU Emacs is distributed in the hope that it will be useful, |
30 | 30 |
31 | 31 |
32 (defun calc-argument (arg) | 32 (defun calc-argument (arg) |
33 (interactive "P") | 33 (interactive "P") |
34 (calc-slow-wrapper | 34 (calc-slow-wrapper |
35 (calc-unary-op "arg" 'calcFunc-arg arg)) | 35 (calc-unary-op "arg" 'calcFunc-arg arg))) |
36 ) | |
37 | 36 |
38 (defun calc-re (arg) | 37 (defun calc-re (arg) |
39 (interactive "P") | 38 (interactive "P") |
40 (calc-slow-wrapper | 39 (calc-slow-wrapper |
41 (calc-unary-op "re" 'calcFunc-re arg)) | 40 (calc-unary-op "re" 'calcFunc-re arg))) |
42 ) | |
43 | 41 |
44 (defun calc-im (arg) | 42 (defun calc-im (arg) |
45 (interactive "P") | 43 (interactive "P") |
46 (calc-slow-wrapper | 44 (calc-slow-wrapper |
47 (calc-unary-op "im" 'calcFunc-im arg)) | 45 (calc-unary-op "im" 'calcFunc-im arg))) |
48 ) | |
49 | 46 |
50 | 47 |
51 (defun calc-polar () | 48 (defun calc-polar () |
52 (interactive) | 49 (interactive) |
53 (calc-slow-wrapper | 50 (calc-slow-wrapper |
54 (let ((arg (calc-top-n 1))) | 51 (let ((arg (calc-top-n 1))) |
55 (if (or (calc-is-inverse) | 52 (if (or (calc-is-inverse) |
56 (eq (car-safe arg) 'polar)) | 53 (eq (car-safe arg) 'polar)) |
57 (calc-enter-result 1 "p-r" (list 'calcFunc-rect arg)) | 54 (calc-enter-result 1 "p-r" (list 'calcFunc-rect arg)) |
58 (calc-enter-result 1 "r-p" (list 'calcFunc-polar arg))))) | 55 (calc-enter-result 1 "r-p" (list 'calcFunc-polar arg)))))) |
59 ) | |
60 | 56 |
61 | 57 |
62 | 58 |
63 | 59 |
64 (defun calc-complex-notation () | 60 (defun calc-complex-notation () |
65 (interactive) | 61 (interactive) |
66 (calc-wrapper | 62 (calc-wrapper |
67 (calc-change-mode 'calc-complex-format nil t) | 63 (calc-change-mode 'calc-complex-format nil t) |
68 (message "Displaying complex numbers in (X,Y) format.")) | 64 (message "Displaying complex numbers in (X,Y) format."))) |
69 ) | |
70 | 65 |
71 (defun calc-i-notation () | 66 (defun calc-i-notation () |
72 (interactive) | 67 (interactive) |
73 (calc-wrapper | 68 (calc-wrapper |
74 (calc-change-mode 'calc-complex-format 'i t) | 69 (calc-change-mode 'calc-complex-format 'i t) |
75 (message "Displaying complex numbers in X+Yi format.")) | 70 (message "Displaying complex numbers in X+Yi format."))) |
76 ) | |
77 | 71 |
78 (defun calc-j-notation () | 72 (defun calc-j-notation () |
79 (interactive) | 73 (interactive) |
80 (calc-wrapper | 74 (calc-wrapper |
81 (calc-change-mode 'calc-complex-format 'j t) | 75 (calc-change-mode 'calc-complex-format 'j t) |
82 (message "Displaying complex numbers in X+Yj format.")) | 76 (message "Displaying complex numbers in X+Yj format."))) |
83 ) | |
84 | 77 |
85 | 78 |
86 (defun calc-polar-mode (n) | 79 (defun calc-polar-mode (n) |
87 (interactive "P") | 80 (interactive "P") |
88 (calc-wrapper | 81 (calc-wrapper |
91 (eq calc-complex-mode 'cplx)) | 84 (eq calc-complex-mode 'cplx)) |
92 (progn | 85 (progn |
93 (calc-change-mode 'calc-complex-mode 'polar) | 86 (calc-change-mode 'calc-complex-mode 'polar) |
94 (message "Preferred complex form is polar.")) | 87 (message "Preferred complex form is polar.")) |
95 (calc-change-mode 'calc-complex-mode 'cplx) | 88 (calc-change-mode 'calc-complex-mode 'cplx) |
96 (message "Preferred complex form is rectangular."))) | 89 (message "Preferred complex form is rectangular.")))) |
97 ) | |
98 | 90 |
99 | 91 |
100 ;;;; Complex numbers. | 92 ;;;; Complex numbers. |
101 | 93 |
102 (defun math-normalize-polar (a) | 94 (defun math-normalize-polar (a) |
111 (equal th 180))) | 103 (equal th 180))) |
112 (math-neg r)) | 104 (math-neg r)) |
113 ((math-negp r) | 105 ((math-negp r) |
114 (math-neg (list 'polar (math-neg r) th))) | 106 (math-neg (list 'polar (math-neg r) th))) |
115 (t | 107 (t |
116 (list 'polar r th)))) | 108 (list 'polar r th))))) |
117 ) | |
118 | 109 |
119 | 110 |
120 ;;; Coerce A to be complex (rectangular form). [c N] | 111 ;;; Coerce A to be complex (rectangular form). [c N] |
121 (defun math-complex (a) | 112 (defun math-complex (a) |
122 (cond ((eq (car-safe a) 'cplx) a) | 113 (cond ((eq (car-safe a) 'cplx) a) |
125 (nth 1 a) | 116 (nth 1 a) |
126 (let ((sc (calcFunc-sincos (nth 2 a)))) | 117 (let ((sc (calcFunc-sincos (nth 2 a)))) |
127 (list 'cplx | 118 (list 'cplx |
128 (math-mul (nth 1 a) (nth 1 sc)) | 119 (math-mul (nth 1 a) (nth 1 sc)) |
129 (math-mul (nth 1 a) (nth 2 sc)))))) | 120 (math-mul (nth 1 a) (nth 2 sc)))))) |
130 (t (list 'cplx a 0))) | 121 (t (list 'cplx a 0)))) |
131 ) | |
132 | 122 |
133 ;;; Coerce A to be complex (polar form). [c N] | 123 ;;; Coerce A to be complex (polar form). [c N] |
134 (defun math-polar (a) | 124 (defun math-polar (a) |
135 (cond ((eq (car-safe a) 'polar) a) | 125 (cond ((eq (car-safe a) 'polar) a) |
136 ((math-zerop a) '(polar 0 0)) | 126 ((math-zerop a) '(polar 0 0)) |
137 (t | 127 (t |
138 (list 'polar | 128 (list 'polar |
139 (math-abs a) | 129 (math-abs a) |
140 (calcFunc-arg a)))) | 130 (calcFunc-arg a))))) |
141 ) | |
142 | 131 |
143 ;;; Multiply A by the imaginary constant i. [N N] [Public] | 132 ;;; Multiply A by the imaginary constant i. [N N] [Public] |
144 (defun math-imaginary (a) | 133 (defun math-imaginary (a) |
145 (if (and (or (Math-objvecp a) (math-infinitep a)) | 134 (if (and (or (Math-objvecp a) (math-infinitep a)) |
146 (not calc-symbolic-mode)) | 135 (not calc-symbolic-mode)) |
148 (if (or (eq (car-safe a) 'polar) | 137 (if (or (eq (car-safe a) 'polar) |
149 (and (not (eq (car-safe a) 'cplx)) | 138 (and (not (eq (car-safe a) 'cplx)) |
150 (eq calc-complex-mode 'polar))) | 139 (eq calc-complex-mode 'polar))) |
151 (list 'polar 1 (math-quarter-circle nil)) | 140 (list 'polar 1 (math-quarter-circle nil)) |
152 '(cplx 0 1))) | 141 '(cplx 0 1))) |
153 (math-mul a '(var i var-i))) | 142 (math-mul a '(var i var-i)))) |
154 ) | |
155 | 143 |
156 | 144 |
157 | 145 |
158 | 146 |
159 (defun math-want-polar (a b) | 147 (defun math-want-polar (a b) |
167 nil)) | 155 nil)) |
168 ((eq (car-safe b) 'polar) | 156 ((eq (car-safe b) 'polar) |
169 t) | 157 t) |
170 ((eq (car-safe b) 'cplx) | 158 ((eq (car-safe b) 'cplx) |
171 nil) | 159 nil) |
172 (t (eq calc-complex-mode 'polar))) | 160 (t (eq calc-complex-mode 'polar)))) |
173 ) | |
174 | 161 |
175 ;;; Force A to be in the (-pi,pi] or (-180,180] range. | 162 ;;; Force A to be in the (-pi,pi] or (-180,180] range. |
176 (defun math-fix-circular (a &optional dir) ; [R R] | 163 (defun math-fix-circular (a &optional dir) ; [R R] |
177 (cond ((eq (car-safe a) 'hms) | 164 (cond ((eq (car-safe a) 'hms) |
178 (cond ((and (Math-lessp 180 (nth 1 a)) (not (eq dir 1))) | 165 (cond ((and (Math-lessp 180 (nth 1 a)) (not (eq dir 1))) |
192 (cond ((and (Math-lessp '(float 18 1) a) (not (eq dir 1))) | 179 (cond ((and (Math-lessp '(float 18 1) a) (not (eq dir 1))) |
193 (math-fix-circular (math-add a '(float -36 1)) -1)) | 180 (math-fix-circular (math-add a '(float -36 1)) -1)) |
194 ((or (Math-lessp '(float -18 1) a) (eq dir -1)) | 181 ((or (Math-lessp '(float -18 1) a) (eq dir -1)) |
195 a) | 182 a) |
196 (t | 183 (t |
197 (math-fix-circular (math-add a '(float 36 1)) 1))))) | 184 (math-fix-circular (math-add a '(float 36 1)) 1)))))) |
198 ) | |
199 | 185 |
200 | 186 |
201 ;;;; Complex numbers. | 187 ;;;; Complex numbers. |
202 | 188 |
203 (defun calcFunc-polar (a) ; [C N] [Public] | 189 (defun calcFunc-polar (a) ; [C N] [Public] |
204 (cond ((Math-vectorp a) | 190 (cond ((Math-vectorp a) |
205 (math-map-vec 'calcFunc-polar a)) | 191 (math-map-vec 'calcFunc-polar a)) |
206 ((Math-realp a) a) | 192 ((Math-realp a) a) |
207 ((Math-numberp a) | 193 ((Math-numberp a) |
208 (math-normalize (math-polar a))) | 194 (math-normalize (math-polar a))) |
209 (t (list 'calcFunc-polar a))) | 195 (t (list 'calcFunc-polar a)))) |
210 ) | |
211 | 196 |
212 (defun calcFunc-rect (a) ; [N N] [Public] | 197 (defun calcFunc-rect (a) ; [N N] [Public] |
213 (cond ((Math-vectorp a) | 198 (cond ((Math-vectorp a) |
214 (math-map-vec 'calcFunc-rect a)) | 199 (math-map-vec 'calcFunc-rect a)) |
215 ((Math-realp a) a) | 200 ((Math-realp a) a) |
216 ((Math-numberp a) | 201 ((Math-numberp a) |
217 (math-normalize (math-complex a))) | 202 (math-normalize (math-complex a))) |
218 (t (list 'calcFunc-rect a))) | 203 (t (list 'calcFunc-rect a)))) |
219 ) | |
220 | 204 |
221 ;;; Compute the complex conjugate of A. [O O] [Public] | 205 ;;; Compute the complex conjugate of A. [O O] [Public] |
222 (defun calcFunc-conj (a) | 206 (defun calcFunc-conj (a) |
223 (let (aa bb) | 207 (let (aa bb) |
224 (cond ((Math-realp a) | 208 (cond ((Math-realp a) |
253 (math-neg (calcFunc-conj (nth 1 a)))) | 237 (math-neg (calcFunc-conj (nth 1 a)))) |
254 ((let ((inf (math-infinitep a))) | 238 ((let ((inf (math-infinitep a))) |
255 (and inf | 239 (and inf |
256 (math-mul (calcFunc-conj (math-infinite-dir a inf)) inf)))) | 240 (math-mul (calcFunc-conj (math-infinite-dir a inf)) inf)))) |
257 (t (calc-record-why 'numberp a) | 241 (t (calc-record-why 'numberp a) |
258 (list 'calcFunc-conj a)))) | 242 (list 'calcFunc-conj a))))) |
259 ) | |
260 | 243 |
261 | 244 |
262 ;;; Compute the complex argument of A. [F N] [Public] | 245 ;;; Compute the complex argument of A. [F N] [Public] |
263 (defun calcFunc-arg (a) | 246 (defun calcFunc-arg (a) |
264 (cond ((Math-anglep a) | 247 (cond ((Math-anglep a) |
282 (if (or (equal a '(var uinf var-uinf)) | 265 (if (or (equal a '(var uinf var-uinf)) |
283 (equal a '(var nan var-nan))) | 266 (equal a '(var nan var-nan))) |
284 '(var nan var-nan) | 267 '(var nan var-nan) |
285 (calcFunc-arg (math-infinite-dir a)))) | 268 (calcFunc-arg (math-infinite-dir a)))) |
286 (t (calc-record-why 'numvecp a) | 269 (t (calc-record-why 'numvecp a) |
287 (list 'calcFunc-arg a))) | 270 (list 'calcFunc-arg a)))) |
288 ) | |
289 | 271 |
290 (defun math-imaginary-i () | 272 (defun math-imaginary-i () |
291 (let ((val (calc-var-value 'var-i))) | 273 (let ((val (calc-var-value 'var-i))) |
292 (or (eq (car-safe val) 'special-const) | 274 (or (eq (car-safe val) 'special-const) |
293 (equal val '(cplx 0 1)) | 275 (equal val '(cplx 0 1)) |
294 (and (eq (car-safe val) 'polar) | 276 (and (eq (car-safe val) 'polar) |
295 (eq (nth 1 val) 0) | 277 (eq (nth 1 val) 0) |
296 (Math-equal (nth 1 val) (math-quarter-circle nil))))) | 278 (Math-equal (nth 1 val) (math-quarter-circle nil)))))) |
297 ) | |
298 | 279 |
299 ;;; Extract the real or complex part of a complex number. [R N] [Public] | 280 ;;; Extract the real or complex part of a complex number. [R N] [Public] |
300 ;;; Also extracts the real part of a modulo form. | 281 ;;; Also extracts the real part of a modulo form. |
301 (defun calcFunc-re (a) | 282 (defun calcFunc-re (a) |
302 (let (aa bb) | 283 (let (aa bb) |
330 (math-known-realp (nth 2 a))) | 311 (math-known-realp (nth 2 a))) |
331 (math-div (calcFunc-re (nth 1 a)) (nth 2 a))) | 312 (math-div (calcFunc-re (nth 1 a)) (nth 2 a))) |
332 ((eq (car a) 'neg) | 313 ((eq (car a) 'neg) |
333 (math-neg (calcFunc-re (nth 1 a)))) | 314 (math-neg (calcFunc-re (nth 1 a)))) |
334 (t (calc-record-why 'numberp a) | 315 (t (calc-record-why 'numberp a) |
335 (list 'calcFunc-re a)))) | 316 (list 'calcFunc-re a))))) |
336 ) | |
337 | 317 |
338 (defun calcFunc-im (a) | 318 (defun calcFunc-im (a) |
339 (let (aa bb) | 319 (let (aa bb) |
340 (cond ((Math-realp a) | 320 (cond ((Math-realp a) |
341 (if (math-floatp a) '(float 0 0) 0)) | 321 (if (math-floatp a) '(float 0 0) 0)) |
368 (math-known-realp (nth 2 a))) | 348 (math-known-realp (nth 2 a))) |
369 (math-div (calcFunc-im (nth 1 a)) (nth 2 a))) | 349 (math-div (calcFunc-im (nth 1 a)) (nth 2 a))) |
370 ((eq (car a) 'neg) | 350 ((eq (car a) 'neg) |
371 (math-neg (calcFunc-im (nth 1 a)))) | 351 (math-neg (calcFunc-im (nth 1 a)))) |
372 (t (calc-record-why 'numberp a) | 352 (t (calc-record-why 'numberp a) |
373 (list 'calcFunc-im a)))) | 353 (list 'calcFunc-im a))))) |
374 ) | 354 |
375 | 355 ;;; calc-cplx.el ends here |
376 | |
377 |