Показать сообщение отдельно
Старый 06.06.2014, 16:37   #2 (permalink)
Vladimir_S
Специалист
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
По умолчанию

Цитата:
Сообщение от alex_6282 Посмотреть сообщение
Помогите написать программу на паскале для проверки совместимости системы уравнений
И только-то? Ну ладно, получите:
Код:
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.
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070