if fl then begin

for nowCharCode: =65 to 67 do

begin

newItem: =operList. Items. Add;

newItem. Caption: =char (nowCharCode);

newItem. SubItems. Add ('Matrix');

// ------------------------

new (nowEl);

nowEl^. typeOf: =matr;

ziroMatr (nowEl^. mt);

nowEl^. strName: =char (nowCharCode);

mainList. Add (nowEl);

// ------------------------

operList. Enabled: =true;

end;

// =========================================

for nowCharCode: =88 to 89 do

begin

newItem: =operList. Items. Add;

newItem. Caption: =char (nowCharCode);

newItem. SubItems. Add ('Vector');

// ------------------------

new (nowEl);

nowEl^. typeOf: =vect;

ziroVect (nowEl^. vt);

nowEl^. strName: =char (nowCharCode);

mainList. Add (nowEl);

// ------------------------

operList. Enabled: =true;

end;

fl: =false;

end;

ziroMatr (nowMatr);

// ==================================================

writeMatr (nowMatr,matrRecLink (mainList [0]) ^. mt);

multMatrToMatr (nowMatr,matrRecLink (mainList [1]) ^. mt,nowMatr);

sumMatr (nowMatr,matrRecLink (mainList [2]) ^. mt,nowMatr);

// --------------------------------------------------

writeVect (nowVect,matrRecLink (mainList [3]) ^. vt);

decVect (nowVect,matrRecLink (mainList [4]) ^. vt,nowVect);

// --------------------------------------------------

multMatrToVect (nowMatr,nowVect,nowVect);

// --------------------------------------------------

for i: =1 to nmax do rezults. rezVect. Cells [i-1,0]: =FloatToStr (nowVect [i]);

rezults. visible: =true;

rezults. Left: =331;

rezults. Top: =222;

// ------------------------

rezults. norm1. Text: =FloatToStr (longOfVect (nowVect));

rezults. norm2. Text: =FloatToStr (absSum (nowVect));

rezults. norm3. Text: =FloatToStr (absMax (nowVect));

end;

procedure TmatrEditor. Button6Click (Sender: TObject);

begin

opViev. Text: ='';

dispose (opers [1]);

dispose (opers [2]);

sizeOfAction: =0;

end;

procedure TmatrEditor. Button7Click (Sender: TObject);

begin

if sizeOfAction=2 then

begin

// ziroMatr (nowMatr);

// ==================================================

// writeMatr (nowMatr,opers [1] ^. mt);

multMatrToMatr (opers [1] ^. mt,opers [2] ^. mt,nowMatr);

for i: =1 to nmax do

for j: =1 to nmax do

rezults. rezMatr. Cells [i-1,j-1]: =FloatToStr (nowMatr [i] [j]);

end;

rezults. visible: =true;

rezults. Left: =331;

rezults. Top: =222;

// -------------------

opViev. Text: ='';

dispose (opers [1]);

dispose (opers [2]);

sizeOfAction: =0;

end;

procedure TmatrEditor. Save1Click (Sender: TObject);

var writeRec: matrRec; var i: integer;

begin

fl: =saveD. Execute;

if fl then

begin

filePath: =saveD. FileName;

assignFile (f,filePath);

rewrite (f);

for i: =0 to mainList. Count-1 do

begin

writeRec: =matrRecLink (mainList [i]) ^;

write (f,writeRec);

end;

procedure TmatrEditor. Open1Click (Sender: TObject);

var writeRec: matrRec;

begin

fl: =openD. Execute;

operList. Clear;

mainList. Clear;

if fl then

begin

filePath: =openD. FileName;

assignFile (f,filePath);

reset (f);

while not (eof (f)) do

begin

new (nowEl);

read (f,nowEl^);

mainList. Add (nowEl);

newItem: =operList. Items. Add;

newItem. Caption: =nowEl^. strName;

if nowEl^. typeOf=vect then

newItem. SubItems. Add ('Vector')

else

newItem. SubItems. Add ('Matrix');

if operList. Items. Count>0 then

nowItem: =0;

operList. Enabled: =true;

end;

procedure TmatrEditor. itemNombChange (Sender: TObject);

var saveVal: real;

begin

if matrRecLink (mainList [nowItem]) ^. typeOf=matr then

begin

saveVal: =matrRecLink (mainList [nowItem]) ^. mt [matrViev. Col+1,matrViev. Row+1];

try

matrRecLink (mainList [nowItem]) ^. mt [matrViev. Col+1,matrViev. Row+1]: =StrToFloat (itemNomb. Text);

matrViev. Cells [matrViev. Col,matrViev. Row]: =FloatToStr (matrRecLink (mainList [nowItem]) ^. mt [matrViev. Col+1,matrViev. Row+1]);

except

on EConvertError do begin

matrRecLink (mainList [nowItem]) ^. mt [matrViev. Col+1,matrViev. Row+1]: =saveVal;

matrViev. Cells [matrViev. Col,matrViev. Row]: =FloatToStr (saveVal);

itemNomb. Text: =FloatToStr (saveVal);

end;

if matrRecLink (mainList [nowItem]) ^. typeOf=vect then

begin

saveVal: =matrRecLink (mainList [nowItem]) ^. vt [vectViev. Col+1];

try

matrRecLink (mainList [nowItem]) ^. vt [vectViev. Col+1]: =StrToFloat (itemNomb. Text);

Label3. Caption: =FloatToStr (vectViev. Col);

vectViev. Cells [vectViev. Col,vectViev. Row]: =FloatToStr (matrRecLink (mainList [nowItem]) ^. vt [vectViev. Col+1]);

except

on EConvertError do begin

showMessage ('Convert error! ');

matrRecLink (mainList [nowItem]) ^. vt [vectViev. Col+1]: =saveVal;

vectViev. Cells [vectViev. Col,vectViev. Row]: =FloatToStr (saveVal);

itemNomb. Text: =FloatToStr (saveVal);

end;

end.

Код модуля "MATRIX":

unit matrix;

interface

const

nmax = 10;

type

size = 1. nmax;

vector = array [size] of real;

matrix_ = array [size,size] of real;

// Vector working ===============================

procedure writeVect (var op1: vector; op2: vector);

procedure ziroVect (var op1: vector);

// - ----------- - ------------------------------

procedure sumVect (op1,op2: vector; var rez: vector);

procedure decVect (op1,op2: vector; var rez: vector);

procedure multVectToNomb (var op1: vector; nomb: real);

function multVectToVect (op1,op2: vector): real;

// NORMS - --

function longOfVect (op1: vector): real;

function absSum (op1: vector): real;

function absMax (op1: vector): real;

// ============== ================================

// matrix_ working ================================

// ============== ================================

procedure writeMatr (var op1: matrix_; op2: matrix_);

procedure ziroMatr (var op1: matrix_);

// - ----------- - ------------------------------

procedure sumMatr (op1,op2: matrix_; var rez: matrix_);

procedure decMatr (op1,op2: matrix_; var rez: matrix_);

procedure multMatrToNomb (var op1: matrix_; nomb: real);

procedure multMatrToVect (op1: matrix_; op2: vector; var rez: vector);

procedure multMatrToMatr (op1,op2: matrix_; var rez: matrix_);

procedure transp (var op1: matrix_);

// NORMS - --

function longOfMatr (op1: matrix_): real;

function ijMaxSum (op1: matrix_): real;

function jiMaxSum (op1: matrix_): real;

implementation

// =============== HELP FUNCTIONS ================

// ------------ - writeVect - -------------------

procedure writeVect (var op1: vector; op2: vector);

var i: size;

begin

for i: =1 to nmax do op1 [i]: =op2 [i];

end;

// ------------ - writeMatr - -------------------

procedure writeMatr (var op1: matrix_; op2: matrix_);

var i,j: size;

begin

for i: =1 to nmax do

for j: =1 to nmax do

op1 [i] [j]: =op2 [i] [j];

end;

// ------------- - ziroVect - -------------------

procedure ziroVect (var op1: vector);

var i: size;

begin

for i: =1 to nmax do op1 [i]: =0;

end;

// ------------- - ziroMatr - -------------------

procedure ziroMatr (var op1: matrix_);

var i,j: size;

begin

for i: =1 to nmax do

for j: =1 to nmax do

op1 [i] [j]: =0;

end;

// =================================================

// ------------- - sumVect - --------------------

procedure sumVect (op1,op2: vector; var rez: vector);

var i: size;

begin

for i: =1 to nmax do rez [i]: =op1 [i] +op2 [i];

end;

// ------------- - decVect - --------------------

procedure decVect (op1,op2: vector; var rez: vector);

var i: size;

begin

for i: =1 to nmax do rez [i]: =op1 [i] - op2 [i];

end;

// --------- - multVectToNomb - -----------------

procedure multVectToNomb (var op1: vector; nomb: real);

var i: size;

begin

for i: =1 to nmax do op1 [i]: =op1 [i] *nomb;

end;

// ------------ - longOfVect - ------------------

function longOfVect (op1: vector): real;

var i: size; tmpVal: real;

begin

tmpVal: =0;

for i: =1 to nmax do tmpVal: =tmpVal+op1 [i] *op1 [i];

longOfVect: =sqrt (tmpVal);

end;

// --------- - multVectToVect - -----------------

function multVectToVect (op1,op2: vector): real;

var i: size; tmpVal: real;

begin

tmpVal: =0;

for i: =1 to nmax do tmpVal: =tmpVal+op1 [i] *op2 [i];

multVectToVect: =tmpVal;

end;

// ------------- - absSum - --------------------

function absSum (op1: vector): real;

var i: size; tmpVal: real;

begin

tmpVal: =0;

for i: =1 to nmax do tmpVal: =tmpVal+abs (op1 [i]);

absSum: =tmpVal;

end;

// ------------- - absMax - -------------------

function absMax (op1: vector): real;

var i: size; tmpVal: real;

begin

tmpVal: =op1 [1];

for i: =2 to nmax do if op1 [i] >tmpVal then tmpVal: =op1 [i];

absMax: =tmpVal;

end;

// ================================================

// =============== matrix_ ================

// ================================================

// ------------- - sumMatr - ------------------

procedure sumMatr (op1,op2: matrix_; var rez: matrix_);

var i,j: size;

begin

for i: =1 to nmax do

for j: =1 to nmax do

rez [i] [j]: =op1 [i] [j] +op2 [i] [j];

end;

// ------------- - decMatr - ------------------

procedure decMatr (op1,op2: matrix_; var rez: matrix_);

var i,j: size;

begin

for i: =1 to nmax do

for j: =1 to nmax do

rez [i] [j]: =op1 [i] [j] - op2 [i] [j];

end;

// ------------- - multMatrToNomb - ------------------

procedure multMatrToNomb (var op1: matrix_; nomb: real);

var i,j: size;

begin

for i: =1 to nmax do

for j: =1 to nmax do

op1 [i] [j]: =op1 [i] [j] *nomb;

end;

// ------------- - multMatrToVect - ------------------

procedure multMatrToVect (op1: matrix_; op2: vector; var rez: vector);

var i,j: size; tmpVal: real;

begin

for i: =1 to nmax do

begin

tmpVal: =0;

for j: =1 to nmax do

tmpVal: =tmpVal+op1 [i] [j] *op2 [j];

rez [i]: =tmpVal;

end;

// ------------- - multMatrToMatr - ------------------

procedure multMatrToMatr (op1,op2: matrix_; var rez: matrix_);

var i,j,j1: size; tmpVal: real;

begin

for i: =1 to nmax do

for j1: =1 to nmax do

begin

tmpVal: =0;

for j: =1 to nmax do

tmpVal: =tmpVal+op1 [i] [j] *op2 [j] [j1];

rez [i] [j1]: =tmpVal;

end;

// ------------------ - transp - ---------------------

procedure transp (var op1: matrix_);

var i,j: size; tmpVal: real;

begin

for i: =1 to nmax do

for j: =i+1 to nmax do

begin

tmpVal: =op1 [i] [j];

op1 [i] [j]: =op1 [j] [i];

op1 [j] [i]: =tmpVal;

end;

// ---------------- - longOfMatr - -------------------

function longOfMatr (op1: matrix_): real;

var i,j: size; tmpVal: real;

begin

tmpVal: =0;

for i: =1 to nmax do

for j: =1 to nmax do

tmpVal: =tmpVal+op1 [i] [j] *op1 [i] [j];

longOfMatr: =sqrt (tmpVal);

end;

// ----------------- - ijSumMax - --------------------

function ijMaxSum (op1: matrix_): real;

var i,j: size; tmpVal1,tmpVal2: real;

begin

for j: =1 to nmax do

tmpVal2: =tmpVal2+op1 [i] [j];

for i: =2 to nmax do

begin

tmpVal1: =0;

for j: =1 to nmax do

tmpVal1: =tmpVal1+op1 [i] [j];

if tmpVal1>tmpVal2 then

tmpVal2: =tmpVal1;

end;

ijMaxSum: =tmpVal2;

end;

// ----------------- - jiMaxSum - --------------------

function jiMaxSum (op1: matrix_): real;

var i,j: size; tmpVal1,tmpVal2: real;

begin

for i: =1 to nmax do

tmpVal2: =tmpVal2+op1 [i] [j];

for j: =2 to nmax do

begin

tmpVal1: =0;

for i: =1 to nmax do

tmpVal1: =tmpVal1+op1 [i] [j];

if tmpVal1>tmpVal2 then

tmpVal2: =tmpVal1;

end;

jiMaxSum: =tmpVal2;

end;

end.

Інтерфейс програми

Перевірка програми

Матриця А

програма вектор матриця інтерфейс

Матриця В

Матриця С

Вектор Х

Вектор Y

Результуючій вектор

Евклідова норма: 206,434591820266

: 581,39

: 116

[1] Усі дії над матрицями та векторами, результатами яких не є скалярне значення треба робити з допомогою процедур, адже функція не може передавати складну структуру даних у якості результату.

[2]У найбільш широкому змісті нормою у лінійній алгебрі називається деяка функція, що ставить у відповідність матриці (вектору) деяке число (скаляр).

Розрахунок норм вектору (стр. 2 из 2)

Інтерфейс програми

Перевірка програми