Матрицы в Delphi

Уважаемые сограждане. В ответ на вопросы Круглого Стола, в основном, от собратьев студентов, публикую алгоритмы матричного исчисления. В них нет ничего сложного, все базируется на функциях стандартного Borland Pascal еще версии 7.0.
Я понимаю, что уровень подготовки наших преподавателей весьма отстает не то, что от нынешних технологий, но даже и от весьма более ранних, но все-таки попробую помочь собратьям "по-несчастью".... :o)))
Перечень функций этой библиотеки:
unit Matrix;
interface
type
 MatrixPtr = ^MatrixRec;
 MatrixRec = record
 MatrixRow: Byte;
 MatrixCol: Byte;
 MatrixArray: Pointer;
 end;
 MatrixElement = Real;
(* Функция возвращает целочисленную степень *)
function IntPower(X, n: Integer): Integer;
(* Функция создает квадратную матрицу *)
function CreateSquareMatrix(Size: Byte): MatrixPtr;
(* Функция создает прямоугольную матрицу *)
function CreateMatrix(Row, Col: Byte): MatrixPtr;
(* Функция дублирует матрицу *)
function CloneMatrix(MPtr: MatrixPtr): MatrixPtr;
(* Функция удаляет матрицу и возвращает TRUE в случае удачи *)
function DeleteMatrix(var MPtr: MatrixPtr): Boolean;
(* Функция заполняет матрицу указанным числом *)
function FillMatrix(MPtr: MatrixPtr; Value: MatrixElement): Boolean;
(* Функция удаляет матрицу MPtr1 и присваивает ей значение MPtr2 *)
function AssignMatrix(var MPtr1: MatrixPtr; MPtr2: MatrixPtr): MatrixPtr;
(* Функция отображает матрицу на консоль *)
function DisplayMatrix(MPtr: MatrixPtr; _Int, _Frac: Byte): Boolean;
(* Функция возвращает TRUE, если матрица 1x1 *)
function IsSingleMatrix(MPtr: MatrixPtr): Boolean;
(* Функция возвращает TRUE, если матрица квадратная *)
function IsSquareMatrix(MPtr: MatrixPtr): Boolean;
(* Функция возвращает количество строк матрицы *)
function GetMatrixRow(MPtr: MatrixPtr): Byte;
(* Функция возвращает количество столбцов матрицы *)
function GetMatrixCol(MPtr: MatrixPtr): Byte;
(* Процедура устанавливает элемент матрицы *)
procedure SetMatrixElement(MPtr: MatrixPtr; Row, Col: Byte; Value: MatrixElement);
(* Функция возвращает элемент матрицы *)
function GetMatrixElement(MPtr: MatrixPtr; Row, Col: Byte): MatrixElement;
(* Функция исключает векторы из матрицы *)
function ExcludeVectorFromMatrix(MPtr: MatrixPtr; Row, Col: Byte): MatrixPtr;
(* Функция заменяет строку(столбец) матрицы вектором *)
function SetVectorIntoMatrix(MPtr, VPtr: MatrixPtr; _Pos: Byte): MatrixPtr;
(* Функция возвращает детерминант матрицы *)
function DetMatrix(MPtr: MatrixPtr): MatrixElement;
(* Функция возвращает детерминант треугольной матрицы *)
function DetTriangularMatrix(MPtr: MatrixPtr): MatrixElement;
(* Функция возвращает алгебраическое дополнение элемента матрицы *)
function AppendixElement(MPtr: MatrixPtr; Row, Col: Byte): MatrixElement;
(* Функция создает матрицу алгебраических дополнений элементов матрицы *)
function CreateAppendixMatrix(MPtr: MatrixPtr): MatrixPtr;
(* Функция транспонирует матрицу *)
function TransponeMatrix(MPtr: MatrixPtr): MatrixPtr;
(* Функция возвращает обратную матрицу *)
function ReverseMatrix(MPtr: MatrixPtr): MatrixPtr;
(* Функция умножает матрицу на число *)
function MultipleMatrixOnNumber(MPtr: MatrixPtr; Number: MatrixElement): MatrixPtr;
(* Функция умножает матрицу на матрицу *)
function MultipleMatrixOnMatrix(MPtr1, MPtr2: MatrixPtr): MatrixPtr;
(* Функция суммирует две матрицы *)
function AddMatrixOnMatrix(MPtr1, MPtr2: MatrixPtr): MatrixPtr;
(* Функция вычитает из первой матрицы вторую *)
function SubMatrixOnMatrix(MPtr1, MPtr2: MatrixPtr): MatrixPtr;
(* Функция решает систему методом Гаусса и возвращает LU-матрицы *)
(* Результат функции - вектор-столбец решений *)
function GausseMethodMatrix(MPtr, VPtr: MatrixPtr;
 var LPtr, UPtr, BPtr: MatrixPtr): MatrixPtr;
implementation
function IntPower(X, n: Integer): Integer;
var
 Res, i: Integer;
begin
 if n < 1 then
 Result := 0
 else
 begin
 Res := X;
 for i := 1 to n - 1 do Res := Res * X;
 Result := Res;
 end;
end;
function CreateSquareMatrix(Size: Byte): MatrixPtr;
var
 TempPtr: MatrixPtr;
begin
 TempPtr := nil;
 GetMem(TempPtr, SizeOf(MatrixRec));
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 with TempPtr^ do
 begin
 MatrixRow := Size;
 MatrixCol := Size;
 MatrixArray := nil;
 GetMem(MatrixArray, Size * Size * SizeOf(MatrixElement));
 if MatrixArray = nil then
 begin
 FreeMem(TempPtr, SizeOf(MatrixRec));
 Result := nil;
 Exit;
 end;
 end;
 FillMatrix(TempPtr, 0);
 Result := TempPtr;
end;
function CreateMatrix(Row, Col: Byte): MatrixPtr;
var
 TempPtr: MatrixPtr;
begin
 TempPtr := nil;
 GetMem(TempPtr, SizeOf(MatrixRec));
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 with TempPtr^ do
 begin
 MatrixRow := Row;
 MatrixCol := Col;
 MatrixArray := nil;
 GetMem(MatrixArray, Row * Col * SizeOf(MatrixElement));
 if MatrixArray = nil then
 begin
 FreeMem(TempPtr, SizeOf(MatrixRec));
 Result := nil;
 Exit;
 end;
 end;
 FillMatrix(TempPtr, 0);
 Result := TempPtr;
end;
function DeleteMatrix(var MPtr: MatrixPtr): Boolean;
begin
 if MPtr = nil then
 Result := False
 else
 with MPtr^ do
 begin
 if MatrixArray <> nil then
 FreeMem(MatrixArray, MatrixRow * MatrixCol * SizeOf(MatrixElement));
 FreeMem(MPtr, SizeOf(MatrixRec));
 MPtr := nil;
 Result := True;
 end;
end;
function CloneMatrix(MPtr: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j: Byte;
begin
 if MPtr = nil then
 Result := nil
 else
 with MPtr^ do
 begin
 TempPtr := CreateMatrix(MPtr^.MatrixRow, MPtr^.MatrixCol);
 if TempPtr <> nil then
 begin
 for i := 1 to MatrixRow do
 for j := 1 to MatrixCol do
 SetMatrixElement(TempPtr, i, j, GetMatrixElement(MPtr, i, j));
 Result := TempPtr;
 end
 else
 Result := nil;
 end;
end;
function FillMatrix(MPtr: MatrixPtr; Value: MatrixElement): Boolean;
var
 i, j: Byte;
begin
 if MPtr = nil then
 Result := False
 else
 with MPtr^ do
 begin
 for i := 1 to MatrixRow do
 for j := 1 to MatrixCol do
 SetMatrixElement(MPtr, i, j, Value);
 Result := True;
 end;
end;
function AssignMatrix(var MPtr1: MatrixPtr; MPtr2: MatrixPtr): MatrixPtr;
begin
 DeleteMatrix(MPtr1);
 MPtr1 := MPtr2;
 Result := MPtr1;
end;
function DisplayMatrix(MPtr: MatrixPtr; _Int, _Frac: Byte): Boolean;
var
 i, j: Byte;
begin
 if MPtr = nil then Result := False
 else
 with MPtr^ do
 begin
 for i := 1 to MatrixRow do
 begin
 for j := 1 to MatrixCol do
 Write(GetMatrixElement(MPtr, i, j): _Int: _Frac);
 WriteLn;
 end;
 Result := True;
 end;
end;
function IsSingleMatrix(MPtr: MatrixPtr): Boolean;
begin
 if MPtr <> nil then
 with MPtr^ do
 begin
 if (MatrixRow = 1) and (MatrixCol = 1) then
 Result := True
 else
 Result := False;
 end
 else
 Result := False;
end;
function IsSquareMatrix(MPtr: MatrixPtr): Boolean;
begin
 if MPtr <> nil then
 with MPtr^ do
 begin
 if MatrixRow = MatrixCol then
 Result := True
 else
 Result := False;
 end
 else
 Result := False;
end;
function GetMatrixRow(MPtr: MatrixPtr): Byte;
begin
 if MPtr <> nil then
 Result := MPtr^.MatrixRow
 else
 Result := 0;
end;
function GetMatrixCol(MPtr: MatrixPtr): Byte;
begin
 if MPtr <> nil then
 Result := MPtr^.MatrixCol
 else
 Result := 0;
end;
procedure SetMatrixElement(MPtr: MatrixPtr; Row, Col: Byte; Value: MatrixElement);
var
 TempPtr: ^MatrixElement;
begin
 if MPtr <> nil then
 if (Row <> 0) or (Col <> 0) then with MPtr^ do
 begin
 pointer(TempPtr) := pointer(MatrixArray);
 Inc(TempPtr, MatrixRow * (Col - 1) + Row - 1);
 TempPtr^ := Value;
 end;
end;
function GetMatrixElement(MPtr: MatrixPtr; Row, Col: Byte): MatrixElement;
var
 TempPtr: ^MatrixElement;
begin
 if MPtr <> nil then
 begin
 if (Row <> 0) and (Col <> 0) then with MPtr^ do
 begin
 pointer(TempPtr) := pointer(MatrixArray);
 Inc(TempPtr, MatrixRow * (Col - 1) + Row - 1);
 Result := TempPtr^;
 end
 else
 Result := 0;
 end
 else
 Result := 0;
end;
function ExcludeVectorFromMatrix(MPtr: MatrixPtr; Row, Col: Byte): MatrixPtr;
var
 NewPtr: MatrixPtr;
 NewRow, NewCol: Byte;
 i, j: Byte;
 DiffRow, DiffCol: Byte;
begin
 if MPtr <> nil then with MPtr^ do
 begin
 if Row = 0 then NewRow := MatrixRow
 else
 NewRow := MatrixRow - 1;
 if Col = 0 then NewCol := MatrixCol
 else
 NewCol := MatrixCol - 1;
 NewPtr := CreateMatrix(NewRow, NewCol);
 if (NewPtr = nil) or (NewPtr^.MatrixArray = nil) then
 begin
 Result := nil;
 Exit;
 end;
 DiffRow := 0;
 DiffCol := 0;
 for i := 1 to MatrixRow do
 begin
 if i = Row then DiffRow := 1
 else
 for j := 1 to MatrixCol do if j = Col then DiffCol := 1
 else
 SetMatrixElement(NewPtr, i - DiffRow, j - DiffCol,
 GetMatrixElement(MPtr, i, j));
 DiffCol := 0;
 end;
 Result := NewPtr;
 end
 else
 Result := nil;
end;
function SetVectorIntoMatrix(MPtr, VPtr: MatrixPtr; _Pos: Byte): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i: Byte;
begin
 if (MPtr <> nil) and (VPtr <> nil) then
 begin
 TempPtr := CloneMatrix(MPtr);
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 if VPtr^.MatrixRow = 1 then
 begin
 for i := 1 to TempPtr^.MatrixCol do
 SetMatrixElement(TempPtr, _Pos, i, GetMatrixElement(VPtr, 1, i));
 end
 else
 begin
 for i := 1 to TempPtr^.MatrixRow do
 SetMatrixElement(TempPtr, i, _Pos, GetMatrixElement(VPtr, i, 1));
 end;
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function DetMatrix(MPtr: MatrixPtr): MatrixElement;
var
 TempPtr: MatrixPtr;
 i, j: Byte;
 Sum: MatrixElement;
begin
 if IsSquareMatrix(MPtr) then
 begin
 if not IsSingleMatrix(MPtr) then
 begin
 TempPtr := nil;
 Sum := 0;
 for j := 1 to GetMatrixCol(MPtr) do
 begin
 AssignMatrix(TempPtr, ExcludeVectorFromMatrix(MPtr, 1, j));
 Sum := Sum + IntPower(-1, j + 1) * GetMatrixElement(MPtr, 1, j) *
 DetMatrix(TempPtr);
 end;
 DeleteMatrix(TempPtr);
 Result := Sum;
 end
 else
 Result := GetMatrixElement(MPtr, 1, 1);
 end
 else
 Result := 0;
end;
function DetTriangularMatrix(MPtr: MatrixPtr): MatrixElement;
var
 i: Byte;
 Sum: MatrixElement;
begin
 if IsSquareMatrix(MPtr) then
 begin
 Sum := 1;
 for i := 1 to MPtr^.MatrixRow do
 Sum := Sum * GetMatrixElement(MPtr, i, i);
 Result := Sum;
 end
 else
 Result := 0;
end;
function AppendixElement(MPtr: MatrixPtr; Row, Col: Byte): MatrixElement;
var
 TempPtr: MatrixPtr;
begin
 if IsSquareMatrix(MPtr) then
 begin
 TempPtr := ExcludeVectorFromMatrix(MPtr, Row, Col);
 if TempPtr = nil then
 begin
 Result := 0;
 Exit;
 end;
 Result := IntPower(-1, Row + Col) * DetMatrix(TempPtr);
 DeleteMatrix(TempPtr);
 end
 else
 Result := 0;
end;
function CreateAppendixMatrix(MPtr: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j: Byte;
begin
 if (MPtr <> nil) or (MPtr^.MatrixArray <> nil) or (not IsSquareMatrix(MPtr)) then
 with MPtr^ do
 begin
 TempPtr := CreateMatrix(MatrixCol, MatrixRow);
 for i := 1 to MatrixRow do
 for j := 1 to MatrixCol do
 SetMatrixElement(TempPtr, i, j, AppendixElement(MPtr, i, j));
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function TransponeMatrix(MPtr: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j: Byte;
begin
 if (MPtr <> nil) or (MPtr^.MatrixArray <> nil) then with MPtr^ do
 begin
 TempPtr := CreateMatrix(MatrixCol, MatrixRow);
 for i := 1 to MatrixRow do
 for j := 1 to MatrixCol do
 SetMatrixElement(TempPtr, j, i, GetMatrixElement(MPtr, i, j));
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function ReverseMatrix(MPtr: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 Determinant: MatrixElement;
begin
 if MPtr <> nil then
 begin
 TempPtr := nil;
 AssignMatrix(TempPtr, CreateAppendixMatrix(MPtr));
 AssignMatrix(TempPtr, TransponeMatrix(TempPtr));
 Determinant := DetMatrix(MPtr);
 if (TempPtr = nil) or (Determinant = 0) then
 begin
 DeleteMatrix(TempPtr);
 Result := nil;
 Exit;
 end;
 AssignMatrix(TempPtr, MultipleMatrixOnNumber(TempPtr, 1 / Determinant));
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function MultipleMatrixOnNumber(MPtr: MatrixPtr; Number: MatrixElement): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j: Byte;
begin
 if MPtr <> nil then with MPtr^ do
 begin
 TempPtr := CreateMatrix(MatrixRow, MatrixCol);
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 for i := 1 to MatrixRow do
 for j := 1 to MatrixCol do
 SetMatrixElement(TempPtr, i, j, GetMatrixElement(MPtr, i, j) * Number);
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function MultipleMatrixOnMatrix(MPtr1, MPtr2: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j, k: Byte;
begin
 if (MPtr1 <> nil) and (MPtr2 <> nil) then
 begin
 TempPtr := CreateMatrix(MPtr1^.MatrixRow, MPtr2^.MatrixCol);
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 for i := 1 to TempPtr^.MatrixRow do
 for j := 1 to TempPtr^.MatrixCol do
 for k := 1 to MPtr1^.MatrixCol do
 SetMatrixElement(TempPtr, i, j, GetMatrixElement(TempPtr, i, j) +
 GetMatrixElement(MPtr1, i, k) * GetMatrixElement(MPtr2, k, j));
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function AddMatrixOnMatrix(MPtr1, MPtr2: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j, k: Byte;
begin
 if (MPtr1 <> nil) and (MPtr2 <> nil) then
 begin
 TempPtr := CreateMatrix(MPtr1^.MatrixRow, MPtr2^.MatrixCol);
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 for i := 1 to TempPtr^.MatrixRow do
 for j := 1 to TempPtr^.MatrixCol do
 SetMatrixElement(TempPtr, i, j, GetMatrixElement(Mptr1, i, j) +
 GetMatrixElement(MPtr2, i, j));
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function SubMatrixOnMatrix(MPtr1, MPtr2: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 i, j, k: Byte;
begin
 if (MPtr1 <> nil) and (MPtr2 <> nil) then
 begin
 TempPtr := CreateMatrix(MPtr1^.MatrixRow, MPtr2^.MatrixCol);
 if TempPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 for i := 1 to TempPtr^.MatrixRow do
 for j := 1 to TempPtr^.MatrixCol do
 SetMatrixElement(TempPtr, i, j, GetMatrixElement(MPtr1, i, j) -
 GetMatrixElement(MPtr2, i, j));
 Result := TempPtr;
 end
 else
 Result := nil;
end;
function GausseMethodMatrix(MPtr, VPtr: MatrixPtr;
 var LPtr, UPtr, BPtr: MatrixPtr): MatrixPtr;
var
 TempPtr: MatrixPtr;
 TempVPtr: MatrixPtr;
 TempLPtr: MatrixPtr;
 TempUPtr: MatrixPtr;
 XSum: MatrixElement;
 i, j, k: Byte;
begin
 if (MPtr <> nil) and (VPtr <> nil) then
 begin
 TempUPtr := CloneMatrix(MPtr);
 if TempUPtr = nil then
 begin
 Result := nil;
 Exit;
 end;
 TempLPtr := CreateMatrix(MPtr^.MatrixRow, MPtr^.MatrixCol);
 if TempLPtr = nil then
 begin
 DeleteMatrix(TempUPtr);
 Result := nil;
 Exit;
 end;
 TempVPtr := CloneMatrix(VPtr);
 if TempVPtr = nil then
 begin
 DeleteMatrix(TempLPtr);
 DeleteMatrix(TempUPtr);
 Result := nil;
 Exit;
 end;
 TempPtr := CreateMatrix(MPtr^.MatrixRow, 1);
 if TempPtr = nil then
 begin
 DeleteMatrix(TempVPtr);
 DeleteMatrix(TempLPtr);
 DeleteMatrix(TempUPtr);
 Result := nil;
 Exit;
 end;
 for j := 1 to MPtr^.MatrixCol - 1 do
 begin
 SetMatrixElement(TempLPtr, j, j, 1);
 for i := j + 1 to MPtr^.MatrixRow do
 begin
 SetMatrixElement(TempLPtr, i, j, GetMatrixElement(TempUPtr, i, j) /
 GetMatrixElement(TempUPtr, j, j));
 for k := j to MPtr^.MatrixCol do
 begin
 SetMatrixElement(TempUPtr, i, k, GetMatrixElement(TempUPtr, i, k) -
 GetMatrixElement(TempLPtr, i, j) * GetMatrixElement(TempUPtr, j, k));
 end;
 SetMatrixElement(TempVPtr, i, 1, GetMatrixElement(TempVPtr, i, 1) -
 GetMatrixElement(TempLPtr, i, j) * GetMatrixElement(TempVPtr, j, 1));
 end;
 end;
 SetMatrixElement(TempLPtr, TempLPtr^.MatrixRow, TempLPtr^.MatrixCol, 1);
 SetMatrixElement(TempPtr, TempPtr^.MatrixRow, 1,
 GetMatrixElement(TempVPtr, TempVPtr^.MatrixRow, 1) /
 GetMatrixElement(TempUPtr, TempUPtr^.MatrixRow, TempUPtr^.MatrixCol));
 for j := MPtr^.MatrixCol - 1 downto 1 do
 begin
 XSum := 0;
 for k := j + 1 to MPtr^.MatrixCol do
 XSum := XSum + GetMatrixElement(TempUPtr, j, k) *
 GetMatrixElement(TempPtr, k, 1);
 SetMatrixElement(TempPtr, j, 1, (GetMatrixElement(TempVPtr, j, 1) - XSum) /
 GetMatrixElement(TempUPtr, j, j));
 end;
 LPtr := TempLPtr;
 UPtr := TempUPtr;
 BPtr := TempVPtr;
 Result := TempPtr;
 end
 else
 Result := nil;
end;
end.
Мне кажется, что интерфейсное описание весьма простое, но если возникнут какие-либо вопросы - пишите на E-mail - постараюсь ответить на все Ваши вопросы. Может быть, азы матричного исчисления я опишу в виде отдельной статьи по причине множества поступивших вопросов, хотя в этой матричной математике нет ничего сложного :o) Следует отметить, что теория матриц дает в Ваши руки весьма мощный инструмент по анализу данных весьма различного характера, в чем я неоднократно убеждался на практике.
Важные, на мой взгляд, замечания. НЕ СТЕСНЯЙТЕСЬ использовать подход, использующий стандартный тип Pascal - record. В объектах мало чего хорошего в межкомпиляторном взаимодействии. Да и, кстати, использование типа record до сих пор является самым быстрым способом математических расчетов, в отличии от ООП. Частенько простое 2+2=4 дает существенный выигрыш по времени выполнения, по сравнению с объектным подходом, а если математических вычислений в Вашей программе великое множество....
Author: Andrew M. Omutov 
Source: http://delphiworld.narod.ru
ID: 03956
Category:Алгоритмы
Category:Матрицы