Решение систем нелинейных алгебраических уравнений

      begin

        M[i]:=F(x);     { занести значение в массив    }

        x:=x+dx;        { следующее значение аргумента }

      end;

  end;

{ Вычисление точек пересечения }

function Solution(

    Xmin,Xmax:real;    { Минимум и максимум аргумента }

    F1,F2:pointer;     { Математические функции       }

var RootMas:TRoot):    { Массив координат пересечения }

    byte;              { Количество точек пересечения }

  type

    TFunc = function (x:real):real; { Описание типа функции }

  var

    Fu1,Fu2 : TFunc; { Математические функции } 

  { Для вычисления точек пересечения задана новая функция,

    как разность двух исходных }

  function Fu(x:real):real;

    begin

      Fu:=Fu1(x)-Fu2(x);

    end;

  { Определить, есть ли решения в поддиапазоне }

  function SubRange (var FirstX, LastX, Step : real) : boolean;

    begin

      { Найти поддиапазон, на котором есть решение.

        Из условия, что при прохождении через ось X функция меняет знак }

      while (Fu(FirstX)*Fu(FirstX+Step)>0)and((FirstX+Step)<=Xmax) do

        FirstX := FirstX+Step;

      if ((FirstX+Step)<=Xmax)

        then

          begin

            LastX := FirstX+Step;

            SubRange := True;

          end

        else SubRange := False;

    end;

  { Вычисление корня }

  function Root (FirstX, LastX, NewStep : real) : real;

    begin

      repeat

        { Вычислить новое значение шага }

        NewStep := NewStep/R;

        { Найти новый (уточненный) поддиапазон }

        SubRange (FirstX,LastX,NewStep);

        { Определение правой границы поддиапазона }

        LastX := FirstX + NewStep;

      until abs(NewStep)<=Epsilon/R; { Условие достижения заданной точности }

      Root := FirstX;          { Возвращение корня }

      writeln(firstx);

    end;

  var

    Step : real;     { Величина подиапазона   }

    CurLeft,CurRight:real; { Границы отрезка, на котором есть решение }

    k:word;                { Номер точки пересечения }

  begin

    k:=0;

    { Задать функции }

    Fu1:=TFunc(F1);    Fu2:=TFunc(F2);

    { Вычислить начальный размер поддиапазона }

    Step:=(Xmax-Xmin)/R;

    { Поиск решения с левой крайней границы отрезка }

    CurLeft := Xmin;

    { Цикл поиска всех решений }

    while SubRange(CurLeft,CurRight,Step) do

      begin

        inc(k);

        RootMas[k].X:=Root(CurLeft,CurRight,Step);

        RootMas[k].Y:=Fu1(RootMas[k].X);

        CurLeft := CurRight;

      end;

    Solution:=K;

  end;

end. 

Второй модуль: 

unit Mathem2;

interface

uses types,consts;

{ Функция вычисления минимума в массиве (таблице) точек }

function Min(

   M : array of real; { Таблица математической функции                }

   N : word           { Количество точек в таблице                    }

            ):real;

{ Функция вычисления минимума в массиве (таблице) точек }

function Max(

   M : array of real; { Таблица математической функции                }

   N : word           { Количество точек в таблице                    }

            ):real;

{ Выбор минимального из двух значений }

function Minimum(x,y:real):real;

{ Выбор максимального из двух значений }

function Maximum(x,y:real):real;

{ Процедура заполнения "экранной" таблицы }

procedure EnterScrMas(

   var Ms : array of word; { "Экранная" таблица             }

       Mm : array of real; { Таблица математической функции }

       Ymin : real;        { Минимум математической функции }

       K  : real;          { Коэффициент масштабирования    }

       var Rect:TRect            { Прямоугольник вывода           }

                     );

{ Вычислить координаты "экранного" нуля }

procedure Zero (

   Xmin,Xmax,Ymin,Ymax:real;   { Математические пределы изменения функций }

   var Rect:Trect;                   { "Экранные" пределы изменения функций     }

   Kx,Ky:real;                 { Коэффициенты масштабирования             }

   var Xo,Yo:word);            { Координаты "экранного" нуля              }

implementation

{ Функция вычисления минимума в массиве (таблице) точек }

function Min(

   M : array of real; { Таблица математической функции                }

   N : word            { Количество точек в таблице                    }

            ):real;

   var i:integer; k:real;

   begin

       k:=M[1];

       for i:=1 to N-1 do

         begin

           if M[i]<k then k:=M[i]

         end;

       Min:=k;

   end;

{ Функция вычисления максимума в массиве (таблице) точек }

function Max(

   M : array of real; { Таблица математической функции                }

   N : word           { Количество точек в таблице                    }

            ):real;

   var i:integer; k:real;

   begin

       k:=M[1];

       for i:=1 to N-1 do

         begin

           if M[i]>k then k:=M[i]

         end;

       Max:=k;

   end;

{ Выбор минимального из двух значений }

function Minimum(x,y:real):real;

begin

    if x<y then Minimum:=x else Minimum:=y

end;

{ Выбор максимального из двух значений }

function Maximum(x,y:real):real;

begin

    if x>y then Maximum:=x else Maximum:=y

end;

{ Процедура заполнения "экранной" таблицы }

procedure EnterScrMas(

   var Ms : array of word; { "Экранная" таблица             }

       Mm : array of real; { Таблица математической функции }

       Ymin : real;        { Минимум математической функции }

       K  : real;          { Коэффициент масштабирования    }

       var Rect:TRect            { Прямоугольник вывода           }

                     );

   var i:integer;

begin

   for i:=1 to Rect.Size.X-1 do

     begin

        if mm[i]<0 then ms[i]:=round(abs(mm[i]*k)+(Ymin*K+rect.size.y)+Rect.Origin.Y);

        if mm[i]=0 then ms[i]:=round(Ymin*K+rect.size.y+Rect.Origin.Y);

        if mm[i]>0 then ms[i]:=round((Ymin*K+rect.size.y+Rect.Origin.Y)-mm[i]*k);

     end;

end;

{ Вычислить координаты "экранного" нуля }

procedure Zero (

   Xmin,Xmax,Ymin,Ymax:real;   { Математические пределы изменения функций }

   var Rect:Trect;                   { "Экранные" пределы изменения функций     }

   Kx,Ky:real;                 { Коэффициенты масштабирования             }

   var Xo,Yo:word);            { Координаты "экранного" нуля              }

begin

   Xo:=round((rect.origin.x+Xmax*Kx));

   Yo:=round((rect.origin.y+Ymax*Ky));

end;

end. 
 
 

Модули прорисовки графика: 

Первый модуль: 

{*********** Процедуры и функции для работы с графикой *************}

unit Draw1;

interface

uses Types;

{ Инициализация графики }

procedure GraphInit;

{ Рисование функции по точкам из массива }

procedure DrawFunction(M:array of word;N:word;Color:byte);

{ Рисование рамки }

procedure Ramka(Rect:TRect;Width,Color:word);

implementation

uses Graph,Consts;

{ Инициализация графики }

procedure GraphInit;

  var

    Driver,Mode:integer;

    Res:integer;

  begin

    Driver:=Detect;

    InitGraph(Driver,Mode,'');

    Res:=GraphResult;

    if Res<>0 then

      begin

        WriteLn(GraphErrorMsg(Res));

        WriteLn('Press <Enter> for exit');

        ReadLn;

        Halt(1);

      end;

  end;

{ Рисование функции по точкам из массива }

procedure DrawFunction(M:array of word;N:word;Color:byte);

  var

    i:word;

  begin

    SetColor(Color);

    MoveTo(OriginX,M[1]);

    for i:=1 to N-1 do

      begin

        LineTo(OriginX+i,M[i]);

      { PutPixel(OriginX+i,M[i],Color);}

      end;

  end;

{ Рисование рамки }

procedure Ramka(Rect:TRect;Width,Color:word);

  var

    i,OldColor:byte;

  begin

    OldColor:=GetColor;