Sources
Delphi Russian Knowledge Base
DRKB - это самая большая и удобная в использовании база знаний по Дельфи в рунете, составленная Виталием Невзоровым

Метод Дихотомии

01.01.2007
program dicotomie;
var y:integer;
function f(var x:real):real;
 
begin
if y=1 then f:=sin(x)-1/2
       
else begin if y=2 then f:=exp(x)-2
                         
else begin if y=3 then f:=sqr(x)-2 end; end;
end;
procedure verif
;
var a,b,m,ep,va:real;
    i
,n:integer;
    r
,c:char;
begin  repeat
   writeln
('choisir une fonction parmis les trois');
   writeln
('f[x]=sin(x)-1/2.....[1]');
   writeln
('f[x]=exp(x)-2.......[2] ');
   writeln
('f[x]=x(puiss)2-2....[3] ');
   write
('entrer le nombre [i] de 1..3 i=');
   readln
(y);
   writeln
('pour calculer la racine de la fonction f[x] donne  lintervalle [a,b]') ;
   write
('                      donner a=');
   readln
(a);
   write
('                      donner b=');
   readln
(b);begin
             
if a>b then
               repeat writeln
('*****************REMARQUE**************');
 writeln
('                       *** il faut que a<b ***     ');
 write
('S.V.P entrer un autre intervalle ou invercer les valeurs a=');
                      readln
(a);
                      write
('                                                         b=');
                      readln
(b);
               
until a<b;
   
begin
     
if f(a)*f(b)>0  then
       repeat
         writeln
('*******************REMARQUE************************');
writeln
('  *** la fonction ne admet aucun zero dans se intervalle *** ');
writeln
('     ');
         write
('S.V.P entrer un autre intervalle a=');
         readln
(a);
         write
('                                 b=');
         readln
(b);
       
until f(a)*f(b)<=0;
         writeln
('la fonctin f admet au moins un zero dans [',a,';',b,']');
         write
('                ');
         write
('entrer le nombre d"iteration n=');
         readln
(n);
           m
:=(a+b)/2; if f(m)=0  then  ep:=m
                             
else
                             
begin  for i:=1 to n-1 do
                               
begin   if f(m)*f(a)>0 then begin a:=m; m:=(b+m)/2;   end
                                                           
else  m:=(a+m)/2; b:=2*m-a;
                                                                 
end;
                                     
end; i:=i+1;
                                          ep
:=m;
                    writeln
('   la RACINE pour l"iteration ',n,' est epsilon=',ep);
                    write
('voulez vous calculerf[',ep,'] O/N?');
                    readln
(c); if c='O' then writeln('f[',ep,']=',f(ep));
       write
('voulez vous continuer O/N? ');
       readln
(r);    end;      end;
 
until r='N';
 
 
end;
 
begin
   writeln
('                           DICOTOMIE                                ');
   writeln
('       ');
 
   writeln
('              ');
     verif
;
 
end.