{$R+}  {Range check}

(* SMUCDECL.PAS

Generate the firm's time series for Salmi & Virtanen "Measuring the
Long-Run Profitability of the Firm; A Simulation Evaluation of the
Financial Statement Based IRR Estimation Methods" 

The version with the double-declining balance depreciation.

Usage of the program: SMUCDECL SMUCPARA.DTA

SMUCPARA.DTA contents outline:

#Identification
1980  #First year (only for computer runs; firstYear)
10    #Total length of the simulation period (T; yearsToSim)
0.08  #Growth rate (k; growthRate)
0.50  #Amplitude of the sinusoidal business cycles (A; amplitude)
2.5   #Shock coefficient (S; shock)
9999  #timing of the investment shock (ç; tau)
40    #First capital expenditure (g(0); firstCapE)
0.0   #Contribution coefficient b(0)
0.7   #Contribution coefficient b(1)
0.6   #Contribution coefficient b(2)
end   #That's it

*)

program SmucDeclProgram;

uses SMUCTPU;  { A unit of common routines }

const progDesc = 'Simulate observations; Declining balance '
               + 'depreciation';
      progName = 'SMUCDECL';
      progDate = 'Fri 11-Oct-96';
      progVers = '1.0';
      maxYears = 50;

type realVectorType = array [0..maxYears] of real;

(* Input variables and constants *)
var firstYear,      { for illustrative purposes only }
    yearsToSim,
    tau             { timing of the investment shock 24; 30}
     : integer;

var growthRate,
    amplitude,      { amplitude of the business cycle }
    shock,          { shock coefficient }
    sigma           { standard deviation in the random component }
     : real;

const cycleLength = 6.0;  { length of the business cycle (C) }

var b               { contribution coefficients }
     : realVectorType;

(* Variables for processing *)
var p,              { accountant's profit }
    v,              { book value }
    f,              { cash inflow }
    g,              { capital expendidure }
    d               { depreciation amount }
     : realVectorType;

var lifeSpan
     : integer;

var irr,            { the true internal rate of return }
    deprCoeff       { double-declining depreciation coefficient }
     : real;

(* Read and display one file from the input parameter file *)
procedure READLINE (var filePointer : text;    { <-- }
                    tx              : string;  { <-- }
                    decimals        : byte;    { <-- }
                    var number      : real);   { --> }
var s : string;   { read line as string }
    k : integer;  { error index }
    i : integer;  { counter }
    j : integer;  { position of the comment initiator '#' }
begin
  i := 0;
  while (i = 0) and not eof(filePointer) do begin
    readln (filePointer, s);
    j := Pos('#',s);
    if (Length(s) > 0) and ((j = 0) or (j > 1)) then begin
      Inc (i);
      if j > 1 then s := TRAILFN (Copy (s, 1, j-1));
      Val (s, number, k);
      writeln (tx, number:0:decimals);
    end
      else writeln (s); {endif}
  end; {while}
end; (* readline *)

(* Read and display the input data *)
procedure READDATA (var firstYear  : integer;
                    var yearsToSim : integer;
                    var growthRate : real;
                    var amplitude  : real;
                    var sigma      : real;
                    var shock      : real;
                    var tau        : integer;
                    var firstCapE  : real;
                    var lifeSpan   : integer;
                    var b : realVectorType);
var filePointer : text;
    number      : real;       { auxiliary variable }
    s           : string;
    j, k        : integer;
begin
  {}
  {... open the input file ...}
  if ParamCount > 0 then begin
    if not FILEXIST (ParamStr(1)) then begin
      writeln;
      writeln ('File ', ParamStr(1), ' not found');
      halt;
    end; {if}
    assign (filePointer, ParamStr(1));
  end
  else begin
    writeln;
    writeln ('Usage: ', progName, ' [InputFileName]');
    halt;
  end; {endif}
  reset (filePointer);
  {}
  {... read the parameter file contents ...}
  READLINE (filePointer, '#First year: ', 0, number);
  firstYear := Trunc(number);
  READLINE (filePointer, '#Years to simulate: ', 0, number);
  yearsToSim := Trunc(number);
  READLINE (filePointer, '#Growth rate: ', 4, growthRate);
  READLINE (filePointer, '#Amplitude of cycles: ', 4, amplitude);
  READLINE (filePointer, '#Random term STD: ', 4, sigma);
  READLINE (filePointer, '#Shock coefficient: ', 4, shock);
  READLINE (filePointer, '#Shock timing: ', 0, number);
  tau := Trunc(number);
  READLINE (filePointer, '#First capital expenditure: ',
                          4, firstCapE);
  {}
  FillChar (b, SizeOf(b), 0);
  lifeSpan := 1;
  repeat
    readln (filePointer, s);
    if eof(filePointer) then break;
    s := TRAILFN(s);
    if s = 'end' then break;
    j := Pos('#',s);
    if (Length(s) > 0) and ((j = 0) or (j > 1)) then begin
      if j > 1 then s := TRAILFN (Copy (s, 1, j-1));
      Val (s, b[lifeSpan], k);
      writeln ('#', lifeSpan : 4, b[lifeSpan]:10:4);
      Inc (lifeSpan);
    end; {if}
  until false; {repeat}
  lifeSpan := lifeSpan - 1;
  {}
  close (filePointer);
end;  (* readdata *)

(* Auxiliary function to calculate net present value *)
function NPVFN (b        : realVectorType;
                rate     : real;
                lifeSpan : integer) : real;
var y : real;
    i : integer;
begin
  y := -1.0;
  for i := 0 to lifeSpan do
    y := y + b[i] / GENPOWFN (1.0 + rate, i);
  npvfn := y;
end;  (* npvfn *)

(* Internal rate of return for the contribution distribution *)
function IRRFN (b : realVectorType; lifeSpan : integer) : real;
const maxIter = 30;
var x, x1, x2, y1, y2 : real;
    j : integer;
begin
  x1 := 0.0;
  x2 := 0.2;
  for j := 1 to maxIter do begin
    y1 := NPVFN (b, x1, lifeSpan);
    y2 := NPVFN (b, x2, lifeSpan);
    x := (x1*y2 - x2*y1) / (y2 - y1);
    x1 := x2;
    x2 := x;
    irrfn := x;
    if abs(x2-x1) < 0.000001 then exit;
  end; {for}
  writeln ('The IRRFN algorithm failed in ', maxIter, ' iterations');
  halt;
end;  (* irrfn *)

(* Perform the simulation *)
procedure DOSIMUL (yearsToSim  : integer;           { <-- }
                   growthRate  : real;              { <-- }
                   lifeSpan    : integer;           { <-- }
                   amplitude   : real;              { <-- }
                   sigma       : real;              { <-- }
                   shock       : real;              { <-- }
                   tau         : integer;           { <-- }
                   var g       : realVectorType;    { <--> }
                   var f,d,p,v : realVectorType);   { --> }
var t, i, m : integer;
    rn : real;
begin
  deprCoeff := 2.0 * (1.0 / lifeSpan);
  {... perform the simulation for all the years ...}
  for t := 0 to yearsToSim do begin
    if t > 0 then begin  { skip the "zero" year ...}
      rn := RNDNRMFN;
      g[t] := g[0] * GENPOWFN ((1.0 + growthRate),(t))
            * (1.0 + amplitude *
               sin(2.0*pi/cycleLength*(t)+pi/cycleLength) )
            * (1.0 + sigma*rn);
      if t = tau then begin
        g[t] := g[t] + shock * g[t];
        g[t] := g[t] /(1.0 + sigma*rn);
      end;
    end;
    {}
    m := MINIFN (lifeSpan, t);
    f[t] := 0.0;
    for i := 0 to m do
      f[t] := f[t] + b[i]*g[t-i];
    {}
    for i := 1 to m do begin
      d[t] := d[t] + deprCoeff * GENPOWFN(1.0-deprCoeff,i-1) * g[t-i];
      if (i = m) and (m = lifeSpan) then
        d[t] := d[t] + GENPOWFN(1.0-deprCoeff,m) * g[t-m];
    end; {for i}
    {}
    p[t] := f[t] - d[t];
    {}
    if t > 0 then v[t] := v[t-1] + g[t] - d[t]
      else v[t] := g[t];
  end; {for t}
end;  (* dosimul *)

(* Write the simulated data *)
procedure WRITEDATA (firstYear  : integer;
                     yearsToSim : integer;
                     lifeSpan   : integer;
                     g,f,d,p,v  : realVectorType;
                     irr        : real);
const ff1 =  5;
      ff2 = 12;
      dd  =  4;
var t : integer;
begin
  writeln;
  write ('#Year'      : ff1);
  write ('Capital'    : ff2);
  write ('FundsFrom'  : ff2);
  write ('Declining'  : ff2);
  write ('Operating'  : ff2);
  write ('Book'       : ff2);
  writeln;
  {}
  write ('#', ' '     : ff1-1);
  write ('expendit'   : ff2);
  write ('operations' : ff2);
  write ('depreciat'  : ff2);
  write ('income'     : ff2);
  write ('value'      : ff2);
  writeln;
  {}
  write ('#', ' '     : ff1-1);
  write ('g(t)'       : ff2);
  write ('f(t)'       : ff2);
  write ('d(t)'       : ff2);
  write ('p(t)'       : ff2);
  write ('v(t)'       : ff2);
  writeln;
  {}
  for t := 0 to yearsToSim do begin
    if t <= lifeSpan + 1 then write ('#', firstYear + t : ff1-1)
      else write (firstYear + t : ff1);
    write (g[t] : ff2:dd);
    write (f[t] : ff2:dd);
    write (d[t] : ff2:dd);
    write (p[t] : ff2:dd);
    write (v[t] : ff2:dd);
    writeln;
  end; {for}
  {}
  writeln;
  writeln ('#True internal rate of return = ', 100.0*irr:0:4, '%');
end;  (* writedata *)

(* Main program *)
begin
  FileMode := 0;
  HEADER (progName, progDesc, progVers, progDate, '#');
  READDATA (firstYear, yearsToSim, growthRate,
            amplitude, sigma, shock, tau, g[0], lifeSpan, b);
  irr := IRRFN (b, lifeSpan);
  DOSIMUL (yearsToSim, growthRate, lifeSpan, amplitude, sigma,
           shock, tau, g, f, d, p, v);
  WRITEDATA (firstYear, yearsToSim, lifeSpan, g, f, d, p, v, irr);
end.  (* SmucDeclProgram *)