unit Compatible;

interface IsCompatible;

implementation

(*
Проверка системы линейных уравнений на существование хотя бы
одного решения.

Вход:
    N       : число уравнений
    M       : число неизвестных
    A       : матрица [1..N , 1..M+1], в которой столбцы с 1
              по M содержат матрицу системы, а M+1-ый столбец
              содержит столбец свободных членов.
    Epsilon : погрешность   расчё  тов.   столбец, по модулю
              меньший Epsilon, считается нулевым.
*)
function IsCompatible(
    const N : Integer;
    const M : Integer;
    A : array of array of Real;
    const Epsilon : Real):Boolean;
var
    CurVec     : Integer;
    CurBaseVec : Integer;
    k          : Integer;
    IsInBasis  : array of Boolean;
    L1          : Real;
    L2          : Real;
    L           : Real;
begin
    SetBounds( IsInBasis, [1, M+1] );

    for CurVec:=1 to M+1 do
    begin
        for CurBaseVec:=1 to CurVec-1 do
        begin
            if not IsInBasis[CurBaseVec] then
                Continue;
                
            L1 := 0;
            for k:=1 to N do
                L1 := L1+A[k,CurVec]*A[k,CurBaseVec];
                
            L2 := 0;
            for k:=1 to N do
                L2 := L2+A[k,CurBaseVec]*A[k,CurBaseVec];
                
            for k:=1 to N do
                A[k,CurVec] := A[k,CurVec]-A[k,CurBaseVec]*L1/L2;
        end;
        
        L := 0;
        for k:=1 to N do
            L := L+A[k,CurVec]*A[k,CurVec];

        IsInBasis[CurVec] := L>Epsilon*Epsilon;
    end;
    
    Result := not IsInBasis[M+1];
end;

end.