Методы решения нелинейных уравнений

Program laba_5;
Uses crt;
Type ss=set of Char;
Const cifra: ss=['1'];
Type sss=set of Char;
Const cifra2: sss=['2'];
Label S;
Var
 Lx,Rx,x,E,a0,a1,a2,a3,a4,a5,a6:real;
 h,n,i,p:integer;
 promezhytki:Array[0..50] Of real;
 ch: char;
Function f(x:real):real;
 Begin
  f:=a6*x*x*x*x*x*x+a5*x*x*x*x*x+a4*x*x*x*x+a3*x*x*x+a2*x*x+a1*x+a0;
 End;
Function ff(x:real):real;
 Begin
  ff:=6*a6*x*x*x*x*x+5*a5*x*x*x*x+4*a4*x*x*x+3*a3*x*x+2*a2*x+a1;
 End;
Procedure otdelenie(Lx,Rx:real);
 Var
  k,i:integer;
  a1,b1:real;
 Begin
  i:=0;
  n:=1;
   For k:=0 To h Do
    Begin
     a1:=f(Lx+(Rx-Lx)*k/h);
     b1:=f(Lx+(Rx-Lx)*(k+1)/h);
    If a1*b1<0 Then
     Begin
      promezhytki[i]:=Lx+(Rx-Lx)*k/h;
      promezhytki[i+1]:=Lx+(Rx-Lx)*(k+1)/h;
      i:=i+2;
      n:=n+1;
    End;
  End;
End;
 
Procedure DIHOTOMIA;
Var
 iter_d: integer;
 qq: real;
 Begin
  iter_d:=1;
  Repeat
   qq:=x;
   If f((Lx+Rx)/2)*f(Rx)<0 Then Lx:=(Lx+Rx)/2 Else Rx:=(Lx+Rx)/2;
   x:=(Lx+Rx)/2;
   inc(iter_d);
  Until (Abs(qq-x)<E) or (iter_d>20);
  WriteLn('Chislo iteracii po metodu dihotomii: ',iter_d);
End;
 
Procedure SEKUSHIH;
 Var
  q,qq: real;
  iter_s: integer;
 Begin
   x:=(Lx+Rx)/2;
   iter_s:=1;
   Repeat
    qq:=x;
    q:=(f(Rx)-f(Lx))/(Rx-Lx);
    if q=0 then q:=1e-9;
    x:=x-f(x)/q;
    inc(iter_s);
   Until  (Abs(x-qq)<E) or (iter_s>20);
   writeln('Chislo iteracii po metodu sekushih: ', iter_s);
 End;
 
Procedure NIUTONA;
 Var
  iter_n: integer;
  q,qq: real;
 Begin
   x:=(Lx+Rx)/2;
   iter_n:=1;
   Repeat
    qq:=x;
    if (ff(x) < 1e-3) then q:=1e-3 else q:=ff(x);
    x:=x-f(x)/q;
    inc(iter_n);
   Until  (Abs(x-qq)<E) or (iter_n>20) ;
   WriteLn('Chislo iteracii po metodu Hiutona: ', iter_n);
 End;
 
Procedure ITERACII;
 Var
  q,qq: real;
  iter_i: integer;
 Begin
   iter_i:=1;
   q:=0.5;
   x:=(Lx+Rx)/2;
   Repeat
    qq:=x;
    x:=x-q*f(x);
    Inc(iter_i);
   Until  (Abs(x-qq)<E) or (iter_i>20);
   WriteLn('Chislo iteracii po metodu Iteracii: ', iter_i);
 End;
 
Begin
 ClrScr;
 WriteLn('1.- Testovii primer;');
 WriteLn('2.- Vvesti polinom;');
 WriteLn('ESC-EXIT');
 ch:=readkey;
 If ch=#27 Then halt;
 If ch in cifra Then
  Begin
   ClrScr;
   a6:=0;
   a5:=0;
   a4:=0;
   a3:=0;
   a2:=1;
   a1:=0;
   a0:=-5;
   Lx:=-10;
   Rx:=10;
   h:=100;
   E:=0.001;
   Otdelenie(Lx, Rx);
   WriteLn('f(x)=x^2-5');
   For i:=0 To n-1 do
    Begin
     p:=i*2;
     Lx:=Promezhytki[p];
     Rx:=Promezhytki[p+1];
     DIHOTOMIA;
     WriteLn('Po metodu DIHOTOMII: ',x:5:5);
     SEKUSHIH;
     WriteLn('Po metodu SEKUSHIH:  ',x:5:5);
     ITERACII;
     WriteLn('Po metodu ITERACII:  ',x:5:5);
     NIUTONA;
     WriteLn('Po Metodu NIUTONA:   ',x:5:5);
    End;
  End;
 If ch In cifra2 Then
  Begin
   ClrScr;
   WriteLn('Vvedite koefficienti polinoma vida: f(x)=a6x^6+a5x^5+a4x^4+a3x^3+a2x^2+a1x+a0');
   Write('Vvedite koefficient a6:');
   ReadLn(a6);
   Write('Vvedite koefficient a5:');
   ReadLn(a5);
   Write('Vvedite koefficient a4:');
   ReadLn(a4);
   Write('Vvedite koefficient a3:');
   ReadLn(a3);
   Write('Vvedite koefficient a2:');
   ReadLn(a2);
   Write('Vvedite koefficient a1:');
   ReadLn(a1);
   Write('Vvedite koefficient a0:');
   ReadLn(a0);
   ClrScr;
S: Write('Vvedite levuju granicu a:');
   ReadLn(Lx);
   Write('Vvedite pravuju granicu b:');
   ReadLn(Rx);
   If Lx>Rx Then
    Begin
     ClrScr;
     WriteLn('Neverno zadan promejutok!');
     Writeln('Vvedite zanovo');
     GoTo S;
    End;
   Write('Vvedite kolichestvo razbienii:');
   ReadLn(h);
   Write('Vvedite tochnost:');
   ReadLn(E);
   ClrScr;
   Otdelenie(Lx, Rx);
   If n=0 Then
    Begin
     WriteLn('Na dannom promejutke net kornei');
     WriteLn('Vvedite novii promejutok');
     GoTo S;
    End;
   For i:=0 To n-1 do
    Begin
     p:=i*2;
     Lx:=Promezhytki[p];
     Rx:=Promezhytki[p+1];
     DIHOTOMIA;
     WriteLn('Po metodu DIHOTOMII: ',x:5:5);
     SEKUSHIH;
     WriteLn('Po metodu SEKUSHIH:  ',x:5:5);
     ITERACII;
     WriteLn('Po metodu ITERACII:  ',x:5:5);
     NIUTONA;
     WriteLn('Po Metodu NIUTONA:   ',x:5:5);
    End;
  End;
  WriteLn('PRESS ENTER');
 ReadLn;
End.

uses crt;
type Fnc=function(x:real):real;
{$F+}
function F(x:real):real; //исследуемая функция
begin
F:=exp(ln(2)*(-x))-sin(x);
end;
{$F-}
const e=0.000001;
procedure Bisec(F:Fnc;a,b:real;k:integer); //метод уточнения корней
var x,c:real;
begin
repeat
 c:=(a+b)/2;
 if F(a)*F(c)<=0 then b:=c
 else a:=c;
until b-a<e;
x:=(a+b)/2;
if k<10 then writeln('x',k,' =',x:10:6)
else writeln('x',k,'=',x:10:6);
end;
 
var a,b,x1,a2,b2,x2:real;
    k:integer;
begin
a:=-2;//начало интервала иследования
k:=0; //номер корня
while a<=59 do//пока не конец интервала
 begin
  if F(a)*F(a+1)<0 then //если знак функции на концах меньшего
   begin                //интервала, в данном случае=1, разный
    k:=k+1; //ищем корень
    Bisec(F,a,a+1,k);//уточнение корня
   end;
  a:=a+1;//новый интервал
 end;
end.