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;
function DeleteMatrix(var MPtr : MatrixPtr) :
boolean;
function FillMatrix(MPtr : MatrixPtr;Value : MatrixElement) :
boolean;
function AssignMatrix(var MPtr1 : MatrixPtr;MPtr2 : MatrixPtr)
: MatrixPtr;
function DisplayMatrix(MPtr : MatrixPtr;_Int,_Frac : byte) :
boolean;
function IsSingleMatrix(MPtr : MatrixPtr) : boolean;
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;
(* El sistema resuelve el método de Gauss y devuelve la matriz LU-*)
(Función * Resultado - soluciones vector columna *)
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 IntPower:= 0
else
begin
Res:=
X;
for
i:=1 to n-1 do
Res:= Res*X;
IntPower:= Res;
end;
end;
function CreateSquareMatrix(Size : byte) : MatrixPtr;
var
TempPtr
: MatrixPtr;
begin
TempPtr:= nil;
GetMem(TempPtr,SizeOf(MatrixRec));
if
TempPtr = nil
then
begin
CreateSquareMatrix:= 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));
CreateSquareMatrix:= nil;
Exit;
end;
end;
FillMatrix(TempPtr,0);
CreateSquareMatrix:= TempPtr;
end;
function CreateMatrix(Row,Col : byte) : MatrixPtr;
var
TempPtr
: MatrixPtr;
begin
TempPtr:= nil;
GetMem(TempPtr,SizeOf(MatrixRec));
if
TempPtr = nil
then
begin
CreateMatrix:= 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));
CreateMatrix:= nil;
Exit;
end;
end;
FillMatrix(TempPtr,0);
CreateMatrix:= TempPtr;
end;
function DeleteMatrix(var MPtr : MatrixPtr) :
boolean;
begin
if
MPtr = nil
then
DeleteMatrix:= FALSE
else
with
MPtr^ do
begin
if
MatrixArray <> nil
then
FreeMem(MatrixArray,MatrixRow*MatrixCol*SizeOf(MatrixElement));
FreeMem(MPtr,SizeOf(MatrixRec));
MPtr:= nil;
DeleteMatrix:= TRUE;
end;
end;
function CloneMatrix(MPtr : MatrixPtr) : MatrixPtr;
var
TempPtr
: MatrixPtr;
i,j
: byte;
begin
if
MPtr = nil
then
CloneMatrix:= 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));
CloneMatrix:= TempPtr;
end
else
CloneMatrix:= nil;
end;
end;
function FillMatrix(MPtr : MatrixPtr;Value : MatrixElement) :
boolean;
var
i,j :
byte;
begin
if
MPtr = nil
then
FillMatrix:= FALSE
else
with
MPtr^ do
begin
for
i:= 1 to MatrixRow do
for
j:= 1 to MatrixCol do
SetMatrixElement(MPtr,i,j,Value);
FillMatrix:= TRUE;
end;
end;
function AssignMatrix(var MPtr1 : MatrixPtr;MPtr2 : MatrixPtr)
: MatrixPtr;
begin
DeleteMatrix(MPtr1);
MPtr1:=
MPtr2;
AssignMatrix:= MPtr1;
end;
function DisplayMatrix(MPtr : MatrixPtr;_Int,_Frac : byte) :
boolean;
var
i,j :
byte;
begin
if
MPtr = nil
then
DisplayMatrix:= 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;
DisplayMatrix:= TRUE;
end;
end;
function IsSingleMatrix(MPtr : MatrixPtr) : boolean;
begin
if
MPtr <> nil
then
with
MPtr^ do
begin
if
(MatrixRow = 1)
and
(MatrixCol = 1)
then
IsSingleMatrix:= TRUE
else
IsSingleMatrix:= FALSE;
end
else
IsSingleMatrix:= FALSE;
end;
function IsSquareMatrix(MPtr : MatrixPtr) : boolean;
begin
if
MPtr <> nil
then
with
MPtr^ do
begin
if
MatrixRow = MatrixCol then
IsSquareMatrix:= TRUE
else
IsSquareMatrix:= FALSE;
end
else
IsSquareMatrix:= FALSE;
end;
function GetMatrixRow(MPtr : MatrixPtr) : byte;
begin
if
MPtr <> nil
then
GetMatrixRow:= MPtr^.MatrixRow
else
GetMatrixRow:= 0;
end;
function GetMatrixCol(MPtr : MatrixPtr) : byte;
begin
if
MPtr <> nil
then
GetMatrixCol:= MPtr^.MatrixCol
else
GetMatrixCol:= 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);
GetMatrixElement:= TempPtr^;
end
else
GetMatrixElement:= 0;
end
else
GetMatrixElement:= 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
ExcludeVectorFromMatrix:= 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;
ExcludeVectorFromMatrix:= NewPtr;
end
else
ExcludeVectorFromMatrix:= 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
SetVectorIntoMatrix:= 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;
SetVectorIntoMatrix:= TempPtr;
end
else
SetVectorIntoMatrix:= 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);
DetMatrix:= Sum;
end
else
DetMatrix:= GetMatrixElement(MPtr,1,1);
end
else
DetMatrix:= 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);
DetTriangularMatrix:= Sum;
end
else
DetTriangularMatrix:= 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
AppendixElement:= 0;
Exit;
end;
AppendixElement:= IntPower(-1,Row+Col)*DetMatrix(TempPtr);
DeleteMatrix(TempPtr);
end
else
AppendixElement:= 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));
CreateAppendixMatrix:= TempPtr;
end
else
CreateAppendixMatrix:= 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));
TransponeMatrix:= TempPtr;
end
else
TransponeMatrix:= 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);
ReverseMatrix:= nil;
Exit;
end;
AssignMatrix(TempPtr,MultipleMatrixOnNumber(TempPtr,1/Determinant));
ReverseMatrix:= TempPtr;
end
else
ReverseMatrix:= 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
MultipleMatrixOnNumber:= nil;
Exit;
end;
for
i:= 1 to MatrixRow do
for
j:= 1 to MatrixCol do
SetMatrixElement(TempPtr,i,j,GetMatrixElement(MPtr,i,j)*Number);
MultipleMatrixOnNumber:= TempPtr;
end
else
MultipleMatrixOnNumber:= 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
MultipleMatrixOnMatrix:= 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));
MultipleMatrixOnMatrix:= TempPtr;
end
else
MultipleMatrixOnMatrix:= 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
AddMatrixOnMatrix:= 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));
AddMatrixOnMatrix:= TempPtr;
end
else
AddMatrixOnMatrix:= 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
SubMatrixOnMatrix:= 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));
SubMatrixOnMatrix:= TempPtr;
end
else
SubMatrixOnMatrix:= 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
GausseMethodMatrix:= nil;
Exit;
end;
TempLPtr:= CreateMatrix(MPtr^.MatrixRow,MPtr^.MatrixCol);
if
TempLPtr = nil
then
begin
DeleteMatrix(TempUPtr);
GausseMethodMatrix:= nil;
Exit;
end;
TempVPtr:= CloneMatrix(VPtr);
if
TempVPtr = nil
then
begin
DeleteMatrix(TempLPtr);
DeleteMatrix(TempUPtr);
GausseMethodMatrix:= nil;
Exit;
end;
TempPtr:= CreateMatrix(MPtr^.MatrixRow,1);
if
TempPtr = nil
then
begin
DeleteMatrix(TempVPtr);
DeleteMatrix(TempLPtr);
DeleteMatrix(TempUPtr);
GausseMethodMatrix:= 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;
GausseMethodMatrix:= TempPtr;
end
else
GausseMethodMatrix:= nil;
end;
end.
LIBROS:
Matemáticas, el fascinante mundo de los números
Matrix computations (Matematical Science)
Geometría analítica del plano y del espacio
Mecánica de fluidos
Geometría Afín y Euclidea
Cuando utilizo los funciones: function DetMatrix(MPtr : MatrixPtr) : MatrixElement; y function ReverseMatrix(MPtr : MatrixPtr) : MatrixPtr; con en Matrices grandes, no se sale bien el resultado en comparación con Excel. Chequeo los códigos, se aparecen que estén bien. NO SÉ POR QUÉ? ME LO PODRÍA EXPLICAR?
ResponderEliminar