Section courante

A propos

Section administrative du site

Il est très agaçant d'avoir des formules toutes préparés d'avance fonctionnant très bien dans des tableurs et ne pas être capable d'effectuer les mêmes calculs et les mêmes réponses dans une situation anodine de la programmation. Une de ces remarquables fonctions, est celle du Lotus 1-2-3 et de Quattro Pro, elle se nomme la fonction PPaymt en anglais ou Principal en français. A l'aide du code source Pascal suivant, vous trouverez la réponse que vous souhaitez :

  1. Program PPaymtSamples;
  2.  
  3. Function Abs(x:Real):Real;Begin
  4.  If x < 0 Then x := -x;
  5.  Abs := x;
  6. End;
  7.  
  8. Function Exp(x:Real):Real;
  9. Var
  10.  Inverse:Boolean;
  11.  n,i:Integer;
  12.  dl,q:Real;
  13. Begin
  14.  Inverse := False;
  15.  n := 0;
  16.  dl := 1;
  17.  i := 1;
  18.  If x < 0 Then Begin
  19.   Inverse := True;
  20.   x := -x;
  21.  End;
  22.  While x >= 2 do Begin
  23.   x := x / 2;
  24.   n := n + 1;
  25.  End;
  26.  x := x / 16;
  27.  n := n + 4;
  28.  q := x;
  29.  While q > 1.0E-15 do Begin
  30.   dl := dl + q;
  31.   i := i + 1;
  32.   q := q * x / i;
  33.  End;
  34.  For i := 1 to n do dl := dl * dl;
  35.  If Inverse Then dl := 1 / dl;
  36.  Exp := dl;
  37. End;
  38.  
  39. Function SquareRoot(X:Real):Real;
  40. Var
  41.  A,B,M,XN:Real;
  42. Begin
  43.  If X=0.0Then Begin
  44.   SquareRoot:=0.0;
  45.  End
  46.   Else
  47.  Begin
  48.   M:=1.0;
  49.   XN:=X;
  50.   While XN>=2.0 do Begin
  51.    XN:=0.25*XN;
  52.    M:=2.0*M;
  53.   End;
  54.   While XN<0.5 do Begin
  55.    XN:=4.0*XN;
  56.    M:=0.5*M;
  57.   End;
  58.   A:=XN;
  59.   B:=1.0-XN;
  60.   Repeat
  61.    A:=A*(1.0+0.5*B);
  62.    B:=0.25*(3.0+B)*B*B;
  63.   Until B<1.0E-15;
  64.   SquareRoot:=A*M;
  65.  End;
  66. End;
  67.  
  68. Function Ln(x:Real):Real;
  69. Var
  70.  negatif:Boolean;
  71.  fois,i:Integer;
  72.  ajout,savx,xp,quotient,dl:Real;
  73. Begin
  74.  negatif := False;
  75.  fois := 1;
  76.  ajout := 0;
  77.  If x <= 0.0 Then Begin
  78.   Ln:=0;
  79.   Exit;
  80.  End;
  81.  If x < 1.0 Then Begin
  82.   negatif := True;
  83.   x := 1.0 / x;
  84.  End;
  85.  While x >= 10.0 do Begin
  86.   x := x / 10.0;
  87.   ajout := ajout + 2.302585092994046;
  88.  End;
  89.  While x >= 1.1 do Begin
  90.   x := SquareRoot(x);
  91.   fois := fois * 2;
  92.  End;
  93.  x := x - 1;
  94.  savx := x;
  95.  i := 2;
  96.  xp := x * x;
  97.  quotient := (xp / i);
  98.  dl := x - quotient;
  99.  While 1.0E-15 < quotient do Begin
  100.   i := i + 1;
  101.   xp := xp * x;
  102.   dl := dl + (xp / i);
  103.   i := i + 1;
  104.   xp := xp * x;
  105.   quotient := (xp / i);
  106.   dl := dl - quotient;
  107.  End;
  108.  dl := dl * fois;
  109.  dl := dl + ajout;
  110.  If(negatif)Then dl := - dl;
  111.  Ln:=dl;
  112. End;
  113.  
  114. Function FVal(Rate,Nper,Pmt,PV,PType:Real):Real;Near;
  115. Var
  116.  F:Real;
  117. Begin
  118.  F:=Exp(NPer*Ln(1+Rate));
  119.  If Abs(Rate)<1E-6Then
  120.   FVal:=-Pmt*Nper*(1+(Nper-1)*Rate/2)*(1+Rate*PType)-PV*F
  121.  Else
  122.   FVal:=Pmt*(1-F)*(1/Rate+PType)-PV*F;
  123. End;
  124.  
  125. Function Paymt(Rate,NPer,PV,FV,PType:Real):Real;Near;
  126. Var
  127.  F:Real;
  128. Begin
  129.  F:=Exp(Nper*Ln(1+Rate));
  130.  Paymt:=(FV+PV*F)*Rate/((1+Rate*PType)*(1-F));
  131. End;
  132.  
  133. Function PPaymt(Rate,Per,NPer,PV,FV,PType:Real):Real;Near;
  134. Var
  135.  F:Real;
  136. Begin
  137.  F:=Paymt(Rate,NPer,PV,FV,PType);
  138.  PPaymt:=F-Rate*FVal(Rate,Per-PType-1,F,PV,PType);
  139. End;
  140.  
  141. BEGIN
  142.  WriteLn('Exemple de versements trimestriels d''un prêt de 10 000$ à 15% par trimestre:');
  143.  WriteLn(PPaymt(0.15/4,24,40,10000,0,1):3:3,'$');
  144.  WriteLn('Exemple de versements d''un prêt de 100 000$ à 10% par mois:');
  145.  WriteLn(PPaymt(0.1/12,2*12,30*12,100000,0,0):3:3,'$');
  146. END.

on obtiendra le résultat suivant :

Exemple de versements trimestriels d'un prêt de 10 000$ à 15% par trimestre:
-233.243
Exemple de versements d'un prêt de 100 000$ à 10% par mois:
-53.542

Dernière mise à jour : Mardi, le 25 octobre 2016