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. |
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) |
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) |
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) |
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) |
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) |
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. |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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) |
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 |
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)) |
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 |
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) |
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) |
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) |
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 |