Skip to content

Instantly share code, notes, and snippets.

@ernado
Created February 20, 2012 23:18
Show Gist options
  • Save ernado/1872213 to your computer and use it in GitHub Desktop.
Save ernado/1872213 to your computer and use it in GitHub Desktop.
Pascal unit for matrix manipulations by Ernado
unit Matrixes;
interface
uses Crt; const NMAX = 10; {Матрица занимает максимум [Nmax^2 + 2] байт}
type Matrix = record m:array[1..NMAX,1..NMAX] of shortint; rows,lines:byte; end;
procedure Error(message:string);
procedure Print(c1:Matrix);
function ZeroM(lines,rows:byte):Matrix;
function AddM(c1,c2:Matrix):Matrix;
function RandomM(lines,rows:byte):Matrix;
function SubtractM(c1,c2:Matrix):Matrix;
function MultiplyM(c1,c2:Matrix):Matrix;
function MultScalarM(c1:Matrix; n:shortint):Matrix;
function TransposeM(c:Matrix):Matrix;
function IdentityM(n:byte):Matrix;
implementation
procedure Error(message:string);
begin WriteLn('Error: ', message); Readkey; Halt(1); end;
procedure Print(c1:Matrix);
var i,j:byte;
begin
Write(' ┌'); for j:=1 to c1.rows do Write('────'); WriteLn('──┐');
for i:=1 to c1.lines do
begin
Write(' │'); for j:=1 to c1.rows do Write(c1.m[i,j]:4); WriteLn(' │');
end;
Write(' └'); for j:=1 to c1.rows do Write('────'); WriteLn('──┘');
end;
function ZeroM(lines,rows:byte):Matrix;
var i,j:byte;
begin
if (lines > NMAX) or (rows > NMAX) then Error('OUT OF RANGE');
ZeroM.lines := lines; ZeroM.rows := rows;
for i:=1 to lines do
for j:=1 to rows do ZeroM.m[i,j] := 0;
end;
function AddM(c1,c2:Matrix):Matrix;
var i,j:byte;
begin
if (c1.lines<>c2.lines) or (c1.rows<>c2.rows) then Error('[N1xM1]!=[N2xM2]');
for i:=1 to c1.lines do
for j:=1 to c1.rows do Inc(c1.m[i,j],c2.m[i,j]);
AddM := c1;
end;
function SubtractM(c1,c2:Matrix):Matrix;
begin SubtractM := AddM(c1,MultScalarM(c2,-1)); end;
function RandomM(lines, rows: byte): Matrix;
var i,j:byte;
begin
RandomM := ZeroM(lines,rows);
for i:=1 to lines do
for j:=1 to rows do RandomM.m[i,j]:=Random(20)-10;
end;
function MultiplyM(c1, c2: Matrix): Matrix;
var i,j,k:byte; c:Matrix;
begin
if (c1.rows <> c2.lines) then Error('A[N1xM1] * B[N2*M2] = ?, M1 != N2');
c := ZeroM(c1.lines, c2.rows);
for i:=1 to c1.lines do
for k:=1 to c2.rows do
for j:=1 to c1.rows do inc(c.m[i,k],c1.m[i,j]*c2.m[j,k]);
MultiplyM := c;
end;
function MultScalarM(c1: Matrix; n: shortint): Matrix;
var i,j:byte;
begin
MultScalarM.lines:=c1.lines; MultScalarM.rows:=c1.rows;
for i:=1 to c1.lines do
for j:=1 to c1.rows do MultScalarM.m[i,j]:=c1.m[i,j]*n;
end;
function TransposeM(c: Matrix): Matrix;
var i,j:byte;
begin
TransposeM.lines:=c.rows; TransposeM.rows:=c.lines;
for i:=1 to c.rows do
for j:=1 to c.lines do TransposeM.m[i,j]:=c.m[j,i];
end;
function IdentityM(n: byte): Matrix;
var k:byte;
begin IdentityM := ZeroM(n,n); for k:=1 to n do IdentityM.m[k,k]:=1; end;
end.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment