Технический форум - Паскаль. Проверка системы уравнений на совместимость

Цитата:

Сообщение от alex_6282 (Сообщение 1038204)

Помогите написать программу на паскале для проверки совместимости системы уравнений

И только-то? Ну ладно, получите:

Код:

Const

 M_max=9; {Max number of equations}

 N_max=9; {Max number of unknowns}

 E=0.000001; {coefficients smaller then E are treated az equal to zero}



Type

 Vector=Array[1..N_max+1] of Real;

 Matrix=Array[1..M_max] of Vector;



Var

 a:Matrix;

 i,j,M,N:byte;



Procedure Step_Form(var SF:Matrix; Ms,Ns:Byte);

var

 i,j,k,q:byte;

 c1:real;

 V:Vector;

begin

 for i:=1 to Ms do

  begin

   c1:=SF[i][i];

   if c1=0 then

    begin

     k:=i;

     repeat

      if k<Ms then Inc(k);

     until (SF[k][i]<>0) or (k=Ms);

     if SF[k][i]<>0 then

      begin

       V:=SF[i];

       SF[i]:=SF[k];

       SF[k]:=V;

      end;

    end;

   c1:=SF[i][i];

   if c1<>0 then

    begin

     for j:=i to Ns do

      begin

       a[i][j]:=a[i][j]/c1;

       if Abs(a[i][j])<E then a[i][j]:=0;

      end;

     for k:=i+1 to N do

      begin

       c1:=SF[k][i];

       if c1<>0 then for j:=i to Ns do

        begin

         a[k][j]:=a[i][j]-a[k][j]/c1;

         if Abs(a[k][j])<E then a[k][j]:=0;

        end;

      end;

    end;

  end;

end;



Function Rank(var R:Matrix; Mr,Nr:Byte):Byte;

var

 i,j,Rnk:byte;

 b:boolean;

begin

 Rnk:=Mr+1;

 repeat

  Dec(Rnk);

  b:=false;

  for j:=1 to Nr do

   if R[Rnk][j]<>0 then b:=true;

 until b or (Rnk=1);

 if (Rnk=1) and not b then Rnk:=0;

 Rank:=Rnk;

end;



Begin

 Write('Number of equations = ');

 Readln(M);

 Write('Number of unknowns = ');

 Readln(N);

 for i:=1 to M do

  begin

   for j:=1 to N do

    begin

     Write('a',i,j,'= ');

     Readln(a[i][j]);

    end;

   Write('b',i,'= ');

   Readln(a[i][N+1]);

  end;

 writeln;

 writeln;

 Step_Form(a,M,N+1);

 if Rank(a,M,N)=Rank(a,M,N+1) then

  writeln('System is collocated!')

 else

  writeln('System is NOT collocated!');

 Readln

End.