pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Add financial function PV and PMT to test_formula_func demo.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3285 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-07-05 21:48:12 +00:00
parent 9fb1a96f20
commit a62bba2b72
3 changed files with 353 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,18 +1,34 @@
{ This demo show how a user-provided function can be used for calculation of
{ This demo show how user-provided functions can be used for calculation of
rpn formulas that are built-in to fpspreadsheet, but don't have an own
calculation procedure. }
calculation procedure.
The example will show implementation of the some financial formulas:
- FV(...) (future value)
- PV(...) (present value)
- PMT(...) (payment)
The demo writes an xls file which uses these formulas and then displays
the result in a console window. (Open the generated file in Excel or
Open/LibreOffice and compare).
}
program test_formula_func;
{$mode objfpc}{$H+}
//{$mode objfpc}{$H+}
{$mode delphi}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, laz_fpspreadsheet
Classes, SysUtils, laz_fpspreadsheet
{ you can add units after this },
math, fpspreadsheet, fpsfunc;
math, fpspreadsheet, xlsbiff8, fpsfunc;
{------------------------------------------------------------------------------}
{ Basic implmentation of the three financial funtions }
{------------------------------------------------------------------------------}
const
paymentAtEnd = 0;
@ -24,24 +40,72 @@ const
- "number_periods" is the number of payment periods, i.e. number of payments
for the annuity.
- "payment" is the amount of the payment made each period
- "PV" is the present value of the payments.
- "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/Future_value
see: http://en.wikipedia.org/wiki/Time_value_of_money
In Excel's implementation the payments and the FV add up to 0:
FV + PV q^n + PMT (q^n - 1) / (q - 1) = 0
}
function FV(interest_rate, number_periods, payment, pv: Double;
function FV(interest_rate: Double; number_periods: Integer; payment, pv: Double;
payment_type: integer): Double;
var
q: Double;
q, qn, factor: Double;
begin
q := 1.0 + interest_rate;
Result := pv * power(q, number_periods) +
(power(q, number_periods) - 1) / (q - 1) * payment;
qn := power(q, number_periods);
factor := (qn - 1) / (q - 1);
if payment_type = paymentAtBegin then
Result := Result * q;
factor := factor * q;
Result := -(pv * qn + payment*factor);
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;
var
data: TsArgNumberArray;
@ -52,14 +116,47 @@ begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
// Call our FV function with the NumberValues of the arguments.
Result := CreateNumberArg(FV(
data[0], // interest rate
data[1], // number of payments
data[2], // payment
data[3], // present value
round(data[4]) // payment type
data[0], // interest rate
round(data[1]), // number of payments
data[2], // payment
data[3], // present value
round(data[4]) // payment type
));
end;
function fpsPMT(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(PMT(
data[0], // interest rate
round(data[1]), // number of payments
data[2], // present value
data[3], // future value
round(data[4]) // payment type
));
end;
function fpsPV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
Result := CreateNumberArg(PV(
data[0], // interest rate
round(data[1]), // number of payments
data[2], // payment
data[3], // future value
round(data[4]) // payment type
));
end;
{------------------------------------------------------------------------------}
{ Write xls file comparing our own calculations with Excel result }
{------------------------------------------------------------------------------}
procedure WriteFile(AFileName: String);
const
INTEREST_RATE = 0.03;
NUMBER_PAYMENTS = 10;
@ -70,54 +167,171 @@ const
var
workbook: TsWorkbook;
worksheet: TsWorksheet;
fval, pval, pmtval: Double;
begin
{ We have to register our financial function in fpspreadsheet. Otherwise an
error code would be displayed in the reading part of this demo in these
formula cells. }
RegisterFormulaFunc(fekFV, @fpsFV);
RegisterFormulaFunc(fekPMT, @fpsPMT);
RegisterFormulaFunc(fekPV, @fpsPV);
workbook := TsWorkbook.Create;
try
worksheet := workbook.AddWorksheet('Financial');
worksheet.Options := worksheet.Options + [soCalcBeforeSaving];
worksheet.WriteColWidth(0, 20);
worksheet.WriteColWidth(0, 40);
worksheet.WriteUTF8Text(0, 0, 'Interest rate');
worksheet.WriteNumber(0, 1, INTEREST_RATE, nfPercentage, 1);
worksheet.WriteNumber(0, 1, INTEREST_RATE, nfPercentage, 1); // B1
worksheet.WriteUTF8Text(1, 0, 'Number of payments');
worksheet.WriteNumber(1, 1, NUMBER_PAYMENTS);
worksheet.WriteNumber(1, 1, NUMBER_PAYMENTS); // B2
worksheet.WriteUTF8Text(2, 0, 'Payment');
worksheet.WriteCurrency(2, 1, PAYMENT, nfCurrency, 2, '$');
worksheet.WriteCurrency(2, 1, PAYMENT, nfCurrency, 2, '$'); // B3
worksheet.WriteUTF8Text(3, 0, 'Present value');
worksheet.WriteCurrency(3, 1, PRESENT_VALUE, nfCurrency, 2, '$');
worksheet.WriteCurrency(3, 1, PRESENT_VALUE, nfCurrency, 2, '$'); // B4
worksheet.WriteUTF8Text(4, 0, 'Payment at end');
worksheet.WriteBoolValue(4, 1, PAYMENT_WHEN = paymentAtEnd);
worksheet.WriteUTF8Text(4, 0, 'Payment at end (0) or at begin (1)');
worksheet.WriteNumber(4, 1, PAYMENT_WHEN); // B5
// future value calculation
fval := FV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, PRESENT_VALUE, PAYMENT_WHEN);
worksheet.WriteUTF8Text(6, 0, 'Future value');
worksheet.WriteFontStyle(6, 0, [fssBold]);
worksheet.WriteUTF8Text(7, 0, 'Our calculation');
worksheet.WriteCurrency(7, 1,
FV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, PRESENT_VALUE, PAYMENT_WHEN),
nfCurrency, 2, '$'
);
worksheet.WriteCurrency(7, 1, fval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(8, 0, 'Excel''s calculation');
worksheet.WriteUTF8Text(8, 0, 'Excel''s calculation using constants');
worksheet.WriteNumberFormat(8, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(8, 1, CreateRPNFormula(
worksheet.WriteRPNFormula(8, 1, CreateRPNFormula( // B9
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(-PAYMENT,
RPNNumber(-PRESENT_VALUE,
RPNNumber(PAYMENT,
RPNNumber(PRESENT_VALUE,
RPNNumber(PAYMENT_WHEN,
RPNFunc(fekFV, 5,
nil))))))));
worksheet.WriteUTF8Text(9, 0, 'Excel''s calculation using cell values');
worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(9, 1, CreateRPNFormula( // B9
RPNCellValue('B1', // interest rate
RPNCellValue('B2', // number of periods
RPNCellValue('B3', // payment
RPNCellValue('B4', // present value
RPNCellValue('B5', // payment at end or at start
RPNFunc(fekFV, 5, // Call Excel's FV formula
nil))))))));
workbook.WriteToFile('test_fv.xls', sfExcel8, true);
// present value calculation
pval := PV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, fval, PAYMENT_WHEN);
worksheet.WriteUTF8Text(11, 0, 'Present value');
worksheet.WriteFontStyle(11, 0, [fssBold]);
worksheet.WriteUTF8Text(12, 0, 'Our calculation');
worksheet.WriteCurrency(12, 1, pval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(13, 0, 'Excel''s 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.WriteRPNFormula(14, 1, CreateRPNFormula(
RPNCellValue('B1', // interest rate
RPNCellValue('B2', // number of periods
RPNCellValue('B3', // payment
RPNCellValue('B10', // future value
RPNCellValue('B5', // payment at end or at start
RPNFunc(fekPV, 5, // Call Excel's PV formula
nil))))))));
// payments calculation
pmtval := PMT(INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, PAYMENT_WHEN);
worksheet.WriteUTF8Text(16, 0, 'Payment');
worksheet.WriteFontStyle(16, 0, [fssBold]);
worksheet.WriteUTF8Text(17, 0, 'Our calculation');
worksheet.WriteCurrency(17, 1, pmtval, nfCurrency, 2, '$');
worksheet.WriteUTF8Text(18, 0, 'Excel''s calculation using constants');
worksheet.WriteNumberFormat(18, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(18, 1, CreateRPNFormula(
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
RPNNumber(PRESENT_VALUE,
RPNNumber(fval,
RPNNumber(PAYMENT_WHEN,
RPNFunc(fekPMT, 5,
nil))))))));
Worksheet.WriteUTF8Text(19, 0, 'Excel''s calculation using cell values');
worksheet.WriteNumberFormat(19, 1, nfCurrency, 2, '$');
worksheet.WriteRPNFormula(19, 1, CreateRPNFormula(
RPNCellValue('B1', // interest rate
RPNCellValue('B2', // number of periods
RPNCellValue('B4', // present value
RPNCellValue('B10', // future value
RPNCellValue('B5', // payment at end or at start
RPNFunc(fekPMT, 5, // Call Excel's PMT formula
nil))))))));
workbook.WriteToFile(AFileName, sfExcel8, true);
finally
workbook.Free;
end;
end;
{------------------------------------------------------------------------------}
{ Read xls file to display Excel's results }
{------------------------------------------------------------------------------}
procedure ReadFile(AFileName: String);
var
workbook: TsWorkbook;
worksheet: TsWorksheet;
r: Cardinal;
s1, s2: String;
begin
workbook := TsWorkbook.Create;
try
workbook.ReadFormulas := true;
workbook.ReadFromFile(AFilename, sfExcel8);
worksheet := workbook.GetFirstWorksheet;
// Write all cells with contents to the console
WriteLn('');
WriteLn('Contents of the first worksheet of the file:');
WriteLn('');
for r := 0 to worksheet.GetLastRowIndex do begin
s1 := UTF8ToAnsi(worksheet.ReadAsUTF8Text(r, 0));
s2 := UTF8ToAnsi(worksheet.ReadAsUTF8Text(r, 1));
if s1 = '' then
WriteLn
else
WriteLn(s1+': ':50, s2);
end;
WriteLn;
WriteLn('Press [ENTER] to close...');
ReadLn;
finally
workbook.Free;
end;
end;
begin
WriteFile('test_fv.xls');
ReadFile('test_fv.xls');
end.