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.