Математические методы Метод Жардана-Гаусса

       end;

       for i:=1 to s do

       begin

       prover:=coef.cells[1,i];

       for l:=1 to length(prover) do

       if prover[l]='.' then prover[l]:=','

      else if prover[l]>'9' then

      begin

      showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

      exit;

      end;

      coef.cells[1,i]:=prover;

      y[i]:=strtofloat(coef.cells[1,i]);

      end;

     {***********************************************} 

     {Решение и вывод результатов}

     {***********************************************}

      gauss1(a,y,x,s,error);

      if not error then

      for i:=1 to s do

      gauss.cells[i,1]:=floattostr(x[i])

      else

      begin

      showmessage('Система решения не имеет');

      new1.Click;

      end;

     {***********************************************}

     end;

 

     procedure TForm1.Button2Click(Sender: TObject);

      var a:ary2s;

      x,y:arys;

      error:boolean;

      i,j,l,k:integer;

      prover:string;

     begin

     {Считывание  массивов с исходными данными}

     {***********************************************}

     {Считывание  массивов с исходными данными  и проверка '.' или ','}

     {***********************************************}

      for i:=1 to s do

      for j:=1 to s do

      begin

      prover:=matrix.Cells[j,i];

      k:=length(prover);

      if k=0 then

      begin

      showmessage('Вы не ввели один или несколько элементов системы.');

      exit;

      end; 

      for l:=1 to length(prover) do

      if prover[l]='.' then prover[l]:=','

      else if prover[l]>'9' then

      begin

      showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

      exit;

      end;

      matrix.Cells[j,i]:=prover;

      a[i,j]:=strtofloat(matrix.cells[j,i]);

      end;

      for i:=1 to s do

      begin

      prover:=coef.cells[1,i];

      for l:=1 to length(prover) do

      if prover[l]='.' then prover[l]:=','

      else if prover[l]>'9' then

      begin

      showmessage('В качестве одного или нескольких элементов системы введена буква. Замените их на числа!');

      exit;

      end;

      coef.cells[1,i]:=prover;

      y[i]:=strtofloat(coef.cells[1,i]);

      end;

     {***********************************************}

     {***********************************************} 

     {Решение  и вывод результатов}

     {***********************************************}

      gaussj(a,y,x,s,error);

      if not error then

      for i:=1 to s do

      jgauss.cells[i,1]:=floattostr(x[i])

      else

      begin

      showmessage('Система решения не имеет');

      new1.Click;

      end;

     {***********************************************}

     end;

     procedure TForm1.Save1Click(Sender: TObject);

      var f:textfile;

      i,j:integer;

     begin

     savedialog1.Filter:='Text files (*.txt)|*.txt|';

     if savedialog1.Execute then

      begin

      assignfile(f,savedialog1.filename+'.txt');

      rewrite(f);

      for i:=1 to s do

      begin

      writeln(f);

      for j:=1 to s do

      write(f,matrix.cells[i,j]:4,' ');

      write(f,'|',coef.cells[1,i]);

      end;

      writeln(f);

      writeln(f);

      writeln(f,'Gauss');

      for i:=1 to s do

      writeln(f,'X'+floattostr(i)+'='+gauss.cells[i,1],' ');

      writeln(f);

      writeln(f,'J-Gauss');

      for i:=1 to s do

      writeln(f,'X'+floattostr(i)+'='+jgauss.cells[i,1],' ');

      closefile(f);

      end;

     end; 

     end.

     Файл-модуль unit2.pas

     unit unit2; 
 

     interface

      const maxr=20; 

      type arys=array[1..maxr] of real;

            ary2s=array[1..maxr,1..maxr] of real; 

      procedure gauss1(a:ary2s; y:arys; var coef:arys; ncol:integer; var error:boolean);

      procedure gaussj(var b:ary2s; y: arys; var coef:arys; ncol:integer; var error: boolean);

     implementation 

      {Решение системы линейных уравнений методом Гаусса}

     {**********************************************************}

      procedure gauss1(a:ary2s; y:arys; var coef:arys; ncol:integer; var error:boolean);

      var  b:ary2s;

       w:arys;

            i,j,i1,k,l,n:integer;

            hold,sum,t,ab,big: real;

      begin

      error:=false;

      n:=ncol;

      for i:=1 to n do

      begin

      for j:=1 to n do

      b[i,j]:=a[i,j];

      w[i]:=y[i]

      end;

      for i:=1 to n-1 do

      begin

      big:=abs(b[i,i]);

      l:=i;

      i1:=i+1;

      for j:=i1 to n do

            begin

            ab:=abs(b[j,i]);

            if ab>big then

            begin

            big:=ab;

            l:=j

            end

      end; 

      if big=0.0 then error:= true

      else

      begin

            if l<>i then

            begin

            for j:=1 to n do

            begin

      hold:=b[l,j];

              b[l,j]:=b[i,j];

                  b[i,j]:=hold

            end;

            hold:=w[l];

            w[l]:=w[i];

      w[i]:=hold

            end;

            for j:=i1 to n do

            begin

      t:=b[j,i]/b[i,i];

      for k:=i1 to n do

                  b[j,k]:=b[j,k]-t*b[i,k];

            w[j]:=w[j]-t*w[i]

            end

            end

      end;

      if b[n,n]=0.0 then error:=true

      else

        begin

        coef[n]:=w[n]/b[n,n];

            i:=n-1;

            repeat

            sum:=0.0;

      for j:=i+1 to n do

            sum:=sum+b[i,j]*coef[j];

            coef[i]:=(w[i]-sum)/b[i,i];

            i:=i-1

            until i=0

            end

      end;

     {**********************************************************} 
 

      {Решение системы линейных уравнений методом Жордана-Гаусса}

     {**********************************************************}

      procedure gaussj(var b:ary2s; y: arys; var coef:arys; ncol:integer; var error: boolean);

      var w:array[1..maxr,1..maxr] of real;

            index:array[1..maxr,1..3] of integer;