| 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 |
|
Parent Directory
| 
Revision Log