1 |
;; Calculator for GNU Emacs, part II [calc-cplx.el] |
;; Calculator for GNU Emacs, part II [calc-cplx.el] |
2 |
;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc. |
;; Copyright (C) 1990, 1991, 1992, 1993, 2001 Free Software Foundation, Inc. |
3 |
;; Written by Dave Gillespie, daveg@synaptics.com. |
;; Written by Dave Gillespie, daveg@synaptics.com. |
4 |
|
|
5 |
;; This file is part of GNU Emacs. |
;; This file is part of GNU Emacs. |
32 |
(defun calc-argument (arg) |
(defun calc-argument (arg) |
33 |
(interactive "P") |
(interactive "P") |
34 |
(calc-slow-wrapper |
(calc-slow-wrapper |
35 |
(calc-unary-op "arg" 'calcFunc-arg arg)) |
(calc-unary-op "arg" 'calcFunc-arg arg))) |
|
) |
|
36 |
|
|
37 |
(defun calc-re (arg) |
(defun calc-re (arg) |
38 |
(interactive "P") |
(interactive "P") |
39 |
(calc-slow-wrapper |
(calc-slow-wrapper |
40 |
(calc-unary-op "re" 'calcFunc-re arg)) |
(calc-unary-op "re" 'calcFunc-re arg))) |
|
) |
|
41 |
|
|
42 |
(defun calc-im (arg) |
(defun calc-im (arg) |
43 |
(interactive "P") |
(interactive "P") |
44 |
(calc-slow-wrapper |
(calc-slow-wrapper |
45 |
(calc-unary-op "im" 'calcFunc-im arg)) |
(calc-unary-op "im" 'calcFunc-im arg))) |
|
) |
|
46 |
|
|
47 |
|
|
48 |
(defun calc-polar () |
(defun calc-polar () |
52 |
(if (or (calc-is-inverse) |
(if (or (calc-is-inverse) |
53 |
(eq (car-safe arg) 'polar)) |
(eq (car-safe arg) 'polar)) |
54 |
(calc-enter-result 1 "p-r" (list 'calcFunc-rect arg)) |
(calc-enter-result 1 "p-r" (list 'calcFunc-rect arg)) |
55 |
(calc-enter-result 1 "r-p" (list 'calcFunc-polar arg))))) |
(calc-enter-result 1 "r-p" (list 'calcFunc-polar arg)))))) |
|
) |
|
56 |
|
|
57 |
|
|
58 |
|
|
61 |
(interactive) |
(interactive) |
62 |
(calc-wrapper |
(calc-wrapper |
63 |
(calc-change-mode 'calc-complex-format nil t) |
(calc-change-mode 'calc-complex-format nil t) |
64 |
(message "Displaying complex numbers in (X,Y) format.")) |
(message "Displaying complex numbers in (X,Y) format."))) |
|
) |
|
65 |
|
|
66 |
(defun calc-i-notation () |
(defun calc-i-notation () |
67 |
(interactive) |
(interactive) |
68 |
(calc-wrapper |
(calc-wrapper |
69 |
(calc-change-mode 'calc-complex-format 'i t) |
(calc-change-mode 'calc-complex-format 'i t) |
70 |
(message "Displaying complex numbers in X+Yi format.")) |
(message "Displaying complex numbers in X+Yi format."))) |
|
) |
|
71 |
|
|
72 |
(defun calc-j-notation () |
(defun calc-j-notation () |
73 |
(interactive) |
(interactive) |
74 |
(calc-wrapper |
(calc-wrapper |
75 |
(calc-change-mode 'calc-complex-format 'j t) |
(calc-change-mode 'calc-complex-format 'j t) |
76 |
(message "Displaying complex numbers in X+Yj format.")) |
(message "Displaying complex numbers in X+Yj format."))) |
|
) |
|
77 |
|
|
78 |
|
|
79 |
(defun calc-polar-mode (n) |
(defun calc-polar-mode (n) |
86 |
(calc-change-mode 'calc-complex-mode 'polar) |
(calc-change-mode 'calc-complex-mode 'polar) |
87 |
(message "Preferred complex form is polar.")) |
(message "Preferred complex form is polar.")) |
88 |
(calc-change-mode 'calc-complex-mode 'cplx) |
(calc-change-mode 'calc-complex-mode 'cplx) |
89 |
(message "Preferred complex form is rectangular."))) |
(message "Preferred complex form is rectangular.")))) |
|
) |
|
90 |
|
|
91 |
|
|
92 |
;;;; Complex numbers. |
;;;; Complex numbers. |
105 |
((math-negp r) |
((math-negp r) |
106 |
(math-neg (list 'polar (math-neg r) th))) |
(math-neg (list 'polar (math-neg r) th))) |
107 |
(t |
(t |
108 |
(list 'polar r th)))) |
(list 'polar r th))))) |
|
) |
|
109 |
|
|
110 |
|
|
111 |
;;; Coerce A to be complex (rectangular form). [c N] |
;;; Coerce A to be complex (rectangular form). [c N] |
118 |
(list 'cplx |
(list 'cplx |
119 |
(math-mul (nth 1 a) (nth 1 sc)) |
(math-mul (nth 1 a) (nth 1 sc)) |
120 |
(math-mul (nth 1 a) (nth 2 sc)))))) |
(math-mul (nth 1 a) (nth 2 sc)))))) |
121 |
(t (list 'cplx a 0))) |
(t (list 'cplx a 0)))) |
|
) |
|
122 |
|
|
123 |
;;; Coerce A to be complex (polar form). [c N] |
;;; Coerce A to be complex (polar form). [c N] |
124 |
(defun math-polar (a) |
(defun math-polar (a) |
127 |
(t |
(t |
128 |
(list 'polar |
(list 'polar |
129 |
(math-abs a) |
(math-abs a) |
130 |
(calcFunc-arg a)))) |
(calcFunc-arg a))))) |
|
) |
|
131 |
|
|
132 |
;;; Multiply A by the imaginary constant i. [N N] [Public] |
;;; Multiply A by the imaginary constant i. [N N] [Public] |
133 |
(defun math-imaginary (a) |
(defun math-imaginary (a) |
139 |
(eq calc-complex-mode 'polar))) |
(eq calc-complex-mode 'polar))) |
140 |
(list 'polar 1 (math-quarter-circle nil)) |
(list 'polar 1 (math-quarter-circle nil)) |
141 |
'(cplx 0 1))) |
'(cplx 0 1))) |
142 |
(math-mul a '(var i var-i))) |
(math-mul a '(var i var-i)))) |
|
) |
|
143 |
|
|
144 |
|
|
145 |
|
|
157 |
t) |
t) |
158 |
((eq (car-safe b) 'cplx) |
((eq (car-safe b) 'cplx) |
159 |
nil) |
nil) |
160 |
(t (eq calc-complex-mode 'polar))) |
(t (eq calc-complex-mode 'polar)))) |
|
) |
|
161 |
|
|
162 |
;;; Force A to be in the (-pi,pi] or (-180,180] range. |
;;; Force A to be in the (-pi,pi] or (-180,180] range. |
163 |
(defun math-fix-circular (a &optional dir) ; [R R] |
(defun math-fix-circular (a &optional dir) ; [R R] |
181 |
((or (Math-lessp '(float -18 1) a) (eq dir -1)) |
((or (Math-lessp '(float -18 1) a) (eq dir -1)) |
182 |
a) |
a) |
183 |
(t |
(t |
184 |
(math-fix-circular (math-add a '(float 36 1)) 1))))) |
(math-fix-circular (math-add a '(float 36 1)) 1)))))) |
|
) |
|
185 |
|
|
186 |
|
|
187 |
;;;; Complex numbers. |
;;;; Complex numbers. |
192 |
((Math-realp a) a) |
((Math-realp a) a) |
193 |
((Math-numberp a) |
((Math-numberp a) |
194 |
(math-normalize (math-polar a))) |
(math-normalize (math-polar a))) |
195 |
(t (list 'calcFunc-polar a))) |
(t (list 'calcFunc-polar a)))) |
|
) |
|
196 |
|
|
197 |
(defun calcFunc-rect (a) ; [N N] [Public] |
(defun calcFunc-rect (a) ; [N N] [Public] |
198 |
(cond ((Math-vectorp a) |
(cond ((Math-vectorp a) |
200 |
((Math-realp a) a) |
((Math-realp a) a) |
201 |
((Math-numberp a) |
((Math-numberp a) |
202 |
(math-normalize (math-complex a))) |
(math-normalize (math-complex a))) |
203 |
(t (list 'calcFunc-rect a))) |
(t (list 'calcFunc-rect a)))) |
|
) |
|
204 |
|
|
205 |
;;; Compute the complex conjugate of A. [O O] [Public] |
;;; Compute the complex conjugate of A. [O O] [Public] |
206 |
(defun calcFunc-conj (a) |
(defun calcFunc-conj (a) |
239 |
(and inf |
(and inf |
240 |
(math-mul (calcFunc-conj (math-infinite-dir a inf)) inf)))) |
(math-mul (calcFunc-conj (math-infinite-dir a inf)) inf)))) |
241 |
(t (calc-record-why 'numberp a) |
(t (calc-record-why 'numberp a) |
242 |
(list 'calcFunc-conj a)))) |
(list 'calcFunc-conj a))))) |
|
) |
|
243 |
|
|
244 |
|
|
245 |
;;; Compute the complex argument of A. [F N] [Public] |
;;; Compute the complex argument of A. [F N] [Public] |
267 |
'(var nan var-nan) |
'(var nan var-nan) |
268 |
(calcFunc-arg (math-infinite-dir a)))) |
(calcFunc-arg (math-infinite-dir a)))) |
269 |
(t (calc-record-why 'numvecp a) |
(t (calc-record-why 'numvecp a) |
270 |
(list 'calcFunc-arg a))) |
(list 'calcFunc-arg a)))) |
|
) |
|
271 |
|
|
272 |
(defun math-imaginary-i () |
(defun math-imaginary-i () |
273 |
(let ((val (calc-var-value 'var-i))) |
(let ((val (calc-var-value 'var-i))) |
275 |
(equal val '(cplx 0 1)) |
(equal val '(cplx 0 1)) |
276 |
(and (eq (car-safe val) 'polar) |
(and (eq (car-safe val) 'polar) |
277 |
(eq (nth 1 val) 0) |
(eq (nth 1 val) 0) |
278 |
(Math-equal (nth 1 val) (math-quarter-circle nil))))) |
(Math-equal (nth 1 val) (math-quarter-circle nil)))))) |
|
) |
|
279 |
|
|
280 |
;;; Extract the real or complex part of a complex number. [R N] [Public] |
;;; Extract the real or complex part of a complex number. [R N] [Public] |
281 |
;;; Also extracts the real part of a modulo form. |
;;; Also extracts the real part of a modulo form. |
313 |
((eq (car a) 'neg) |
((eq (car a) 'neg) |
314 |
(math-neg (calcFunc-re (nth 1 a)))) |
(math-neg (calcFunc-re (nth 1 a)))) |
315 |
(t (calc-record-why 'numberp a) |
(t (calc-record-why 'numberp a) |
316 |
(list 'calcFunc-re a)))) |
(list 'calcFunc-re a))))) |
|
) |
|
317 |
|
|
318 |
(defun calcFunc-im (a) |
(defun calcFunc-im (a) |
319 |
(let (aa bb) |
(let (aa bb) |
350 |
((eq (car a) 'neg) |
((eq (car a) 'neg) |
351 |
(math-neg (calcFunc-im (nth 1 a)))) |
(math-neg (calcFunc-im (nth 1 a)))) |
352 |
(t (calc-record-why 'numberp a) |
(t (calc-record-why 'numberp a) |
353 |
(list 'calcFunc-im a)))) |
(list 'calcFunc-im a))))) |
|
) |
|
|
|
|
|
|
|
354 |
|
|
355 |
|
;;; calc-cplx.el ends here |