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

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

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

revision 1.1 by eliz, Tue Nov 6 18:59:06 2001 UTC revision 1.2 by walters, Wed Nov 14 09:02:37 2001 UTC
# Line 1  Line 1 
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.
# Line 32  Line 32 
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 ()
# Line 55  Line 52 
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    
# Line 65  Line 61 
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)
# Line 93  Line 86 
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.
# Line 113  Line 105 
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]
# Line 127  Line 118 
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)
# Line 137  Line 127 
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)
# Line 150  Line 139 
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    
# Line 169  Line 157 
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]
# Line 194  Line 181 
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.
# Line 206  Line 192 
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)
# Line 215  Line 200 
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)
# Line 255  Line 239 
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]
# Line 284  Line 267 
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)))
# Line 293  Line 275 
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.
# Line 332  Line 313 
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)
# Line 370  Line 350 
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

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

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