Mercurial > emacs
annotate lisp/calc/calc-fin.el @ 96215:ad9760e68890
(Todo): Update.
author | Dan Nicolaescu <dann@ics.uci.edu> |
---|---|
date | Tue, 24 Jun 2008 03:24:38 +0000 |
parents | 6c9af2bfcfee |
children | a9dc0e7c3f2b |
rev | line source |
---|---|
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
1 ;;; calc-fin.el --- financial functions for Calc |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
2 |
64325
1db49616ce05
Update copyright information.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
62442
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001, 2002, 2003, 2004, |
79702 | 4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
5 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
6 ;; Author: David Gillespie <daveg@synaptics.com> |
77465
1154f082efd9
Update maintainer's address.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
76595
diff
changeset
|
7 ;; Maintainer: Jay Belanger <jay.p.belanger@gmail.com> |
40785 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
12 ;; it under the terms of the GNU General Public License as published by |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
40785 | 15 |
76595
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
16 ;; GNU Emacs is distributed in the hope that it will be useful, |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
19 ;; GNU General Public License for more details. |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
20 |
497d17a80bb8
Change form of license text to match rest of Emacs.
Glenn Morris <rgm@gnu.org>
parents:
75346
diff
changeset
|
21 ;; You should have received a copy of the GNU General Public License |
94654
6c9af2bfcfee
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
40785 | 23 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
24 ;;; Commentary: |
40785 | 25 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
26 ;;; Code: |
40785 | 27 |
28 ;; This file is autoloaded from calc-ext.el. | |
58653
1fd405160ceb
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
29 |
40785 | 30 (require 'calc-ext) |
31 (require 'calc-macs) | |
32 | |
33 ;;; Financial functions. | |
34 | |
35 (defun calc-fin-pv () | |
36 (interactive) | |
37 (calc-slow-wrapper | |
38 (if (calc-is-hyperbolic) | |
39 (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3))) | |
40 (if (calc-is-inverse) | |
41 (calc-enter-result 3 "pvb" (cons 'calcFunc-pvb (calc-top-list-n 3))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
42 (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3))))))) |
40785 | 43 |
44 (defun calc-fin-npv (arg) | |
45 (interactive "p") | |
46 (calc-slow-wrapper | |
47 (if (calc-is-inverse) | |
48 (calc-vector-op "npvb" 'calcFunc-npvb (1+ arg)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
49 (calc-vector-op "npv" 'calcFunc-npv (1+ arg))))) |
40785 | 50 |
51 (defun calc-fin-fv () | |
52 (interactive) | |
53 (calc-slow-wrapper | |
54 (if (calc-is-hyperbolic) | |
55 (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) | |
56 (if (calc-is-inverse) | |
57 (calc-enter-result 3 "fvb" (cons 'calcFunc-fvb (calc-top-list-n 3))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
58 (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3))))))) |
40785 | 59 |
60 (defun calc-fin-pmt () | |
61 (interactive) | |
62 (calc-slow-wrapper | |
63 (if (calc-is-hyperbolic) | |
64 (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) | |
65 (if (calc-is-inverse) | |
66 (calc-enter-result 3 "pmtb" (cons 'calcFunc-pmtb (calc-top-list-n 3))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
67 (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3))))))) |
40785 | 68 |
69 (defun calc-fin-nper () | |
70 (interactive) | |
71 (calc-slow-wrapper | |
72 (if (calc-is-hyperbolic) | |
73 (calc-enter-result 3 "nprl" (cons 'calcFunc-nperl (calc-top-list-n 3))) | |
74 (if (calc-is-inverse) | |
75 (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb | |
76 (calc-top-list-n 3))) | |
77 (calc-enter-result 3 "nper" (cons 'calcFunc-nper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
78 (calc-top-list-n 3))))))) |
40785 | 79 |
80 (defun calc-fin-rate () | |
81 (interactive) | |
82 (calc-slow-wrapper | |
83 (calc-pop-push-record 3 | |
84 (if (calc-is-hyperbolic) "ratl" | |
85 (if (calc-is-inverse) "ratb" "rate")) | |
86 (calc-to-percentage | |
87 (calc-normalize | |
88 (cons (if (calc-is-hyperbolic) 'calcFunc-ratel | |
89 (if (calc-is-hyperbolic) 'calcFunc-rateb | |
90 'calcFunc-rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
91 (calc-top-list-n 3))))))) |
40785 | 92 |
93 (defun calc-fin-irr (arg) | |
94 (interactive "P") | |
95 (calc-slow-wrapper | |
96 (if (calc-is-inverse) | |
97 (calc-vector-op "irrb" 'calcFunc-irrb arg) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
98 (calc-vector-op "irr" 'calcFunc-irr arg)))) |
40785 | 99 |
100 (defun calc-fin-sln () | |
101 (interactive) | |
102 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
103 (calc-enter-result 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3))))) |
40785 | 104 |
105 (defun calc-fin-syd () | |
106 (interactive) | |
107 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
108 (calc-enter-result 4 "syd" (cons 'calcFunc-syd (calc-top-list-n 4))))) |
40785 | 109 |
110 (defun calc-fin-ddb () | |
111 (interactive) | |
112 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
113 (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4))))) |
40785 | 114 |
115 | |
116 (defun calc-to-percentage (x) | |
117 (cond ((Math-objectp x) | |
118 (setq x (math-mul x 100)) | |
119 (if (Math-num-integerp x) | |
120 (setq x (math-trunc x))) | |
121 (list 'calcFunc-percent x)) | |
122 ((Math-vectorp x) | |
123 (cons 'vec (mapcar 'calc-to-percentage (cdr x)))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
124 (t x))) |
40785 | 125 |
126 (defun calc-convert-percent () | |
127 (interactive) | |
128 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
129 (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1))))) |
40785 | 130 |
131 (defun calc-percent-change () | |
132 (interactive) | |
133 (calc-slow-wrapper | |
134 (let ((res (calc-normalize (cons 'calcFunc-relch (calc-top-list 2))))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
135 (calc-pop-push-record 2 "%ch" (calc-to-percentage res))))) |
40785 | 136 |
137 | |
138 ;;; Financial functions. | |
139 | |
140 (defun calcFunc-pv (rate num amount &optional lump) | |
141 (math-check-financial rate num) | |
142 (math-with-extra-prec 2 | |
143 (let ((p (math-pow (math-add 1 rate) num))) | |
144 (math-add (math-mul amount | |
145 (math-div (math-sub 1 (math-div 1 p)) | |
146 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
147 (math-div (or lump 0) p))))) |
40785 | 148 (put 'calcFunc-pv 'math-expandable t) |
149 | |
150 (defun calcFunc-pvl (rate num amount) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
151 (calcFunc-pv rate num 0 amount)) |
40785 | 152 (put 'calcFunc-pvl 'math-expandable t) |
153 | |
154 (defun calcFunc-pvb (rate num amount &optional lump) | |
155 (math-check-financial rate num) | |
156 (math-with-extra-prec 2 | |
157 (let* ((p (math-pow (math-add 1 rate) num))) | |
158 (math-add (math-mul amount | |
159 (math-div (math-mul (math-sub 1 (math-div 1 p)) | |
160 (math-add 1 rate)) | |
161 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
162 (math-div (or lump 0) p))))) |
40785 | 163 (put 'calcFunc-pvb 'math-expandable t) |
164 | |
165 (defun calcFunc-npv (rate &rest flows) | |
166 (math-check-financial rate 1) | |
167 (math-with-extra-prec 2 | |
168 (let* ((flat (math-flatten-many-vecs flows)) | |
169 (pp (math-add 1 rate)) | |
170 (p pp) | |
171 (accum 0)) | |
172 (while (setq flat (cdr flat)) | |
173 (setq accum (math-add accum (math-div (car flat) p)) | |
174 p (math-mul p pp))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
175 accum))) |
40785 | 176 (put 'calcFunc-npv 'math-expandable t) |
177 | |
178 (defun calcFunc-npvb (rate &rest flows) | |
179 (math-check-financial rate 1) | |
180 (math-with-extra-prec 2 | |
181 (let* ((flat (math-flatten-many-vecs flows)) | |
182 (pp (math-add 1 rate)) | |
183 (p 1) | |
184 (accum 0)) | |
185 (while (setq flat (cdr flat)) | |
186 (setq accum (math-add accum (math-div (car flat) p)) | |
187 p (math-mul p pp))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
188 accum))) |
40785 | 189 (put 'calcFunc-npvb 'math-expandable t) |
190 | |
191 (defun calcFunc-fv (rate num amount &optional initial) | |
192 (math-check-financial rate num) | |
193 (math-with-extra-prec 2 | |
194 (let ((p (math-pow (math-add 1 rate) num))) | |
195 (math-add (math-mul amount | |
196 (math-div (math-sub p 1) | |
197 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
198 (math-mul (or initial 0) p))))) |
40785 | 199 (put 'calcFunc-fv 'math-expandable t) |
200 | |
201 (defun calcFunc-fvl (rate num amount) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
202 (calcFunc-fv rate num 0 amount)) |
40785 | 203 (put 'calcFunc-fvl 'math-expandable t) |
204 | |
205 (defun calcFunc-fvb (rate num amount &optional initial) | |
206 (math-check-financial rate num) | |
207 (math-with-extra-prec 2 | |
208 (let ((p (math-pow (math-add 1 rate) num))) | |
209 (math-add (math-mul amount | |
210 (math-div (math-mul (math-sub p 1) | |
211 (math-add 1 rate)) | |
212 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
213 (math-mul (or initial 0) p))))) |
40785 | 214 (put 'calcFunc-fvb 'math-expandable t) |
215 | |
216 (defun calcFunc-pmt (rate num amount &optional lump) | |
217 (math-check-financial rate num) | |
218 (math-with-extra-prec 2 | |
219 (let ((p (math-pow (math-add 1 rate) num))) | |
220 (math-div (math-mul (math-sub amount | |
221 (math-div (or lump 0) p)) | |
222 rate) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
223 (math-sub 1 (math-div 1 p)))))) |
40785 | 224 (put 'calcFunc-pmt 'math-expandable t) |
225 | |
226 (defun calcFunc-pmtb (rate num amount &optional lump) | |
227 (math-check-financial rate num) | |
228 (math-with-extra-prec 2 | |
229 (let ((p (math-pow (math-add 1 rate) num))) | |
230 (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate) | |
231 (math-mul (math-sub 1 (math-div 1 p)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
232 (math-add 1 rate)))))) |
40785 | 233 (put 'calcFunc-pmtb 'math-expandable t) |
234 | |
235 (defun calcFunc-nper (rate pmt amount &optional lump) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
236 (math-compute-nper rate pmt amount lump nil)) |
40785 | 237 (put 'calcFunc-nper 'math-expandable t) |
238 | |
239 (defun calcFunc-nperb (rate pmt amount &optional lump) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
240 (math-compute-nper rate pmt amount lump 'b)) |
40785 | 241 (put 'calcFunc-nperb 'math-expandable t) |
242 | |
243 (defun calcFunc-nperl (rate pmt amount) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
244 (math-compute-nper rate pmt amount nil 'l)) |
40785 | 245 (put 'calcFunc-nperl 'math-expandable t) |
246 | |
247 (defun math-compute-nper (rate pmt amount lump bflag) | |
248 (and lump (math-zerop lump) | |
249 (setq lump nil)) | |
250 (and lump (math-zerop pmt) | |
251 (setq amount lump | |
252 lump nil | |
253 bflag 'l)) | |
254 (or (math-objectp rate) (and math-expand-formulas (null lump)) | |
255 (math-reject-arg rate 'numberp)) | |
256 (and (math-zerop rate) | |
257 (math-reject-arg rate 'nonzerop)) | |
258 (or (math-objectp pmt) (and math-expand-formulas (null lump)) | |
259 (math-reject-arg pmt 'numberp)) | |
260 (or (math-objectp amount) (and math-expand-formulas (null lump)) | |
261 (math-reject-arg amount 'numberp)) | |
262 (if lump | |
263 (progn | |
264 (or (math-objectp lump) | |
265 (math-reject-arg lump 'numberp)) | |
266 (let ((root (math-find-root (list 'calcFunc-eq | |
267 (list (if bflag | |
268 'calcFunc-pvb | |
269 'calcFunc-pv) | |
270 rate | |
271 '(var DUMMY var-DUMMY) | |
272 pmt | |
273 lump) | |
274 amount) | |
275 '(var DUMMY var-DUMMY) | |
276 '(intv 3 0 100) | |
277 t))) | |
278 (if (math-vectorp root) | |
279 (nth 1 root) | |
280 root))) | |
281 (math-with-extra-prec 2 | |
282 (let ((temp (if (eq bflag 'l) | |
283 (math-div amount pmt) | |
284 (math-sub 1 (math-div (math-mul amount rate) | |
285 (if bflag | |
286 (math-mul pmt (math-add 1 rate)) | |
287 pmt)))))) | |
288 (if (or (math-posp temp) math-expand-formulas) | |
289 (math-neg (calcFunc-log temp (math-add 1 rate))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
290 (math-reject-arg pmt "*Payment too small to cover interest rate")))))) |
40785 | 291 |
292 (defun calcFunc-rate (num pmt amount &optional lump) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
293 (math-compute-rate num pmt amount lump 'calcFunc-pv)) |
40785 | 294 |
295 (defun calcFunc-rateb (num pmt amount &optional lump) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
296 (math-compute-rate num pmt amount lump 'calcFunc-pvb)) |
40785 | 297 |
298 (defun math-compute-rate (num pmt amount lump func) | |
299 (or (math-objectp num) | |
300 (math-reject-arg num 'numberp)) | |
301 (or (math-objectp pmt) | |
302 (math-reject-arg pmt 'numberp)) | |
303 (or (math-objectp amount) | |
304 (math-reject-arg amount 'numberp)) | |
305 (or (null lump) | |
306 (math-objectp lump) | |
307 (math-reject-arg lump 'numberp)) | |
308 (let ((root (math-find-root (list 'calcFunc-eq | |
309 (list func | |
310 '(var DUMMY var-DUMMY) | |
311 num | |
312 pmt | |
313 (or lump 0)) | |
314 amount) | |
315 '(var DUMMY var-DUMMY) | |
316 '(intv 3 (float 1 -4) 1) | |
317 t))) | |
318 (if (math-vectorp root) | |
319 (nth 1 root) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
320 root))) |
40785 | 321 |
322 (defun calcFunc-ratel (num pmt amount) | |
323 (or (math-objectp num) math-expand-formulas | |
324 (math-reject-arg num 'numberp)) | |
325 (or (math-objectp pmt) math-expand-formulas | |
326 (math-reject-arg pmt 'numberp)) | |
327 (or (math-objectp amount) math-expand-formulas | |
328 (math-reject-arg amount 'numberp)) | |
329 (math-with-extra-prec 2 | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
330 (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1))) |
40785 | 331 |
332 (defun calcFunc-irr (&rest vecs) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
333 (math-compute-irr vecs 'calcFunc-npv)) |
40785 | 334 |
335 (defun calcFunc-irrb (&rest vecs) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
336 (math-compute-irr vecs 'calcFunc-npvb)) |
40785 | 337 |
338 (defun math-compute-irr (vecs func) | |
339 (let* ((flat (math-flatten-many-vecs vecs)) | |
340 (root (math-find-root (list func | |
341 '(var DUMMY var-DUMMY) | |
342 flat) | |
343 '(var DUMMY var-DUMMY) | |
344 '(intv 3 (float 1 -4) 1) | |
345 t))) | |
346 (if (math-vectorp root) | |
347 (nth 1 root) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
348 root))) |
40785 | 349 |
350 (defun math-check-financial (rate num) | |
351 (or (math-objectp rate) math-expand-formulas | |
352 (math-reject-arg rate 'numberp)) | |
353 (and (math-zerop rate) | |
354 (math-reject-arg rate 'nonzerop)) | |
355 (or (math-objectp num) math-expand-formulas | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
356 (math-reject-arg num 'numberp))) |
40785 | 357 |
358 | |
359 (defun calcFunc-sln (cost salvage life &optional period) | |
360 (or (math-realp cost) math-expand-formulas | |
361 (math-reject-arg cost 'realp)) | |
362 (or (math-realp salvage) math-expand-formulas | |
363 (math-reject-arg salvage 'realp)) | |
364 (or (math-realp life) math-expand-formulas | |
365 (math-reject-arg life 'realp)) | |
366 (if (math-zerop life) (math-reject-arg life 'nonzerop)) | |
367 (if (and period | |
368 (if (math-num-integerp period) | |
369 (or (Math-lessp life period) (not (math-posp period))) | |
370 (math-reject-arg period 'integerp))) | |
371 0 | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
372 (math-div (math-sub cost salvage) life))) |
40785 | 373 (put 'calcFunc-sln 'math-expandable t) |
374 | |
375 (defun calcFunc-syd (cost salvage life period) | |
376 (or (math-realp cost) math-expand-formulas | |
377 (math-reject-arg cost 'realp)) | |
378 (or (math-realp salvage) math-expand-formulas | |
379 (math-reject-arg salvage 'realp)) | |
380 (or (math-realp life) math-expand-formulas | |
381 (math-reject-arg life 'realp)) | |
382 (if (math-zerop life) (math-reject-arg life 'nonzerop)) | |
383 (or (math-realp period) math-expand-formulas | |
384 (math-reject-arg period 'realp)) | |
385 (if (or (Math-lessp life period) (not (math-posp period))) | |
386 0 | |
387 (math-div (math-mul (math-sub cost salvage) | |
388 (math-add (math-sub life period) 1)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
389 (math-div (math-mul life (math-add life 1)) 2)))) |
40785 | 390 (put 'calcFunc-syd 'math-expandable t) |
391 | |
392 (defun calcFunc-ddb (cost salvage life period) | |
393 (if (math-messy-integerp period) (setq period (math-trunc period))) | |
394 (or (integerp period) (math-reject-arg period 'fixnump)) | |
395 (or (math-realp cost) (math-reject-arg cost 'realp)) | |
396 (or (math-realp salvage) (math-reject-arg salvage 'realp)) | |
397 (or (math-realp life) (math-reject-arg life 'realp)) | |
398 (if (math-zerop life) (math-reject-arg life 'nonzerop)) | |
399 (if (or (Math-lessp life period) (<= period 0)) | |
400 0 | |
401 (let ((book cost) | |
402 (res 0)) | |
403 (while (>= (setq period (1- period)) 0) | |
404 (setq res (math-div (math-mul book 2) life) | |
405 book (math-sub book res)) | |
406 (if (Math-lessp book salvage) | |
407 (setq res (math-add res (math-sub book salvage)) | |
408 book salvage))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
409 res))) |
40785 | 410 |
58653
1fd405160ceb
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
411 (provide 'calc-fin) |
1fd405160ceb
Add a provide statement.
Jay Belanger <jay.p.belanger@gmail.com>
parents:
52401
diff
changeset
|
412 |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79702
diff
changeset
|
413 ;; arch-tag: 82f30ca8-d02f-4b33-84b4-bb6ecd84597b |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
414 ;;; calc-fin.el ends here |