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 NPer (nombre de période de paiement). A l'aide du code source Pascal suivant, vous trouverez la réponse que vous souhaitez :

  1. Program NPerSamples;
  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 NPer(Rate,Pmt,PV,FV,PType:Real):Real;Near;
  126. Var
  127.  F:Real;
  128. Begin
  129.  F:=Pmt*(1+Rate*PType);
  130.  If Abs(Rate)>1E-6Then NPer:=Ln((F-Rate*FV)/(PV*Rate+F))/Ln(1+Rate)
  131.                   Else NPer:=-(FV+PV)/(PV*Rate+F);
  132. End;
  133.  
  134. BEGIN
  135.  WriteLn('En disposant de 2000$, et que le solde actuel est de 633$ et l''intérêt de 11,5%:');
  136.  WriteLn(NPer(0.115,-2000,-633,50000,0):2:2);
  137. END.

on obtiendra le résultat suivant:

En disposant de 2000$, et que le solde actuel est de 633$ et l'intérêt de 11,5%:
12.12

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