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
| //Définition du type fonction
type
TFonction=function(x:real):real;
...
//définition des fonctions
function f1(x:real):real;
begin
result:=sin(x);
end;
function f2(x:real):real;
begin
result:=x*x-2;
end;
function root(f:TFonction;BorneInf,BorneSup,Delta:real):real;
const maxit=30;
var dx,y,yl,swap,xl,rts: real;
j: integer;
trouve:boolean;
begin
trouve:=false;
yl := f(BorneInf);
y := f(BorneSup);
if (abs(yl)<abs(y)) then
begin
rts:=BorneInf;
xl:=BorneSup;
swap:=yl;
yl:=y;
y:=swap
end
else
begin
xl :=BorneInf;
rts:=BorneSup;
end;
j:=1;
while ((j<=maxit) and (not trouve)) do
begin
dx:=(xl-rts)*y/(y-yl);
xl:=rts;
yl:=y;
rts:=rts+dx;
y:=f(rts);
trouve:=((abs(dx)<Delta) OR (y=0.0));
inc(j);
end;
if not trouve
then ShowMessage('Nombre maximum d''iterations atteint : racine non trouvée');
result:=rts;
end;
//utilisation
procedure TForm1.Button1Click(Sender: TObject);
var y0:real;
begin
y0:=root(f1,-1,1,1e-3);
ShowMessage(FloatToStr(y0));
y0:=root(f2,1,2,1e-3);
ShowMessage(FloatToStr(y0));
end;
... |
Partager