Скачиваний:
2
Добавлен:
01.05.2014
Размер:
3.53 Кб
Скачать
unit UMatr;


interface
Uses Dialogs, SysUtils, Controls;

Const Max = 10000;

type
type_el=integer;
ind_M = Longint;
Next = ^Matr_Elem;
Matr_Elem = record
Row, Col:ind_M;
Val: type_el;
Down, Right:Next end; {Matr_Elem}
Base = array [0..Max] of Matr_Elem;
Matr = record
BaseRow, BaseCol : Base end;

Procedure Cr(i_,j_:ind_M; el_:type_el;var q_:next);
Procedure Input( n_,i_,j_:ind_M; var el_: type_el;var A_:Matr);
Procedure Null(var A_:Matr; var n_:ind_M);
Procedure Proizv (var A_,B_:Matr; i_,j_:ind_M; var rez_:type_el);
Procedure DelMatr(var A_:Matr;n_:ind_M);
Procedure CopyMatr(var A_,B_:Matr;n_:ind_M);

implementation

Procedure Cr(i_,j_:ind_M; el_:type_el;var q_:next);
Begin{Cr}
if el_<>0 then
begin
new(q_);
q_^.row:=i_;
q_^.col:=j_;
q_^.val:=el_;
end;
end; {Cr--new Element}

Procedure Input( n_,i_,j_:ind_M; var el_: type_el;var A_:Matr);
var p,q:next;
Begin {Input}
P := A_.BaseRow[i_-1].Right;
Q := P;
While Q^.Col <> 0 do
Begin
If (Q^.Row = i_) and (Q^.Col = J_) then
Begin
If MessageDlg('Вы хотите заменить элемент?',mtConfirmation, [mbYes, mbNo], 0)= mrYes then
Begin
Q^.Val := El_;
Exit;
End;
End;
Q := Q.Right;
End;

p:=@(A_.BaseRow[i_-1]);
Cr(i_,j_,el_,q);
while (p^.right^.col<>0) and (j_>=p^.right^.col) do
p:=p^.right;
if j_<>p^.col then
begin
q^.right:=p^.right;
p^.right:=q;
end;
p:=@(A_.BaseCol [j_-1]);
while (p^.down^.row<>0) and (i_>=p^.down^.row) do
p:=p^.down;
if i_<>p^.row then
begin
q^.down:=p^.down;
p^.down:=q;
end;
end;{Input}


Procedure Null(var A_:Matr; var n_:ind_M);
var i:ind_m;
begin
For i:=0 to n_-1 do
begin
A_.BaseRow[i].col:=0;
A_.BaseRow[i].right:=@(A_.BaseRow[i]);
A_.BaseCol[i].row:=0;
A_.BaseCol[i].Down:=@(A_.BaseCol[i]); end;
end;{Null}



Procedure Proizv (var A_,B_:Matr; i_,j_:ind_M; var rez_:type_el);
var p,q:next;
begin
p:=A_.BaseRow[i_].right;
q:=B_.BaseCol[j_].down;
rez_:=0;
while (p^.col<>0) and (q^.row<>0) do
begin
if p^.col=q^.row then
begin
rez_:= rez_+p^.val*q^.val;
p:=p^.right;
q:=q^.down;
end
else
if p^.Col>q^.row
then q:=q^.down
else p:=p^.right;
end; {while}
end;{Proizv}

Procedure DelMatr(var A_:Matr;n_:ind_M);
var i:ind_M; p,q:next;
begin
For i:=0 to n_-1 do
begin
p:=@(A_.BaseRow[i]);
while p^.right^.col<>0 do
begin
q:=p^.right;
while q^.right^.Col<>0 do
begin
q:=q^.right;
p:=p^.right;
end;
p^.right:=@(A_.BaseRow[i]);
p:=@(A_.BaseRow[i]);
dispose(q);
end;{while}
A_.BaseCol[i].down:= @(A_.BaseCol[i]);
end;{for}
end;{DelMatr}


Procedure CopyMatr(var A_,B_:Matr;n_:ind_M);
var i,j,k:ind_M; el:type_el; P:next;
begin
Null(B_,n_);
K:=0;
for k:=0 to n_-1 do
begin
p:=A_.BaseRow[k].right;
while p^.Col<>0 do
begin
i:=p^.Row;
j:=p^.Col;
el:=p^.Val;
Input(n_,i,j,el,B_); p:=p^.right;
end;
end;
end;{CopyMatr}

end.
Соседние файлы в папке Возведение матрицы в степень
  • #
    01.05.20149.17 Кб3UMain_F.dcu
  • #
    01.05.201451 б2UMain_F.ddp
  • #
    01.05.201411.52 Кб2UMain_F.dfm
  • #
    01.05.20144.73 Кб2UMain_F.pas
  • #
    01.05.20142.42 Кб3UMatr.dcu
  • #
    01.05.20143.53 Кб2UMatr.pas
  • #
    01.05.20143.23 Кб2Uprog.dcu
  • #
    01.05.201451 б2Uprog.ddp
  • #
    01.05.20141.5 Кб2Uprog.dfm
  • #
    01.05.2014345 б2Uprog.pas
  • #
    01.05.20144.42 Кб2UShow.dcu