1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
| unit uFAires;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Buttons, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
SpeedButton1: TSpeedButton;
procedure SpeedButton1Click(Sender: TObject);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
type tFonc = function (X : Extended) : Extended;
var FF: tFonc;
// 2 Routines définissant des fonctions du type FF = f(x)
function F1(x : Extended) : Extended;
begin Result:=3*x*x; end;
// La primitive de F1 est x-au-cube
// Résultats pour x de 0 à 5 sur 10 paires de sous-intervalles :
//Aire /Méth Rectangles : 144.375
//Aire /Méth Trapèzes : 125.625
//Aire /Méth Simpson : 125
//Aire exacte 5 au cube : 125
function F2(x : Extended) : Extended;
begin Result:=Exp(x); end;
// La primitive de F2 est Exp(x)
// Résultats pour x de 0 à 5 sur 10 paires de sous-intervalles :
//Aire /Méth Rectangles : 187.324835773627
//Aire /Méth Trapèzes : 150.471545997983
//Aire /Méth Simpson : 147.416334525476
//Aire exacte Exp(5) : 148.413159
function F3(x : Extended) : Extended;
begin Result:=sin(x); end;
// La primitive de F3 est cos(x)
// Résultats pour x de 0 à 5 sur 10 intervalles :
//Aire /Méth Rectangles : 0.501388098098371
//Aire /Méth Trapèzes : 0.459314548857976
//Aire /Méth Simpson : 0.459697710098338
// Pour les 3 Routines de calcul d'aires ou d'intégrales ci-après :
// En entrée : - FF : la fonction
// - typCalcul : A = calcul d'aire, I = calcul d'intégrale
// - deX,aX : bornes, inférieure et supérieure, de variation de x
// - ni : nombre d'intervalles intermédiaires
function MRectangles(FF: tFonc; typCalcul : char; deX,aX : Extended; ni : integer) : Extended;
var x,y,dx,St,Si : Extended; i : integer;
begin dx := abs(aX - deX)/ni;
St:=0; x:=deX;
for i:=1 to ni do
begin x:=x+dx;
if typCalcul='A' then y:=abs(FF(x)) else y:=FF(x);
Si:= y*dx;
St:=St+Si;
end;
Result:=St;
end;
function MTrapezes(FF: tFonc; typCalcul : char; deX,aX : Extended; ni : integer) : Extended;
var xo,x1,yo,y1,dx,St,Si : Extended; i : integer;
begin dx := abs(aX - deX)/ni;
St:=0; xo:=deX; x1:=xo;
for i:=1 to ni do
begin x1:=x1+dx;
if typCalcul='A'
then begin yo:=abs(FF(xo)); y1:=abs(FF(x1)); end
else begin yo:=FF(xo); y1:=FF(x1); end;
Si:= 0.5*(yo+y1)*dx;
St:=St+Si;
xo:=xo+dx;
end;
Result:=St;
end;
function MSimpson(FF: tFonc; typCalcul : char; deX,aX : Extended; ni : integer) : Extended;
var x,h,k,s : Extended; i : integer;
begin h := abs(aX - deX)/(2*ni);
k:=h/3;
x:=deX;
if typCalcul='A' then s:=abs(k*(FF(deX)+FF(aX))) else s:=k*(FF(deX)+FF(aX));
for i:=1 to ni-1 do
begin x:=x+h;
if typCalcul='A' then s:=s+abs(k*4*FF(x)) else s:=s+k*4*FF(x);
x:=x+h;
if typCalcul='A' then s:=s+abs(k*2*FF(x)) else s:=s+k*2*FF(x);
end;
x:=x+h;
if typCalcul='A' then s:=s+abs(k*4*FF(x)) else s:=s+k*4*FF(x);
Result:=s;
end;
procedure TForm1.SpeedButton1Click(Sender: TObject);
begin with Memo1.lines do
begin Add('Aire /Méth Rectangles : '+FloatToStr(MRectangles(F1,'A',0,5,5)));
Add('Aire /Méth Trapèzes : '+FloatToStr(MTrapezes(F1,'A',0,5,5)));
Add('Aire /Méth Simpson : '+FloatToStr(MSimpson(F1,'A',0,5,5)));
end;
end;
end. |
Partager