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 IPaymt en anglais ou Interet en français. A l'aide du code source Pascal suivant, vous trouverez la réponse que vous souhaitez:

  1. Program IPaymt;
  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.  
  69. Function Ln(x:Real):Real;
  70. Var
  71.  negatif:Boolean;
  72.  fois,i:Integer;
  73.  ajout,savx,xp,quotient,dl:Real;
  74. Begin
  75.  negatif := False;
  76.  fois := 1;
  77.  ajout := 0;
  78.  If x <= 0.0 Then Begin
  79.   Ln:=0;
  80.   Exit;
  81.  End;
  82.  If x < 1.0 Then Begin
  83.   negatif := True;
  84.   x := 1.0 / x;
  85.  End;
  86.  While x >= 10.0 do Begin
  87.   x := x / 10.0;
  88.   ajout := ajout + 2.302585092994046;
  89.  End;
  90.  While x >= 1.1 do Begin
  91.   x := SquareRoot(x);
  92.   fois := fois * 2;
  93.  End;
  94.  x := x - 1;
  95.  savx := x;
  96.  i := 2;
  97.  xp := x * x;
  98.  quotient := (xp / i);
  99.  dl := x - quotient;
  100.  While 1.0E-15 < quotient do Begin
  101.   i := i + 1;
  102.   xp := xp * x;
  103.   dl := dl + (xp / i);
  104.   i := i + 1;
  105.   xp := xp * x;
  106.   quotient := (xp / i);
  107.   dl := dl - quotient;
  108.  End;
  109.  dl := dl * fois;
  110.  dl := dl + ajout;
  111.  If(negatif)Then dl := - dl;
  112.  Ln:=dl;
  113. End;
  114.  
  115. Function FVal(Rate,Nper,Pmt,PV,PType:Real):Real;Near;
  116. Var
  117.  F:Real;
  118. Begin
  119.  F:=Exp(NPer*Ln(1+Rate));
  120.  If Abs(Rate)<1E-6Then
  121.   FVal:=-Pmt*Nper*(1+(Nper-1)*Rate/2)*(1+Rate*PType)-PV*F
  122.  Else
  123.   FVal:=Pmt*(1-F)*(1/Rate+PType)-PV*F;
  124. End;
  125.  
  126. Function Paymt(Rate,NPer,PV,FV,PType:Real):Real;Near;
  127. Var
  128.  F:Real;
  129. Begin
  130.  F:=Exp(Nper*Ln(1+Rate));
  131.  Paymt:=(FV+PV*F)*Rate/((1+Rate*PType)*(1-F));
  132. End;
  133.  
  134. Function IPAYMT(Rate,Per,NPer,PV,FV,PType:Real):Real;Begin
  135.  IPayMt:=Rate*FVal(Rate,Per-PType-1,PayMt(Rate,NPer,PV,FV,PType),PV,PType);
  136. End;
  137.  
  138. BEGIN
  139.  WriteLn('Prêt hypothécaire de 30 ans à 15% de 200 000$:');
  140.  WriteLn(IPAYMT(0.15/12.0,2*12,30*12,200000,2,0):4:2);
  141. END.

on obtiendra le résultat suivant:

Prêt hypothécaire de 30 ans à 15% de 200 000$:
-2490.45$

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