Mercurial > emacs
annotate lisp/calc/calc-fin.el @ 57026:992d9837a265
(vc-arch-state): Fix parsing for `names' method.
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 08 Sep 2004 22:15:34 +0000 |
parents | 695cf19ef79e |
children | 1fd405160ceb 375f2633d815 |
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 |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
3 ;; Copyright (C) 1990, 1991, 1992, 1993, 2001 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
|
4 |
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
5 ;; Author: David Gillespie <daveg@synaptics.com> |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49263
diff
changeset
|
6 ;; Maintainers: D. Goel <deego@gnufans.org> |
49263
f4d68f97221e
Add new maintainer (deego).
Deepak Goel <deego@gnufans.org>
parents:
41271
diff
changeset
|
7 ;; Colin Walters <walters@debian.org> |
40785 | 8 |
9 ;; This file is part of GNU Emacs. | |
10 | |
11 ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 ;; but WITHOUT ANY WARRANTY. No author or distributor | |
13 ;; accepts responsibility to anyone for the consequences of using it | |
14 ;; or for whether it serves any particular purpose or works at all, | |
15 ;; unless he says so in writing. Refer to the GNU Emacs General Public | |
16 ;; License for full details. | |
17 | |
18 ;; Everyone is granted permission to copy, modify and redistribute | |
19 ;; GNU Emacs, but only under the conditions described in the | |
20 ;; GNU Emacs General Public License. A copy of this license is | |
21 ;; supposed to have been given to you along with GNU Emacs so you | |
22 ;; can know your rights and responsibilities. It should be in a | |
23 ;; file named COPYING. Among other things, the copyright notice | |
24 ;; and this notice must be preserved on all copies. | |
25 | |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
26 ;;; Commentary: |
40785 | 27 |
41271
fcd507927105
Change all toplevel `setq' forms to `defvar' forms, and move them
Colin Walters <walters@gnu.org>
parents:
41047
diff
changeset
|
28 ;;; Code: |
40785 | 29 |
30 ;; This file is autoloaded from calc-ext.el. | |
31 (require 'calc-ext) | |
32 | |
33 (require 'calc-macs) | |
34 | |
35 (defun calc-Need-calc-fin () nil) | |
36 | |
37 | |
38 ;;; Financial functions. | |
39 | |
40 (defun calc-fin-pv () | |
41 (interactive) | |
42 (calc-slow-wrapper | |
43 (if (calc-is-hyperbolic) | |
44 (calc-enter-result 3 "pvl" (cons 'calcFunc-pvl (calc-top-list-n 3))) | |
45 (if (calc-is-inverse) | |
46 (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
|
47 (calc-enter-result 3 "pv" (cons 'calcFunc-pv (calc-top-list-n 3))))))) |
40785 | 48 |
49 (defun calc-fin-npv (arg) | |
50 (interactive "p") | |
51 (calc-slow-wrapper | |
52 (if (calc-is-inverse) | |
53 (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
|
54 (calc-vector-op "npv" 'calcFunc-npv (1+ arg))))) |
40785 | 55 |
56 (defun calc-fin-fv () | |
57 (interactive) | |
58 (calc-slow-wrapper | |
59 (if (calc-is-hyperbolic) | |
60 (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) | |
61 (if (calc-is-inverse) | |
62 (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
|
63 (calc-enter-result 3 "fv" (cons 'calcFunc-fv (calc-top-list-n 3))))))) |
40785 | 64 |
65 (defun calc-fin-pmt () | |
66 (interactive) | |
67 (calc-slow-wrapper | |
68 (if (calc-is-hyperbolic) | |
69 (calc-enter-result 3 "fvl" (cons 'calcFunc-fvl (calc-top-list-n 3))) | |
70 (if (calc-is-inverse) | |
71 (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
|
72 (calc-enter-result 3 "pmt" (cons 'calcFunc-pmt (calc-top-list-n 3))))))) |
40785 | 73 |
74 (defun calc-fin-nper () | |
75 (interactive) | |
76 (calc-slow-wrapper | |
77 (if (calc-is-hyperbolic) | |
78 (calc-enter-result 3 "nprl" (cons 'calcFunc-nperl (calc-top-list-n 3))) | |
79 (if (calc-is-inverse) | |
80 (calc-enter-result 3 "nprb" (cons 'calcFunc-nperb | |
81 (calc-top-list-n 3))) | |
82 (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
|
83 (calc-top-list-n 3))))))) |
40785 | 84 |
85 (defun calc-fin-rate () | |
86 (interactive) | |
87 (calc-slow-wrapper | |
88 (calc-pop-push-record 3 | |
89 (if (calc-is-hyperbolic) "ratl" | |
90 (if (calc-is-inverse) "ratb" "rate")) | |
91 (calc-to-percentage | |
92 (calc-normalize | |
93 (cons (if (calc-is-hyperbolic) 'calcFunc-ratel | |
94 (if (calc-is-hyperbolic) 'calcFunc-rateb | |
95 'calcFunc-rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
96 (calc-top-list-n 3))))))) |
40785 | 97 |
98 (defun calc-fin-irr (arg) | |
99 (interactive "P") | |
100 (calc-slow-wrapper | |
101 (if (calc-is-inverse) | |
102 (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
|
103 (calc-vector-op "irr" 'calcFunc-irr arg)))) |
40785 | 104 |
105 (defun calc-fin-sln () | |
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 3 "sln" (cons 'calcFunc-sln (calc-top-list-n 3))))) |
40785 | 109 |
110 (defun calc-fin-syd () | |
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 "syd" (cons 'calcFunc-syd (calc-top-list-n 4))))) |
40785 | 114 |
115 (defun calc-fin-ddb () | |
116 (interactive) | |
117 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
118 (calc-enter-result 4 "ddb" (cons 'calcFunc-ddb (calc-top-list-n 4))))) |
40785 | 119 |
120 | |
121 (defun calc-to-percentage (x) | |
122 (cond ((Math-objectp x) | |
123 (setq x (math-mul x 100)) | |
124 (if (Math-num-integerp x) | |
125 (setq x (math-trunc x))) | |
126 (list 'calcFunc-percent x)) | |
127 ((Math-vectorp x) | |
128 (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
|
129 (t x))) |
40785 | 130 |
131 (defun calc-convert-percent () | |
132 (interactive) | |
133 (calc-slow-wrapper | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
134 (calc-pop-push-record 1 "c%" (calc-to-percentage (calc-top-n 1))))) |
40785 | 135 |
136 (defun calc-percent-change () | |
137 (interactive) | |
138 (calc-slow-wrapper | |
139 (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
|
140 (calc-pop-push-record 2 "%ch" (calc-to-percentage res))))) |
40785 | 141 |
142 | |
143 ;;; Financial functions. | |
144 | |
145 (defun calcFunc-pv (rate num amount &optional lump) | |
146 (math-check-financial rate num) | |
147 (math-with-extra-prec 2 | |
148 (let ((p (math-pow (math-add 1 rate) num))) | |
149 (math-add (math-mul amount | |
150 (math-div (math-sub 1 (math-div 1 p)) | |
151 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
152 (math-div (or lump 0) p))))) |
40785 | 153 (put 'calcFunc-pv 'math-expandable t) |
154 | |
155 (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
|
156 (calcFunc-pv rate num 0 amount)) |
40785 | 157 (put 'calcFunc-pvl 'math-expandable t) |
158 | |
159 (defun calcFunc-pvb (rate num amount &optional lump) | |
160 (math-check-financial rate num) | |
161 (math-with-extra-prec 2 | |
162 (let* ((p (math-pow (math-add 1 rate) num))) | |
163 (math-add (math-mul amount | |
164 (math-div (math-mul (math-sub 1 (math-div 1 p)) | |
165 (math-add 1 rate)) | |
166 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
167 (math-div (or lump 0) p))))) |
40785 | 168 (put 'calcFunc-pvb 'math-expandable t) |
169 | |
170 (defun calcFunc-npv (rate &rest flows) | |
171 (math-check-financial rate 1) | |
172 (math-with-extra-prec 2 | |
173 (let* ((flat (math-flatten-many-vecs flows)) | |
174 (pp (math-add 1 rate)) | |
175 (p pp) | |
176 (accum 0)) | |
177 (while (setq flat (cdr flat)) | |
178 (setq accum (math-add accum (math-div (car flat) p)) | |
179 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
|
180 accum))) |
40785 | 181 (put 'calcFunc-npv 'math-expandable t) |
182 | |
183 (defun calcFunc-npvb (rate &rest flows) | |
184 (math-check-financial rate 1) | |
185 (math-with-extra-prec 2 | |
186 (let* ((flat (math-flatten-many-vecs flows)) | |
187 (pp (math-add 1 rate)) | |
188 (p 1) | |
189 (accum 0)) | |
190 (while (setq flat (cdr flat)) | |
191 (setq accum (math-add accum (math-div (car flat) p)) | |
192 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
|
193 accum))) |
40785 | 194 (put 'calcFunc-npvb 'math-expandable t) |
195 | |
196 (defun calcFunc-fv (rate num amount &optional initial) | |
197 (math-check-financial rate num) | |
198 (math-with-extra-prec 2 | |
199 (let ((p (math-pow (math-add 1 rate) num))) | |
200 (math-add (math-mul amount | |
201 (math-div (math-sub p 1) | |
202 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
203 (math-mul (or initial 0) p))))) |
40785 | 204 (put 'calcFunc-fv 'math-expandable t) |
205 | |
206 (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
|
207 (calcFunc-fv rate num 0 amount)) |
40785 | 208 (put 'calcFunc-fvl 'math-expandable t) |
209 | |
210 (defun calcFunc-fvb (rate num amount &optional initial) | |
211 (math-check-financial rate num) | |
212 (math-with-extra-prec 2 | |
213 (let ((p (math-pow (math-add 1 rate) num))) | |
214 (math-add (math-mul amount | |
215 (math-div (math-mul (math-sub p 1) | |
216 (math-add 1 rate)) | |
217 rate)) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
218 (math-mul (or initial 0) p))))) |
40785 | 219 (put 'calcFunc-fvb 'math-expandable t) |
220 | |
221 (defun calcFunc-pmt (rate num amount &optional lump) | |
222 (math-check-financial rate num) | |
223 (math-with-extra-prec 2 | |
224 (let ((p (math-pow (math-add 1 rate) num))) | |
225 (math-div (math-mul (math-sub amount | |
226 (math-div (or lump 0) p)) | |
227 rate) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
228 (math-sub 1 (math-div 1 p)))))) |
40785 | 229 (put 'calcFunc-pmt 'math-expandable t) |
230 | |
231 (defun calcFunc-pmtb (rate num amount &optional lump) | |
232 (math-check-financial rate num) | |
233 (math-with-extra-prec 2 | |
234 (let ((p (math-pow (math-add 1 rate) num))) | |
235 (math-div (math-mul (math-sub amount (math-div (or lump 0) p)) rate) | |
236 (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
|
237 (math-add 1 rate)))))) |
40785 | 238 (put 'calcFunc-pmtb 'math-expandable t) |
239 | |
240 (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
|
241 (math-compute-nper rate pmt amount lump nil)) |
40785 | 242 (put 'calcFunc-nper 'math-expandable t) |
243 | |
244 (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
|
245 (math-compute-nper rate pmt amount lump 'b)) |
40785 | 246 (put 'calcFunc-nperb 'math-expandable t) |
247 | |
248 (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
|
249 (math-compute-nper rate pmt amount nil 'l)) |
40785 | 250 (put 'calcFunc-nperl 'math-expandable t) |
251 | |
252 (defun math-compute-nper (rate pmt amount lump bflag) | |
253 (and lump (math-zerop lump) | |
254 (setq lump nil)) | |
255 (and lump (math-zerop pmt) | |
256 (setq amount lump | |
257 lump nil | |
258 bflag 'l)) | |
259 (or (math-objectp rate) (and math-expand-formulas (null lump)) | |
260 (math-reject-arg rate 'numberp)) | |
261 (and (math-zerop rate) | |
262 (math-reject-arg rate 'nonzerop)) | |
263 (or (math-objectp pmt) (and math-expand-formulas (null lump)) | |
264 (math-reject-arg pmt 'numberp)) | |
265 (or (math-objectp amount) (and math-expand-formulas (null lump)) | |
266 (math-reject-arg amount 'numberp)) | |
267 (if lump | |
268 (progn | |
269 (or (math-objectp lump) | |
270 (math-reject-arg lump 'numberp)) | |
271 (let ((root (math-find-root (list 'calcFunc-eq | |
272 (list (if bflag | |
273 'calcFunc-pvb | |
274 'calcFunc-pv) | |
275 rate | |
276 '(var DUMMY var-DUMMY) | |
277 pmt | |
278 lump) | |
279 amount) | |
280 '(var DUMMY var-DUMMY) | |
281 '(intv 3 0 100) | |
282 t))) | |
283 (if (math-vectorp root) | |
284 (nth 1 root) | |
285 root))) | |
286 (math-with-extra-prec 2 | |
287 (let ((temp (if (eq bflag 'l) | |
288 (math-div amount pmt) | |
289 (math-sub 1 (math-div (math-mul amount rate) | |
290 (if bflag | |
291 (math-mul pmt (math-add 1 rate)) | |
292 pmt)))))) | |
293 (if (or (math-posp temp) math-expand-formulas) | |
294 (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
|
295 (math-reject-arg pmt "*Payment too small to cover interest rate")))))) |
40785 | 296 |
297 (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
|
298 (math-compute-rate num pmt amount lump 'calcFunc-pv)) |
40785 | 299 |
300 (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
|
301 (math-compute-rate num pmt amount lump 'calcFunc-pvb)) |
40785 | 302 |
303 (defun math-compute-rate (num pmt amount lump func) | |
304 (or (math-objectp num) | |
305 (math-reject-arg num 'numberp)) | |
306 (or (math-objectp pmt) | |
307 (math-reject-arg pmt 'numberp)) | |
308 (or (math-objectp amount) | |
309 (math-reject-arg amount 'numberp)) | |
310 (or (null lump) | |
311 (math-objectp lump) | |
312 (math-reject-arg lump 'numberp)) | |
313 (let ((root (math-find-root (list 'calcFunc-eq | |
314 (list func | |
315 '(var DUMMY var-DUMMY) | |
316 num | |
317 pmt | |
318 (or lump 0)) | |
319 amount) | |
320 '(var DUMMY var-DUMMY) | |
321 '(intv 3 (float 1 -4) 1) | |
322 t))) | |
323 (if (math-vectorp root) | |
324 (nth 1 root) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
325 root))) |
40785 | 326 |
327 (defun calcFunc-ratel (num pmt amount) | |
328 (or (math-objectp num) math-expand-formulas | |
329 (math-reject-arg num 'numberp)) | |
330 (or (math-objectp pmt) math-expand-formulas | |
331 (math-reject-arg pmt 'numberp)) | |
332 (or (math-objectp amount) math-expand-formulas | |
333 (math-reject-arg amount 'numberp)) | |
334 (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
|
335 (math-sub (math-pow (math-div pmt amount) (math-div 1 num)) 1))) |
40785 | 336 |
337 (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
|
338 (math-compute-irr vecs 'calcFunc-npv)) |
40785 | 339 |
340 (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
|
341 (math-compute-irr vecs 'calcFunc-npvb)) |
40785 | 342 |
343 (defun math-compute-irr (vecs func) | |
344 (let* ((flat (math-flatten-many-vecs vecs)) | |
345 (root (math-find-root (list func | |
346 '(var DUMMY var-DUMMY) | |
347 flat) | |
348 '(var DUMMY var-DUMMY) | |
349 '(intv 3 (float 1 -4) 1) | |
350 t))) | |
351 (if (math-vectorp root) | |
352 (nth 1 root) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
353 root))) |
40785 | 354 |
355 (defun math-check-financial (rate num) | |
356 (or (math-objectp rate) math-expand-formulas | |
357 (math-reject-arg rate 'numberp)) | |
358 (and (math-zerop rate) | |
359 (math-reject-arg rate 'nonzerop)) | |
360 (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
|
361 (math-reject-arg num 'numberp))) |
40785 | 362 |
363 | |
364 (defun calcFunc-sln (cost salvage life &optional period) | |
365 (or (math-realp cost) math-expand-formulas | |
366 (math-reject-arg cost 'realp)) | |
367 (or (math-realp salvage) math-expand-formulas | |
368 (math-reject-arg salvage 'realp)) | |
369 (or (math-realp life) math-expand-formulas | |
370 (math-reject-arg life 'realp)) | |
371 (if (math-zerop life) (math-reject-arg life 'nonzerop)) | |
372 (if (and period | |
373 (if (math-num-integerp period) | |
374 (or (Math-lessp life period) (not (math-posp period))) | |
375 (math-reject-arg period 'integerp))) | |
376 0 | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
377 (math-div (math-sub cost salvage) life))) |
40785 | 378 (put 'calcFunc-sln 'math-expandable t) |
379 | |
380 (defun calcFunc-syd (cost salvage life period) | |
381 (or (math-realp cost) math-expand-formulas | |
382 (math-reject-arg cost 'realp)) | |
383 (or (math-realp salvage) math-expand-formulas | |
384 (math-reject-arg salvage 'realp)) | |
385 (or (math-realp life) math-expand-formulas | |
386 (math-reject-arg life 'realp)) | |
387 (if (math-zerop life) (math-reject-arg life 'nonzerop)) | |
388 (or (math-realp period) math-expand-formulas | |
389 (math-reject-arg period 'realp)) | |
390 (if (or (Math-lessp life period) (not (math-posp period))) | |
391 0 | |
392 (math-div (math-mul (math-sub cost salvage) | |
393 (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
|
394 (math-div (math-mul life (math-add life 1)) 2)))) |
40785 | 395 (put 'calcFunc-syd 'math-expandable t) |
396 | |
397 (defun calcFunc-ddb (cost salvage life period) | |
398 (if (math-messy-integerp period) (setq period (math-trunc period))) | |
399 (or (integerp period) (math-reject-arg period 'fixnump)) | |
400 (or (math-realp cost) (math-reject-arg cost 'realp)) | |
401 (or (math-realp salvage) (math-reject-arg salvage 'realp)) | |
402 (or (math-realp life) (math-reject-arg life 'realp)) | |
403 (if (math-zerop life) (math-reject-arg life 'nonzerop)) | |
404 (if (or (Math-lessp life period) (<= period 0)) | |
405 0 | |
406 (let ((book cost) | |
407 (res 0)) | |
408 (while (>= (setq period (1- period)) 0) | |
409 (setq res (math-div (math-mul book 2) life) | |
410 book (math-sub book res)) | |
411 (if (Math-lessp book salvage) | |
412 (setq res (math-add res (math-sub book salvage)) | |
413 book salvage))) | |
41047
73f364fd8aaa
Style cleanup; don't put closing parens on their
Colin Walters <walters@gnu.org>
parents:
40785
diff
changeset
|
414 res))) |
40785 | 415 |
52401 | 416 ;;; 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
|
417 ;;; calc-fin.el ends here |