1 |
// Upgraded to Delphi 2009: Sebastian Zierer
|
2 |
|
3 |
(* ***** BEGIN LICENSE BLOCK *****
|
4 |
* Version: MPL 1.1
|
5 |
*
|
6 |
* The contents of this file are subject to the Mozilla Public License Version
|
7 |
* 1.1 (the "License"); you may not use this file except in compliance with
|
8 |
* the License. You may obtain a copy of the License at
|
9 |
* http://www.mozilla.org/MPL/
|
10 |
*
|
11 |
* Software distributed under the License is distributed on an "AS IS" basis,
|
12 |
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
13 |
* for the specific language governing rights and limitations under the
|
14 |
* License.
|
15 |
*
|
16 |
* The Original Code is TurboPower SysTools
|
17 |
*
|
18 |
* The Initial Developer of the Original Code is
|
19 |
* TurboPower Software
|
20 |
*
|
21 |
* Portions created by the Initial Developer are Copyright (C) 1996-2002
|
22 |
* the Initial Developer. All Rights Reserved.
|
23 |
*
|
24 |
* Contributor(s):
|
25 |
*
|
26 |
* ***** END LICENSE BLOCK ***** *)
|
27 |
|
28 |
{*********************************************************}
|
29 |
{* SysTools: StFIN.pas 4.04 *}
|
30 |
{*********************************************************}
|
31 |
{* SysTools: Financial math functions modeled on *}
|
32 |
{* those in Excel *}
|
33 |
{*********************************************************}
|
34 |
|
35 |
{$I StDefine.inc}
|
36 |
|
37 |
unit StFIN;
|
38 |
|
39 |
interface
|
40 |
|
41 |
uses
|
42 |
Windows,
|
43 |
{$IFDEF UseMathUnit}
|
44 |
Math,
|
45 |
{$ELSE}
|
46 |
StMath,
|
47 |
{$ENDIF}
|
48 |
SysUtils,
|
49 |
StBase,
|
50 |
StConst,
|
51 |
StDate;
|
52 |
|
53 |
type
|
54 |
TStPaymentTime = (ptEndOfPeriod, ptStartOfPeriod);
|
55 |
TStFrequency = (fqAnnual, fqSemiAnnual, fqQuarterly, fqMonthly);
|
56 |
TStBasis = (BasisNASD, {US (NASD) 30/360}
|
57 |
BasisActAct, {Actual/actual}
|
58 |
BasisAct360, {Actual/360}
|
59 |
BasisAct365, {Actual/365}
|
60 |
BasisEur30360); {European 30/360}
|
61 |
|
62 |
TStDateArray = array[0..(StMaxBlockSize div SizeOf(TStDate))-1] of TStDate;
|
63 |
|
64 |
|
65 |
const
|
66 |
StDelta : Extended = 0.00001; {delta for difference equations}
|
67 |
StEpsilon : Extended = 0.00001; {epsilon for difference equations}
|
68 |
StMaxIterations : Integer = 100; {max attempts for convergence}
|
69 |
|
70 |
|
71 |
function AccruedInterestMaturity(Issue, Maturity : TStDate;
|
72 |
Rate, Par : Extended;
|
73 |
Basis : TStBasis) : Extended;
|
74 |
{-Returns the accrued interest for a security that pays interest at maturity}
|
75 |
|
76 |
function AccruedInterestPeriodic(Issue, Settlement, Maturity : TStDate;
|
77 |
Rate, Par : Extended;
|
78 |
Frequency : TStFrequency;
|
79 |
Basis : TStBasis) : Extended;
|
80 |
{-Returns the accrued interest for a security that pays periodic interest}
|
81 |
|
82 |
function BondDuration(Settlement, Maturity : TStDate;
|
83 |
Rate, Yield : Extended;
|
84 |
Frequency : TStFrequency;
|
85 |
Basis : TStBasis) : Extended;
|
86 |
{-Returns the Macauley duration for an assumed par value of $100}
|
87 |
|
88 |
function BondPrice(Settlement, Maturity : TStDate;
|
89 |
Rate, Yield, Redemption : Extended;
|
90 |
Frequency : TStFrequency;
|
91 |
Basis : TStBasis) : Extended;
|
92 |
{-Returns the "clean" bond price per $100 face value of a security}
|
93 |
|
94 |
function CumulativeInterest(Rate : Extended;
|
95 |
NPeriods : Integer;
|
96 |
PV : Extended;
|
97 |
StartPeriod, EndPeriod : Integer;
|
98 |
Frequency : TStFrequency;
|
99 |
Timing : TStPaymentTime) : Extended;
|
100 |
{-Returns the cumulative interest paid on a loan in specified periods}
|
101 |
|
102 |
function CumulativePrincipal(Rate : Extended;
|
103 |
NPeriods : Integer;
|
104 |
PV : Extended;
|
105 |
StartPeriod, EndPeriod : Integer;
|
106 |
Frequency : TStFrequency;
|
107 |
Timing : TStPaymentTime) : Extended;
|
108 |
{-Returns the cumulative principal paid on a loan in specified periods}
|
109 |
|
110 |
function DayCount(Day1, Day2 : TStDate; Basis : TStBasis) : LongInt;
|
111 |
{-Returns the number of days from Day1 to Day2 according to day count basis}
|
112 |
|
113 |
function DecliningBalance(Cost, Salvage : Extended;
|
114 |
Life, Period, Month : Integer) : Extended;
|
115 |
{-Fixed rate declining balance depreciation}
|
116 |
|
117 |
function DiscountRate(Settlement, Maturity : TStDate;
|
118 |
Price, Redemption : Extended;
|
119 |
Basis : TStBasis) : Extended;
|
120 |
{-Returns the discount Rate for a security}
|
121 |
|
122 |
function DollarToDecimal(FracDollar : Extended;
|
123 |
Fraction : Integer) : Extended;
|
124 |
{-Converts a fractional dollar value to decimal dollar value}
|
125 |
|
126 |
function DollarToDecimalText(DecDollar : Extended) : string;
|
127 |
{-Converts a decimal dollar value into an English text string}
|
128 |
|
129 |
function DollarToFraction(DecDollar : Extended;
|
130 |
Fraction : Integer) : Extended;
|
131 |
{-Converts a decimal dollar value to fractional dollar value}
|
132 |
|
133 |
function DollarToFractionStr(FracDollar : Extended;
|
134 |
Fraction : Integer) : string;
|
135 |
{-Converts a fractional dollar value to number string}
|
136 |
|
137 |
function EffectiveInterestRate(NominalRate : Extended;
|
138 |
Frequency : TStFrequency) : Extended;
|
139 |
{-Converts nominal annual interest Rate to effective Rate}
|
140 |
|
141 |
function FutureValue(Rate : Extended;
|
142 |
NPeriods : Integer;
|
143 |
Pmt, PV : Extended;
|
144 |
Frequency : TStFrequency;
|
145 |
Timing: TStPaymentTime) : Extended;
|
146 |
{-Returns the future value of an annuity}
|
147 |
|
148 |
function FutureValueSchedule(Principal : Extended;
|
149 |
const Schedule : array of Double) : Extended;
|
150 |
|
151 |
function FutureValueSchedule16(Principal : Extended;
|
152 |
const Schedule; NRates : Integer) : Extended;
|
153 |
{-Returns the future value of investment with variable interest rates}
|
154 |
|
155 |
function InterestRate(NPeriods : Integer;
|
156 |
Pmt, PV, FV : Extended;
|
157 |
Frequency : TStFrequency;
|
158 |
Timing : TStPaymentTime;
|
159 |
Guess : Extended) : Extended;
|
160 |
{-Returns the interest Rate per period of an annuity}
|
161 |
|
162 |
function InternalRateOfReturn(const Values : array of Double;
|
163 |
Guess : Extended) : Extended;
|
164 |
|
165 |
function InternalRateOfReturn16(const Values; NValues : Integer;
|
166 |
Guess : Extended) : Extended;
|
167 |
{-Returns internal rate of return of a series of periodic cash flows}
|
168 |
|
169 |
function IsCardValid(const S : string) : Boolean;
|
170 |
{-Checks for valid credit card number (MasterCard, Visa, AMEX, Discover)}
|
171 |
|
172 |
function ModifiedDuration(Settlement, Maturity : TStDate;
|
173 |
Rate, Yield : Extended;
|
174 |
Frequency : TStFrequency;
|
175 |
Basis : TStBasis) : Extended;
|
176 |
{-Returns the modified duration for bond with an assumed par value of $100}
|
177 |
|
178 |
function ModifiedIRR(const Values : array of Double;
|
179 |
FinanceRate, ReinvestRate : Extended) : Extended;
|
180 |
|
181 |
function ModifiedIRR16(const Values; NValues : Integer;
|
182 |
FinanceRate, ReinvestRate : Extended) : Extended;
|
183 |
{-Returns the MIRR for a series of periodic cash flows}
|
184 |
|
185 |
function NetPresentValue(Rate : Extended;
|
186 |
const Values : array of Double) : Extended;
|
187 |
|
188 |
function NetPresentValue16(Rate : Extended;
|
189 |
const Values; NValues : Integer) : Extended;
|
190 |
{-Returns the net present value of a series of periodic cash flows}
|
191 |
|
192 |
function NominalInterestRate(EffectRate : Extended;
|
193 |
Frequency : TStFrequency) : Extended;
|
194 |
{-Converts effective annual interest Rate to nominal Rate}
|
195 |
|
196 |
function NonperiodicIRR(const Values : array of Double;
|
197 |
const Dates : array of TStDate;
|
198 |
Guess : Extended) : Extended;
|
199 |
|
200 |
function NonperiodicIRR16(const Values;
|
201 |
const Dates; NValues : Integer;
|
202 |
Guess : Extended) : Extended;
|
203 |
{-Returns the IRR for a series of irregular cash flows}
|
204 |
|
205 |
function NonperiodicNPV(Rate : Extended;
|
206 |
const Values : array of Double;
|
207 |
const Dates : array of TStDate) : Extended;
|
208 |
|
209 |
function NonperiodicNPV16(Rate : Extended;
|
210 |
const Values;
|
211 |
const Dates;
|
212 |
NValues : Integer) : Extended;
|
213 |
{-Returns the net present value for a series of irregular cash flows}
|
214 |
|
215 |
function Payment(Rate : Extended;
|
216 |
NPeriods : Integer;
|
217 |
PV, FV : Extended;
|
218 |
Frequency : TStFrequency;
|
219 |
Timing : TStPaymentTime) : Extended;
|
220 |
{-Returns the interest payment per period in an annuity}
|
221 |
|
222 |
function Periods(Rate : Extended;
|
223 |
Pmt, PV, FV : Extended;
|
224 |
Frequency : TStFrequency;
|
225 |
Timing: TStPaymentTime) : Integer;
|
226 |
{-Returns the number of periods for an annuity}
|
227 |
|
228 |
function PresentValue(Rate : Extended;
|
229 |
NPeriods : Integer;
|
230 |
Pmt, FV : Extended;
|
231 |
Frequency : TStFrequency;
|
232 |
Timing : TStPaymentTime) : Extended;
|
233 |
{-Returns present value of an annity}
|
234 |
|
235 |
function ReceivedAtMaturity(Settlement, Maturity : TStDate;
|
236 |
Investment, Discount : Extended;
|
237 |
Basis : TStBasis) : Extended;
|
238 |
{-Returns the amount received at Maturity for a fully invested security}
|
239 |
|
240 |
function RoundToDecimal(Value : Extended;
|
241 |
Places : Integer;
|
242 |
Bankers : Boolean) : Extended;
|
243 |
{-Rounds a real value to the specified number of decimal places}
|
244 |
|
245 |
function TBillEquivYield(Settlement, Maturity : TStDate;
|
246 |
Discount : Extended) : Extended;
|
247 |
{-Returns the bond-equivalent yield for a treasury bill}
|
248 |
|
249 |
function TBillPrice(Settlement, Maturity : TStDate;
|
250 |
Discount : Extended) : Extended;
|
251 |
{-Returns the price per $100 face value for a treasury bill}
|
252 |
|
253 |
function TBillYield(Settlement, Maturity : TStDate;
|
254 |
Price : Extended) : Extended;
|
255 |
{-Returns the yield for a treasury bill}
|
256 |
|
257 |
function VariableDecliningBalance(Cost, Salvage : Extended;
|
258 |
Life : Integer;
|
259 |
StartPeriod, EndPeriod, Factor : Extended;
|
260 |
NoSwitch : boolean) : Extended;
|
261 |
{-Variable rate declining balance depreciation}
|
262 |
|
263 |
function YieldDiscounted(Settlement, Maturity : TStDate;
|
264 |
Price, Redemption : Extended;
|
265 |
Basis : TStBasis) : Extended;
|
266 |
{-Returns the annual yield for a discounted security}
|
267 |
|
268 |
function YieldPeriodic(Settlement, Maturity : TStDate;
|
269 |
Rate, Price, Redemption : Extended;
|
270 |
Frequency : TStFrequency;
|
271 |
Basis : TStBasis) : Extended;
|
272 |
{-Returns the yield on a security that pays periodicinterest}
|
273 |
|
274 |
function YieldMaturity(Issue, Settlement, Maturity : TStDate;
|
275 |
Rate, Price : Extended;
|
276 |
Basis : TStBasis) : Extended;
|
277 |
{-Returns the annual yield of a security that pays interest at Maturity}
|
278 |
|
279 |
|
280 |
{========================================================================}
|
281 |
|
282 |
implementation
|
283 |
|
284 |
const
|
285 |
PaymentType : array[TStPaymentTime] of Integer = (0, 1);
|
286 |
{Used for converting Timing to integer 0 or 1}
|
287 |
|
288 |
CouponsPerYear : array[TStFrequency] of Integer = (1, 2, 4, 12);
|
289 |
{Used for converting Frequency to integer 1, 2, 4, or 12}
|
290 |
|
291 |
CouponPeriod : array[TStFrequency] of Integer = (12, 6, 3, 1);
|
292 |
{Used for converting Frequency to duration}
|
293 |
|
294 |
DefaultGuess : Extended = 0.1;
|
295 |
{Starting point for rate approximation routines}
|
296 |
|
297 |
var
|
298 |
RecipLn10 : Extended;
|
299 |
{Used for common log computation}
|
300 |
|
301 |
|
302 |
{================= Local routines used by this unit ==================}
|
303 |
|
304 |
procedure RaiseStFinError(Code : Longint);
|
305 |
begin
|
306 |
Raise EStFinError.CreateResTP(Code, 0);
|
307 |
end;
|
308 |
|
309 |
{-------------------------------------------------------}
|
310 |
|
311 |
function Exp10(Exponent : Extended) : Extended;
|
312 |
{-Returns 10^Exponent}
|
313 |
begin
|
314 |
Result := Power(10.0, Exponent);
|
315 |
end;
|
316 |
|
317 |
{-------------------------------------------------------}
|
318 |
|
319 |
function Log10(Value : Extended) : Extended;
|
320 |
{-Returns common log of Value}
|
321 |
begin
|
322 |
Result := Ln(Value) * RecipLn10;
|
323 |
end;
|
324 |
|
325 |
{-------------------------------------------------------}
|
326 |
|
327 |
function DayCount(Day1, Day2 : TStDate; Basis : TStBasis) : LongInt;
|
328 |
{-The number of days from Day1 to Day2 according to day count basis}
|
329 |
var
|
330 |
BDT : TStBondDateType;
|
331 |
begin
|
332 |
case Basis of
|
333 |
BasisNASD : BDT := bdt30360PSA;
|
334 |
BasisEur30360 : BDT := bdt30E360;
|
335 |
else
|
336 |
BDT := bdtActual;
|
337 |
end;
|
338 |
Result := Longint(BondDateDiff(Day1, Day2, BDT));
|
339 |
end;
|
340 |
|
341 |
{-------------------------------------------------------}
|
342 |
|
343 |
function LastCoupon(Settlement, Maturity : TStDate;
|
344 |
Frequency : TStFrequency) : TStDate;
|
345 |
{-The last coupon date prior to settlement}
|
346 |
var
|
347 |
Last : TStDate;
|
348 |
Months : Integer;
|
349 |
begin
|
350 |
Last := Maturity;
|
351 |
Months := 0;
|
352 |
while (Last >= Settlement) do begin
|
353 |
Months := Months + CouponPeriod[Frequency];
|
354 |
Last := IncDateTrunc(Maturity, -Months, 0);
|
355 |
end;
|
356 |
Result := Last;
|
357 |
end;
|
358 |
|
359 |
{-------------------------------------------------------}
|
360 |
|
361 |
function NextCoupon(Settlement, Maturity : TStDate;
|
362 |
Frequency : TStFrequency) : TStDate;
|
363 |
{-The next coupon date after settlement}
|
364 |
var
|
365 |
Next : TStDate;
|
366 |
begin
|
367 |
Next := LastCoupon(Settlement, Maturity, Frequency);
|
368 |
Result := IncDateTrunc(Next, CouponPeriod[Frequency], 0);
|
369 |
end;
|
370 |
|
371 |
{-------------------------------------------------------}
|
372 |
|
373 |
function CouponsToMaturity(Settlement, Maturity : TStDate;
|
374 |
Frequency : TStFrequency) : Integer;
|
375 |
{-The number of coupons remaining after settlement}
|
376 |
var
|
377 |
CouponDate : TStDate;
|
378 |
Months : Integer;
|
379 |
Coupons : Integer;
|
380 |
begin
|
381 |
CouponDate := Maturity;
|
382 |
Coupons := 0;
|
383 |
Months := 0;
|
384 |
while (CouponDate > Settlement) do begin
|
385 |
Months := Months + CouponPeriod[Frequency];
|
386 |
CouponDate := IncDateTrunc(Maturity, -Months, 0);
|
387 |
Coupons := Coupons + 1;
|
388 |
end;
|
389 |
Result := Coupons;
|
390 |
end;
|
391 |
|
392 |
{-------------------------------------------------------}
|
393 |
|
394 |
function DayCountFraction(Day1, Day2, Settlement, Maturity : TStDate;
|
395 |
Frequency : TStFrequency;
|
396 |
Basis : TStBasis) : Extended;
|
397 |
{-The number of days from Day1 to Day2 divided by days/year
|
398 |
except for Act/Act which uses actual coupon period x frequency}
|
399 |
var
|
400 |
Last, Next : TStDate;
|
401 |
DPY : Integer;
|
402 |
begin
|
403 |
if (Basis = BasisActAct) then begin
|
404 |
Last := LastCoupon(Settlement, Maturity, Frequency);
|
405 |
Next := NextCoupon(Settlement, Maturity, Frequency);
|
406 |
DPY := DayCount(Last, Next, Basis) * CouponsPerYear[Frequency];
|
407 |
end else if (Basis = BasisAct365) then
|
408 |
DPY := 365
|
409 |
else
|
410 |
DPY := 360;
|
411 |
Result := DayCount(Day1, Day2, Basis) / DPY;
|
412 |
end;
|
413 |
|
414 |
{-------------------------------------------------------}
|
415 |
|
416 |
function BondDirtyPrice(Settlement, Maturity : TStDate;
|
417 |
Rate, Yield, Redemption : Extended;
|
418 |
Frequency : TStFrequency;
|
419 |
Basis : TStBasis) : Extended;
|
420 |
{-Bond Price including interest accrued in current coupon period}
|
421 |
var
|
422 |
C, DCF, Yw : Extended;
|
423 |
Vn, Vdcf : Extended;
|
424 |
Next : TStDate;
|
425 |
N, W : Integer;
|
426 |
begin
|
427 |
W := CouponsPerYear[Frequency];
|
428 |
C := Redemption * (Rate / W);
|
429 |
Yw := Yield / W;
|
430 |
N := CouponsToMaturity(Settlement, Maturity, Frequency);
|
431 |
Next := NextCoupon(Settlement, Maturity, Frequency);
|
432 |
DCF := DayCountFraction(Settlement, Next, Settlement, Maturity,
|
433 |
Frequency, Basis);
|
434 |
Vdcf := Power(1.0 / (1.0 + Yw), DCF * W);
|
435 |
Vn := Power(1.0 / (1.0 + Yw), N - 1.0);
|
436 |
Result := Vdcf * (( C * (1.0 - Vn) / Yw) + Redemption * Vn + C);
|
437 |
end;
|
438 |
|
439 |
|
440 |
|
441 |
{====================== Public Routines ============================}
|
442 |
|
443 |
|
444 |
function AccruedInterestMaturity(Issue, Maturity : TStDate;
|
445 |
Rate, Par : Extended;
|
446 |
Basis : TStBasis) : Extended;
|
447 |
var
|
448 |
DCF : Extended;
|
449 |
begin
|
450 |
If (Rate <= 0.0) or (Par <= 0.0) or (Issue >= Maturity) then
|
451 |
RaiseStFinError(stscFinBadArg);
|
452 |
DCF := DayCountFraction(Issue, Maturity, Issue, Maturity,
|
453 |
fqAnnual, Basis);
|
454 |
Result := Par * Rate * DCF;
|
455 |
end;
|
456 |
|
457 |
{-------------------------------------------------------}
|
458 |
|
459 |
function AccruedInterestPeriodic(Issue, Settlement, Maturity : TStDate;
|
460 |
Rate, Par : Extended;
|
461 |
Frequency : TStFrequency;
|
462 |
Basis : TStBasis) : Extended;
|
463 |
var
|
464 |
Last : TStDate;
|
465 |
DCF : Extended;
|
466 |
begin
|
467 |
if (Rate <= 0.0) or (Par <= 0.0) or (Issue >= Settlement) then
|
468 |
RaiseStFinError(stscFinBadArg);
|
469 |
Last := LastCoupon(Settlement, Maturity, Frequency);
|
470 |
if (Issue > Last) then
|
471 |
Last := Issue;
|
472 |
DCF := DayCountFraction(Last, Settlement, Settlement, Maturity,
|
473 |
Frequency, Basis);
|
474 |
Result := Par * Rate * DCF;
|
475 |
end;
|
476 |
|
477 |
{-------------------------------------------------------}
|
478 |
|
479 |
function BondDuration(Settlement,Maturity : TStDate;
|
480 |
Rate, Yield : Extended;
|
481 |
Frequency : TStFrequency;
|
482 |
Basis : TStBasis) : Extended;
|
483 |
var
|
484 |
B, dB : Extended;
|
485 |
Yw : Extended;
|
486 |
begin
|
487 |
if (Rate < 0.0) or (Yield < 0.0) or (Settlement >= Maturity) then
|
488 |
RaiseStFinError(stscFinBadArg);
|
489 |
Yw := Yield / CouponsPerYear[Frequency];
|
490 |
B := BondDirtyPrice(Settlement, Maturity, Rate, Yield, 100.0,
|
491 |
Frequency, Basis);
|
492 |
if (B <> 0.0) then begin
|
493 |
dB := BondDirtyPrice(Settlement, Maturity, Rate, Yield + StDelta, 100.0,
|
494 |
Frequency, Basis) - B;
|
495 |
Result := -((1.0 + Yw) / B) * (dB / StDelta);
|
496 |
end else
|
497 |
Result := 0;
|
498 |
end;
|
499 |
|
500 |
{-------------------------------------------------------}
|
501 |
|
502 |
function BondPrice(Settlement, Maturity : TStDate;
|
503 |
Rate, Yield, Redemption : Extended;
|
504 |
Frequency : TStFrequency;
|
505 |
Basis : TStBasis) : Extended;
|
506 |
var
|
507 |
B, DCF : Extended;
|
508 |
Last : TStDate;
|
509 |
begin
|
510 |
if (Yield < 0.0) or (Rate < 0.0) or (Redemption <= 0) or
|
511 |
(Settlement >= Maturity) then
|
512 |
RaiseStFinError(stscFinBadArg);
|
513 |
B := BondDirtyPrice(Settlement, Maturity, Rate, Yield, Redemption,
|
514 |
Frequency, Basis);
|
515 |
Last := LastCoupon(Settlement, Maturity, Frequency);
|
516 |
DCF := DayCountFraction(Last, Settlement, Settlement, Maturity,
|
517 |
Frequency, Basis);
|
518 |
Result := B - Redemption * Rate * DCF;
|
519 |
end;
|
520 |
|
521 |
{-------------------------------------------------------}
|
522 |
|
523 |
function CumulativeInterest(Rate : Extended;
|
524 |
NPeriods : Integer;
|
525 |
PV : Extended;
|
526 |
StartPeriod, EndPeriod : Integer;
|
527 |
Frequency : TStFrequency;
|
528 |
Timing : TStPaymentTime) : Extended;
|
529 |
var
|
530 |
P, CP : Extended;
|
531 |
begin
|
532 |
if (Rate <=0.0) or (NPeriods <= 0) or (PV <= 0.0) or (StartPeriod < 1) or
|
533 |
(EndPeriod < 1) or (StartPeriod > EndPeriod) then
|
534 |
RaiseStFinError(stscFinBadArg);
|
535 |
P := Payment(Rate, NPeriods, PV, 0.0, Frequency, Timing);
|
536 |
CP := CumulativePrincipal(Rate, NPeriods, PV, StartPeriod, EndPeriod,
|
537 |
Frequency, Timing);
|
538 |
Result := P * (EndPeriod - (StartPeriod - 1.0)) - CP;
|
539 |
end;
|
540 |
|
541 |
{-------------------------------------------------------}
|
542 |
|
543 |
function CumulativePrincipal(Rate : Extended;
|
544 |
NPeriods : Integer;
|
545 |
PV : Extended;
|
546 |
StartPeriod, EndPeriod : Integer;
|
547 |
Frequency : TStFrequency;
|
548 |
Timing : TStPaymentTime) : Extended;
|
549 |
var
|
550 |
P : Extended;
|
551 |
begin
|
552 |
if (Rate <=0.0) or (NPeriods <= 0) or (PV <= 0.0) or (StartPeriod < 1) or
|
553 |
(EndPeriod < 1) or (StartPeriod > EndPeriod) then
|
554 |
RaiseStFinError(stscFinBadArg);
|
555 |
P := Payment(Rate, NPeriods, PV, 0.0, Frequency, Timing);
|
556 |
Result := FutureValue(Rate, StartPeriod - 1, P, PV, Frequency, Timing) -
|
557 |
FutureValue(Rate, EndPeriod, P, PV, Frequency, Timing);
|
558 |
end;
|
559 |
|
560 |
{-------------------------------------------------------}
|
561 |
|
562 |
function DecliningBalance(Cost, Salvage : Extended;
|
563 |
Life, Period, Month : Integer) : Extended;
|
564 |
var
|
565 |
Rate : Extended;
|
566 |
DPv : Extended;
|
567 |
TDPv : Extended;
|
568 |
I : Integer;
|
569 |
begin
|
570 |
if (Cost <= 0.0) or (Cost < Salvage) or (Period < 1) or (Life < 2) or
|
571 |
(Period > (Life + 1)) then
|
572 |
RaiseStFinError(stscFinBadArg);
|
573 |
DPv := 0.0;
|
574 |
TDPv := 0.0;
|
575 |
if (Salvage = 0) then
|
576 |
Salvage := 0.001;
|
577 |
if (Month = 0) then
|
578 |
Month := 12;
|
579 |
Rate := RoundToDecimal(1.0 - Power(Salvage / Cost, 1.0 / Life), 3, false);
|
580 |
for I := 1 to Period do begin
|
581 |
if (I = 1) then
|
582 |
DPv := (Cost * Rate * Month) / 12.0 {1st Period}
|
583 |
else if (I = (Life + 1)) then
|
584 |
DPv := (Cost - TDPv) * Rate * (12.0 - Month) / 12.0 {Last Period}
|
585 |
else
|
586 |
DPv := (Cost - TDPv) * Rate; {All the rest}
|
587 |
TDpv := TDpv + Dpv
|
588 |
end;
|
589 |
Result := RoundToDecimal(Dpv, 3, False);
|
590 |
end;
|
591 |
|
592 |
{-------------------------------------------------------}
|
593 |
|
594 |
function DiscountRate(Settlement, Maturity : TStDate;
|
595 |
Price, Redemption : Extended;
|
596 |
Basis : TStBasis) : Extended;
|
597 |
var
|
598 |
DCF : Extended;
|
599 |
begin
|
600 |
If (Price <= 0.0) or (Redemption <= 0.0) or (Settlement >= Maturity) then
|
601 |
RaiseStFinError(stscFinBadArg);
|
602 |
DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
603 |
fqAnnual, Basis);
|
604 |
Result := (Redemption - Price) / (Redemption * DCF);
|
605 |
end;
|
606 |
|
607 |
{-------------------------------------------------------}
|
608 |
|
609 |
function DollarToDecimal(FracDollar : Extended;
|
610 |
Fraction : Integer) : Extended;
|
611 |
var
|
612 |
I, F, N : Extended;
|
613 |
begin
|
614 |
if (Fraction < 1) then
|
615 |
RaiseStFinError(stscFinBadArg);
|
616 |
I := Int(FracDollar); {Integral part}
|
617 |
N := Int(Log10(Fraction) + 1.0); {Number of decimal places}
|
618 |
F := Frac(FracDollar); {Fractional part}
|
619 |
Result := I + (F * Exp10(N) / Fraction);
|
620 |
end;
|
621 |
|
622 |
{-------------------------------------------------------}
|
623 |
|
624 |
function DollarToDecimalText(DecDollar : Extended) : string;
|
625 |
var
|
626 |
A, P : Extended;
|
627 |
N, I : Integer;
|
628 |
Str : string;
|
629 |
T : Longint;
|
630 |
CentVal : Integer;
|
631 |
const
|
632 |
Orders : array[0..5] of string = ('', 'Thousand ', 'Million ',
|
633 |
'Billion ', 'Trillion ', 'Quadrillion ');
|
634 |
|
635 |
function Text100(Num: Longint) : string;
|
636 |
{formats an integer in the range 0 to 999}
|
637 |
var
|
638 |
I, J : Integer;
|
639 |
A, T : Longint;
|
640 |
S : string;
|
641 |
const
|
642 |
Tens : array[0..9] of string =
|
643 |
('', '', 'Twenty', 'Thirty', 'Forty', 'Fifty',
|
644 |
'Sixty', 'Seventy', 'Eighty', 'Ninety');
|
645 |
Ones : array[0..19] of string =
|
646 |
('', 'One', 'Two', 'Three', 'Four', 'Five',
|
647 |
'Six', 'Seven', 'Eight', 'Nine', 'Ten',
|
648 |
'Eleven', 'Twelve', 'Thirteen', 'Fourteen', 'Fifteen',
|
649 |
'Sixteen', 'Seventeen', 'Eighteen', 'Nineteen');
|
650 |
begin
|
651 |
S := '';
|
652 |
I := 0;
|
653 |
J := 0;
|
654 |
Result := S;
|
655 |
if (Num = 0) then
|
656 |
Exit;
|
657 |
A := Num;
|
658 |
T := A div 100;
|
659 |
if (T > 0) then begin
|
660 |
I := T; {I = Hundreds digit}
|
661 |
A := A - (T * 100);
|
662 |
end;
|
663 |
T := A div 10;
|
664 |
if (T > 1) then begin
|
665 |
J := T; {J = Tens digit}
|
666 |
A := A - (T * 10); {A = Ones digit}
|
667 |
end;
|
668 |
if (I > 0) then
|
669 |
S := Ones[I] + ' Hundred';
|
670 |
if (J > 0) then begin
|
671 |
if (I > 0) then
|
672 |
S := S + ' ' + Tens[J]
|
673 |
else
|
674 |
S := S + Tens[J];
|
675 |
end;
|
676 |
if (A > 0) then begin
|
677 |
if (J > 0) then
|
678 |
S := S + '-';
|
679 |
if (I > 0) and (J = 0) then
|
680 |
S := S + ' ' + Ones[A]
|
681 |
else
|
682 |
S := S + Ones[A];
|
683 |
end;
|
684 |
Result := S;
|
685 |
end;
|
686 |
|
687 |
begin
|
688 |
Str := '';
|
689 |
if (DecDollar < 0) then
|
690 |
RaiseStFinError(stscFinBadArg);
|
691 |
if (DecDollar > 0) then begin
|
692 |
N := Trunc(Log10(DecDollar));
|
693 |
if (N > 17) then {DecDollar too large}
|
694 |
RaiseStFinError(stscFinBadArg);
|
695 |
A := DecDollar;
|
696 |
for I := N downto 0 do begin
|
697 |
P := Int(Exp10(I * 3));
|
698 |
T := Trunc(A / P);
|
699 |
if (T > 0) then
|
700 |
Str := Str + {' ' +} Text100(T) + ' ' + Orders[I];
|
701 |
A := A - (T * P);
|
702 |
end;
|
703 |
end;
|
704 |
if (Str = '') then
|
705 |
Str := 'Zero ';
|
706 |
Str := Str + 'and ';
|
707 |
CentVal := Round(Frac(DecDollar) * 100);
|
708 |
if (CentVal < 10) then
|
709 |
Str := Str + '0';
|
710 |
Result := Str + IntToStr(CentVal) + '/100';
|
711 |
end;
|
712 |
|
713 |
{-------------------------------------------------------}
|
714 |
|
715 |
function DollarToFraction(DecDollar : Extended;
|
716 |
Fraction : Integer) : Extended;
|
717 |
var
|
718 |
I, F, N : Extended;
|
719 |
begin
|
720 |
if (Fraction < 1) then
|
721 |
RaiseStFinError(stscFinBadArg);
|
722 |
I := Int(DecDollar); {Integral part}
|
723 |
N := Int(Log10(Fraction) + 1.0); {Number of decimal places}
|
724 |
F := Frac(DecDollar); {Fractional part}
|
725 |
Result := I + (F * Fraction / Exp10(N));
|
726 |
end;
|
727 |
|
728 |
{-------------------------------------------------------}
|
729 |
|
730 |
function DollarToFractionStr(FracDollar : Extended;
|
731 |
Fraction : Integer) : string;
|
732 |
var
|
733 |
I, F, N : Extended;
|
734 |
begin
|
735 |
Result := '';
|
736 |
if (Fraction < 1) then
|
737 |
RaiseStFinError(stscFinBadArg);
|
738 |
I := Int(FracDollar); {Integral part}
|
739 |
N := Int(Log10(Fraction) + 1.0); {Number of decimal places}
|
740 |
F := Frac(FracDollar) * Exp10(N); {Fractional part}
|
741 |
Result := IntToStr(Trunc(I));
|
742 |
if (F > 0) then
|
743 |
Result := Result + ' ' + FloatToStrF(F, ffNumber, Trunc(N), 0) +
|
744 |
'/' + IntToStr(Fraction);
|
745 |
end;
|
746 |
|
747 |
{-------------------------------------------------------}
|
748 |
|
749 |
function EffectiveInterestRate(NominalRate : Extended;
|
750 |
Frequency : TStFrequency) : Extended;
|
751 |
var
|
752 |
W : Integer;
|
753 |
begin
|
754 |
if (NominalRate <= 0.0) then
|
755 |
RaiseStFinError(stscFinBadArg);
|
756 |
W := CouponsPerYear[Frequency];
|
757 |
Result := Power(1.0 + NominalRate / W, W) - 1.0;
|
758 |
end;
|
759 |
|
760 |
{-------------------------------------------------------}
|
761 |
|
762 |
function FutureValue(Rate : Extended;
|
763 |
NPeriods : Integer;
|
764 |
Pmt, PV : Extended;
|
765 |
Frequency : TStFrequency;
|
766 |
Timing: TStPaymentTime) : Extended;
|
767 |
var
|
768 |
S, Rw : Extended;
|
769 |
PT : Integer;
|
770 |
|
771 |
begin
|
772 |
PT := PaymentType[Timing];
|
773 |
Rw := Rate / CouponsPerYear[Frequency];
|
774 |
S := Power(1.0 + Rw, NPeriods);
|
775 |
Result := -((PV * S) + Pmt * (S - 1.0) * (1.0 + Rw * PT) / Rw);
|
776 |
end;
|
777 |
|
778 |
{-------------------------------------------------------}
|
779 |
|
780 |
function FutureValueSchedule(Principal : Extended;
|
781 |
const Schedule : array of Double) : Extended;
|
782 |
begin
|
783 |
Result := FutureValueSchedule16(Principal, Schedule,
|
784 |
High(Schedule) + 1);
|
785 |
end;
|
786 |
|
787 |
function FutureValueSchedule16(Principal : Extended;
|
788 |
const Schedule; NRates : Integer) : Extended;
|
789 |
var
|
790 |
I : Integer;
|
791 |
begin
|
792 |
Result := Principal;
|
793 |
for I := 0 to (NRates - 1) do
|
794 |
Result := Result * (1.0 + TDoubleArray(Schedule)[I]);
|
795 |
end;
|
796 |
|
797 |
{-------------------------------------------------------}
|
798 |
|
799 |
function InterestRate(NPeriods : Integer;
|
800 |
Pmt, PV, FV : Extended;
|
801 |
Frequency : TStFrequency;
|
802 |
Timing : TStPaymentTime;
|
803 |
Guess : Extended) : Extended;
|
804 |
var
|
805 |
Rate : Extended;
|
806 |
NextRate : Extended;
|
807 |
T, dT : Extended;
|
808 |
Count : Integer;
|
809 |
begin
|
810 |
Count := 0;
|
811 |
NextRate := Guess;
|
812 |
if (Guess = 0.0) then
|
813 |
NextRate := DefaultGuess;
|
814 |
{Solve FV(rate) = FV for rate by Newton's method}
|
815 |
repeat
|
816 |
Rate := NextRate;
|
817 |
if (Rate <= - CouponsPerYear[Frequency]) then
|
818 |
Rate := -0.999 * CouponsPerYear[Frequency];
|
819 |
T := FutureValue(Rate, NPeriods, Pmt, PV, Frequency, Timing) - FV;
|
820 |
dT := FutureValue(Rate + StDelta, NPeriods, Pmt, PV, Frequency,
|
821 |
Timing) - FV - T;
|
822 |
if (dT = 0.0) then
|
823 |
Count := StMaxIterations
|
824 |
else
|
825 |
NextRate := Rate - StDelta * T / dT;
|
826 |
Inc(Count);
|
827 |
until (Abs(NextRate - Rate) < StEpsilon) or (Count > StMaxIterations);
|
828 |
if (Count > StMaxIterations) then
|
829 |
RaiseStFinError(stscFinNoConverge);
|
830 |
Result := NextRate;
|
831 |
end;
|
832 |
|
833 |
{-------------------------------------------------------}
|
834 |
|
835 |
function InternalRateOfReturn(const Values : array of Double;
|
836 |
Guess : Extended) : Extended;
|
837 |
begin
|
838 |
Result := InternalRateOfReturn16(Values, High(Values) + 1, Guess);
|
839 |
end;
|
840 |
|
841 |
function InternalRateOfReturn16(const Values;
|
842 |
NValues : Integer;
|
843 |
Guess : Extended) : Extended;
|
844 |
var
|
845 |
Rate : Extended;
|
846 |
NextRate : Extended;
|
847 |
PV : Extended;
|
848 |
dPV : Extended;
|
849 |
Count : Integer;
|
850 |
begin
|
851 |
Count := 0;
|
852 |
NextRate := Guess;
|
853 |
if (Guess = 0.0) then
|
854 |
NextRate := DefaultGuess;
|
855 |
{Solve NPV(Rate) = 0 for rate by Newton's method}
|
856 |
repeat
|
857 |
Rate := NextRate;
|
858 |
if (Rate <= -1.0) then
|
859 |
Rate := -0.999;
|
860 |
PV := NetPresentValue16(Rate, Values, NValues);
|
861 |
dPV := NetPresentValue16(Rate + StDelta, Values, NValues) - PV;
|
862 |
if (dPV = 0.0) then
|
863 |
Count := StMaxIterations
|
864 |
else
|
865 |
NextRate := Rate - (StDelta * PV) / dPV;
|
866 |
Inc(Count);
|
867 |
until (Abs(NextRate - Rate) < StEpsilon) or (Count > StMaxIterations);
|
868 |
if (Count > StMaxIterations) then
|
869 |
RaiseStFinError(stscFinNoConverge);
|
870 |
Result := NextRate;
|
871 |
end;
|
872 |
|
873 |
{-------------------------------------------------------}
|
874 |
|
875 |
function IsCardValid(const S : string) : Boolean;
|
876 |
const
|
877 |
Ord0 = Ord('0');
|
878 |
var
|
879 |
Temp : string;
|
880 |
I, J, K : Integer;
|
881 |
begin
|
882 |
Result := False;
|
883 |
Temp := '';
|
884 |
for I := 1 to Length(S) do
|
885 |
if (S[I] in ['0'..'9']) then
|
886 |
Temp := Temp + S[I];
|
887 |
if Temp = '' then
|
888 |
Exit;
|
889 |
K := 0;
|
890 |
I := 1;
|
891 |
if not Odd(Length(Temp)) then begin
|
892 |
J := Ord(Temp[I]) - Ord0;
|
893 |
J := J shl 1;
|
894 |
if J > 9 then
|
895 |
J := J - 9;
|
896 |
K := K + J;
|
897 |
Inc(I);
|
898 |
end;
|
899 |
while I <= Length(Temp) do begin
|
900 |
K := K + Ord(Temp[I]) - Ord0;
|
901 |
Inc(I);
|
902 |
if I > Length(Temp) then
|
903 |
Break;
|
904 |
J := Ord(Temp[I]) - Ord0;
|
905 |
J := J shl 1;
|
906 |
if J > 9 then
|
907 |
J := J - 9;
|
908 |
K := K + J;
|
909 |
Inc(I);
|
910 |
end;
|
911 |
Result := (K mod 10 = 0);
|
912 |
end;
|
913 |
|
914 |
{-------------------------------------------------------}
|
915 |
|
916 |
function ModifiedDuration(Settlement, Maturity : TStDate;
|
917 |
Rate, Yield : Extended;
|
918 |
Frequency : TStFrequency;
|
919 |
Basis : TStBasis) : Extended;
|
920 |
begin
|
921 |
if (Rate < 0.0) or (Yield < 0.0) or (Settlement >= Maturity) then
|
922 |
RaiseStFinError(stscFinBadArg);
|
923 |
Result := BondDuration(Settlement, Maturity, Rate, Yield,
|
924 |
Frequency, Basis)/ (1.0 + Yield / CouponsPerYear[Frequency]);
|
925 |
end;
|
926 |
|
927 |
{-------------------------------------------------------}
|
928 |
|
929 |
function ModifiedIRR(const Values : array of Double;
|
930 |
FinanceRate, ReinvestRate : Extended) : Extended;
|
931 |
begin
|
932 |
Result := ModifiedIRR16(Values, High(Values) + 1, FinanceRate,
|
933 |
ReinvestRate);
|
934 |
end;
|
935 |
|
936 |
function ModifiedIRR16(const Values;
|
937 |
NValues : Integer;
|
938 |
FinanceRate, ReinvestRate : Extended) : Extended;
|
939 |
var
|
940 |
NPVPos : Extended;
|
941 |
NPVNeg : Extended;
|
942 |
Val : Extended;
|
943 |
Rn, Fn : Extended;
|
944 |
I : Integer;
|
945 |
begin
|
946 |
NPVPos := 0.0;
|
947 |
NPVNeg := 0.0;
|
948 |
for I := 0 to (NValues - 1) do begin
|
949 |
Val := TDoubleArray(Values)[I];
|
950 |
if (Val > 0.0) then
|
951 |
NPVPos := NPVPos + Val / Power(1.0 + ReinvestRate, I + 1.0)
|
952 |
else
|
953 |
NPVNeg := NPVNeg + Val / Power(1.0 + FinanceRate, I + 1.0);
|
954 |
end;
|
955 |
Rn := Power(1.0 + ReInvestRate, NValues);
|
956 |
Fn := 1.0 + FinanceRate;
|
957 |
Result := Power(-NPVPos * Rn / (NPVNeg * Fn), 1.0 / (NValues - 1.0)) - 1.0;
|
958 |
end;
|
959 |
|
960 |
{-------------------------------------------------------}
|
961 |
|
962 |
function NetPresentValue(Rate : Extended;
|
963 |
const Values : array of Double) : Extended;
|
964 |
begin
|
965 |
Result := NetPresentValue16(Rate, Values, High(Values) + 1);
|
966 |
end;
|
967 |
|
968 |
function NetPresentValue16(Rate : Extended;
|
969 |
const Values;
|
970 |
NValues : Integer) : Extended;
|
971 |
var
|
972 |
I : Integer;
|
973 |
begin
|
974 |
Result := 0;
|
975 |
for I := 0 to (NValues - 1) do
|
976 |
Result := Result + TDoubleArray(Values)[I] / Power(1.0 + Rate, I + 1.0);
|
977 |
end;
|
978 |
|
979 |
{-------------------------------------------------------}
|
980 |
|
981 |
function NominalInterestRate(EffectRate : Extended;
|
982 |
Frequency : TStFrequency) : Extended;
|
983 |
var
|
984 |
W : Extended;
|
985 |
begin
|
986 |
if (EffectRate <= 0.0) then
|
987 |
RaiseStFinError(stscFinBadArg);
|
988 |
W := CouponsPerYear[Frequency];
|
989 |
Result := W * (Power(EffectRate + 1.0, 1.0 / W) - 1.0);
|
990 |
end;
|
991 |
|
992 |
{-------------------------------------------------------}
|
993 |
|
994 |
function NonperiodicIRR(const Values : array of Double;
|
995 |
const Dates : array of TStDate;
|
996 |
Guess : Extended) : Extended;
|
997 |
begin
|
998 |
Result := NonPeriodicIRR16(Values, Dates, High(Values) + 1, Guess);
|
999 |
end;
|
1000 |
|
1001 |
function NonperiodicIRR16(const Values;
|
1002 |
const Dates;
|
1003 |
NValues : Integer;
|
1004 |
Guess : Extended) : Extended;
|
1005 |
var
|
1006 |
Rate : Extended;
|
1007 |
NextRate : Extended;
|
1008 |
PV, dPV : Extended;
|
1009 |
Count : Integer;
|
1010 |
begin
|
1011 |
Count := 0;
|
1012 |
NextRate := Guess;
|
1013 |
if (Guess = 0.0) then
|
1014 |
NextRate := DefaultGuess;
|
1015 |
{Solve XNPV(Rate) = 0 for rate by Newton's method}
|
1016 |
repeat
|
1017 |
Rate := NextRate;
|
1018 |
if (Rate <= -1.0) then
|
1019 |
Rate := -0.999;
|
1020 |
PV := NonPeriodicNPV16(Rate, Values, Dates, NValues);
|
1021 |
dPV := NonPeriodicNPV16(Rate + StDelta, Values, Dates, NValues) - PV;
|
1022 |
if (dPV = 0.0) then
|
1023 |
Count := StMaxIterations
|
1024 |
else
|
1025 |
NextRate := Rate - (StDelta * PV) / dPV;
|
1026 |
Inc(Count);
|
1027 |
until (Abs(NextRate - Rate) < StEpsilon) or (Count > StMaxIterations);
|
1028 |
if (Count > StMaxIterations) then
|
1029 |
RaiseStFinError(stscFinNoConverge);
|
1030 |
Result := NextRate;
|
1031 |
end;
|
1032 |
|
1033 |
{-------------------------------------------------------}
|
1034 |
|
1035 |
function NonperiodicNPV(Rate : Extended;
|
1036 |
const Values : array of Double;
|
1037 |
const Dates : array of TStDate) : Extended;
|
1038 |
begin
|
1039 |
Result := NonperiodicNPV16(Rate, Values, Dates, High(Values) + 1);
|
1040 |
end;
|
1041 |
|
1042 |
function NonperiodicNPV16(Rate : Extended;
|
1043 |
const Values;
|
1044 |
const Dates;
|
1045 |
NValues : Integer) : Extended;
|
1046 |
var
|
1047 |
Day1 : TStDate;
|
1048 |
Diff : Double;
|
1049 |
I : Integer;
|
1050 |
begin
|
1051 |
Result := 0.0;
|
1052 |
Day1 := TStDateArray(Dates)[0];
|
1053 |
for I := 0 to (NValues - 1) do begin
|
1054 |
Diff := TStDateArray(Dates)[I] - Day1;
|
1055 |
if (Diff < 0) then
|
1056 |
RaiseStFinError(stscFinBadArg);
|
1057 |
Result := Result + TDoubleArray(Values)[I] / Power(1.0 + Rate, Diff / 365.0);
|
1058 |
end;
|
1059 |
end;
|
1060 |
|
1061 |
{-------------------------------------------------------}
|
1062 |
|
1063 |
function Payment(Rate : Extended;
|
1064 |
NPeriods : Integer;
|
1065 |
PV, FV : Extended;
|
1066 |
Frequency : TStFrequency;
|
1067 |
Timing : TStPaymentTime) : Extended;
|
1068 |
var
|
1069 |
PT, Rw, S : Extended;
|
1070 |
begin
|
1071 |
PT := PaymentType[Timing];
|
1072 |
Rw := Rate / CouponsPerYear[Frequency];
|
1073 |
S := Power(1.0 + Rw, NPeriods);
|
1074 |
Result := Rw * (FV - PV * S) / ((S - 1.0) * (1.0 + Rw * PT));
|
1075 |
end;
|
1076 |
|
1077 |
{-------------------------------------------------------}
|
1078 |
function Periods(Rate : Extended;
|
1079 |
Pmt, PV, FV : Extended;
|
1080 |
Frequency : TStFrequency;
|
1081 |
Timing: TStPaymentTime) : Integer;
|
1082 |
var
|
1083 |
S, Rw : Extended;
|
1084 |
|
1085 |
begin
|
1086 |
Rw := Rate / CouponsPerYear[Frequency];
|
1087 |
S := Pmt * (1.0 + Rw * PaymentType[Timing]);
|
1088 |
Result := Round(Ln((Rw*FV + S) / (Rw*PV + S)) / Ln(1.0 + Rw));
|
1089 |
end;
|
1090 |
|
1091 |
{-------------------------------------------------------}
|
1092 |
|
1093 |
function PresentValue(Rate : Extended;
|
1094 |
NPeriods : Integer;
|
1095 |
Pmt, FV : Extended;
|
1096 |
Frequency : TStFrequency;
|
1097 |
Timing : TStPaymentTime) : Extended;
|
1098 |
var
|
1099 |
PT, Rw, S : Extended;
|
1100 |
begin
|
1101 |
PT := PaymentType[Timing];
|
1102 |
Rw := Rate / CouponsPerYear[Frequency];
|
1103 |
S := Power(1.0 + Rw, -NPeriods);
|
1104 |
Result := (FV * S) + Pmt * (S - 1.0) * (1.0 + Rw * PT) / Rw;
|
1105 |
end;
|
1106 |
|
1107 |
{-------------------------------------------------------}
|
1108 |
|
1109 |
function ReceivedAtMaturity(Settlement, Maturity : TStDate;
|
1110 |
Investment, Discount : Extended;
|
1111 |
Basis : TStBasis) : Extended;
|
1112 |
var
|
1113 |
DCF : Extended;
|
1114 |
begin
|
1115 |
if (Investment <= 0.0) or (Discount <= 0.0) or (Settlement >= Maturity) then
|
1116 |
RaiseStFinError(stscFinBadArg);
|
1117 |
DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
1118 |
fqAnnual, Basis);
|
1119 |
Result := Investment / (1.0 - Discount * DCF);
|
1120 |
end;
|
1121 |
|
1122 |
{-------------------------------------------------------}
|
1123 |
|
1124 |
{revised}
|
1125 |
function RoundToDecimal(Value : Extended;
|
1126 |
Places : Integer;
|
1127 |
Bankers : Boolean) : Extended;
|
1128 |
var
|
1129 |
Val, IV, N, F : Extended;
|
1130 |
T : Integer;
|
1131 |
begin
|
1132 |
IV := 0;
|
1133 |
N := Exp10(Places);
|
1134 |
if (Places > 0) then
|
1135 |
IV := Int(Value);
|
1136 |
Val := (Value - IV) * N;
|
1137 |
T := Trunc(Val);
|
1138 |
F := (Val - T);
|
1139 |
if Bankers then
|
1140 |
Val := Round(Val) / N {Delphi's Round does Bankers}
|
1141 |
else begin
|
1142 |
if Abs(Round(10.0 * F)) >= 5 then begin
|
1143 |
if (F > 0) then
|
1144 |
Val := (T + 1.0) / N
|
1145 |
else
|
1146 |
Val := (T - 1.0) / N;
|
1147 |
end else
|
1148 |
Val := T / N;
|
1149 |
end;
|
1150 |
Result := Val + IV;
|
1151 |
end;
|
1152 |
|
1153 |
{-------------------------------------------------------}
|
1154 |
|
1155 |
function TBillEquivYield(Settlement, Maturity : TStDate;
|
1156 |
Discount : Extended) : Extended;
|
1157 |
var
|
1158 |
DCF : Extended;
|
1159 |
begin
|
1160 |
if (Discount <= 0.0) or (Settlement > Maturity) then
|
1161 |
RaiseStFinError(stscFinBadArg);
|
1162 |
DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
1163 |
fqAnnual, BasisAct360);
|
1164 |
if (DCF > 1.0) then
|
1165 |
RaiseStFinError(stscFinBadArg);
|
1166 |
Result := (365.0 / 360.0) * Discount / (1.0 - Discount * DCF);
|
1167 |
end;
|
1168 |
|
1169 |
{-------------------------------------------------------}
|
1170 |
|
1171 |
function TBillPrice(Settlement, Maturity : TStDate;
|
1172 |
Discount : Extended) : Extended;
|
1173 |
var
|
1174 |
DCF : Extended;
|
1175 |
begin
|
1176 |
if (Discount <= 0.0) or (Settlement > Maturity) then
|
1177 |
RaiseStFinError(stscFinBadArg);
|
1178 |
DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
1179 |
fqAnnual, BasisAct360);
|
1180 |
if (DCF > 1.0) then
|
1181 |
RaiseStFinError(stscFinBadArg);
|
1182 |
Result := 100.0 * ( 1.0 - Discount * DCF);
|
1183 |
end;
|
1184 |
|
1185 |
{-------------------------------------------------------}
|
1186 |
|
1187 |
function TBillYield(Settlement, Maturity : TStDate;
|
1188 |
Price : Extended) : Extended;
|
1189 |
var
|
1190 |
DCF : Extended;
|
1191 |
begin
|
1192 |
if (Price <= 0.0) or (Settlement > Maturity) then
|
1193 |
RaiseStFinError(stscFinBadArg);
|
1194 |
DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
1195 |
fqAnnual, BasisAct360);
|
1196 |
if (DCF > 1.0) then
|
1197 |
RaiseStFinError(stscFinBadArg);
|
1198 |
Result := ((100.0 - Price) / Price) * (1.0 / DCF);
|
1199 |
end;
|
1200 |
|
1201 |
{-------------------------------------------------------}
|
1202 |
|
1203 |
function VariableDecliningBalance(Cost, Salvage : Extended;
|
1204 |
Life : Integer;
|
1205 |
StartPeriod, EndPeriod, Factor : Extended;
|
1206 |
NoSwitch : Boolean) : Extended;
|
1207 |
var
|
1208 |
VDB : Extended;
|
1209 |
SLD : Extended;
|
1210 |
Rate : Extended;
|
1211 |
begin
|
1212 |
if (Cost <= 0.0) or (Cost < Salvage) or (Life < 2) or (EndPeriod > Life) or
|
1213 |
(StartPeriod > EndPeriod) or (StartPeriod < 0) then
|
1214 |
RaiseStFinError(stscFinBadArg);
|
1215 |
if (Factor = 0.0) then
|
1216 |
Rate := 2.0 / Life
|
1217 |
else
|
1218 |
Rate := Factor / Life;
|
1219 |
SLD := (Cost - Salvage) * (EndPeriod - StartPeriod) / Life;
|
1220 |
VDB := Cost * (Power(1.0 - Rate, StartPeriod) - Power(1.0 - Rate, EndPeriod));
|
1221 |
if (not NoSwitch) and (SLD > VDB) then
|
1222 |
Result := SLD
|
1223 |
else
|
1224 |
Result := VDB;
|
1225 |
end;
|
1226 |
|
1227 |
{-------------------------------------------------------}
|
1228 |
|
1229 |
function YieldDiscounted(Settlement, Maturity : TStDate;
|
1230 |
Price, Redemption : Extended;
|
1231 |
Basis : TStBasis) : Extended;
|
1232 |
var
|
1233 |
DCF : Extended;
|
1234 |
begin
|
1235 |
if (Price <= 0.0) or (Redemption <= 0.0) or (Settlement >= Maturity) then
|
1236 |
RaiseStFinError(stscFinBadArg);
|
1237 |
DCF := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
1238 |
fqAnnual, Basis);
|
1239 |
Result := (Redemption - Price) / (Price * DCF);
|
1240 |
end;
|
1241 |
|
1242 |
{-------------------------------------------------------}
|
1243 |
|
1244 |
function YieldPeriodic(Settlement, Maturity : TStDate;
|
1245 |
Rate, Price, Redemption : Extended;
|
1246 |
Frequency : TStFrequency;
|
1247 |
Basis : TStBasis) : Extended;
|
1248 |
var
|
1249 |
Yield : Extended;
|
1250 |
NextYield : Extended;
|
1251 |
P, dP : Extended;
|
1252 |
Count : Integer;
|
1253 |
begin
|
1254 |
if (Price <= 0.0) or (Rate < 0.0) or (Redemption <= 0.0) or
|
1255 |
(Settlement >= Maturity) then
|
1256 |
RaiseStFinError(stscFinBadArg);
|
1257 |
Count := 0;
|
1258 |
NextYield := Rate;
|
1259 |
repeat {Solve B = BondPrice(yield) - Price = 0 by Newton's method}
|
1260 |
if (NextYield > 0) then
|
1261 |
Yield := NextYield
|
1262 |
else
|
1263 |
Yield := 0.001;
|
1264 |
P := BondPrice(Settlement, Maturity, Rate, Yield, Redemption,
|
1265 |
Frequency, Basis) - Price;
|
1266 |
dP := BondPrice(Settlement, Maturity, Rate, Yield + StDelta,
|
1267 |
Redemption, Frequency, Basis) - Price - P;
|
1268 |
if (dP = 0.0) then
|
1269 |
Count := StMaxIterations
|
1270 |
else
|
1271 |
NextYield := Yield - StDelta * P / dP;
|
1272 |
Inc(Count);
|
1273 |
until (Abs(NextYield - Yield) < StEpsilon) or (Count > StMaxIterations);
|
1274 |
if (Count > StMaxIterations) then
|
1275 |
RaiseStFinError(stscFinNoConverge);
|
1276 |
Result := NextYield;
|
1277 |
end;
|
1278 |
|
1279 |
{-------------------------------------------------------}
|
1280 |
|
1281 |
function YieldMaturity(Issue, Settlement, Maturity : TStDate;
|
1282 |
Rate, Price : Extended;
|
1283 |
Basis : TStBasis) : Extended;
|
1284 |
var
|
1285 |
DCFim, DCFsm, DCFis : Extended;
|
1286 |
begin
|
1287 |
if (Price <= 0.0) or (Rate < 0.0) or (Settlement < Issue) or
|
1288 |
(Settlement >= Maturity) then
|
1289 |
RaiseStFinError(stscFinBadArg);
|
1290 |
DCFim := DayCountFraction(Issue, Maturity, Settlement, Maturity,
|
1291 |
fqAnnual, Basis);
|
1292 |
DCFsm := DayCountFraction(Settlement, Maturity, Settlement, Maturity,
|
1293 |
fqAnnual, Basis);
|
1294 |
DCFis := DayCountFraction(Issue, Settlement, Settlement, Maturity,
|
1295 |
fqAnnual, Basis);
|
1296 |
Result := 100.0 * (1.0 + Rate * DCFim);
|
1297 |
Result := Result / (Price + 100.0 * Rate * DCFis);
|
1298 |
Result := (Result - 1.0) / DCFsm;
|
1299 |
end;
|
1300 |
|
1301 |
|
1302 |
|
1303 |
initialization
|
1304 |
RecipLn10 := 1.0 / Ln(10.0);
|
1305 |
end.
|
1306 |
|