unit Equ1;
// Методы поиска корней нелинейного уравнения

interface
// X и FDelta: результат расчета - значение корня и невязки
// Xmin и Xmax: границы начального интервала для некоторых методов
// X0: начальная точка  для некоторых методов
// DAbsX: заданная абсолютна допустимая погрешность X
// DRelX: заданная относительная допустимая погрешность X
// DF: заданная допустимая невязка

var X, FDelta, Xmin, Xmax, X0: real;
    DAbsX: real = 0.001;
    DRelX: real = 0.001;
    DF: real = 0;

// Func: переменная - функция
var Func: function(X: real): real;

// Метод дихотомии
function Dihot: boolean;

// Метод хорд
function Chord: boolean;

// Метод простых итераций
function Iterat: boolean;

// Модифицированный метод Ньютона
function Nevton: boolean;

implementation
uses Forms, Windows, Sysutils;

function Dihot: boolean;
// Метод дихотомии
// a и b: границы текущего интервала неопределенности
// Fa: значение функции на левой границе
// исходного интервала неопределенности
var a, b: real;
    Fa: real;
begin
 a := Xmin;
 b := XMax;
 Fa := Func(a);
 if (Fa*Func(b) > 0) then
   if Application.MessageBox(
       'В заданном интервале или четное чило корней'+
       #13+'или нет ни одного корня. Продолжать?',
       'Подтвердите продолжение расчета корня',
       MB_YESNOCANCEL+MB_ICONQUESTION) <> IDYES
     then begin
      Result := false;
      exit;
     end;
 repeat
  X := (a + b) / 2;
  FDelta := Func(X);
  // Проверка критериев окончания
  if (b - X <= DAbsX) or (b - X <= Abs(X * DRelX)) or
     (Abs(FDelta) <= DF)
  then begin
   Result := true;
   exit;
  end;

  if (Fa*FDelta > 0)
  then a := X
  else b := X;
 until false;
end;

function Chord: boolean;
// Метод хорд
// a и b - границы текущего интервала неопределенности
// Fa и Fb- значения функции на границах интервала неопределенности
// XOld - значение X на предыдущей итерации
// SPChar - вспомагательная переменная для формирования строки сообщения
var a, b: real;
    Fa, Fb: real;
    XOld: real;
begin
 a := Xmin;
 b := XMax;
 Fa := Func(a);
 Fb := Func(b);
 if (Fa*Fb > 0) then begin
   Application.MessageBox(PChar('Функции на концах интервала одного знака:'+
       #13+FloatToStr(Fa) + ' и ' + FloatToStr(Fb)),
       'Расчет методом хорд невозможен',
       MB_OK + MB_ICONSTOP);
    Result := false;
    exit;
  end;
 X := a;
 repeat
  XOld := X;
  X := a - (b - a) * Fa / (Fb - Fa);
  FDelta := Func(X);
  // Проверка критериев окончания
  if (Abs(X - XOld) <= DAbsX) or (Abs(X - XOld) <= Abs(X * DRelX)) or
     (Abs(FDelta) <= DF)
  then begin
   Result := true;
   exit;
  end;

  if (Fa*FDelta > 0)
  then begin
   a := X;
   Fa := FDelta;
  end
  else begin
   b := X;
   Fb := FDelta;
  end;
 until false;
end;

function Iterat: boolean;
// Метод простых итераций
// MaxIter: максимальное число итераций
const MaxIter = 1000;

// XOld: приближение корня на предыдущей итерации
// DX: изменение оценки корня на предыдущей  итерации
// Iter: текущее количество итераций
var XOld, DX: real;
    Iter: integer;
begin
 Iter := 0;
 X := X0;
 repeat
  XOld := X;
  X := Func(X);
  FDelta := Abs(X - XOld);
  if (FDelta <= DAbsX) or (FDelta <= Abs(X * DRelX))
  then begin
   Result := true;
   exit;
  end;
  if (XOld <> X0)
   then if (FDelta > DX)
    then begin
     Application.MessageBox(
                   'Метод расходится!' + #13 +
                   'Смените исходную точку или метод',
                   'Метод простых итераций расходится', MB_OK + MB_ICONSTOP);
     Result := false;
     exit;
    end
    else if (Iter > MaxIter) then
    if Application.MessageBox(
              'Лимит итераций исчерпан.' + #13 +
              'Есть опасность, что метод зацикливается.' +
               #13 + 'Продолжать?',
              'Подтвердите продолжение расчета',
              MB_YESNOCANCEL+MB_ICONQUESTION) <> IDYES
     then begin
      Result := false;
      exit;
     end
     else Iter := 0;
  DX := FDelta;
  Inc(Iter);
 until false;
end;

function Nevton: boolean;
// Модифицированный метод Ньютона
// MaxIter: максимальное число итераций
const MaxIter = 1000;

// XOld: приближение корня на предыдущей итерации
// FOld: модуль невязки на предыдущей итерации
// DX: поправка Ньютона
// t: параметр метода
// Iter: текущее количество итераций
var XOld, FOld, DX, t: real;
    Iter: integer;

begin
 Iter := 0;
 X := X0;
 FDelta := Func(X);
 repeat
  t := 1;
  XOld := X;
  FOld := Abs(FDelta);
  try
   DX := -FDelta * DAbsX / (Func(X + DAbsX)-FDelta);
   if(FloatToStr(DX) = '-INF')or(FloatToStr(DX) = 'INF')
    or(FloatToStr(DX) = 'NAN')
      then raise EMathError.Create('');
  except
   Application.MessageBox(
           'Ошибка вычислений !' + #13 +
           'Смените исходную точку или метод',
           'Ошибка вычислений', MB_OK + MB_ICONSTOP);
   Result := false;
   exit;
  end;
  X := XOld + DX;
  FDelta := Func(X);

  while (FOld < Abs(FDelta)) do
  begin
   t := t / 2;
   if (t < 0.001)
    then begin
     Application.MessageBox(
                   'Метод расходится!' + #13 +
                   'Смените исходную точку или метод',
                   'Метод Ньютона расходится', MB_OK + MB_ICONSTOP);
     Result := false;
     exit;
    end;
   X := XOld + t * DX;
   FDelta := Func(X);
  end;

  if (XOld <> X0) and
     ((Abs(DX) <= DAbsX) or (Abs(DX) <= Abs(X * DRelX)) or
     (Abs(FDelta) <= DF))
  then begin
   Result := true;
   exit;
  end;
  if (Iter > MaxIter) then
    if Application.MessageBox(
           'Лимит итераций исчерпан.' + #13 +
           'Есть опасность, что метод зацикливается.' +
           #13 + 'Продолжать?',
           'Подтвердите продолжение расчета',
           MB_YESNOCANCEL+MB_ICONQUESTION) <> IDYES
     then begin
      Result := false;
      exit;
     end
  else Iter := 0;
  Inc(Iter);
 until false;
end;

end.

