paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Add interest rate calculation to complete financial functions supported by fpspreadsheet. Extract financial stuff into separate unit "financemath.pas" which will be proposed as a fpc feature request.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3294 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2014-07-07 12:04:33 +00:00
parent c30222aac7
commit 9f226d94bd
4 changed files with 414 additions and 273 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

184
components/fpspreadsheet/examples/other/financemath.pas Normal file
View File

@ -0,0 +1,184 @@
unit financemath;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
{ Cash flow equation:
FV + PV * q^n + PMT (q^n - 1) / (q - 1) = 0 (1)
with
q = 1 + interest rate (RATE)
PV = present value of an investment
FV = future value of an investment
PMT = regular payment (per period)
n = NPER = number of payment periods
This is valid for payments occuring at the end of each period. If payments
occur at the start of each period the payments are multiplied by a factor q.
This case is indicated by means of the parameter PaymentTime below.
The interest rate is considered as "per period" - whatever that is.
If the period is 1 year then we use the "usual" interest rate.
If the period is 1 month then we use 1/12 of the yearly interest rate.
Sign rules:
- Money that I receive is to a positive number
- Money that I pay is to a negative number.
Example 1: Saving account
- A saving account has an initial balance of 1000 $ (PV).
I paid this money to the bank --> negative number
- I deposit 100$ regularly to this account (PMT): I pay this money --> negative number.
- At the end of the payments (NPER periods) I get the money back --> positive number.
This is the FV.
Example 2: Loan
- I borrow 1000$ from the bank: I get money --> positive PV
- I pay 100$ back to the bank in regular intervals --> negative PMT
- At the end, all debts are paid --> FV = 0.
The cash flow equation (1) contains 5 parameters (Rate, PV, FV, PMT, NPER).
The functions below solve this equation always for one of these parameters.
References:
- http://en.wikipedia.org/wiki/Time_value_of_money
- https://wiki.openoffice.org/wiki/Documentation/How_Tos/Calc:_Derivation_of_Financial_Formulas
}
type
TPaymentTime = (ptEndOfPeriod, ptStartOfPeriod);
function FutureValue(ARate: Extended; NPeriods: Integer;
APayment, APresentValue: Extended; APaymentTime: TPaymentTime): Extended;
function InterestRate(NPeriods: Integer; APayment, APresentValue, AFutureValue: Extended;
APaymentTime: TPaymentTime): Extended;
function NumberOfPeriods(ARate, APayment, APresentValue, AFutureValue: Extended;
APaymentTime: TPaymentTime): Extended;
function Payment(ARate: Extended; NPeriods: Integer;
APresentValue, AFutureValue: Extended; APaymentTime: TPaymentTime): Extended;
function PresentValue(ARate: Extended; NPeriods: Integer;
APayment, AFutureValue: Extended; APaymentTime: TPaymentTime): Extended;
implementation
uses
math;
function FutureValue(ARate: Extended; NPeriods: Integer;
APayment, APresentValue: Extended; APaymentTime: TPaymentTime): Extended;
var
q, qn, factor: Extended;
begin
if ARate = 0 then
Result := -APresentValue - APayment * NPeriods
else begin
q := 1.0 + ARate;
qn := power(q, NPeriods);
factor := (qn - 1) / (q - 1);
if APaymentTime = ptStartOfPeriod then
factor := factor * q;
Result := -(APresentValue * qn + APayment*factor);
end;
end;
function InterestRate(NPeriods: Integer; APayment, APresentValue, AFutureValue: Extended;
APaymentTime: TPaymentTime): Extended;
{ The interest rate cannot be calculated analytically. We solve the equation
numerically by means of the Newton method:
- guess value for the interest reate
- calculate at which interest rate the tangent of the curve fv(rate)
(straight line!) has the requested future vale.
- use this rate for the next iteration. }
const
DELTA = 0.001;
EPS = 1E-9; // required precision of interest rate (after typ. 6 iterations)
MAXIT = 20; // max iteration count to protect agains non-convergence
var
r1, r2, dr: Extended;
fv1, fv2: Extended;
iteration: Integer;
begin
iteration := 0;
r1 := 0.05; // inital guess
repeat
r2 := r1 + DELTA;
fv1 := FutureValue(r1, NPeriods, APayment, APresentValue, APaymentTime);
fv2 := FutureValue(r2, NPeriods, APayment, APresentValue, APaymentTime);
dr := (AFutureValue - fv1) / (fv2 - fv1) * delta; // tangent at fv(r)
r1 := r1 + dr; // next guess
inc(iteration);
until (abs(dr) < EPS) or (iteration >= MAXIT);
Result := r1;
end;
function NumberOfPeriods(ARate, APayment, APresentValue, AFutureValue: extended;
APaymentTime: TPaymentTime): extended;
{ Solve the cash flow equation (1) for q^n and take the logarithm }
var
q, x1, x2: Extended;
begin
if ARate = 0 then
Result := -(APresentValue + AFutureValue) / APayment
else begin
q := 1.0 + ARate;
if APaymentTime = ptStartOfPeriod then
APayment := APayment * q;
x1 := APayment - AFutureValue * ARate;
x2 := APayment + APresentValue * ARate;
if (x2 = 0) // we have to divide by x2
or (sign(x1) * sign(x2) < 0) // the argument of the log is negative
then
Result := Infinity
else begin
Result := ln(x1/x2) / ln(q);
end;
end;
end;
function Payment(ARate: Extended; NPeriods: Integer;
APresentValue, AFutureValue: Extended; APaymentTime: TPaymentTime): Extended;
var
q, qn, factor: Extended;
begin
if ARate = 0 then
Result := -(AFutureValue + APresentValue) / NPeriods
else begin
q := 1.0 + ARate;
qn := power(q, NPeriods);
factor := (qn - 1) / (q - 1);
if APaymentTime = ptStartOfPeriod then
factor := factor * q;
Result := -(AFutureValue + APresentValue * qn) / factor;
end;
end;
function PresentValue(ARate: Extended; NPeriods: Integer;
APayment, AFutureValue: Extended; APaymentTime: TPaymentTime): Extended;
var
q, qn, factor: Extended;
begin
if ARate = 0.0 then
Result := -AFutureValue - APayment * NPeriods
else begin
q := 1.0 + ARate;
qn := power(q, NPeriods);
factor := (qn - 1) / (q - 1);
if APaymentTime = ptStartOfPeriod then
factor := factor * q;
Result := -(AFutureValue + APayment*factor) / qn;
end;
end;
end.

7
components/fpspreadsheet/examples/other/test_formula_func.lpi
View File

@ -60,12 +60,17 @@
<PackageName Value="laz_fpspreadsheet"/> <PackageName Value="laz_fpspreadsheet"/>
</Item1> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="1"> <Units Count="2">
<Unit0> <Unit0>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="test_formula_func"/> <UnitName Value="test_formula_func"/>
</Unit0> </Unit0>
<Unit1>
<Filename Value="financemath.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="financemath"/>
</Unit1>
</Units> </Units>
</ProjectOptions> </ProjectOptions>
<CompilerOptions> <CompilerOptions>

123
components/fpspreadsheet/examples/other/test_formula_func.lps
View File

@ -4,204 +4,211 @@
<PathDelim Value="\"/> <PathDelim Value="\"/>
<Version Value="9"/> <Version Value="9"/>
<BuildModes Active="Debug"/> <BuildModes Active="Debug"/>
<Units Count="8"> <Units Count="9">
<Unit0> <Unit0>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="test_formula_func"/> <UnitName Value="test_formula_func"/>
<IsVisibleTab Value="True"/> <IsVisibleTab Value="True"/>
<TopLine Value="373"/> <TopLine Value="134"/>
<CursorPos X="30" Y="209"/> <CursorPos X="57" Y="142"/>
<UsageCount Value="37"/> <UsageCount Value="39"/>
<Bookmarks Count="1"> <Bookmarks Count="1">
<Item0 X="21" Y="325" ID="1"/> <Item0 X="21" Y="239" ID="1"/>
</Bookmarks> </Bookmarks>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="financemath.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="financemath"/>
<EditorIndex Value="1"/>
<TopLine Value="34"/>
<UsageCount Value="22"/>
<Loaded Value="True"/>
</Unit1>
<Unit2>
<Filename Value="..\..\fpspreadsheet.pas"/> <Filename Value="..\..\fpspreadsheet.pas"/>
<UnitName Value="fpspreadsheet"/> <UnitName Value="fpspreadsheet"/>
<EditorIndex Value="5"/> <EditorIndex Value="5"/>
<TopLine Value="1216"/> <TopLine Value="1216"/>
<CursorPos X="9" Y="1128"/> <CursorPos X="9" Y="1128"/>
<UsageCount Value="18"/> <UsageCount Value="20"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit1> </Unit2>
<Unit2> <Unit3>
<Filename Value="..\..\fpsfunc.pas"/> <Filename Value="..\..\fpsfunc.pas"/>
<UnitName Value="fpsfunc"/> <UnitName Value="fpsfunc"/>
<EditorIndex Value="4"/> <EditorIndex Value="4"/>
<TopLine Value="113"/> <TopLine Value="113"/>
<CursorPos X="10" Y="132"/> <CursorPos X="10" Y="132"/>
<UsageCount Value="18"/> <UsageCount Value="20"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit2> </Unit3>
<Unit3> <Unit4>
<Filename Value="..\..\fpsutils.pas"/> <Filename Value="..\..\fpsutils.pas"/>
<UnitName Value="fpsutils"/> <UnitName Value="fpsutils"/>
<EditorIndex Value="3"/> <EditorIndex Value="3"/>
<TopLine Value="876"/> <TopLine Value="876"/>
<CursorPos Y="894"/> <CursorPos Y="894"/>
<UsageCount Value="18"/> <UsageCount Value="20"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit3> </Unit4>
<Unit4> <Unit5>
<Filename Value="..\..\fpolebasic.pas"/> <Filename Value="..\..\fpolebasic.pas"/>
<UnitName Value="fpolebasic"/> <UnitName Value="fpolebasic"/>
<EditorIndex Value="2"/> <EditorIndex Value="2"/>
<TopLine Value="43"/> <TopLine Value="43"/>
<CursorPos X="29" Y="53"/> <CursorPos X="29" Y="53"/>
<UsageCount Value="18"/> <UsageCount Value="20"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit4> </Unit5>
<Unit5> <Unit6>
<Filename Value="..\..\xlsbiff8.pas"/> <Filename Value="..\..\xlsbiff8.pas"/>
<UnitName Value="xlsbiff8"/> <UnitName Value="xlsbiff8"/>
<EditorIndex Value="6"/> <EditorIndex Value="6"/>
<TopLine Value="63"/> <TopLine Value="63"/>
<CursorPos X="20" Y="83"/> <CursorPos X="20" Y="83"/>
<UsageCount Value="17"/> <UsageCount Value="19"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit5> </Unit6>
<Unit6> <Unit7>
<Filename Value="..\..\xlscommon.pas"/> <Filename Value="..\..\xlscommon.pas"/>
<UnitName Value="xlscommon"/> <UnitName Value="xlscommon"/>
<EditorIndex Value="7"/> <EditorIndex Value="7"/>
<TopLine Value="1084"/> <TopLine Value="1084"/>
<CursorPos Y="1103"/> <CursorPos Y="1103"/>
<UsageCount Value="17"/> <UsageCount Value="19"/>
<Loaded Value="True"/> <Loaded Value="True"/>
</Unit6> </Unit7>
<Unit7> <Unit8>
<Filename Value="d:\lazarus-svn\fpc\2.6.4\source\rtl\objpas\math.pp"/> <Filename Value="d:\lazarus-svn\fpc\2.6.4\source\rtl\objpas\math.pp"/>
<UnitName Value="math"/> <EditorIndex Value="-1"/>
<EditorIndex Value="1"/>
<TopLine Value="294"/> <TopLine Value="294"/>
<CursorPos X="10" Y="313"/> <CursorPos X="10" Y="313"/>
<UsageCount Value="13"/> <UsageCount Value="13"/>
<Loaded Value="True"/> </Unit8>
</Unit7>
</Units> </Units>
<JumpHistory Count="30" HistoryIndex="29"> <JumpHistory Count="30" HistoryIndex="29">
<Position1> <Position1>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="66" Column="12" TopLine="53"/> <Caret Line="74" TopLine="51"/>
</Position1> </Position1>
<Position2> <Position2>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="78" Column="28" TopLine="59"/> <Caret Line="77" TopLine="51"/>
</Position2> </Position2>
<Position3> <Position3>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="70" TopLine="59"/> <Caret Line="78" TopLine="51"/>
</Position3> </Position3>
<Position4> <Position4>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="71" TopLine="59"/> <Caret Line="69" Column="42" TopLine="51"/>
</Position4> </Position4>
<Position5> <Position5>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="73" TopLine="59"/> <Caret Line="82" TopLine="63"/>
</Position5> </Position5>
<Position6> <Position6>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="74" TopLine="59"/> <Caret Line="83" Column="29" TopLine="63"/>
</Position6> </Position6>
<Position7> <Position7>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="77" TopLine="59"/> <Caret Line="86" Column="22" TopLine="63"/>
</Position7> </Position7>
<Position8> <Position8>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="78" TopLine="59"/> <Caret Line="96" Column="103" TopLine="78"/>
</Position8> </Position8>
<Position9> <Position9>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="96" Column="46" TopLine="59"/> <Caret Line="99" TopLine="68"/>
</Position9> </Position9>
<Position10> <Position10>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="362" TopLine="262"/> <Caret Line="97" Column="68" TopLine="69"/>
</Position10> </Position10>
<Position11> <Position11>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="70" TopLine="51"/> <Caret Line="98" Column="13" TopLine="64"/>
</Position11> </Position11>
<Position12> <Position12>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="71" TopLine="51"/> <Caret Line="97" Column="3" TopLine="68"/>
</Position12> </Position12>
<Position13> <Position13>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="73" TopLine="51"/> <Caret Line="96" Column="3" TopLine="68"/>
</Position13> </Position13>
<Position14> <Position14>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="74" TopLine="51"/> <Caret Line="98" Column="13" TopLine="71"/>
</Position14> </Position14>
<Position15> <Position15>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="77" TopLine="51"/> <Caret Line="97" Column="9" TopLine="71"/>
</Position15> </Position15>
<Position16> <Position16>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="78" TopLine="51"/> <Caret Line="92" Column="11" TopLine="71"/>
</Position16> </Position16>
<Position17> <Position17>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="69" Column="42" TopLine="51"/> <Caret Line="367" Column="28" TopLine="346"/>
</Position17> </Position17>
<Position18> <Position18>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="82" TopLine="63"/> <Caret Line="379" Column="26" TopLine="339"/>
</Position18> </Position18>
<Position19> <Position19>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="83" Column="29" TopLine="63"/> <Caret Line="105" Column="8" TopLine="103"/>
</Position19> </Position19>
<Position20> <Position20>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="86" Column="22" TopLine="63"/> <Caret Line="293" TopLine="288"/>
</Position20> </Position20>
<Position21> <Position21>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="96" Column="103" TopLine="78"/> <Caret Line="49" Column="36" TopLine="35"/>
</Position21> </Position21>
<Position22> <Position22>
<Filename Value="test_formula_func.pas"/> <Filename Value="financemath.pas"/>
<Caret Line="99" TopLine="68"/> <Caret Line="55" Column="21" TopLine="51"/>
</Position22> </Position22>
<Position23> <Position23>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="97" Column="68" TopLine="69"/> <Caret Line="113" Column="31" TopLine="109"/>
</Position23> </Position23>
<Position24> <Position24>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="98" Column="13" TopLine="64"/> <Caret Line="170" Column="34" TopLine="163"/>
</Position24> </Position24>
<Position25> <Position25>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="97" Column="3" TopLine="68"/> <Caret Line="198" Column="34" TopLine="183"/>
</Position25> </Position25>
<Position26> <Position26>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="96" Column="3" TopLine="68"/> <Caret Line="213" Column="76" TopLine="198"/>
</Position26> </Position26>
<Position27> <Position27>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="98" Column="13" TopLine="71"/> <Caret Line="118" Column="29" TopLine="105"/>
</Position27> </Position27>
<Position28> <Position28>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="97" Column="9" TopLine="71"/> <Caret Line="209" Column="44" TopLine="189"/>
</Position28> </Position28>
<Position29> <Position29>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="92" Column="11" TopLine="71"/> <Caret Line="114" Column="36" TopLine="100"/>
</Position29> </Position29>
<Position30> <Position30>
<Filename Value="test_formula_func.pas"/> <Filename Value="test_formula_func.pas"/>
<Caret Line="367" Column="28" TopLine="346"/> <Caret Line="123" Column="39" TopLine="108"/>
</Position30> </Position30>
</JumpHistory> </JumpHistory>
</ProjectSession> </ProjectSession>

373
components/fpspreadsheet/examples/other/test_formula_func.pas
View File

@ -24,134 +24,29 @@ uses
{$ENDIF}{$ENDIF} {$ENDIF}{$ENDIF}
Classes, SysUtils, laz_fpspreadsheet Classes, SysUtils, laz_fpspreadsheet
{ you can add units after this }, { you can add units after this },
math, fpspreadsheet, xlsbiff8, fpsfunc; math, fpspreadsheet, xlsbiff8, fpsfunc, financemath;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
{ Basic implmentation of the four financial funtions } { Adaption of financial functions to usage by fpspreadsheet }
{------------------------------------------------------------------------------} { The functions are implemented in the unit "financemath.pas". }
const
paymentAtEnd = 0;
paymentAtBegin = 1;
{ Calculates the future value (FV) of an investment based on an interest rate and
a constant payment schedule:
- "interest_rate" (r) is the interest rate for the investment (as decimal, not percent)
- "number_periods" (n) is the number of payment periods, i.e. number of payments
for the annuity.
- "payment" (PMT) is the amount of the payment made each period
- "pv" is the present value of the payments.
- "payment_type" indicates when the payments are due (see paymentAtXXX constants)
see: http://en.wikipedia.org/wiki/Time_value_of_money
or https://wiki.openoffice.org/wiki/Documentation/How_Tos/Calc:_Derivation_of_Financial_Formulas#PV.2C_FV.2C_PMT.2C_NPER.2C_RATE
As in Excel's implementation the cash flow is a signed number:
- Positive cash flow means: "I get money"
- Negative cash flow means: "I pay money"
With these conventions, the contributions (FV, PV, Payments) add up to 0:
FV + PV q^n + PMT (q^n - 1) / (q - 1) = 0 ( q = 1 + r )
}
function FV(interest_rate: Double; number_periods: Integer; payment, pv: Double;
payment_type: integer): Double;
var
q, qn, factor: Double;
begin
q := 1.0 + interest_rate;
qn := power(q, number_periods);
factor := (qn - 1) / (q - 1);
if payment_type = paymentAtBegin then
factor := factor * q;
Result := -(pv * qn + payment*factor);
end;
{ Calculates the number of periods for an investment based on an interest rate
and a constant payment schedule.
Solve above formula for qn and then take the log to get n.
}
function NPER(interest_rate, payment, pv, fv: Double;
payment_type:Integer): double;
var
q, x1, x2, T: Double;
begin
if interest_rate = 0 then
Result := (pv + fv) / payment
else
q := 1.0 + interest_rate;
if payment_type = paymentAtBegin then
payment := payment * q;
x2 := pv * interest_rate + payment;
if x2 = 0 then
Result := Infinity
else begin
x1 := -fv * interest_rate + payment;
Result := ln(x1/x2) / ln(q);
end;
end;
{ Calculates the regular payments for a loan based on an interest rate and a
constant payment schedule
Arguments as shown for FV(), in addition:
- "fv" is the future value of the payments.
see: http://en.wikipedia.org/wiki/Time_value_of_money
}
function PMT(interest_rate: Double; number_periods: Integer; pv, fv: Double;
payment_type: Integer): Double;
var
q, qn, factor: Double;
begin
q := 1.0 + interest_rate;
qn := power(q, number_periods);
factor := (qn - 1) / (q - 1);
if payment_type = paymentAtBegin then
factor := factor * q;
Result := -(fv + pv * qn) / factor;
end;
{ Calculates the present value of an investment based on an interest rate and
a constant payment schedule.
Arguments as shown for FV(), in addition:
- "fv" is the future value of the payments.
see: http://en.wikipedia.org/wiki/Time_value_of_money
}
function PV(interest_rate: Double; number_periods: Integer; payment, fv: Double;
payment_type: Integer): Double;
var
q, qn, factor: Double;
begin
q := 1.0 + interest_rate;
qn := power(q, number_periods);
factor := (qn - 1) / (q - 1);
if payment_type = paymentAtBegin then
factor := factor * q;
Result := -(fv + payment*factor) / qn;
end;
{------------------------------------------------------------------------------}
{ Adaption for usage by fpspreadsheet }
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
function fpsFV(Args: TsArgumentStack; NumArgs: Integer): TsArgument; function fpsFV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var var
data: TsArgNumberArray; data: TsArgNumberArray;
begin begin
// Pop the argument off the stack. This can be done by means of PopNumberValues // Pop the argument from the stack. This can be done by means of PopNumberValues
// which brings the values back into the right order and reports an error // which brings the values back in the right order and reports an error
// in case of non-numerical values. // in case of non-numerical values.
if Args.PopNumberValues(NumArgs, false, data, Result) then if Args.PopNumberValues(NumArgs, false, data, Result) then
// Call our FV function with the NumberValues of the arguments. // Call the FutureValue function with the NumberValues of the arguments.
Result := CreateNumberArg(FV( Result := CreateNumberArg(FutureValue(
data[0], // interest rate data[0], // interest rate
round(data[1]), // number of payments round(data[1]), // number of payments
data[2], // payment data[2], // payment
data[3], // present value data[3], // present value
round(data[4]) // payment type TPaymentTime(round(data[4])) // payment type
)); ));
end; end;
@ -160,12 +55,12 @@ var
data: TsArgNumberArray; data: TsArgNumberArray;
begin begin
if Args.PopNumberValues(NumArgs, false, data, Result) then if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(PMT( Result := CreateNumberArg(Payment(
data[0], // interest rate data[0], // interest rate
round(data[1]), // number of payments round(data[1]), // number of payments
data[2], // present value data[2], // present value
data[3], // future value data[3], // future value
round(data[4]) // payment type TPaymentTime(round(data[4])) // payment type
)); ));
end; end;
@ -174,12 +69,12 @@ var
data: TsArgNumberArray; data: TsArgNumberArray;
begin begin
if Args.PopNumberValues(NumArgs, false, data, Result) then if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(PV( Result := CreateNumberArg(PresentValue(
data[0], // interest rate data[0], // interest rate
round(data[1]), // number of payments round(data[1]), // number of payments
data[2], // payment data[2], // payment
data[3], // future value data[3], // future value
round(data[4]) // payment type TPaymentTime(round(data[4])) // payment type
)); ));
end; end;
@ -188,12 +83,26 @@ var
data: TsArgNumberArray; data: TsArgNumberArray;
begin begin
if Args.PopNumberValues(NumArgs, false, data, Result) then if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(NPER( Result := CreateNumberArg(NumberOfPeriods(
data[0], // interest rate data[0], // interest rate
data[1], // payment data[1], // payment
data[2], // present value data[2], // present value
data[3], // future value data[3], // future value
round(data[4]) // payment type TPaymentTime(round(data[4])) // payment type
));
end;
function fpsRATE(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(InterestRate(
round(data[0]), // number of payment periods
data[1], // payment
data[2], // present value
data[3], // future value
TPaymentTime(round(data[4])) // payment type
)); ));
end; end;
@ -202,159 +111,192 @@ end;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
procedure WriteFile(AFileName: String); procedure WriteFile(AFileName: String);
const const
INTEREST_RATE = 0.03; INTEREST_RATE = 0.03; // interest rate per period
NUMBER_PAYMENTS = 10; NUMBER_PAYMENTS = 10; // number of payment periods
PAYMENT = 1000; REG_PAYMENT = 1000; // regular payment per period
PRESENT_VALUE = 10000; PRESENT_VALUE = 10000; // present value of investment
PAYMENT_WHEN = paymentAtEnd; PAYMENT_WHEN: TPaymentTime = ptEndOfPeriod; // when is the payment made
var var
workbook: TsWorkbook; workbook: TsWorkbook;
worksheet: TsWorksheet; worksheet: TsWorksheet;
fval, pval, pmtval, nperval: Double; fval, pval, pmtval, nperval, rateval: Double;
begin begin
{ We have to register our financial function in fpspreadsheet. Otherwise an { We have to register our financial functions in fpspreadsheet. Otherwise an
error code would be displayed in the reading part of this demo in these error code would be displayed in the reading part of this demo for these
formula cells. } formula cells. }
RegisterFormulaFunc(fekFV, @fpsFV); RegisterFormulaFunc(fekFV, @fpsFV);
RegisterFormulaFunc(fekPMT, @fpsPMT); RegisterFormulaFunc(fekPMT, @fpsPMT);
RegisterFormulaFunc(fekPV, @fpsPV); RegisterFormulaFunc(fekPV, @fpsPV);
RegisterFormulaFunc(fekNPER, @fpsNPER); RegisterFormulaFunc(fekNPER, @fpsNPER);
RegisterFormulaFunc(fekRATE, @fpsRATE);
workbook := TsWorkbook.Create; workbook := TsWorkbook.Create;
try try
worksheet := workbook.AddWorksheet('Financial'); worksheet := workbook.AddWorksheet('Financial');
worksheet.Options := worksheet.Options + [soCalcBeforeSaving]; worksheet.Options := worksheet.Options + [soCalcBeforeSaving];
worksheet.WriteColWidth(0, 40); worksheet.WriteColWidth(0, 40);
worksheet.WriteColWidth(1, 15);
worksheet.WriteUTF8Text(0, 0, 'Interest rate'); worksheet.WriteUTF8Text(0, 0, 'INPUT DATA');
worksheet.WriteNumber(0, 1, INTEREST_RATE, nfPercentage, 1); // B1 worksheet.WriteFontStyle(0, 0, [fssBold]);
worksheet.WriteUTF8Text(1, 0, 'Number of payments'); worksheet.WriteUTF8Text(1, 0, 'Interest rate');
worksheet.WriteNumber(1, 1, NUMBER_PAYMENTS); // B2 worksheet.WriteNumber(1, 1, INTEREST_RATE, nfPercentage, 1); // B2
worksheet.WriteUTF8Text(2, 0, 'Payment'); worksheet.WriteUTF8Text(2, 0, 'Number of payments');
worksheet.WriteCurrency(2, 1, PAYMENT, nfCurrency, 2, '$'); // B3 worksheet.WriteNumber(2, 1, NUMBER_PAYMENTS); // B3
worksheet.WriteUTF8Text(3, 0, 'Present value'); worksheet.WriteUTF8Text(3, 0, 'Payment');
worksheet.WriteCurrency(3, 1, PRESENT_VALUE, nfCurrency, 2, '$'); // B4 worksheet.WriteCurrency(3, 1, REG_PAYMENT, nfCurrency, 2, '$'); // B4
worksheet.WriteUTF8Text(4, 0, 'Payment at end (0) or at begin (1)'); worksheet.WriteUTF8Text(4, 0, 'Present value');
worksheet.WriteNumber(4, 1, PAYMENT_WHEN); // B5 worksheet.WriteCurrency(4, 1, PRESENT_VALUE, nfCurrency, 2, '$'); // B5
worksheet.WriteUTF8Text(5, 0, 'Payment at end (0) or at begin (1)');
worksheet.WriteNumber(5, 1, ord(PAYMENT_WHEN)); // B6
// future value calculation // future value calculation
fval := FV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, PRESENT_VALUE, PAYMENT_WHEN); fval := FutureValue(INTEREST_RATE, NUMBER_PAYMENTS, REG_PAYMENT, PRESENT_VALUE, PAYMENT_WHEN);
worksheet.WriteUTF8Text(6, 0, 'Calculation of the future value'); worksheet.WriteUTF8Text(7, 0, 'CALCULATION OF THE FUTURE VALUE');
worksheet.WriteFontStyle(6, 0, [fssBold]); worksheet.WriteFontStyle(7, 0, [fssBold]);
worksheet.WriteUTF8Text(7, 0, 'Our calculation'); worksheet.WriteUTF8Text(8, 0, 'Direct calculation');
worksheet.WriteCurrency(7, 1, fval, nfCurrency, 2, '$'); worksheet.WriteCurrency(8, 1, fval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(8, 0, 'Excel''s calculation using constants'); worksheet.WriteUTF8Text(9, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(8, 1, nfCurrency, 2, '$'); worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(8, 1, CreateRPNFormula( // B9 worksheet.WriteRPNFormula(9, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE, RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS, RPNNumber(NUMBER_PAYMENTS,
RPNNumber(PAYMENT, RPNNumber(REG_PAYMENT,
RPNNumber(PRESENT_VALUE, RPNNumber(PRESENT_VALUE,
RPNNumber(PAYMENT_WHEN, RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekFV, 5, RPNFunc(fekFV, 5,
nil)))))))); nil))))))));
worksheet.WriteUTF8Text(9, 0, 'Excel''s calculation using cell values'); worksheet.WriteUTF8Text(10, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$'); worksheet.WriteNumberFormat(10, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(9, 1, CreateRPNFormula( // B9 worksheet.WriteRPNFormula(10, 1, CreateRPNFormula(
RPNCellValue('B1', // interest rate RPNCellValue('B2', // interest rate
RPNCellValue('B2', // number of periods RPNCellValue('B3', // number of periods
RPNCellValue('B3', // payment RPNCellValue('B4', // payment
RPNCellValue('B4', // present value RPNCellValue('B5', // present value
RPNCellValue('B5', // payment at end or at start RPNCellValue('B6', // payment at end or at start
RPNFunc(fekFV, 5, // Call Excel's FV formula RPNFunc(fekFV, 5, // Call Excel's FV formula
nil)))))))); nil))))))));
// present value calculation // present value calculation
pval := PV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, fval, PAYMENT_WHEN); pval := PresentValue(INTEREST_RATE, NUMBER_PAYMENTS, REG_PAYMENT, fval, PAYMENT_WHEN);
worksheet.WriteUTF8Text(11, 0, 'Calculation of the present value'); worksheet.WriteUTF8Text(12, 0, 'CALCULATION OF THE PRESENT VALUE');
worksheet.WriteFontStyle(11, 0, [fssBold]); worksheet.WriteFontStyle(12, 0, [fssBold]);
worksheet.WriteUTF8Text(12, 0, 'Our calculation'); worksheet.WriteUTF8Text(13, 0, 'Direct calculation');
worksheet.WriteCurrency(12, 1, pval, nfCurrency, 2, '$'); worksheet.WriteCurrency(13, 1, pval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(13, 0, 'Excel''s calculation using constants'); worksheet.WriteUTF8Text(14, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(13, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(13, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(PAYMENT,
RPNNumber(fval,
RPNNumber(PAYMENT_WHEN,
RPNFunc(fekPV, 5,
nil))))))));
Worksheet.WriteUTF8Text(14, 0, 'Excel''s calculation using cell values');
worksheet.WriteNumberFormat(14, 1, nfCurrency, 2, '$'); worksheet.WriteNumberFormat(14, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(14, 1, CreateRPNFormula( worksheet.WriteRPNFormula(14, 1, CreateRPNFormula(
RPNCellValue('B1', // interest rate RPNNumber(INTEREST_RATE,
RPNCellValue('B2', // number of periods RPNNumber(NUMBER_PAYMENTS,
RPNCellValue('B3', // payment RPNNumber(REG_PAYMENT,
RPNCellValue('B10', // future value RPNNumber(fval,
RPNCellValue('B5', // payment at end or at start RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekPV, 5,
nil))))))));
Worksheet.WriteUTF8Text(15, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(15, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(15, 1, CreateRPNFormula(
RPNCellValue('B2', // interest rate
RPNCellValue('B3', // number of periods
RPNCellValue('B4', // payment
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekPV, 5, // Call Excel's PV formula RPNFunc(fekPV, 5, // Call Excel's PV formula
nil)))))))); nil))))))));
// payments calculation // payments calculation
pmtval := PMT(INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, PAYMENT_WHEN); pmtval := Payment(INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, PAYMENT_WHEN);
worksheet.WriteUTF8Text(16, 0, 'Calculation of the payment'); worksheet.WriteUTF8Text(17, 0, 'CALCULATION OF THE PAYMENT');
worksheet.WriteFontStyle(16, 0, [fssBold]); worksheet.WriteFontStyle(17, 0, [fssBold]);
worksheet.WriteUTF8Text(17, 0, 'Our calculation'); worksheet.WriteUTF8Text(18, 0, 'Direct calculation');
worksheet.WriteCurrency(17, 1, pmtval, nfCurrency, 2, '$'); worksheet.WriteCurrency(18, 1, pmtval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(18, 0, 'Excel''s calculation using constants'); worksheet.WriteUTF8Text(19, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(18, 1, nfCurrency, 2, '$'); worksheet.WriteNumberFormat(19, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(18, 1, CreateRPNFormula( worksheet.WriteRPNFormula(19, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE, RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS, RPNNumber(NUMBER_PAYMENTS,
RPNNumber(PRESENT_VALUE, RPNNumber(PRESENT_VALUE,
RPNNumber(fval, RPNNumber(fval,
RPNNumber(PAYMENT_WHEN, RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekPMT, 5, RPNFunc(fekPMT, 5,
nil)))))))); nil))))))));
Worksheet.WriteUTF8Text(19, 0, 'Excel''s calculation using cell values'); Worksheet.WriteUTF8Text(20, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(19, 1, nfCurrency, 2, '$'); worksheet.WriteNumberFormat(20, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(19, 1, CreateRPNFormula( worksheet.WriteRPNFormula(20, 1, CreateRPNFormula(
RPNCellValue('B1', // interest rate RPNCellValue('B2', // interest rate
RPNCellValue('B2', // number of periods RPNCellValue('B3', // number of periods
RPNCellValue('B4', // present value RPNCellValue('B5', // present value
RPNCellValue('B10', // future value RPNCellValue('B11', // future value
RPNCellValue('B5', // payment at end or at start RPNCellValue('B6', // payment at end or at start
RPNFunc(fekPMT, 5, // Call Excel's PMT formula RPNFunc(fekPMT, 5, // Call Excel's PMT formula
nil)))))))); nil))))))));
// number of periods calculation // number of periods calculation
nperval := NPER(INTEREST_RATE, PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN); nperval := NumberOfPeriods(INTEREST_RATE, REG_PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN);
worksheet.WriteUTF8Text(21, 0, 'Calculation of the number of payment periods'); worksheet.WriteUTF8Text(22, 0, 'CALCULATION OF THE NUMBER OF PAYMENT PERIODS');
worksheet.WriteFontStyle(21, 0, [fssBold]); worksheet.WriteFontStyle(22, 0, [fssBold]);
worksheet.WriteUTF8Text(22, 0, 'Our calculation'); worksheet.WriteUTF8Text(23, 0, 'Direct calculation');
worksheet.WriteNumber(22, 1, nperval, nfFixed, 2); worksheet.WriteNumber(23, 1, nperval, nfFixed, 2);
worksheet.WriteUTF8Text(23, 0, 'Excel''s calculation using constants'); worksheet.WriteUTF8Text(24, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(23, 1, nfFixed, 2);
worksheet.WriteRPNFormula(23, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(PAYMENT,
RPNNumber(PRESENT_VALUE,
RPNNumber(fval,
RPNNumber(PAYMENT_WHEN,
RPNFunc(fekNPER, 5,
nil))))))));
Worksheet.WriteUTF8Text(24, 0, 'Excel''s calculation using cell values');
worksheet.WriteNumberFormat(24, 1, nfFixed, 2); worksheet.WriteNumberFormat(24, 1, nfFixed, 2);
worksheet.WriteRPNFormula(24, 1, CreateRPNFormula( worksheet.WriteRPNFormula(24, 1, CreateRPNFormula(
RPNCellValue('B1', // interest rate RPNNumber(INTEREST_RATE,
RPNCellValue('B3', // payment RPNNumber(REG_PAYMENT,
RPNCellValue('B4', // present value RPNNumber(PRESENT_VALUE,
RPNCellValue('B10', // future value RPNNumber(fval,
RPNCellValue('B5', // payment at end or at start RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekNPER, 5,
nil))))))));
Worksheet.WriteUTF8Text(25, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(25, 1, nfFixed, 2);
worksheet.WriteRPNFormula(25, 1, CreateRPNFormula(
RPNCellValue('B2', // interest rate
RPNCellValue('B4', // payment
RPNCellValue('B5', // present value
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekNPER, 5, // Call Excel's PMT formula RPNFunc(fekNPER, 5, // Call Excel's PMT formula
nil)))))))); nil))))))));
// interest rate calculation
rateval := InterestRate(NUMBER_PAYMENTS, REG_PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN);
worksheet.WriteUTF8Text(27, 0, 'CALCULATION OF THE INTEREST RATE');
worksheet.WriteFontStyle(27, 0, [fssBold]);
worksheet.WriteUTF8Text(28, 0, 'Direct calculation');
worksheet.WriteNumber(28, 1, rateval, nfPercentage, 2);
worksheet.WriteUTF8Text(29, 0, 'Worksheet calculation using constants');
worksheet.WriteNumberFormat(29, 1, nfPercentage, 2);
worksheet.WriteRPNFormula(29, 1, CreateRPNFormula(
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(REG_PAYMENT,
RPNNumber(PRESENT_VALUE,
RPNNumber(fval,
RPNNumber(ord(PAYMENT_WHEN),
RPNFunc(fekRATE, 5,
nil))))))));
Worksheet.WriteUTF8Text(30, 0, 'Worksheet calculation using cell values');
worksheet.WriteNumberFormat(30, 1, nfPercentage, 2);
worksheet.WriteRPNFormula(30, 1, CreateRPNFormula(
RPNCellValue('B3', // number of payments
RPNCellValue('B4', // payment
RPNCellValue('B5', // present value
RPNCellValue('B11', // future value
RPNCellValue('B6', // payment at end or at start
RPNFunc(fekRATE, 5, // Call Excel's PMT formula
nil))))))));
workbook.WriteToFile(AFileName, sfExcel8, true); workbook.WriteToFile(AFileName, sfExcel8, true);
finally finally
@ -389,6 +331,9 @@ begin
s2 := UTF8ToAnsi(worksheet.ReadAsUTF8Text(r, 1)); s2 := UTF8ToAnsi(worksheet.ReadAsUTF8Text(r, 1));
if s1 = '' then if s1 = '' then
WriteLn WriteLn
else
if s2 = '' then
WriteLn(s1)
else else
WriteLn(s1+': ':50, s2); WriteLn(s1+': ':50, s2);
end; end;