Sign In
Create Account
Follow Us on Twitter
Subscribe on Youtube
see the functions & procedures & overloading operators :rules:
Quote
I'm new here friends :pinguin:
unit Math;
interface
uses
Crt, Sysutils, Dos, IPC, Linux, MMX, Objects, Printer, SOCKETS, Strings;
const
maxm = 100;
maxn = 100;
flod = 100000000;
type
{ Matrix Type }
{ 0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
0 0 0 0 0 0
}
Matrix = Object { 40 functions }
RowCount : Integer;
{ First ِAxis :: Lines' number }
ColCount : Integer;
{ Second Axis :: Lines' number }
name : String;
{ key of the array }
Cell : Array [1..maxn, 1..maxm] of extended;
{ Cell of the array :: n*m || [maxn,maxn]}
procedure Save;
{ save object's information }
procedure Display;
{ display the Cell without its key }
procedure HyperDisplay;
{ display the Cell with its key }
procedure Inputdata;
{ reading object contents }
procedure RandomInput(x, y : integer);
{ Random input for RowCount , ColCount & Cells }
procedure Init;
{ make object initialized
Cell :: 0
RowCount :: 0
ColCount :: 0 }
procedure Unitary;
{ make the Cell unitary array }
function itsUnitary : boolean;
procedure MultLine_Const(x : Integer; temp : extended);
{ Multiplication | Const * one Line }
procedure DivLine_Const(x : Integer; temp : extended);
{ Division | Const / one Line }
procedure SumLine_Const(x : Integer; temp : extended);
{ Adding | Const + one Line }
procedure SubLine_Const(x : Integer; temp : extended);
{ Sub | Const - one Line }
procedure MultColumn_Const(x : integer; temp : extended);
{ Multiplication | Const * one Column }
procedure DivColumn_Const(x : integer; temp : extended);
{ Division | Const / one Column }
procedure SumColumn_Const(x : integer; temp : extended);
{ Adding | Const + one Column }
procedure SubColumn_Const(x : integer; temp : extended);
{ Sub | Const - one Column }
procedure SumLines(x, y : Integer);
{ Sum tow Lines in the Cell }
procedure SubLines(x, y : Integer);
{ Sub tow Lines in the Cell }
procedure MultLines(x, y : Integer);
{ Mult tow Lines in the Cell }
procedure DivLines(x, y : integer);
{ Div tow Lines in the Cell }
procedure SumColumns(x, y : Integer);
{ Sum tow Columns in the Cell }
procedure SubColumns(x, y : Integer);
{ Sub tow Columns in the Cell }
procedure MultColumns(x, y : Integer);
{ Mult tow Columns in the Cell }
procedure DivColumns(x, y : integer);
{ Div tow Columns in the Cell }
procedure SwichLines(x, y : integer);
{ Siwech bettwen to Lines }
procedure SwichColumns(x, y : integer);
{ Swich bettwen tow columns }
function transport : Matrix;
{ return transported of the Cell }
function Power(x : Integer) : Matrix;
{ retern power of the Cell by x }
function MultConst(x : extended) : Matrix;
{ return new Matrix Multiplication by x }
function SumConst(x : extended) : Matrix;
{ return new Matrix Adding +x }
function SubConst(x : extended) : Matrix;
{ return new Matrix Subtraction -x }
function DivConst(x : extended) : Matrix;
{ return new Matrix Division by x }
function Tringle : Boolean;
{ Checking the Cell if : tringle -> return true
: not tranle -> return false }
function equation(A : matrix) : boolean;
{ Checking if Cell = parameter's Cell }
function Symme : Boolean;
{ Chicking the Cell if Symmetrically }
function RevereseSymme : Boolean;
{ Chicking the Cell if Reverse Symmetrically }
procedure TransferTo(var B : Matrix);
{ transfer data from object Cell to parameter Cell }
function MaxValue : extended;
{ Found Max Value in the Matrix }
function MaxValueLine(x : integer) : extended;
{ Found Max Value in line number x }
function MaxValueColumn(x : integer) : extended;
{ Found Max Value in column number x }
function MinValue : extended;
{ Found Min Value in the Matrix }
function MinValueLine(x : integer) : extended;
{ Found Min Value in line number x }
function MinValueColumn(x : integer) : extended;
{ Found Min Value in column number x }
end;
Vector = Object { 15 functions }
private
CellsCount : longint;
{ Vector's Cells Count }
name : String;
{ key of the vector }
Cell : Array [1..flod] of extended;
{ Cell of the contents }
public
procedure InputData;
{ reading object's contents }
procedure Init;
{ make object initialized
Cell :: 0
CellsCount :: 0 }
procedure Unitary;
{ make the Cell unitary vector }
procedure Disply;
{ display vector contents }
procedure Swich(x, y : longint);
{ Swich tow Cells in the vector }
procedure TransferTo(var A : vector);
{ transfer vector tow new vector }
procedure MultConst(x : extended);
{ Mult All vector's Cell by x }
procedure DivConst(x : extended);
{ Div All vector's Cells by x }
procedure SumConst(x : extended);
{ Add x to All vector's Cells }
procedure SubConst(x : extended);
{ Sub x from All vector's Cells }
procedure BubbleSort;
{ Sort the vector by bubble sort algorithm }
function MaxValue : extended;
{ Search about max value in the vector and return it }
function MinValue : extended;
{ Search about min value in the vector and return it }
function found(x : extended) : boolean;
{ Search about x Cell and return "true" or "false" == "found" or "not found"}
function index(x : extended) : longint;
{ return index of x value in the vector }
end;
{ . .. ... Algebra Functions ... .. .} { 17 functions }
operator + (A, B : Matrix) C : Matrix;
function CanSum(A, B : Matrix) : boolean;
operator - (A, B : Matrix) C : Matrix;
function CanSub(A, B : Matrix) : boolean;
operator * (A, B : Matrix) C : Matrix;
function CanMult(A, B : Matrix) : boolean;
function Det(A : Matrix) : extended;
function DirectDet(A : Matrix) : extended;
function minor(A : Matrix; x, y : Integer) : Matrix;
function BeTringleLines(A : Matrix) : Matrix;
function BeTringleColumns(A : Matrix) : Matrix;
function Rank(H : Matrix) : integer;
function invers(A : Matrix) : Matrix;
function adj(A : Matrix) : Matrix;
function SumVector(A, B : vector) : vector;
function SubVector(A, B : vector) : vector;
function MultVector(A, B : vector) : extended;
{ . .. ... Other's Functions ... .. . } { 13 functions }
function power(x : extended; n : integer) : extended;
function factorial(n : integer) : extended;
function fibonacci(n : integer) : extended;
function GCD(x, y : extended) : extended;
function ACM(x, y : extended) : extended;
function Reflex(n : longint) : longint;
procedure friend(n : longint);
procedure Reduse(var m, n : longint);
procedure blockfloat(n : extended);
function BinToDec(n : Binary) : longint;
function DecToBin(n : longint) : Binary;
function signBinToDec(n : Binary) : longint;
function StrToInt(s : string) : Integer;
implementation
{... Matrix Methods ...}
procedure Matrix.RandomInput(x, y : integer);
var
i, j : integer;
begin
RowCount := x;
ColCount := y;
for i:=1 to RowCount do
for j:=1 to ColCount do
Cell[i, j] := Random(10);
end;
procedure Matrix.Save;
var
f : text;
i, j : integer;
temp : Matrix;
begin
Assign(f, name);
rewrite(f);
writeln(f, '-key');
writeln(f, name);
writeln(f);
writeln(f, '-RowCount');
writeln(f, RowCount);
writeln(f);
writeln(f, '-ColCount');
writeln(f, ColCount);
writeln(f);
writeln(f, '-Cells');
for i:=1 to RowCount do
begin
for j:=1 to ColCount do
if Cell[i, j] = trunc(Cell[i, j]) then
writeln(f, Cell[i, j]:3:0, ' ')
else
writeln(f, Cell[i, j]:3:3, ' ');
end;
writeln(f);
writeln(f, '-Tringly Array');
TransferTo(temp);
BeTringleLines(temp).TransferTo(temp);
for i:=1 to temp.RowCount do
begin
for j:=1 to temp.ColCount do
if temp.Cell[i, j] = trunc(temp.Cell[i, j]) then
writeln(f, temp.Cell[i, j]:3:0, ' ')
else
writeln(f, temp.Cell[i, j]:3:3, ' ');
end;
writeln(f);
writeln(f, '-determinant(',name,')');
writeln(f, Det(temp):6:3);
writeln(f);
writeln(f, '-Rank(',name,')');
writeln(f, Rank(temp));
writeln(f);
writeln(f);
close(f);
end;
procedure Matrix.Unitary;
var
i, j : Integer;
begin
for i:=1 to RowCount do
for j:=1 to ColCount do
if i = j then
Cell[i, j] := 1
else
Cell[i, j] := 0;
end;
function Matrix.itsUnitary : boolean;
var
its : boolean;
i, j : integer;
begin
its := true;
for i:=1 to RowCount do
for j:=1 to ColCount do
if i = j then
if Cell[i, j] <> 1 then
begin
its := false;
break;
end
else if Cell[i, j] <> 0 then
begin
its := false;
break;
end;
itsUnitary := its;
end;
procedure Matrix.Init;
var
i, j : Integer;
begin
for i:=1 to RowCount do
for j:=1 to ColCount do
Cell[i, j] := 0;
name := '';
end;
procedure Matrix.inputdata;
var
i, j : Integer;
begin
write('input columns digits : ');
readln(RowCount);
write('input lines digits : ');
readln(ColCount);
write('input Array name : ');
readln(name);
name := '( ' + name + ' )';
for i:=1 to RowCount do
begin
for j:=1 to ColCount do
begin
write(name,'[',i,',',j,'] : ');
readln(Cell[i, j]);
end;
end;
end;
procedure Matrix.HyperDisplay;
var
i, j : integer;
begin
writeln(name);
for i:=1 to RowCount do
begin
for j:=1 to ColCount do
if Cell[i, j] = trunc(Cell[i, j]) then
write(Cell[i, j]:3:0, ' ')
else
begin
Blockfloat(Cell[i, j]);
write(' ');
end;
writeln;
end;
end;
procedure Matrix.Display;
var
i, j : Integer;
begin
writeln;
for i:=1 to RowCount do
begin
for j:=1 to ColCount do
if Cell[i, j] = trunc(Cell[i, j]) then
write(Cell[i, j]:3:0, ' ')
else
write(Cell[i, j]:3:3, ' ');
writeln;
end;
end;
function Matrix.transport : Matrix;
var
i, j : Integer;
temp : Matrix;
begin
temp.RowCount := ColCount;
temp.ColCount := RowCount;
temp.name := '';
for i:=1 to RowCount do
for j:=1 to ColCount do
temp.Cell[j, i] := Cell[i, j];
transport := temp;
end;
function Matrix.MultConst(x : extended) : Matrix;
var
i, j : Integer;
temp : Matrix;
begin
temp.RowCount := RowCount;
temp.ColCount := ColCount;
for i:=1 to RowCount do
for j:=1 to ColCount do
temp.Cell[i, j] := Cell[i, j] * x;
MultConst := temp;
end;
function Matrix.SumConst(x : extended) : Matrix;
var
i, j : Integer;
temp : Matrix;
begin
temp.RowCount := RowCount;
temp.ColCount := ColCount;
for i:=1 to RowCount do
for j:=1 to ColCount do
temp.Cell[i, j] := Cell[i, j] + x;
SumConst := temp;
end;
function Matrix.SubConst(x : extended) : Matrix;
var
i, j : Integer;
temp : Matrix;
begin
temp.RowCount := RowCount;
temp.ColCount := ColCount;
for i:=1 to RowCount do
for j:=1 to ColCount do
temp.Cell[i, j] := Cell[i, j] - x;
SubConst := temp;
end;
function Matrix.DivConst(x : extended) : Matrix;
var
i, j : Integer;
temp : Matrix;
begin
temp.RowCount := RowCount;
temp.ColCount := ColCount;
for i:=1 to RowCount do
for j:=1 to ColCount do
temp.Cell[i, j] := Cell[i, j] / x;
DivConst := temp;
end;
function Matrix.Power(x : Integer) : Matrix;
var
temp : Matrix;
A : Matrix;
i, j : Integer;
begin
A.RowCount := RowCount;
A.ColCount := ColCount;
for i:=1 to RowCount do
for j:=1 to ColCount do
A.Cell[i, j] := Cell[i, j];
temp.Unitary;
temp.RowCount := RowCount;
temp.ColCount := ColCount;
temp.name := '';
while x <> 0 do
begin
temp := A * temp;
x := x - 1;
end;
Power := temp;
end;
procedure Matrix.MultLine_Const(x : Integer; temp : extended);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] * temp;
end;
procedure Matrix.DivLine_Const(x : Integer; temp : extended);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] / temp;
end;
procedure Matrix.SumLine_Const(x : Integer; temp : extended);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] + temp;
end;
procedure Matrix.SubLine_Const(x : Integer; temp : extended);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] - temp;
end;
procedure Matrix.MultColumn_Const(x : integer; temp : extended);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] * temp;
end;
procedure Matrix.DivColumn_Const(x : integer; temp : extended);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] / temp;
end;
procedure Matrix.SumColumn_Const(x : integer; temp : extended);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] + temp;
end;
procedure Matrix.SubColumn_Const(x : integer; temp : extended);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] - temp;
end;
procedure Matrix.SumLines(x, y : Integer);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] + Cell[y, j];
end;
procedure Matrix.SubLines(x, y : Integer);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] - Cell[y, j] ;
end;
procedure Matrix.MultLines(x, y : Integer);
var
j : Integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] * Cell[y, j];
end;
procedure Matrix.DivLines(x, y : integer);
var
j : integer;
begin
for j:=1 to ColCount do
Cell[x, j] := Cell[x, j] / Cell[y, j];
end;
procedure Matrix.SumColumns(x, y : Integer);
var
i : integer;
begin
for i:=1 to ColCount do
Cell[i, x] := Cell[i, x] + Cell[i, y];
end;
procedure Matrix.SubColumns(x, y : Integer);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] - Cell[i, y];
end;
procedure Matrix.MultColumns(x, y : Integer);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] * Cell[i, y];
end;
procedure Matrix.DivColumns(x, y : integer);
var
i : integer;
begin
for i:=1 to RowCount do
Cell[i, x] := Cell[i, x] / Cell[i, y];
end;
procedure Matrix.SwichLines(x, y : integer);
var
j : integer;
begin
for j:=1 to ColCount do
begin
Cell[x, j] := Cell[y, j] + Cell[x, j];
Cell[y, j] := Cell[x, j] - Cell[y, j];
Cell[x, j] := Cell[x, j] - Cell[y, j];
end;
end;
procedure Matrix.SwichColumns(x, y : integer);
var
i : integer;
begin
for i:=1 to ColCount do
begin
Cell[i, x] := Cell[i, y] + Cell[i, x];
Cell[i, y] := Cell[i, x] - Cell[i, y];
Cell[i, x] := Cell[i, x] - Cell[i, y];
end;
end;
function Matrix.Tringle : Boolean;
var
i : Integer = 2;
j : Integer = 1;
index : Integer;
IO : Boolean = true;
begin
while i<= RowCount do
begin
j := 1;
index := i - j;
for j:=1 to index do
if Cell[i, j] <> 0 then
begin
IO := false;
break;
end;
i := i + 1;
end;
Tringle := IO;
end;
function Matrix.equation(A : matrix) : boolean;
var
i, j : integer;
ex : boolean = true;
begin
if (RowCount = A.RowCount) and (A.ColCount = ColCount) then
begin
for i:=1 to RowCount do
for j:=1 to ColCount do
if A.Cell[i, j] <> Cell[i, j] then
begin
ex := false;
break;
end;
end
else
equation := false;
equation := ex;
end;
function Matrix.Symme : Boolean;
begin
if equation(transport) then
Symme := true
else
Symme := false;
end;
function Matrix.RevereseSymme : Boolean;
var
i, j : integer;
Bool : Boolean = true;
begin
for i:=1 to RowCount do
begin
for j:=1 to ColCount do
if (i <> j) and (Cell[i, j] <> -1*Cell[j, i]) then
begin
Bool := false;
break;
end;
if not Bool then
break;
end;
RevereseSymme := Bool;
end;
procedure Matrix.TransferTo(var B : Matrix);
var
i, j : Integer;
begin
B.RowCount := RowCount;
B.ColCount := ColCount;
B.name := name;
for i:=1 to RowCount do
for j:=1 to ColCount do
B.Cell[i, j] := Cell[i, j];
end;
function Matrix.MaxValue : extended;
var
max : extended = 0.0;
i, j : integer;
begin
max := 0.0;
for i:=1 to RowCount do
for j:=1 to ColCount do
if Cell[i, j] > max then
max := Cell[i, j];
MaxValue := max;
end;
function Matrix.MaxValueLine(x : integer) : extended;
var
max : extended = 0.0;
j : integer;
begin
max := 0.0;
for j:=1 to ColCount do
if Cell[x, j] > max then
max := Cell[x, j];
MaxValueLine := max;
end;
function Matrix.MaxValueColumn(x : integer) : extended;
var
max : extended = 0.0;
i : integer;
begin
max := 0.0;
for i:=1 to RowCount do
if Cell[i, x] > max then
max := Cell[i, x];
MaxValueColumn := max;
end;
function Matrix.MinValue : extended;
var
min : extended = 0.0;
i, j : integer;
begin
min := Cell[1, 1];
for i:=1 to RowCount do
for j:=1 to ColCount do
if Cell[i, j] < min then
min := Cell[i, j];
MinValue := min;
end;
function Matrix.MinValueLine(x : integer) : extended;
var
min : extended = 0.0;
j : integer;
begin
min := Cell[x, 1];
for j:=1 to ColCount do
if Cell[x, j] < min then
min := Cell[x, j];
MinValueLine := min;
end;
function Matrix.MinValueColumn(x : integer) : extended;
var
min : extended = 0.0;
i : integer;
begin
min := Cell[1, x];
for i:=1 to RowCount do
if Cell[i, x] < min then
min := Cell[i, x];
MinValueColumn := min;
end;
{********** End of Matrix Object ************}
{... Vector Object ...}
procedure Vector.InputData;
var
i : longint;
begin
write('input Cells digits : ');
readln(CellsCount);
write('input vector name : ');
readln(name);
for i:=1 to CellsCount do
begin
write(name, '[', i, '] : ');
readln(Cell[i]);
end;
end;
procedure Vector.Init;
var
i : longint;
begin
CellsCount := 0;
for i:=1 to flod do
Cell[i] := 0;
end;
procedure Vector.Unitary;
var
i : integer;
begin
for i:=1 to CellsCount do
Cell[i] := 1;
end;
procedure Vector.Disply;
var
i : longint;
begin
for i:=1 to CellsCount do
if Cell[i] = trunc(Cell[i]) then
writeln(trunc(Cell[i]))
else
writeln(Cell[i]:6:4);
end;
procedure Vector.Swich(x, y : longint);
var
temp : extended = 0.0;
begin
temp := Cell[x];
Cell[x] := Cell[y];
Cell[y] := temp;
end;
procedure Vector.TransferTo(var A : vector);
var
i : longint;
begin
A.CellsCount := CellsCount;
for i:=1 to CellsCount do
A.Cell[i] := Cell[i];
end;
procedure Vector.MultConst(x : extended);
var
i : longint;
begin
for i:=1 to CellsCount do
Cell[i] := Cell[i] * x;
end;
procedure Vector.DivConst(x : extended);
var
i : longint;
begin
for i:=1 to CellsCount do
Cell[i] := Cell[i] / x;
end;
procedure Vector.SumConst(x : extended);
var
i : longint;
begin
for i:=1 to CellsCount do
Cell[i] := Cell[i] + x;
end;
procedure Vector.SubConst(x : extended);
var
i : longint;
begin
for i:=1 to CellsCount do
Cell[i] := Cell[i] - x;
end;
procedure Vector.BubbleSort;
var
i, j : integer;
begin
for i:=1 to CellsCount - 1 do
for j:=i+1 to CellsCount do
if Cell[i] > Cell[j] then
Swich(i, j);
end;
function Vector.MaxValue : extended;
var
i : longint;
max : extended = 0.0;
begin
max := 0.0;
for i:=1 to CellsCount do
if Cell[i] > max then
max := Cell[i];
MaxValue := max;
end;
function Vector.MinValue : extended;
var
i : longint;
min : extended = 0.0;
begin
min := Cell[1];
for i:=1 to CellsCount do
if Cell[i] < min then
min := Cell[i];
MinValue := min;
end;
function Vector.found(x : extended) : boolean;
var
i : longint;
finde : boolean = false;
begin
finde := false;
for i:=1 to CellsCount do
if Cell[i] = x then
begin
finde := true;
break;
end;
found := finde;
end;
function Vector.index(x : extended) : longint;
var
i : longint;
return : longint = -1;
begin
return := -1;
for i:=1 to CellsCount do
if Cell[i] = x then
begin
return := i;
break;
end;
index := return;
end;
{... Algebra Functions ...}
operator + (A, B : Matrix) C : Matrix;
var
i, j : Integer;
begin
C.Init;
C.RowCount := A.RowCount;
C.ColCount := A.ColCount;
C.name := '';
for i:=1 to C.RowCount do
for j:=1 to C.ColCount do
C.Cell[i, j] := A.Cell[i, j] + B.Cell[i, j];
end;
function CanSum(A, B : Matrix) : boolean;
begin
if (A.RowCount = B.RowCount) and (A.ColCount = B.ColCount) then
CanSum := true
else
CanSum := false;
end;
operator - (A, B : Matrix) C : Matrix;
var
i, j : Integer;
begin
C.Init;
C.RowCount := A.RowCount;
C.ColCount := A.ColCount;
C.name := '';
for i:=1 to C.RowCount do
for j:=1 to C.ColCount do
C.Cell[i, j] := A.Cell[i, j] - B.Cell[i, j];
end;
function CanSub(A, B : Matrix) : boolean;
begin
if (A.RowCount = B.RowCount) and (A.ColCount = B.ColCount) then
CanSub := true
else
CanSub := false;
end;
operator * (A, B : Matrix) C : Matrix;
var
i, j, k : Integer;
begin
C.Init;
C.RowCount := A.RowCount;
C.ColCount := B.ColCount;
for i:=1 to C.RowCount do
for j:=1 to C.ColCount do
for k:=1 to A.ColCount do
C.Cell[i, j] := A.Cell[i, k] * B.Cell[k, j];
end;
function CanMult(A, B : Matrix) : boolean;
begin
if (A.RowCount = B.ColCount) and (A.ColCount = B.RowCount) then
CanMult := true
else
CanMult := false;
end;
function adj(A : Matrix) : Matrix;
var
i, j : integer;
temp : Matrix;
begin
temp.RowCount := A.RowCount;
temp.ColCount := A.RowCount;
for i:=1 to A.RowCount do
for j:=1 to A.ColCount do
if (i + j) mod 2 = 0 then
temp.Cell[i, j] := det(minor(A, i, j))
else
temp.Cell[i, j] := -1*det(minor(A, i, j));
adj := temp.transport;
end;
function invers(A : Matrix) : Matrix;
var
temp : Matrix;
begin
temp := adj(A);
invers := temp.MultConst(1/det(A));
end;
function minor(A : Matrix; x, y : Integer) : Matrix;
var
b : Matrix;
x1, y1 : Integer;
i, j : Integer;
begin
b.RowCount := A.RowCount - 1;
b.ColCount := A.ColCount - 1;
for i:=1 to A.RowCount do
begin
if i = x then
begin
x1 := 1;
continue;
end;
for j:=1 to A.ColCount do
begin
if j = y then
begin
y1 := 1;
continue;
end;
b.Cell[i-x1, j-y1] := A.Cell[i, j];
end;
y1 := 0;
end;
minor := b;
end;
function DirectDet(A : Matrix) : extended;
var
i, l : Integer;
Sum : extended;
begin
if A.itsUnitary then
DirectDet := 1
else
if A.RowCount = 1 then
DirectDet := A.Cell[1, 1]
else
begin
Sum := 0;
for i:=1 to A.RowCount do
begin
if i mod 2 = 0 then
l := 1
else
l := -1;
Sum := Sum + l*A.Cell[1, i]*DirectDet(minor(A, 1, i));
end;
DirectDet := -1*Sum;
end;
end;
function Det(A : Matrix) : extended;
var
out : extended;
i, j : integer;
begin
out := 1.0;
BeTringleLines(A).TransferTo(A);
for i:=1 to A.RowCount do
for j:=1 to A.ColCount do
if i = j then
out := out * A.Cell[i, j];
Det := out;
end;
function BeTringleLines(A : Matrix) : Matrix;
var
index : integer;
pos : integer;
i, j : integer;
vol : integer = 1;
r, rate : extended;
begin
index := 1;
while index < A.RowCount do
begin
if A.Cell[index, index] = 0 then
begin
vol := vol + 1;
for pos:=1 to A.RowCount do
begin
r := A.Cell[index+1, vol];
A.Cell[index, vol] := A.Cell[index + 1, vol];
A.Cell[index + 1, vol] := r;
end;
end
else
for i:=index+1 to A.RowCount do
begin
rate := -1*(A.Cell[i, index]/A.Cell[index, index]);
for j:=index to A.RowCount do
A.Cell[i, j] := rate*A.Cell[index, j]+A.Cell[i, j];
end;
index := index + 1;
end;
BeTringleLines := A;
end;
function BeTringleColumns(A : Matrix) : Matrix;
var
B : Matrix;
begin
A.transport.TransferTo(B);
A.Init;
BeTringleLines(B).TransferTo(A);
B.Init;
A.transport.TransferTo(B);
BeTringleColumns := B;
end;
function GetRank(H : Matrix) : integer;
var
i, j, r : integer;
z : boolean;
begin
r := 0;
for i:=1 to H.RowCount do
begin
z := true;
for j:=1 to H.ColCount do
if (H.Cell[i,j] <> 0) then
begin
z := false;
break;
end;
if not z then
r := r + 1;
end;
GetRank := r;
end;
function Rank(H : Matrix) : integer;
begin
if GetRank(BeTringleLines(H)) >= GetRank(BeTringleColumns(H)) then
Rank := GetRank(BeTringleLines(H))
else
Rank := GetRank(BeTringleColumns(H));
end;
function SumVector(A, B : vector) : vector;
var
temp : vector;
i : longint;
begin
temp.CellsCount := A.CellsCount;
for i:=1 to temp.CellsCount do
temp.Cell[i] := A.Cell[i] + B.Cell[i];
SumVector := temp;
end;
function SubVector(A, B : vector) : vector;
var
temp : vector;
i : integer;
begin
temp.CellsCount := A.CellsCount;
for i:=1 to temp.CellsCount do
temp.Cell[i] := A.Cell[i] - B.Cell[i];
SubVector := temp;
end;
function MultVector(A, B : vector) : extended;
var
i : integer;
return : extended = 0.0;
begin
return := 0.0;
for i:=1 to A.CellsCount do
return := return + A.Cell[i] * B.Cell[i];
MultVector := return;
end;
{ . .. ... Other Functions ... .. . }
function power(x : extended; n : integer) : extended;
begin
if n = 0 then
power := 1
else
if n = 1 then
power := x
else
power := x * power(x, n - 1);
end;
function factorial(n : integer) : extended;
var
factorStack : extended = 1;
begin
factorStack := 1;
while n > 1 do
begin
factorStack := factorStack * n;
n := n - 1;
end;
factorial := factorStack;
end;
function fibonacci(n : integer) : extended;
var
S, S1, S0 : extended;
i : longint;
begin
S := 0;
S1 := 1;
S0 := 0;
if (n = 0) then
S0 := 0;
if (n = 1) then
S1 := 1;
for i:=1 to n - 1 do
begin
S := S0 + S1;
S0 := S1;
S1 := S;
end;
fibonacci := S;
end;
function GCD(x, y : extended) : extended;
begin
if x = y then
GCD := x
else
begin
repeat
if x > y then
x := x - y
else if x < y then
y := y - x;
until x = y;
GCD := x;
end;
end;
function ACM(x, y : extended) : extended;
var
ix, iy : extended;
begin
if x = y then
ACM := x
else
begin
ix := x;
iy := y;
repeat
if x > y then
y := y + iy
else if x < y then
x := x + ix;
until x = y;
ACM := x;
end;
end;
procedure friend(n : longint);
var
m, i, l, sum1, sum2 : longint;
begin
while (n <> 0) do
begin
for m:=1 to n do
begin
sum1 := 0;
sum2 := 0;
for i:=n div 2 downto 1 do
if (n mod i = 0) then
sum1 := sum1 + i;
for l:=m div 2 downto 1 do
if (m mod l = 0) then
sum2 := sum2 + l;
if (sum1 = m) and (sum2 = n) and (m <> n) then
writeln(n,' .. friend .. ', m);
end;
n := n - 1;
end;
end;
procedure Reduse(var m, n:longint);
var
i, l : longint;
begin
for i:=1 to m do
for l:=i to n do
if (m mod l=0) and (n mod l=0) then
begin
m := m div l;
n := n div l;
end;
end;
procedure blockfloat(n : extended);
var
x : extended = 0.0;
i : longint;
begin
x := n;
i := 0;
while (x - int(x) <> 0) do
begin
i := i + 1;
x := n * i;
end;
write(trunc(x), '/', i);
end;
function Reflex(n : longint) : longint;
var
y : longint;
begin
y := 0;
while n <> 0 do
begin
y := y * 10 + n mod 10;
n := n div 10;
end;
Reflex := y;
end;
function BinToDec(n : Binary) : longint;
var
y : longint = 0;
i, j : longint;
begin
y := 0;
j := 0;
for i:=length(n) downto 1 do
begin
y := y + (StrToInt(n[i]) * trunc(power(2, j)));
j := j + 1;
end;
BinToDec := y;
end;
function DecToBin(n : longint) : Binary;
var
y : Binary;
begin
y := '';
while n <> 0 do
begin
if n mod 2 = 0 then
begin
y := '0' + y;
n := n div 2;
end
else
begin
y := '1' + y;
n := n - 1;
n := n div 2;
end;
end;
DecToBin := y;
end;
function signBinToDec(n : Binary) : longint;
begin
if n[1] = '1' then
signBinToDec := -1*(256 - BinToDec(n))
else
signBinToDec := +1*(256 - BinToDec(n));
end;
function StrToInt(s : Binary) : Integer;
var i : Integer;
sum : Integer;
begin
sum := 0;
for i:=1 to length(s) do
sum := sum * 10 + ord(s[i]) - 48;
StrToInt := sum;
end;
begin
end.
Back to top
