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

Diff of /emacs/lisp/calc/calc-fin.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:03:52 2001 UTC
# Line 1  Line 1 
1  ;; Calculator for GNU Emacs, part II [calc-fin.el]  ;; Calculator for GNU Emacs, part II [calc-fin.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 38  Line 38 
38         (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3)))         (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3)))
39       (if (calc-is-inverse)       (if (calc-is-inverse)
40           (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3)))           (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3)))
41         (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3))))))         (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3)))))))
 )  
42    
43  (defun calc-fin-npv (arg)  (defun calc-fin-npv (arg)
44    (interactive "p")    (interactive "p")
45    (calc-slow-wrapper    (calc-slow-wrapper
46     (if (calc-is-inverse)     (if (calc-is-inverse)
47         (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg))         (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg))
48       (calc-vector-op "npv" 'calcFunc-npv (1+ arg))))       (calc-vector-op "npv" 'calcFunc-npv (1+ arg)))))
 )  
49    
50  (defun calc-fin-fv ()  (defun calc-fin-fv ()
51    (interactive)    (interactive)
# Line 56  Line 54 
54         (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))         (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
55       (if (calc-is-inverse)       (if (calc-is-inverse)
56           (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3)))           (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3)))
57         (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3))))))         (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3)))))))
 )  
58    
59  (defun calc-fin-pmt ()  (defun calc-fin-pmt ()
60    (interactive)    (interactive)
# Line 66  Line 63 
63         (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))         (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3)))
64       (if (calc-is-inverse)       (if (calc-is-inverse)
65           (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3)))           (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3)))
66         (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3))))))         (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3)))))))
 )  
67    
68  (defun calc-fin-nper ()  (defun calc-fin-nper ()
69    (interactive)    (interactive)
# Line 78  Line 74 
74           (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb           (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb
75                                             (calc-top-list-n 3)))                                             (calc-top-list-n 3)))
76         (calc-enter-result 3 "nper" (cons 'calcFunc-nper         (calc-enter-result 3 "nper" (cons 'calcFunc-nper
77                                           (calc-top-list-n 3))))))                                           (calc-top-list-n 3)))))))
 )  
78    
79  (defun calc-fin-rate ()  (defun calc-fin-rate ()
80    (interactive)    (interactive)
# Line 92  Line 87 
87                             (cons (if (calc-is-hyperbolic) 'calcFunc-ratel                             (cons (if (calc-is-hyperbolic) 'calcFunc-ratel
88                                     (if (calc-is-hyperbolic) 'calcFunc-rateb                                     (if (calc-is-hyperbolic) 'calcFunc-rateb
89                                       'calcFunc-rate))                                       'calcFunc-rate))
90                                   (calc-top-list-n 3))))))                                   (calc-top-list-n 3)))))))
 )  
91    
92  (defun calc-fin-irr (arg)  (defun calc-fin-irr (arg)
93    (interactive "P")    (interactive "P")
94    (calc-slow-wrapper    (calc-slow-wrapper
95     (if (calc-is-inverse)     (if (calc-is-inverse)
96         (calc-vector-op "irrb" 'calcFunc-irrb arg)         (calc-vector-op "irrb" 'calcFunc-irrb arg)
97       (calc-vector-op "irr" 'calcFunc-irr arg)))       (calc-vector-op "irr" 'calcFunc-irr arg))))
 )  
98    
99  (defun calc-fin-sln ()  (defun calc-fin-sln ()
100    (interactive)    (interactive)
101    (calc-slow-wrapper    (calc-slow-wrapper
102     (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3))))     (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3)))))
 )  
103    
104  (defun calc-fin-syd ()  (defun calc-fin-syd ()
105    (interactive)    (interactive)
106    (calc-slow-wrapper    (calc-slow-wrapper
107     (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4))))     (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4)))))
 )  
108    
109  (defun calc-fin-ddb ()  (defun calc-fin-ddb ()
110    (interactive)    (interactive)
111    (calc-slow-wrapper    (calc-slow-wrapper
112     (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4))))     (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4)))))
 )  
113    
114    
115  (defun calc-to-percentage (x)  (defun calc-to-percentage (x)
# Line 130  Line 120 
120           (list 'calcFunc-percent x))           (list 'calcFunc-percent x))
121          ((Math-vectorp x)          ((Math-vectorp x)
122           (cons 'vec (mapcar 'calc-to-percentage (cdr x))))           (cons 'vec (mapcar 'calc-to-percentage (cdr x))))
123          (t x))          (t x)))
 )  
124    
125  (defun calc-convert-percent ()  (defun calc-convert-percent ()
126    (interactive)    (interactive)
127    (calc-slow-wrapper    (calc-slow-wrapper
128     (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1))))     (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1)))))
 )  
129    
130  (defun calc-percent-change ()  (defun calc-percent-change ()
131    (interactive)    (interactive)
132    (calc-slow-wrapper    (calc-slow-wrapper
133     (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2)))))     (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2)))))
134       (calc-pop-push-record 2 "%ch" (calc-to-percentage res))))       (calc-pop-push-record 2 "%ch" (calc-to-percentage res)))))
 )  
   
   
   
135    
136    
137  ;;; Financial functions.  ;;; Financial functions.
# Line 159  Line 143 
143        (math-add (math-mul amount        (math-add (math-mul amount
144                            (math-div (math-sub 1 (math-div 1 p))                            (math-div (math-sub 1 (math-div 1 p))
145                                      rate))                                      rate))
146                  (math-div (or lump 0) p))))                  (math-div (or lump 0) p)))))
 )  
147  (put 'calcFunc-pv 'math-expandable t)  (put 'calcFunc-pv 'math-expandable t)
148    
149  (defun calcFunc-pvl (rate num amount)  (defun calcFunc-pvl (rate num amount)
150    (calcFunc-pv rate num 0 amount)    (calcFunc-pv rate num 0 amount))
 )  
151  (put 'calcFunc-pvl 'math-expandable t)  (put 'calcFunc-pvl 'math-expandable t)
152    
153  (defun calcFunc-pvb (rate num amount &optional lump)  (defun calcFunc-pvb (rate num amount &optional lump)
# Line 176  Line 158 
158                            (math-div (math-mul (math-sub 1 (math-div 1 p))                            (math-div (math-mul (math-sub 1 (math-div 1 p))
159                                                (math-add 1 rate))                                                (math-add 1 rate))
160                                      rate))                                      rate))
161                  (math-div (or lump 0) p))))                  (math-div (or lump 0) p)))))
 )  
162  (put 'calcFunc-pvb 'math-expandable t)  (put 'calcFunc-pvb 'math-expandable t)
163    
164  (defun calcFunc-npv (rate &rest flows)  (defun calcFunc-npv (rate &rest flows)
# Line 190  Line 171 
171        (while (setq flat (cdr flat))        (while (setq flat (cdr flat))
172          (setq accum (math-add accum (math-div (car flat) p))          (setq accum (math-add accum (math-div (car flat) p))
173                p (math-mul p pp)))                p (math-mul p pp)))
174        accum))        accum)))
 )  
175  (put 'calcFunc-npv 'math-expandable t)  (put 'calcFunc-npv 'math-expandable t)
176    
177  (defun calcFunc-npvb (rate &rest flows)  (defun calcFunc-npvb (rate &rest flows)
# Line 204  Line 184 
184        (while (setq flat (cdr flat))        (while (setq flat (cdr flat))
185          (setq accum (math-add accum (math-div (car flat) p))          (setq accum (math-add accum (math-div (car flat) p))
186                p (math-mul p pp)))                p (math-mul p pp)))
187        accum))        accum)))
 )  
188  (put 'calcFunc-npvb 'math-expandable t)  (put 'calcFunc-npvb 'math-expandable t)
189    
190  (defun calcFunc-fv (rate num amount &optional initial)  (defun calcFunc-fv (rate num amount &optional initial)
# Line 215  Line 194 
194        (math-add (math-mul amount        (math-add (math-mul amount
195                            (math-div (math-sub p 1)                            (math-div (math-sub p 1)
196                                      rate))                                      rate))
197                  (math-mul (or initial 0) p))))                  (math-mul (or initial 0) p)))))
 )  
198  (put 'calcFunc-fv 'math-expandable t)  (put 'calcFunc-fv 'math-expandable t)
199    
200  (defun calcFunc-fvl (rate num amount)  (defun calcFunc-fvl (rate num amount)
201    (calcFunc-fv rate num 0 amount)    (calcFunc-fv rate num 0 amount))
 )  
202  (put 'calcFunc-fvl 'math-expandable t)  (put 'calcFunc-fvl 'math-expandable t)
203    
204  (defun calcFunc-fvb (rate num amount &optional initial)  (defun calcFunc-fvb (rate num amount &optional initial)
# Line 232  Line 209 
209                            (math-div (math-mul (math-sub p 1)                            (math-div (math-mul (math-sub p 1)
210                                                (math-add 1 rate))                                                (math-add 1 rate))
211                                      rate))                                      rate))
212                  (math-mul (or initial 0) p))))                  (math-mul (or initial 0) p)))))
 )  
213  (put 'calcFunc-fvb 'math-expandable t)  (put 'calcFunc-fvb 'math-expandable t)
214    
215  (defun calcFunc-pmt (rate num amount &optional lump)  (defun calcFunc-pmt (rate num amount &optional lump)
# Line 243  Line 219 
219        (math-div (math-mul (math-sub amount        (math-div (math-mul (math-sub amount
220                                      (math-div (or lump 0) p))                                      (math-div (or lump 0) p))
221                            rate)                            rate)
222                  (math-sub 1 (math-div 1 p)))))                  (math-sub 1 (math-div 1 p))))))
 )  
223  (put 'calcFunc-pmt 'math-expandable t)  (put 'calcFunc-pmt 'math-expandable t)
224    
225  (defun calcFunc-pmtb (rate num amount &optional lump)  (defun calcFunc-pmtb (rate num amount &optional lump)
# Line 253  Line 228 
228      (let ((p (math-pow (math-add 1 rate) num)))      (let ((p (math-pow (math-add 1 rate) num)))
229        (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate)        (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate)
230                  (math-mul (math-sub 1 (math-div 1 p))                  (math-mul (math-sub 1 (math-div 1 p))
231                            (math-add 1 rate)))))                            (math-add 1 rate))))))
 )  
232  (put 'calcFunc-pmtb 'math-expandable t)  (put 'calcFunc-pmtb 'math-expandable t)
233    
234  (defun calcFunc-nper (rate pmt amount &optional lump)  (defun calcFunc-nper (rate pmt amount &optional lump)
235    (math-compute-nper rate pmt amount lump nil)    (math-compute-nper rate pmt amount lump nil))
 )  
236  (put 'calcFunc-nper 'math-expandable t)  (put 'calcFunc-nper 'math-expandable t)
237    
238  (defun calcFunc-nperb (rate pmt amount &optional lump)  (defun calcFunc-nperb (rate pmt amount &optional lump)
239    (math-compute-nper rate pmt amount lump 'b)    (math-compute-nper rate pmt amount lump 'b))
 )  
240  (put 'calcFunc-nperb 'math-expandable t)  (put 'calcFunc-nperb 'math-expandable t)
241    
242  (defun calcFunc-nperl (rate pmt amount)  (defun calcFunc-nperl (rate pmt amount)
243    (math-compute-nper rate pmt amount nil 'l)    (math-compute-nper rate pmt amount nil 'l))
 )  
244  (put 'calcFunc-nperl 'math-expandable t)  (put 'calcFunc-nperl 'math-expandable t)
245    
246  (defun math-compute-nper (rate pmt amount lump bflag)  (defun math-compute-nper (rate pmt amount lump bflag)
# Line 315  Line 286 
286                                              pmt))))))                                              pmt))))))
287          (if (or (math-posp temp) math-expand-formulas)          (if (or (math-posp temp) math-expand-formulas)
288              (math-neg (calcFunc-log temp (math-add 1 rate)))              (math-neg (calcFunc-log temp (math-add 1 rate)))
289            (math-reject-arg pmt "*Payment too small to cover interest rate")))))            (math-reject-arg pmt "*Payment too small to cover interest rate"))))))
 )  
290    
291  (defun calcFunc-rate (num pmt amount &optional lump)  (defun calcFunc-rate (num pmt amount &optional lump)
292    (math-compute-rate num pmt amount lump 'calcFunc-pv)    (math-compute-rate num pmt amount lump 'calcFunc-pv))
 )  
293    
294  (defun calcFunc-rateb (num pmt amount &optional lump)  (defun calcFunc-rateb (num pmt amount &optional lump)
295    (math-compute-rate num pmt amount lump 'calcFunc-pvb)    (math-compute-rate num pmt amount lump 'calcFunc-pvb))
 )  
296    
297  (defun math-compute-rate (num pmt amount lump func)  (defun math-compute-rate (num pmt amount lump func)
298    (or (math-objectp num)    (or (math-objectp num)
# Line 348  Line 316 
316                                t)))                                t)))
317      (if (math-vectorp root)      (if (math-vectorp root)
318          (nth 1 root)          (nth 1 root)
319        root))        root)))
 )  
320    
321  (defun calcFunc-ratel (num pmt amount)  (defun calcFunc-ratel (num pmt amount)
322    (or (math-objectp num) math-expand-formulas    (or (math-objectp num) math-expand-formulas
# Line 359  Line 326 
326    (or (math-objectp amount) math-expand-formulas    (or (math-objectp amount) math-expand-formulas
327        (math-reject-arg amount 'numberp))        (math-reject-arg amount 'numberp))
328    (math-with-extra-prec 2    (math-with-extra-prec 2
329      (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1))      (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1)))
 )  
330    
331  (defun calcFunc-irr (&rest vecs)  (defun calcFunc-irr (&rest vecs)
332    (math-compute-irr vecs 'calcFunc-npv)    (math-compute-irr vecs 'calcFunc-npv))
 )  
333    
334  (defun calcFunc-irrb (&rest vecs)  (defun calcFunc-irrb (&rest vecs)
335    (math-compute-irr vecs 'calcFunc-npvb)    (math-compute-irr vecs 'calcFunc-npvb))
 )  
336    
337  (defun math-compute-irr (vecs func)  (defun math-compute-irr (vecs func)
338    (let* ((flat (math-flatten-many-vecs vecs))    (let* ((flat (math-flatten-many-vecs vecs))
# Line 380  Line 344 
344                                 t)))                                 t)))
345      (if (math-vectorp root)      (if (math-vectorp root)
346          (nth 1 root)          (nth 1 root)
347        root))        root)))
 )  
348    
349  (defun math-check-financial (rate num)  (defun math-check-financial (rate num)
350    (or (math-objectp rate) math-expand-formulas    (or (math-objectp rate) math-expand-formulas
# Line 389  Line 352 
352    (and (math-zerop rate)    (and (math-zerop rate)
353         (math-reject-arg rate 'nonzerop))         (math-reject-arg rate 'nonzerop))
354    (or (math-objectp num) math-expand-formulas    (or (math-objectp num) math-expand-formulas
355        (math-reject-arg num 'numberp))        (math-reject-arg num 'numberp)))
 )  
356    
357    
358  (defun calcFunc-sln (cost salvage life &optional period)  (defun calcFunc-sln (cost salvage life &optional period)
# Line 406  Line 368 
368                 (or (Math-lessp life period) (not (math-posp period)))                 (or (Math-lessp life period) (not (math-posp period)))
369               (math-reject-arg period 'integerp)))               (math-reject-arg period 'integerp)))
370        0        0
371      (math-div (math-sub cost salvage) life))      (math-div (math-sub cost salvage) life)))
 )  
372  (put 'calcFunc-sln 'math-expandable t)  (put 'calcFunc-sln 'math-expandable t)
373    
374  (defun calcFunc-syd (cost salvage life period)  (defun calcFunc-syd (cost salvage life period)
# Line 424  Line 385 
385        0        0
386      (math-div (math-mul (math-sub cost salvage)      (math-div (math-mul (math-sub cost salvage)
387                          (math-add (math-sub life period) 1))                          (math-add (math-sub life period) 1))
388                (math-div (math-mul life (math-add life 1)) 2)))                (math-div (math-mul life (math-add life 1)) 2))))
 )  
389  (put 'calcFunc-syd 'math-expandable t)  (put 'calcFunc-syd 'math-expandable t)
390    
391  (defun calcFunc-ddb (cost salvage life period)  (defun calcFunc-ddb (cost salvage life period)
# Line 445  Line 405 
405          (if (Math-lessp book salvage)          (if (Math-lessp book salvage)
406              (setq res (math-add res (math-sub book salvage))              (setq res (math-add res (math-sub book salvage))
407                    book salvage)))                    book salvage)))
408        res))        res)))
 )  
   
   
409    
410    ;;; calc-fin.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