Отчеты по лабораторным работам
  • Регистрация
1 1 1 1 1 1 1 1 1 1 Рейтинг 0.00 (0 Голоса)

Лабораторная работа № 1. “ Построение матриц инциденций”

 

Цель. Изучить методы построения матриц инцидентности и матриц инциденций.

Задание.

Используя матрицу смежности, получить матрицу инциденций.

Листинг программы.

unit driver;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, Grids, Buttons, StdCtrls, Spin, Menus;

type

TForm1 = class(TForm)

opnDlg: TOpenDialog;

svDlg: TSaveDialog;

Panel1: TPanel;

Panel2: TPanel;

Panel3: TPanel;

GroupBox1: TGroupBox;

smMtx: TStringGrid;

SEmsm: TSpinEdit;

GroupBox2: TGroupBox;

incdMtx: TStringGrid;

SBtnSm2Incd: TSpeedButton;

Label1: TLabel;

MainMenu1: TMainMenu;

N1: TMenuItem;

N2: TMenuItem;

N3: TMenuItem;

N4: TMenuItem;

N5: TMenuItem;

N6: TMenuItem;

N7: TMenuItem;

N8: TMenuItem;

N9: TMenuItem;

N10: TMenuItem;

N11: TMenuItem;

procedure SEmsmChange(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure smMtxSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

procedure smMtxSetEditText(Sender: TObject; ACol, ARow: Integer;

const Value: String);

procedure smMtxKeyPress(Sender: TObject; var Key: Char);

procedure N8Click(Sender: TObject);

procedure N4Click(Sender: TObject);

procedure SBtnSm2IncdClick(Sender: TObject);

procedure Fillsm(Sender: TObject);

procedure N11Click(Sender: TObject);

procedure N7Click(Sender: TObject);

procedure N2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

Procedure SetNum(var SG:TStringGrid);

procedure FillSmMtx(SG:TStringGrid;Cnt:integer);

function trueMtx:boolean;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

uses

conv, baseunt, InMtxSm;

procedure TForm1.SEmsmChange(Sender: TObject);

begin

if SEmsm. Text <>'' Then

begin

smMtx. ColCount :=SEmsm. Value+1;

smMtx. RowCount :=SEmsm. Value+1;

incdMtx. RowCount :=smMtx. RowCount;

incdMtx. ColCount :=Round(0.5*SEmsm. Value*(SEmsm. Value-1))+1;

setNum(incdMtx);

if SEmsm. Value >=SEmsm. MinValue then

begin

smMtx. FixedCols :=1;

smMtx. FixedRows :=1;

incdMtx. FixedRows :=1;

incdMtx. FixedCols :=1;

setNum(smMtx);

end;

FillSmMtx(smMtx, SEmsm. Value)

end;

end;

procedure TForm1.SetNum(var SG: TStringGrid);

var

i:Integer;

begin

SG. Rows[0].Clear;

SG. Cols[0].Clear;

for i:=1 to SG. ColCount -1 do

SG. Cells [i,0] :=inttostr(i);

for i:=1 to SG. RowCount -1 do

SG. Cells [0,i] :=inttostr(i);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

setNum(smMtx);

SEmsmChange(Sender);

new(sm_byte);

new(incd_byte);

opnDlg. InitialDir :=ExtractFileDir(Application. ExeName);

svDlg. InitialDir :=opnDlg. InitialDir

end;

procedure TForm1.FillSmMtx(SG: TStringGrid;Cnt:integer);

var

i:Integer;

begin

for i:=1 to Cnt do SG. Cells [i, i] :='0'

end;

procedure TForm1.smMtxSelectCell(Sender: TObject; ACol, ARow: Integer;

var CanSelect: Boolean);

begin

CanSelect :=ACol>ARow;

end;

procedure TForm1.smMtxSetEditText(Sender: TObject; ACol, ARow: Integer;

const Value: String);

begin

smMtx. Cells [ARow, ACol] :=Value;

end;

procedure TForm1.smMtxKeyPress(Sender: TObject; var Key: Char);

begin

case key of

'0','1',#08: smMtx. Cells [smMtx. Col, smMtx. Row] :=key;

#13:begin

if smMtx. Cells [smMtx. Col, smMtx. Row]='' then smMtx. Cells [smMtx. Col, smMtx. Row] :='0';

if smMtx. Col <smMtx. ColCount-1 then smMtx. Col :=smMtx. Col +1

else

if smMtx. Row <smMtx. RowCount-1 then begin smMtx. Row :=smMtx. Row +1; smMtx. Col :=smMtx. Row+1 end;

end;

else key :=#0;

end;

end;

procedure TForm1.N8Click(Sender: TObject);

begin

Close

end;

function Str2P(const s:string):PChar;

var sp:array [0..500] of char;

begin

// new(sp);

StrPCopy(sp, s);

Result :=sp;

// dispose(sp);

end;

procedure TForm1.N4Click(Sender: TObject);

var

FName:String;

begin

if svDlg. Execute then

begin

SG2sm(sm_byte, smMtx, SEmsm. Value);

FName := svDlg. FileName;

if pos('.smm',FName)=0 then FName := FName + '.smm';

messagebox(form1.Handle, str2P(format(errors[WRITE2File(FName, sm_byte, SEmsm. Value)].txt,[FName])),'Сохранение файла',mb_iconwarning);

end;

end;

procedure TForm1.SBtnSm2IncdClick(Sender: TObject);

var

d:smallint;

begin

if (n11.Checked and trueMtx) or (not n11.Checked) then

begin

SG2sm(sm_byte, smMtx, SEmsm. Value);

d :=sm2incd_byte(sm_byte, SEmsm. Value, incd_byte);

incdMtx. ColCount :=d;

incd2SG(incd_byte, SEmsm. Value, d,incdMtx);

//SetNum(incdMtx)

end

end;

procedure TForm1.Fillsm(Sender: TObject);

var

i, j:byte;

begin

for i:=1 to SEmsm. Value do

for j:=1 to SEmsm. Value do

if i<>j then smMtx. Cells [j, i]:='1';

end;

procedure TForm1.N11Click(Sender: TObject);

begin

n11.Checked :=not n11.checked

end;

function TForm1.trueMtx: boolean;

var

ers:byte;

begin

ers:=CheckMtx(smMtx, SEmsm. Value);

messagebox(form1.Handle, str2P(format(errors[ers].txt,[smMtx. Row, smMtx. Col, smMtx. Col, smMtx. Row])),'Проверка',mb_iconwarning);

Result :=ers=0

end;

procedure TForm1.N7Click(Sender: TObject);

begin

trueMtx

end;

procedure TForm1.N2Click(Sender: TObject);

var

cn:byte;

ee:byte;

begin

if opnDlg. Execute then

begin

if Pos ('.smm',opnDlg. FileName)=0 then opnDlg. FileName := opnDlg. FileName +'.smm';

ee:=READFromFile(opnDlg. FileName, sm_byte, cn);

messagebox(form1.Handle, str2P(format(errors[ee].txt,[opnDlg. FileName])),'Загрузка файла',mb_iconwarning);

if ee=0 then

sm2SG(cn, smMtx);

SEmsm. Value :=cn

end;

end;

end.

unit BaseUnt;

interface

Type

TTByteSmArr = array [0..31] Of byte;

TTByteIArr = array [0..31,0..239] Of smallint;

TByteSmArr = ^TTByteSmArr;

TByteIArr = ^TTByteIArr;

type

er = record

num:byte;

txt:String;

end;

const

errCnt =6;

errors:array [0..errCnt] of er =((num:0;txt:'Îøèáîê íå îáíàğóæåíî'),

(num:1;txt:'Îøèáêà ÷òåíèÿ: ğàçìåğ ìàòğèöû ñìåæíîñòè íå ñîâïàäàåò ñ ğàçìåğîì ôàéëà'),

(num:2;txt:'Ìàòğèöà ñìåæíîñòè íå ñèììåòğè÷íà!!! [%d;%d] è [%d;%d]'),

(num:3;txt:'Îøèáêà çàïèñè: íå ìîãó çàïèñàòü â ôàéë %s'),

(num:4;txt:'Îøèáêà ÷òåíèÿ: íå ìîãó ïğî÷èòàòü ôàéë %s'),

(num:5;txt:'Ôàéë %s óñïåøíî ñîõğàíåí'),

(num:6;txt:' ìàòğèöå ñìåæíîñòè íå çàïîëíåíà ÿ÷åéêà [%d;%d]')

);

var

sm_byte:TByteSmArr;

incd_byte:TByteIArr;

implementation

end.

unit conv;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls,

Grids, BaseUnt;

function sm2incd_byte(const sm:TByteSmArr; const cnt:integer; var im:TByteIArr):smallint;

procedure sm2SG(w:integer; SG:TStringGrid);

procedure incd2SG(const incd:TByteIArr; w, d:integer; SG:TStringGrid);

procedure SG2sm(var sm:TByteSmArr; SG:TStringGrid;w:byte);

function CheckMtx(mtx:TStringGrid;w:byte):byte;

implementation

function sm2incd_byte(const sm:TByteSmArr; const cnt:integer; var im:TByteIArr):smallint;

var

i0,i_,j, k,g, m,f:integer;

// fl:TextFile;

begin

for i0:=0 to 31 do for j:=0 to 239 do im^[i0,j] :=0;

k :=0;

i0 :=-2;

i_:=0;

// AssignFile(fl, ExtractFileDir(application. ExeName)+'\trace'+inttostr(cnt)+'.trs');

// ReWrite(fl);

for i_ :=0 to cnt-2 do

begin

if cnt <=8 then i0 :=i_

else

case i_=8 Of

true :i0:=i0+3;

false:i0:=i0+2;

end;

m :=i0;

for j:=i_ to cnt-1 do

begin

if (j=8)and(i_<8) then begin m:=i0+1; end;

// else if i_<8 then m:=i0;

if j<8 then f:=1 else f :=2;

g:=abs(f*8-j-1);

if ((sm^[m] shr (g))and 1) = 1 then

begin

im^[i_,k] :=1;

im^[j, k] :=-1;

inc(k);

end;

// writeln(fl,'i_=',i_,' j=',j,' i0=',i0,' k=',k,' g=',g,' m=',m,' sm^[m]=',sm^[m]);

end;

end;

// close(fl);

Result :=k+1

end;

procedure sm2SG(w:integer; SG:TStringGrid);

var

i, j,j_,k:byte;

begin

i:=0;

while i<w do

begin

for j:=0 to w-1 do

begin

if j<8 then k :=sm_byte^[i]

else k :=sm_byte^[i+1];

if j<8 then j_ :=7-j;

if j>=8 then j_ :=15-j;

SG. Cells [j+1,i+1] :=inttostr(((k shr j_)and 1));

end;

if w<=8 then inc(i)

else inc(i,2);

end;

end;

procedure incd2SG(const incd:TByteIArr; w, d:integer;SG:TStringGrid);

var

i, j:word;

begin

SG. ColCount :=d;

for j:=0 to d -1 do

for i:=0 to w-1 do

SG. Cells [j+1,i+1] :=inttostr(incd^[i, j])

end;

procedure SG2sm(var sm:TByteSmArr; SG:TStringGrid;w:byte);

var

i, j,f, g:byte;

// fl:textfile;

begin

for i:=0 to round(0.5*w*(w-1))-1 do sm^[i]:=0;

g:=0;

// assignfile(fl, extractfiledir(application. ExeName)+'\sm'+inttostr(w)+'.trs');

// rewrite(fl);

for i:=0 to w-1 do

begin

j :=0;

f:=7;

while j<w do

begin

if j=8 then begin {write(fl, sm^[g],' '); }inc(g); f:=7; end;

sm^[g] := sm^[g] or (strtoint(SG. Cells [j+1,i+1]) shl (f));

dec(f);

inc(j);

end;

// write(fl, sm^[g],' ');

inc(g)

end;

// close(fl);

end;

function CheckMtx(mtx:TStringGrid;w:byte):byte;

var

i, j:byte;

e:byte;

begin

e:=0;

j:=0;

for i:=1 to w do

begin

if e<>0 then break;

for j:=i to w do

if mtx. Cells [j, i]='' then begin e:=6; break end;

end;

if e=0 then

begin

for i:=1 to w-1 do

begin

if e<>0 then break;

for j:=i+1 to w do

if mtx. Cells [j, i]<>mtx. Cells [i, j] then begin e:=2; break; end

end;

end;

// else

// begin

if j<=w then begin

mtx. Row :=i-1;

mtx. Col :=j;

end;

Result :=e;

end;

end.

unit InMtxSm;

interface

Uses

BaseUnt, Windows, Grids;

Function READFromFile(FName:String;var Mtx:TByteSmArr;var Num:Byte):Byte;

Function WRITE2File(FName:String;Mtx:TByteSmArr;num:byte):Byte;

implementation

var

f:file of byte;

fsize:integer;

Function READFromFile(FName:String;var Mtx:TByteSmArr;var Num:Byte):Byte;

var

i:integer;

ee:byte;

begin

AssignFile(f, FName);

{$I-}

ReSet(f);

if IOResult <>0 then ee :=4

else

begin

READ(f, Num);

if num>8 then fsize:=num*2

else fsize :=num;

i:=0;

begin

while not EOF(f) do

begin

if i=fsize then

begin

if not eof(f) then ee :=1;

break;

end;

read(f, mtx^[i]);

Inc(i);

end;

close(f);

if i<fsize then ee :=1

else ee:=0;

end;

end;

{I+}

Result :=ee;

end;

Function WRITE2File(FName:String;Mtx:TByteSmArr;num:byte):Byte;

var

i:integer;

begin

AssignFile(F, FName);

{%I-}

ReWrite(F);

if IOResult<>0 then Result :=3

else

begin

write(f, num);

if num>8 then fsize:=num*2

else fsize :=num;

for i:=0 to fsize-1 do write(f, mtx^[i]);

Close(f);

Result :=5

end;

end;

end.

3. Исправление ошибок:

- Матрица смежности не симметрична

- Ошибка записи: не могу записать в файл %s

- Ошибка чтения: не могу прочитать файл %s

- В матрице смежности не заполнена ячейка

4. Тестирование:

Исходный граф:

Матрица «Смежности»:

1 2 3 4 5 6 7 8 9 10

1 0 1 0 1 0 0 0 1 0 1

2 1 0 1 1 0 1 0 0 1 0

3 1 0 0 1 0 1 0 1 0 1

4 0 0 1 0 1 1 0 0 0 0

5 0 1 0 0 0 0 0 0 1 0

6 0 0 1 0 1 0 0 1 0 1

7 0 0 1 0 0 0 0 0 0 1

8 0 0 0 1 0 0 0 0 1 1

9 0 1 0 0 0 1 0 0 0 1

10 0 0 0 1 0 0 0 1 0 0

Матрица «Инциденций»:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33

1 1 1 1 1-1 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0

2 -1 0 0 0 1 1 1 1 1 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 0 0 0 -1 0 0 0 0

3 0 0 0 0 0-1 0 0 0 1 1 1 1 1 -1 0 0 0 0 -1 0 0 0 -1 0 0 0 0 0 0 0 0 0

4 0-1 0 0 0 0-1 0 0 0 -1 0 0 0 1 1 1 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 -1 0

5 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 -1 0 1 1 0 -1 0 0 0 0 0 0 0 0 0 0 0 0

6 0 0 0 0 0 0 0-1 0 0 0 -1 0 0 0 0 -1 0 0 1 1 1 1 0 0 0 0 0 0 -1 0 0 0

7 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0

8 0 0-1 0 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 0 -1 0 0 0 1 1 1 0 0 0 0 -1

9 0 0 0 0 0 0 0 0-1 0 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 -1 0 1 1 1 0 0

10 0 0 0-1 0 0 0 0 0 0 0 0 0 -1 0 0 0 0 0 0 0 0 -1 0 -1 0 0 -1 0 0 -1 1 1

Вывод: В ходе выполнения лабораторной работы были изучены методы построения матриц инциденций.

Добавить комментарий


Защитный код
Обновить

По темам:

История Украины

Культурология

Высшая математика

Информатика

Охотоведение

Статистика

География

Военная наука

Английский язык

Генетика

Разное

Технологиеские темы

Украинский язык

Филология

Философия

Химия

Экология

Социология

Физическое воспитание

Растениевосдство

Педагогика

История

Психология

Религиоведение

Плодоводство

Экономические темы

Бухгалтерские темы

Маркетинг

Иностранные языки

Ветеринарная медицина

Технические темы

Землеустройство

Медицинские темы

Творчество

Лесное и парковое хозяйство