Абстрактные типы данных

Размещено на http://www.allbest.ru/

Московский Государственный Институт Радиотехники, Электроники и Автоматики

(Технический Университет)

ОТЧЕТ ПО ЛАБОРАТОРНЫМ РАБОТАМ

Выполнил

студент группы ВВ-1-07

Каменков Иван

Москва

2009

Лабораторная работа 1

Задача: Разработать класс TDate для работы с датой.

Определить метод Create, устанавливающий значения полей даты при создании объекта.

Определить интерфейсные методы, которые возвращают год, месяц и день по отдельности.

Также определите метод доступа, который может устанавливать как некоторые, так и все сразу элементы экземпляра класса (объекта).

Логика работы: Создается класс TDate, полями которого являются числа, день, месяц и год, поля класса заполняются посредствам ввода чисел через поля ввода окон формы, вывод даты как сразу целиком, так и по частям производится через поля формы.

unit Unit1; //главный модуль программы

interface

uses

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

Dialogs, StdCtrls, Unit2, Grids;

type

TForm1 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Edit2: TEdit;

Edit3: TEdit;

Edit4: TEdit;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Memo1: TMemo;

StringGrid1: TStringGrid;

procedure Button1Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

//объявление переменных

var

Form1: TForm1;

date:TDate;

implementation

{$R *.dfm}

procedure TForm1.Button6Click(Sender: TObject); //создание класса

begin

date:=TDate.Create;

end;

procedure tForm1.Button1Click(Sender: TObject); //заполнение полей класса

begin

if (Edit2.Text)<>'' then Date.fDay:=StrToInt(Edit2.Text) else ShowMessage('Одно из полей не заполнено');

if (Edit3.Text)<>'' then Date.fMonth:=StrToInt(Edit3.Text) else ShowMessage('Одно из полей не заполнено');

if (Edit4.Text)<>'' then Date.fYear:=StrToInt(Edit4.Text) else ShowMessage('Одно из полей не заполнено');

end;

procedure tForm1.Button5Click(Sender: TObject); //вывод класса

begin

StringGrid1.Cells[1,1]:=IntToStr(Date.fDay);

StringGrid1.Cells[2,1]:=IntToStr(Date.fMonth);

StringGrid1.Cells[3,1]:=IntToStr(Date.fYear);

Memo1.Lines.Add(IntToStr(Date.fDay)+'.'+IntToStr(Date.fMonth)+ '.'+IntToStr(Date.fYear));

end;

end.

unit Unit2; //процедурный модуль работы с выводом даты

interface

uses

SysUtils;

type

TDate=class //описание класса, его полей и методов

fDay,fMonth,fYear:integer;

constructor create;

procedure set_Day (Day:integer); //задать день

procedure set_Month (Month:integer); //задать месяц

procedure set_Year (Year:integer); //задать год

function get_Day:integer; //вернуть день

function get_Month:integer; //вернуть месяц

function get_Year:integer; //вернуть год

property Day:integer read get_Day write set_Day; // поле класса, заполнение и считывание

property Month:integer read get_Month write set_Month; // поле класса, заполнение и считыв

property Year:integer read get_Year write set_Year; //поле класса, заполнение и считывание

procedure input_object(c1,c2,c3:string);

end;

implementation

procedure TDate.input_object(c1,c2,c3:string);

begin

fDay:= strtoint(c1);

fMonth:= strtoint(c2);

fYear:= strtoint (c3);

end;

////////////////////////////////////////////////////////////////////////////////

constructor TDate.create; //создание объекта

fDay:=0;

fMonth:=0;

fYear:=0;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TDate.set_Day (Day:integer); //задать день

begin

fDay:=Day;

end;

////////////////////////////////////////////////////////////////////////////////

function TDate.get_Day:integer; //вернуть день

begin

result:=fDay;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TDate.set_Month (Month:integer); //задать месяц

begin

fMonth:=Month;

end;

////////////////////////////////////////////////////////////////////////////////

function TDate.get_Month:integer; //вернуть месяц

begin

result:=fMonth;

end;

////////////////////////////////////////////////////////////////////////////////

procedure TDate.set_Year (Year:integer); //задать год

begin

fYear:=Year;

end;

////////////////////////////////////////////////////////////////////////////////

function TDate.get_Year:integer; //вернуть год

begin

result:=fYear;

end;

////////////////////////////////////////////////////////////////////////////////

end.

Лабораторная работа 2

Задача 1. Изучить назначение метода construtor.

2. Написать методы:

- для сложения векторов (TVector.Add(const SecondVector: TVector)),

- обработка вектора в соответствии с вариантом

3. Дополнить проект этими методами и продемонстрировать их работу

Логика работы:

Вектор задается несколькими координатами, `длина вектора' - количество его координат, при сложении векторов, согласно длине вектора происходит поэлементное сложение их координат.

unit OOP; //главный модуль работы с векторами

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

ButtonInput: TButton;

ButtonExit: TButton;

Memo1: TMemo;

procedure ButtonInputClick(Sender: TObject);

procedure ButtonExitClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

uses Vectors;

{$R *.dfm}

procedure TForm1.ButtonInputClick(Sender: TObject);

var V, SecondV: TVector;

i, N: integer; R: double;

begin

//Создание экземпляров класса

V:=TVector.Create; SecondV:=TVector.Create;

try

//установка длины векторов = 4

V.Length:=4; SecondV.Length:= 4;

for i:=0 to V.Length-1 do

begin

Randomize;

V[i]:=Random(100);

end;

Memo1.Lines.add('Vector 1');

Memo1.Lines.add(V.AsString);

for i:=0 to SecondV.Length-1 do

SecondV[i]:= 10;

Memo1.Lines.add('Vector 2');

Memo1.Lines.add(SecondV.AsString);

V.Product(10);

Memo1.Lines.add('Vector 1 * 10');

Memo1.Lines.add(V.AsString);

V.Product(SecondV);

Memo1.Lines.add('Vector 1 * Vector 2');

Memo1.Lines.add(V.AsString);

//V.Add(SecondV);

//Memo1.Lines.Add(V.AsString);

//R:=V.ScalarProduct(SecondV);

//Memo1.Lines.Add(FloatToStr(R));

finally

V.Free; SecondV.Free;

end;

end;

procedure TForm1.ButtonExitClick(Sender: TObject);

begin

close

end;

end.

Unit Vectors;

interface

uses

SysUtils, Classes;

Type

//Vector

TVector = class

//Скрытые объекты класса

private

//Поле - Динамический массив вещественных чисел

FValues: array of double;

//Возвращает длину вектора

function GetLength: integer;

//Устанавливает длину вектора

procedure SetLength(const Value: integer);

//Возвращает значение по индексу

function GetValues(Index: integer):double;

//Присваивает значение Value элементу с номером Index

procedure SetValues(Index: integer; const Value: double);

// Проверка индекса

procedure CheckIndex(Index: integer);

//Доступные извне методы класса

public

constructor Create;

//Вектор в виде строки

function AsString: string;

//Свойство - элемент вектора с индексом Index

property Values[Index: integer]: double

read GetValues Write SetValues; default;

//Длина вектора

property Length: integer read GetLength write SetLength;

//Перегружаемые методы Product

//От типа параметров зависит какой метод будет вызван

//Произведение вектора на число

procedure Product(Factor: double); overload;

//Поэлементное произведение двух векторов

procedure Product(const SecondVector: TVector); overload;

end;

implementation

{TVector}

//создание обекта класса TVector

constructor TVector.Create;

begin

System.SetLength(Fvalues, 1); //длина = 1

end;

//Вектор в виде строки

function TVector.AsString: string;

var i: integer;

begin

Result := '(';

for i:=0 to Length-1 do

begin

if i>0 then

Result:= Result+' , ';

Result:=Result+Format('%.3n',[Values[i]]);

end;

Result:=Result+')';

end;

//Возвращает длину вектора

function TVector.GetLength: integer;

begin

Result:=System.Length(FValues);

end;

//Возвращает значение по индексу

function TVector.GetValues(Index: integer): double;

begin

CheckIndex(Index);

Result:=FValues[Index];

end;

procedure TVector.SetLength(const Value: integer);

begin

if Value<1 then

raise Exception.Create('Invalid vector length');

System.SetLength(FValues, Value);

end;

//Присваивает значение Value элементу с номером Index

procedure TVector.SetValues(Index: integer; const Value: double);

begin

CheckIndex(Index);

FValues[Index]:=Value;

end;

//Проверка допустимости индекса

procedure TVector.CheckIndex(Index: integer);

begin

if (Index>=0) and (Index>=Length) then

raise Exception.Create('Index out of the bounds');

end;

//Произведение вектора на число

Procedure TVector.Product(Factor: double);

var i: integer;

Begin

For i:=0 to Self.Length-1 do

Fvalues[I]:= Self[i] * Factor;

end;

//Поэлементное сложение векторов

Procedure TVector.Product(const SecondVector: TVector);

var i: integer;

Begin

For i:=0 to SecondVector.Length-1 do

Fvalues[I]:= Self[i] + SecondVector[i];

end;

end.

массив список граф



Лабораторная работа 3

Дополнить АТД «Список» следующей операцией (функцией). Продемонстрировать выполнение этой операции.

Написать следующие функции (указатель на голову списка; а элемент -- переменная типа Integer):

Функция возвращает число вхождений элемента в список.

Логика работы:

В абстрактном типе данных список, у каждого элемента есть информационное поле и указатель на следующий элемент, в данной функции выполняется пробег по всем элементам списка при помощи этих указателей, и при совпадении информационной части элемента с заданным числом, к выходному значению функции, изначально равному нулю, прибавляется 1.

unit List_test; //главный модуль формы

interface

uses

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

Dialogs, StdCtrls, list;

Type //задание формы и ее элементов

TForm1 = class(TForm)

Memo1: TMemo;

Label1: TLabel;

Memo2: TMemo;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Memo3: TMemo;

procedure Button1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

//объявление переменных

var

Form1: TForm1;

var

il: tlist;

no: integer;

implementation

{$R *.dfm}

//создание и вывод списка

procedure TForm1.Button1Click(Sender: TObject);

var i:integer;

begin

il.init;

//Writeln('Create list with elements [2, 4, 6, ..., 20]');

for i := 1 to 10 do

il.append(2 * i);

il.print(memo1);

end;

//вставка до заданного элемента

procedure TForm1.Button4Click(Sender: TObject);

begin

il.print(memo1);

il.insert_before(il.find(14), 22);

il.print(memo2);

end;

//вставка после заданного элемента

procedure TForm1.Button5Click(Sender: TObject);

begin

il.print(memo1);

il.insert_after(il.find(10), 22);

il.print(memo2);

end;

//удаление заданного элемента

procedure TForm1.Button3Click(Sender: TObject);

begin

il.print(memo1);

il.remove(22);

il.print(memo2);

end;

//удаление списка

procedure TForm1.Button2Click(Sender: TObject);

begin

il.print(memo1);

il.done;

il.print(memo2);

end;

//подсчет количества заданных элементов списка

procedure TForm1.Button6Click(Sender: TObject);

begin

il.print(memo1);

No:=il.kol(22);

il.print(memo2);

Memo3.Lines.Append(IntToStr(No));

end;

end.

unit item; //модуль создания типа данных - элемент списка

interface

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

Dialogs, StdCtrls;

type //задание объекта-элемента списка

ttype = integer; его поля - значение и указатель

ptitem = ^titem;

titem = object

info: ttype;

next: ptitem;

constructor init(x: ttype;

nxt: ptitem);

destructor done;

function tostr(x:ttype):string;

end;

implementation

//процедура выделения памяти и инициализации списка

constructor titem.init(x: ttype;

nxt: ptitem);

begin

info := x;

next := nxt

end;

destructor titem.done;

begin end;

function titem.tostr(x: ttype):string;

begin

result:=inttostr(x)

end;

end.

unit list; //модуль описания методов списка

interface

uses item, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

const

maxlength = 100 { или другое подходящее число };

type

list = record

elements: array[1..maxlength] of elementtype;

last: integer

end;

position = integer;

constructor init; //создать список

destructor done; //удалить список

procedure invert; //проинвертировать список

procedure append(x: ttype);

procedure insert(x: ttype); //вставк элемента

function present(x: ttype): boolean;

function find(x: ttype): ptitem;

function kol(x: ttype): integer; //подсчет числа элементов

function remove(x: ttype): integer; //удаление

procedure insert_before(p: ptitem; //вставить до

x: ttype);

procedure insert_after(p: ptitem; //вставить после

x: ttype);

function empty: boolean; //проверка на пустоту

procedure print(memo:TMemo);

function END ( var L: LIST ): position; //последний элемент

procedure INSERT (x: elementtype; р: position; var L: LIST ); //вставить элемент

procedure DELETE ( p: position; var L: LIST ); //удалить элемент

function LOCATE ( x: elementtype; L: LIST ): position; //определить элемент

private

procedure remove_item(p: ptitem); //удалить объект из списка

end;

implementation

//создание списка

constructor tlist.init;

begin

first := nil; last := nil;

end;

//удаление списка

destructor tlist.done;

var p, T: ptitem;

begin

p := first;

while assigned(p) do begin

T := p;

p := p^.next;

dispose(T, done)

end;

first:=p;

end;

//Проверка списка на пустоту

function tlist.empty: boolean;

begin

empty := not assigned(first)

end;

{

empty - this method will return true

if the memo buffer does not have anything in it

or if the current position, Pos,

is beyond the end of the buffer.

insert new item to the start of list

// Вставка

}

procedure tlist.insert(x: ttype);

var p: ptitem;

begin

new(p, init(x, first));

if empty then last := p;

first := p

end;

{

append new item to the end of list

}

procedure tlist.append(x: ttype); //создать элемент перед добавкой в список

var p: ptitem;

begin

new(p, init(x, nil));

if empty then

first := p

else

last^.next := p;

last := p

end;

//вывод списка

procedure tlist.print(memo:TMemo);

var p: ptitem;

begin

p := first;

memo.Text:='';

while assigned(p) do begin

memo.text:=memo.text+p^.tostr(p^.info)+#13+#10;

p := p^.next

end;

end;

//инверсия списка

procedure tlist.invert;

var p, T: ptitem;

begin

if empty or (not assigned(first^.next)) then exit

else begin

p := nil; last := first;

while assigned(first) do begin

T := first^.next;

first^.next := p;

p := first;

first := T

end;

first := p

end

end;

//вставка до

procedure tlist.insert_before(p: ptitem;

x: ttype);

var T: ptitem;

begin

if p<>nil then

begin

new(T, init(p^.info, p^.next));

p^.next := T;

p^.info := x

end

else

MessageBox(0,'The list is empty: CREATE LIST', 'Error', MB_OK);

end;

//вставка после

procedure tlist.insert_after(p: ptitem;

x: ttype);

var T: ptitem;

begin

if p<>nil then

begin

new(T, init(x, p^.next));

p^.next := T;

end

else

MessageBox(0,'The list is empty: CREATE LIST', 'Error', MB_OK);

end;

//поиск

function tlist.find(x: ttype): ptitem;

var

p: ptitem;

ok: boolean;

begin

p := first;

ok := true;

while assigned(p) and ok do

if p^.info = x then ok := false

else p := p^.next;

find := p

end;

function tlist.present(x: ttype): boolean;

begin

present := (find(x) <> nil)

end;

//удаление заданого элемента

function tlist.remove(x: ttype): integer;

var

T: ptitem;

count: integer;

begin

count := 0;

repeat

T := find(x);

if assigned(T) then begin

remove_item(T);

inc(count)

end

until (T = nil);

remove := count

end;

//удаление элемента и переназначение указателей

procedure tlist.remove_item(p: ptitem);

var r: ptitem;

begin

r := p^.next;

p^ := r^;

dispose(r, done);

r := nil

end;

//Возврат числа вхождений элемента в список

function tlist.kol(x: ttype): integer;

var

p: ptitem;

No: integer;

begin

p := first; No:=0;

while assigned(p) do

if p^.info = x then begin inc(No); p := p^.next end

else p := p^.next;

result:=No;

end;

//указатель на последний

function END ( var L: LIST ): position;

begin

return(i.last + 1)

end; { END }

procedure INSERT (x: elementtype; р: position; var L: LIST );

{ INSERT вставляет элемент x в позицию p в списке L }

var q: position;

begin

if L.last >= maxlength then

error('Список полон')

else if (p > L.last + 1) or (p < 1) then

error('Такой позиции не существует')

else

begin

for g:= L.last downto p do

{ перемещение элементов из позиций р, р+1, ... на

одну позицию к концу списка }

L.elements[q+1]:= L.elements[q];

L.last:= L.last + 1;

L.elements[p]:= x

end

end; { INSERT }

procedure DELETE ( p: position; var L: LIST );

{ DELETE удаляет элемент в позиции р списка L }

var q: position;

begin

if (p > L.last) or (p < 1) then

error('Такой позиции не существует')

else

begin

L.last:= L.last - 1;

for q:= p to L.last do

{ перемещение элементов из позиций р+1, р+2, ...

на одну позицию к началу списка }

L.elements[q]:= L.elements[q+1]

end

end; { DELETE }

function LOCATE ( x: elementtype; L: LIST ): position;

{ LOCATE возвращает позицию элемента x в списке L }

var q: position;

begin

for q-.= 1 to L.last do

if L.elements[q] = x then

return(q) ;

return(L.last +1) { элемент х не найден }

end; { LOCATE } end.



Лабораторная работа 4

Реализовать АТД «Список» с использованием массива и продемонстрировать его работу.

Логика работы:

При реализации списков с помощью массивов элементы списка располагаются в смежных ячейках массива.

Это представление позволяет легко просматривать содержимое списка и вставлять новые элементы в его конец.

Но вставка нового элемента в середину списка требует перемещения всех последующих элементов на одну позицию к концу массива, чтобы освободить место для нового элемента.

Удаление элемента также требует перемещения элементов, чтобы закрыть освободившуюся ячейку.

При использовании массива мы определяем тип LIST как запись, имеющую два поля:

elements (элементы) -- это элементы массива, чей размер считается достаточным для хранения списков любой длины, встречающихся в данной реализации или программе

last (последний) целочисленного типа указывает на позицию последнего элемента списка в массиве

i-й элемент списка, если 1<i<last, находится в i-й ячейке массива

unit item; //модуль описания элемента списка-массива

interface

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

Dialogs, StdCtrls;

Type //создание класса, конструктора и деструктора этого класса

ttype = integer;

titem = object

info: ttype;

constructor init(x: ttype);

destructor done;

function tostr(x:ttype):string;

end;

implementation

//выделение памяти под класс и его инициализация

constructor titem.init(x: ttype);

begin

info := x;

end;

destructor titem.done;

begin end;

function titem.tostr(x: ttype):string;

begin

result:=inttostr(x)

end;

end.

unit list; //Модуль описания методов списка-массива

interface

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

Dialogs, StdCtrls, math;

const

maxlength = 10;

type //создание атд список в виде массива, элементы класса: все числа массива и указатель на последний элемент массива.

position= integer;

elementtype=integer;

Tlist = class

еlements: array[1..maxlength] of elementtype;

flast: integer;

constructor init; //инициализация списка

destructor done; //удаление списка

function fin: position; //определить положение в массиве

procedure insert (x: elementtype; p: position); //вставить в массив элемент

procedure insertlast (x: elementtype); //вставить в конец массива

procedure delete ( p: position); //удалить элемент в опред. позиции

function locate ( x: elementtype ): position;

function kol ( x: elementtype ): integer; //подсчет количества заданного элемента

procedure print(memo:TMemo); //вывод списка на форму через мемо

procedure zapoln (colv:integer); //первое заполнение списка-массива

end;

implementation

constructor tlist.init; //инициализация списка

var i:integer;

begin

tlist.create;

for i:=1 to maxlength do begin

elements[i]:=0; end;

flast:=0;

end;

destructor tlist.done; //удаление списка

var i:integer;

begin

for i:=1 to maxlength do

begin

elements[i]:=0; end;

flast:=0;

end;

{процедуры}

function tlist.fin: position; //определение последнего числа массива

begin

result:=flast + 1;

end; { END }

procedure tlist.zapoln (colv:integer); //заполнение массива

var i:integer;

begin

flast:=colv;

for i:= 1 to colv do

begin

randomize;

elements[i]:= random(10); end;

end;

procedure tlist.insert (x: elementtype; p: position);

{ INSERT вставляет элемент x в позицию p в списке L }

var q: position; g:integer;

begin

if flast >= maxlength then

showmessage('Список полон')

else if (p > flast + 1) or (p < 1) then

showmessage('Такой позиции не существует')

else

begin

for q:=flast downto p do

{ перемещение элементов из позиций р, р+1, ... на

одну позицию к концу списка }

elements[q+1]:= elements[q];

flast:= flast + 1;

elements[p]:= x

end

end; { INSERT }

procedure tlist.delete (p: position);

{ DELETE удаляет элемент в позиции р списка L }

var q: position;

begin

if (p > flast) or (p < 1) then

showmessage('Такой позиции не существует')

else

begin

flast:= flast - 1;

for q:= p to (flast+1) do

{ перемещение элементов из позиций р+1, р+2, ...

на одну позицию к началу списка }

elements[q]:= elements[q+1]

end

end; { DELETE }

function tlist.locate (x: elementtype): position;

{ LOCATE возвращает позицию элемента x в списке L }

var q: position;

begin

for q:= 1 to flast do

if elements[q] = x then

result:=q;

result:=flast +1 { элемент х не найден }

end; { LOCATE }

function tlist.kol (x: elementtype): integer;

var m: integer;

begin

result:=0;

for m:= 1 to flast do

if elements[m] = x then

result:=result+1;

end;

procedure tlist.print(memo:TMemo); //вывод массива в Memo окна формы

var i:integer;

begin

memo.Text:='';

for i:=1 to maxlength do

begin

memo.Text:=memo.text+IntToStr(elements[i])+#13+#10;

end;

end;

procedure tlist.insertlast (x: elementtype); //вставить последний элемент

var q: position; g:integer;

begin flast:=flast+1;

elements[flast]:= x;

end;

end.

unit List_test; //главный модуль, работа со списком через форму

interface

uses

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

Dialogs, StdCtrls, list;

type

TForm1 = class(TForm)

Memo1: TMemo;

Label1: TLabel;

Memo2: TMemo;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Memo3: TMemo;

Button5: TButton;

procedure Button1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

//объявление переменных

var

Form1: TForm1;

var

il: tlist;

no: integer;

implementation

{$R *.dfm}

//заполнить список

procedure TForm1.Button1Click(Sender: TObject);

var i:integer;

begin

il:=tlist.init;

il.zapoln(9);

il.print(memo1);

end;

//вывод списка

procedure TForm1.Button4Click(Sender: TObject);

begin

il.print(memo1);

il.insert(55, 5);

il.print(memo2);

end;

//удалить заданный элемент

procedure TForm1.Button3Click(Sender: TObject);

begin

il.print(memo1);

il.delete(2);

il.print(memo2);

end;

//удаление списка

procedure TForm1.Button2Click(Sender: TObject);

begin

il.print(memo1);

il.done;

end;

//подсчет количества”22” в списке

procedure TForm1.Button6Click(Sender: TObject);

begin

il.print(memo1);

No:=il.kol(22);

il.print(memo2);

Memo3.Lines.Append(IntToStr(No));

end;

//вставить в конец списка

procedure TForm1.Button5Click(Sender: TObject);

begin

il.print(memo1);

il.insertlast(77);

il.print(memo2);

end; end.

Лабораторная работа 5

1. Разработать АТД «Дек», включающий следующие операции:

· Стандартные (включение в начало, исключение из начала, …)

· Поиск

· Подсчет количества элементов

Описать этот АТД на русском языке.

2. Реализовать этот АТД в виде динамического двунаправленного списка с указателями на начало дека и на конец дека.

Логика работы:

• Дек (от англ. deq - double ended queue, т.е очередь с двумя концами) - это такой последовательный список, в котором как включение, так и исключение элементов может осуществляться с любого из двух концов списка.

• Частный случай дека - дек с ограниченным входом и дек с ограниченным выходом.

• Логическая и физическая структуры дека аналогичны логической и физической структуре кольцевой FIFO-очереди.

• Однако, применительно к деку целесообразно говорить не о начале и конце, а о левом и правом конце.

Unit item;

interface

type //задание нового типа данных, описание полей элемента дека

ttype = string; //поля дека - значение, указатель на следующий, на предыдущий

ptitem = ^titem;

titem = object

info: ttype;

next: ptitem;

prev: ptitem;

constructor init(x: ttype;

nxt, prv: ptitem);

destructor done;

end;

implementation

//выделение памяти под класс и его инициализация

constructor titem.init(x: ttype;

nxt,prv: ptitem);

begin

info := x;

next := nxt;

prev:= prv;

end;

//удаление класса и освобождение памяти

destructor titem.done;

begin end;

end.

unit Deque; //модуль описания методов дека

interface

uses item,

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

Dialogs, StdCtrls;

type

pttype = ^ttype;

tdeque = object

constructor init;

destructor done;

procedure put_start(x: ttype); //добавить в начало

function get_start(var x: ttype): boolean; //убрать из начала

procedure put_finish(x: ttype); //добавить в конец

function get_finish(var x: ttype): boolean; //убрать из конца

function empty: boolean; //проверка на пустоту

function find(var x: ttype; a:string): string; //найти

procedure print (memo:TMemo); //вывести на мемо

function elts(var x: ttype): integer; //подсчет элементов

private

start,finish: ptitem;

end;

implementation

constructor tdeque.init; //создание дека

begin

start:= nil;

finish := nil;

end;

destructor tdeque.done; //удаление дека

var x: ttype;

begin

while get_start(x) do;

end;

procedure tdeque.put_start(x: ttype); //добавить в начало дека

var d: ptitem;

begin

if (start<>nil) and (finish^.prev=nil) then finish^.prev:=start;

new(d);

d.init(x, start, nil);

if (start<>nil) then start^.prev:=d;

start := d;

if finish=nil then begin finish:=start; end;

end;

procedure tdeque.put_finish(x: ttype); //добавить в конец дека

var d: ptitem;

begin

if (finish<>nil) and (start^.prev=nil) then start^.prev:=finish;

new(d);

d.init(x, nil,finish);

if (finish<>nil) then finish^.next:=d;

finish := d;

if start=nil then begin start:=finish; end;

end;

function tdeque.get_finish(var x: ttype): boolean; //убрать с начала дека

var p: ptitem;

begin

get_finish := true;

if not empty then begin

p := finish;

finish := finish^.prev;

finish^.next:=nil;

x := p^.info;

dispose(p, done);

end

else begin

get_finish := false;

end;

end;

function tdeque.get_start(var x: ttype): boolean; //убрать с конца дека

var p: ptitem;

begin

get_start := true;

if not empty then begin

p := start;

start := start^.next;

x := p^.info;

dispose(p, done);

end

else begin

get_start := false;

end;

end;

function tdeque.empty: boolean; //проверка дека на пустоту

begin

empty := not assigned(start);

end;

procedure tdeque.print(memo:Tmemo); //вывод дека в мемо

var p: ptitem;

begin

memo.text:='';

p := start;

while assigned(p) do begin

memo.text:=memo.text+p^.info+#13+#10;

p := p^.next

end;

end;

function tdeque.find(var x: ttype; a: string): string; //найти элемент дека

var p: ptitem;

begin

x := a;

if not empty then

begin

p := start;

while assigned(p) do begin

if x = p^.info then begin

result:=a; p:=p^.next end

else

p:=p^.next;

end end;

end;

function tdeque.elts(var x: ttype): integer; //подсчет числа элементов дека

var p: ptitem;

begin

result:=0;

if not empty then

begin

p := start;

while assigned(p) do begin

result:=result+1; p:=p^.next end

end;

end;

end.

unit Deque; //главный модуль работы с деком через форму

interface

uses

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

Dialogs, StdCtrls, stack, item;

type

TForm1 = class(TForm)

Memo1: TMemo;

Label1: TLabel;

Memo2: TMemo;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Edit1: TEdit;

Label3: TLabel;

Edit2: TEdit;

Label4: TLabel;

Button5: TButton;

Button6: TButton;

Edit3: TEdit;

Button7: TButton;

Edit4: TEdit;

Label5: TLabel;

Button8: TButton;

Label6: TLabel;

procedure Button1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

//объявление переменных

var

Form1: TForm1;

var

ist: tdeque;

i: integer;

x: ttype;

a:string;

implementation

{$R *.dfm}

//задать дек из строки

procedure TForm1.Button1Click(Sender: TObject);

var i:integer;

begin

ist.init;

//Writeln('Create list with elements [2, 4, 6, ..., 20]');

a:=edit2.text;

for i := 1 to length(a) do begin

ist.put_start(a[i]);

ist.print(memo1); end;

end;

//добавить в начало

procedure TForm1.Button4Click(Sender: TObject);

begin

ist.print(memo1);

ist.put_start(edit1.Text);

ist.print(memo2);

end;

procedure TForm1.Button5Click(Sender: TObject);

Var x:ttype;

begin

ist.print(memo1);

if ist.get_finish(x) Then

label4.Caption:=x

else

MessageBox(0,'The stack is empty: PUSH ITEMS TO STACK',

'Error', MB_OK);

ist.print(memo2);

//label

end;

//убрать из начала

procedure TForm1.Button3Click(Sender: TObject);

Var x:ttype;

begin

ist.print(memo1);

if ist.get_start(x) Then

label3.Caption:=x

else

MessageBox(0,'The stack is empty: PUSH ITEMS TO STACK',

'Error', MB_OK);

ist.print(memo2);

//label

end;

//удалить дек

procedure TForm1.Button2Click(Sender: TObject);

begin

ist.print(memo1);

ist.done;

ist.print(memo2);

end;

//убрать из конца

procedure TForm1.Button6Click(Sender: TObject);

begin

ist.print(memo1);

ist.put_finish(edit3.Text);

ist.print(memo2);

end;

//найти элемент

procedure TForm1.Button7Click(Sender: TObject);

Var x:ttype; p:ptitem;

begin

a:=edit4.Text;

label5.Caption:=ist.find(a,a);

end;

procedure TForm1.Button8Click(Sender: TObject); //количество элементов в деке

Var x:ttype; p:ptitem;

begin

label6.Caption:=IntToStr(ist.elts(a));

end;

end.



Лабораторная работа 6

Задание Стек, очередь, дек, кольцо

С использованием АТД «Дек» написать программу «Считалочка» - начав от первого, удаляют каждого k-го, смыкая при этом круг. Определить порядок удаления ребят из круга.

Логика работы:

Начиная с начала списка, переменной присваивается значение элемента списка по указателю на следующий, как только переменная принимает значение элемента с нужным номером (в моей работе третьего), элемент удаляется специальной процедуры, и со следующего после удаленного элемента отсчет продолжается.

Удаление каждого третьего продолжается пока не останется 1.

procedure tdeque.minus(x: ttype; Edit5 :TEdit; memo1:tmemo); //проход до элемента, его

var p,y: ptitem; k: integer; удаление, начало следущего

begin отсчета и вывод удаленного

y:=start; элемента

while (start<>finish) do

begin

if (y^.next <> nil) then y:=y^.next

else y:=start;

if (y^.next <> nil) then y:=y^.next

else y:=start;

Edit5.text:=Edit5.text+y.info+#32;

if y.next<>nil then

p:=y.next else p:=start;

remove_item(y);

y:=p;

print(memo1);

end;

end;

procedure tdeque.remove_item(p: ptitem); //удаление элемента из середины дека

var r: ptitem;

begin

r := p;

if p^.prev <> nil then

begin

p^.prev^.next := p^.next;

if p^.next<> nil then

p^.next^.prev:=p^.prev;

end;

if p = start then

begin

p.next.prev:=nil;

start:=p.next;

end;

if p = finish then

begin

p.prev.next:=nil;

finish:=p.prev;

end;

if p^.next <> nil then

begin

p^.next^.prev := p^.prev;

if p^.prev<> nil then

p^.prev^.next:=p^.next;

end;

dispose(r,done); r:=nil

end;

Лабораторная работа 7

Задание. Деревья двоичного поиска

Написать процедуру, которая удаляет из дерева все четные элементы

Логика работы:

Процедура осуществляет обход всего дерева `снизу вверх', при удачной проверке элемента на четность, он удаляется с помощью имеющейся процедуры удаления элемента по выбору.

unit Tree_test; //главный модуль программы, работа через форму

interface

uses

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

Dialogs, StdCtrls, tree, item;

type

TForm1 = class(TForm)

Memo1: TMemo;

Label1: TLabel;

Memo2: TMemo;

Label2: TLabel;

Button1: TButton;

Button2: TButton;

Button3: TButton;

Button4: TButton;

Button5: TButton;

Button6: TButton;

Button7: TButton;

Button8: TButton;

Label3: TLabel;

Label4: TLabel;

Button9: TButton;

procedure Button1Click(Sender: TObject);

procedure Button4Click(Sender: TObject);

procedure Button5Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button6Click(Sender: TObject);

procedure Button7Click(Sender: TObject);

procedure Button8Click(Sender: TObject);

procedure Button9Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

//объявление переменных

var

Form1: TForm1;

var

t: ttree;

implementation

{$R *.dfm}

//создать дерево и осуществить обход

procedure TForm1.Button1Click(Sender: TObject);

var i, n:integer;

begin

t.init;

//Writeln('Create list with elements [2, 4, 6, ..., 20]');

//for i := 1 to 4 do

//t.insrec(t.root,(strtoint(inputbox('Ввведите чиисло','',''))));

label4.caption:='';

for i := 1 to 7 do

begin

n:= strtoint(inputbox('Ввведите чиисло','',''));

t.root:=t.addtotree(t.root,n);

label4.Caption:= label4.Caption+' '+inttostr(n)

end;

memo1.Text:='';

t.printtreeLex(t.root,memo1);

end;

//симметричный обход и удаление дерева

procedure TForm1.Button2Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeLex(t.root,memo1);

t.done;

memo2.Text:='';

t.printtreeLex(t.root,memo2);

end;

// симметричный обход с удалением элемента дерева

procedure TForm1.Button3Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeLex(t.root,memo1);

t.delete(t.root,strtoint(inputbox('Ввведите чиисло','','')));

memo2.Text:='';

t.printtreeLex(t.root,memo2);

end;

//добавление элемента

procedure TForm1.Button4Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeLex(t.root,memo1);

t.root:=t.addtotree(t.root,strtoint(inputbox('Ввведите чиисло','','')));

memo2.Text:='';

t.printtreeLex(t.root,memo2);

end;

//поиск элемента

procedure TForm1.Button5Click(Sender: TObject);

var p:ptitem;

begin

memo1.Text:='';

t.printtreeLex(t.root,memo1);

p:=t.find(t.root,strtoint(inputbox('Ввведите чиисло','','')));

memo2.Text:='';

if p <> nil then

memo2.text:='найден'

else

memo2.text:='не найден'

end;

//симметричный обход

procedure TForm1.Button6Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeLex(t.root,memo1);

end;

//обход сверху вних

procedure TForm1.Button7Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeDown(t.root,memo1);

end;

//обход снизу вверх

procedure TForm1.Button8Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeUp(t.root,memo1);

end;

//удаление всех четных элементов

procedure TForm1.Button9Click(Sender: TObject);

begin

memo1.Text:='';

t.printtreeLex(t.root,memo1);

t.delete2(t.root);

memo2.Text:='';

t.printtreeLex(t.root,memo2);

end;

end.

--------------------------------------------------------------------------------------------

unit Tree; //модуль описания свойств абстрактного типа данных

interface

uses item, Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls;

type

ttree = object

root: ptitem;

constructor init; //инициализация

destructor done; //удаление

Procedure InsRec( p:ptitem;x : ttype); //начальное заполнение дерева

Procedure PrintTreeLex(p:ptitem; memo : TMemo); //симметричный обход

Procedure PrintTreeDown(p:ptitem; memo : TMemo); //обход сверху вниз

Procedure PrintTreeUp(p:ptitem; memo : TMemo); //обход снизу вверх

function find(p:ptitem;x : ttype) : ptitem; //поиск элемента

function Delete(p:ptitem;x: ttype) : ptitem; //удаление элемента

function AddToTree(p: ptitem;x: TType): ptitem; //добавление элемента

procedure delete2(p:ptitem); //удаление всех четных

end;

implementation

//инициализация дерева

constructor ttree.init;

begin

root := nil;

end;

//удаление дерева и освобождение памяти

destructor ttree.done;

procedure Remove(Root: ptitem);

begin

if Root = nil then exit;

remove(Root^.Right);

remove(Root^.Left);

Dispose(Root)

end;

begin

//remove(root)

root:=nil

end;

//процедура обхода

Procedure ttree.PrintTreeLex(p:ptitem; memo : TMemo);

begin

if p <> nil then

begin

PrintTreeLex(p^.Left,memo);

memo.text:=memo.text+p^.tostr(p^.info)+' ';

PrintTreeLex(p^.right,memo)

end;

end;

Procedure ttree.PrintTreeDown(p:ptitem; memo : TMemo); //удаление всех четных

Begin (переделанный обход)

if p <> nil then

begin

if (p.info mod 2)=1 then begin

memo.text:=memo.text+p^.tostr(p^.info)+' '; end

else

ttree.Delete( p, p^.info);

memo.text:=memo.text+p^.tostr(p^.info)+' ';

PrintTreeDown(p^.Left,memo);

PrintTreeDown(p^.right,memo) ;

end

end;

//процедура обхода снизу вверх

Procedure ttree.PrintTreeUp(p:ptitem; memo : TMemo);

var r: ptitem;

begin

r:=p;

if p <> nil then

begin

PrintTreeUp(p^.Left,memo);

PrintTreeUp(p^.right,memo);

if (p.info mod 2)=1 then begin

memo.text:=memo.text+p^.tostr(p^.info)+' '; end

else

ttree.Delete( r, p^.info);

end

end;

//процедура начального заполнения дерева

Procedure ttree.InsRec(p:ptitem; x : ttype);

Begin

p:=root;

If p = Nil

Then Begin

New(p);

p^.left := Nil;

p^.right := Nil;

p^.Info := x

End

Else If x < p^.info

Then InsRec(p^.left, x)

Else InsRec(p^.right, x);

root:=p;

End;

//добавить элемент

Function ttree.AddToTree(p: ptitem;x: TType): ptitem;

Begin

//If no child - create new item

If p = nil Then

Begin

p := New(ptitem);

p^.info := x;

p^.left := nil;

p^.right := nil;

AddToTree := p; Exit

End;

If p^.info < x Then

p^.right := AddToTree(p^.right, x)

Else if p^.info > x Then

p^.left := AddToTree(p^.left, x)

else

MessageBox(0, 'такой элемент в дереве уже есть!','Внимание',MB_OK);

AddToTree := p

End;

//поиск элемента

function ttree.find( p:ptitem;x : ttype) : ptitem;

begin

if p=nil then

find := nil

else if p^.info=x then

Find := p

else if x < p^.info then

Find := Find(p^.left, x)

else

Find := Find(p^.right, x)

end;

//удаление заданного элемента

function ttree.Delete( p:ptitem;x: ttype) : ptitem; //в процедуру поступает значение элемента

var P1, v : ptitem;

begin

if (p=nil) then

MessageBox(0, 'такого элемента в дереве нет!','Внимание',MB_OK)

else if x < p^.info then

p^.left := Delete(p^.left, x) {случай 1} //переходим дальше если текущий

Else if x > p^.info then элемент не равен запрошенному

p^.right := Delete(p^.right, x) {случай 1}

else

begin {случай 1} //начинаем удаление

P1 := p;

if p^.right=nil then

p:=p^.left

else if p^.left=nil then

p:=p^.right

else

begin {случай 2}

v := p^.left;

while v^.right^.right <> nil do

v:= v^.right;

p^.info := v^.right^.info;

P1 := v^.right;

v^.right :=v^.right^.left;

end;

dispose(P1);

end;

Delete := p end;

Procedure ttree.PrintTreeUp(p:ptitem; memo : TMemo); //обход дерева с удалением четных

var r: ptitem; элементов

begin

r:=p;

if p <> nil then

begin

PrintTreeUp(p^.Left,memo);

PrintTreeUp(p^.right,memo);

if (p.info mod 2)=1 then begin //проверка на четность

memo.text:=memo.text+p^.tostr(p^.info)+' '; end //вывод если нечетный

else

ttree.Delete( r, p^.info); //вызов удаления если четный

end

end; end.



Лабораторная работа 8

Задание. Графы

• Реализовать АТД «Неориентированный граф»

– Представление графа - в виде матрицы смежности

– Исходные данные о графе хранятся в текстовом файле

• Операции:

– Создание и инициализация

– Добавить вершину

– Добавить ребро

– Удалить вершину

– Удалить ребро

- Вывести граф

Логика работы:

Матрицей смежности графа с n вершинами называется матрица А= [aij], i, j= 1, 2,..., n, в которой

aij = 1, если существует ребро (xi ,xj) 0, если вершины xi ,xj не связаны ребром (xi ,xj)

Количество единиц в строке матрицы смежности равно степени вершины, соответствующей данной строке.

Матрица смежности для неориентированного графа будет симметричной относительно своей главной диагонали,

unit mainForm; //главный модуль программы

interface

uses

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

Dialogs, Grids, StdCtrls, SmegnMatrix, ExtCtrls;

type

TfrmMain = class(TForm)

btAdd: TButton;

Image1: TImage;

cbIds: TComboBox;

btDel: TButton;

Label1: TLabel;

Label2: TLabel;

btSave: TButton;

btLoad: TButton;

btExit: TButton;

OpenDialog1: TOpenDialog;

SaveDialog1: TSaveDialog;

btClear: TButton;

procedure FormCreate(Sender: TObject); // задание матрицы

procedure btAddClick(Sender: TObject); //добавка вершины(те строки и столбца)

procedure Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer); //добавить связь через окно формы

procedure btDelClick(Sender: TObject); //удалить вершину

procedure btExitClick(Sender: TObject); //выход из программы

procedure btSaveClick(Sender: TObject); //сохранение в файл

procedure btLoadClick(Sender: TObject); //считать из файла

procedure btClearClick(Sender: TObject); //очистить полностью окно вывода матрицы

private

mas : TSmegnMatrix;

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject); //свойства окна работы с графикой, первое

begin // задание матрицы

mas := TSmegnMatrix.create;

mas.addCell;

mas.addCell;

mas.addCell;

mas.addCell;

mas.rebr( 1, 3);

mas.rebr( 1, 2);

mas.rebr( 3, 1);

mas.rebr( 2, 3);

mas.import( image1 );

mas.import( cbIds );

end;

procedure TfrmMain.btAddClick(Sender: TObject); //добавка вершины(те строки и столбца)

begin

mas.addCell;

mas.import( image1 );

mas.import( cbIds );

end;

procedure TfrmMain.Image1MouseDown(Sender: TObject; Button: TMouseButton;

Shift: TShiftState; X, Y: Integer); //добавить связь через окно формы

begin

mas.swapcon( x, y );

mas.import( image1 );

end;

procedure TfrmMain.btDelClick(Sender: TObject); //удалить вершину

var s : string;

begin

s := cbIds.Text;

if ( s <> '' ) then

begin

mas.delCell( strtoint( s ) );

mas.import( image1 );

mas.import( cbIds );

end;

end;

//выход из программы

procedure TfrmMain.btExitClick(Sender: TObject);

begin

close;

end;

procedure TfrmMain.btSaveClick(Sender: TObject); //сохранение в файл

begin

if savedialog1.Execute then

mas.serialize( savedialog1.FileName );

end;

procedure TfrmMain.btLoadClick(Sender: TObject); //считать из файла

begin

if opendialog1.Execute then

begin

mas.desirialize( opendialog1.FileName );

mas.import( image1 );

mas.import( cbIds );

end;

end;

//очистить полностью окно вывода матрицы

procedure TfrmMain.btClearClick(Sender: TObject);

begin

mas.clear;

mas.import( image1 );

mas.import( cbIds );

end;

end.

unit SmegnMatrix; //модуль описания свойств матрицы смежности

interface

uses

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

Dialogs, Grids, StdCtrls, ExtCtrls;

const

OFFSET : integer = 30;

type

TSMatrix = array of array of boolean; //создание матрицы

type

TSmegnMatrix = class

private

mt : TSMatrix;

len : integer;

used : integer;

public

constructor create();//создать матрицу и задать ее размер

destructor free();

procedure addCell(); //добавить вершину, добавка столбца и строки матрицы

procedure rebr( idFrom, idTo : integer ); //изменить значение ячейки матрицы

procedure disconnect( idFrom, idTo : integer ); /разъединение

procedure swapcon( i, j : integer ); //изменить значение ячейки матрицы(добавить - убрать)

procedure delCell( id : integer ); //удалить вершину, уменьшить матрицу

procedure import( im : TImage );overload; //вывод матрицы на форму

procedure import( cb : TComboBox );overload; //добавление элемента матрицы в соответствии с добавлением галочки в квадратик

procedure serialize( fName : string );//сохранение в файл

procedure desirialize( fName : string ); //загрузка из файла

procedure ccArray( var n : TSMatrix ); //процедура расширения матрицы

procedure clear; //удаление матрицы

end;

implementation

{ TSmegnMatrix }

procedure TSmegnMatrix.addCell(); //добавить вершину, добавка столбца и строки матрицы

var

tmp : TSMatrix;

i : integer;

begin

if ( used >= len ) then

begin

ccArray( tmp ); //процедура расширения матрицы

mt := tmp;

end;

for i := 0 to len - 1 do

begin

mt[used, i] := false;

end;

inc(used);

end;

procedure TSmegnMatrix.ccArray(var n: TSMatrix); //расширение матрицы

var nlen, i, j : integer;

begin

nlen := len*len;

if ( len >= nlen ) then

nlen := 16;

setLength( n, nlen );

for i := 0 to nlen - 1 do

begin

setLength( n[i], nlen );

j := 0;

if ( i < len ) then

for j := 0 to len - 1 do

begin

n[i,j] := mt[i,j];

end;

while( j < nlen -1 ) do

begin

n[i,j] := false;

inc( j );

end;

end;

len := nlen;

end;

procedure TSmegnMatrix.clear; //удаление матрицы

begin

used := 0;

end;

procedure TSmegnMatrix.rebr(idFrom, idTo: integer); //изменить значение ячейки матрицы

var

ifrom, ito : integer;

begin

if ( ifrom > -1 ) and ( ito > -1 )

and ( ifrom < used ) and ( ito < used ) then

begin

mt[ifrom,ito] := true;

end;

end;

constructor TSmegnMatrix.create; //создать матрицу и задать ее размер

var

i : integer;

begin

len := 0;

used := 0;

setLength( mt, len );

for i := 0 to len - 1 do

begin

setLength( mt[i], len );

end;

end;

procedure TSmegnMatrix.delCell(id: integer); //удалить вершину, уменьшить матрицу

var

i, j : integer;

begin

if ( id < 0 ) or ( id >= used ) then

exit;

for i := id to used - 2 do

begin

for j := 0 to id - 1 do

begin

mt[j,i] := mt[j,i+1];

end;

for j := id to used - 2 do

begin

mt[j,i] := mt[j+1,i+1];

end;

end;

dec(used);

end;

procedure TSmegnMatrix.desirialize(fName: string); //загрузка из файла

var

i, j, str, t : integer;

sl : TStringList;

begin

clear;

str := 0;

sl := TStringList.Create;

sl.LoadFromFile( fName );

t := strtoint( sl.Strings[str] );

for i := 0 to t - 1 do

addCell;

inc(str);

for i := 0 to used - 1 do

for j := 0 to used - 1 do

begin

if ( sl.Strings[str] = '0' ) then

disconnect( j, i )

else

rebr( j, i );

inc(str);

end;

end;

procedure TSmegnMatrix.disconnect(idFrom, idTo: integer); //разъединение

var

ifrom, ito : integer;

begin

if ( ifrom > -1 ) and ( ito > -1 )

and ( ifrom < used ) and ( ito < used ) then

begin

mt[ifrom,ito] := false;

end;

end;

destructor TSmegnMatrix.free;

begin

end;

procedure TSmegnMatrix.import(im: TImage); //вывод матрицы на форму

var i, j: integer;

pts : array[0..3] of TPoint;

begin

// im.Width := used * 24 + OFFSET + 24;

// im.Height := used * 24 + OFFSET + 24;

// im.ClientHeight := used * 24 + OFFSET+24;

// im.ClientWidth := used * 24 + OFFSET+24;

im.Canvas.Brush.Color := clWhite;

im.Canvas.Pen.Color := clWhite;

im.Canvas.Rectangle(0,0, im.Width, im.Height);

im.Canvas.Font.Size := 20;

im.Canvas.Brush.Color := clWhite;

im.Canvas.Pen.Color := clBlack;

for i := 0 to used -1 do

begin

im.Canvas.TextOut( (i)*24 + OFFSET, 0, inttostr( i ) );

for j := 0 to used -1 do

begin

im.Canvas.TextOut( 0, OFFSET + (j)*24, inttostr( j ) );

end;

end;

im.Canvas.Brush.Color := clGreen;

im.Canvas.Pen.Color := clBlack;

for i := 0 to used -1 do

begin

for j := 0 to used -1 do

begin

if ( mt[i,j] ) then

begin

//im.Canvas.Rectangle( OFFSET + j*24, OFFSET + i*24,

// OFFSET + (j+1)*24, OFFSET + (i+1)*24 );

pts[0].X := OFFSET + j*24 + 4;

pts[0].Y := OFFSET + i*24 + 10;

pts[1].X := OFFSET + j * 24+ 6;

pts[1].Y := OFFSET + i*24 + 20;

pts[2].X := OFFSET + j * 24+ 16;

pts[2].Y := OFFSET + i*24 + 4;

pts[3].X := OFFSET + j * 24 + 6;

pts[3].Y := OFFSET + i*24 + 16;

//pts[4] := TPoint( OFFSET + j * 24 + 4, OFFSET + i*24 + 10 );

im.Canvas.Polygon( pts );

end;

end;

end;

for i := 0 to used do

begin

im.Canvas.MoveTo( OFFSET + i * 24, 0 );

im.Canvas.LineTo( OFFSET + i*24, im.ClientHeight);

end;

for i := 0 to used do

begin

im.Canvas.MoveTo( 0, OFFSET + i * 24 );

im.Canvas.LineTo( im.ClientWidth, OFFSET + i*24);

end;

end;

//добавление элемента матрицы в соответствии с добавлением галочки в квадратик

procedure TSmegnMatrix.import(cb: TComboBox);

var i : integer;

begin

cb.Clear;

for i := 0 to used - 1 do

begin

cb.AddItem( inttostr( i ), nil );

end;

end;

procedure TSmegnMatrix.serialize(fName: string); //сохранение в файл

var

i, j : integer;

s : integer;

sl : TStringList;

begin

sl := TStringList.Create;

sl.Add( inttostr( used ) );

for i := 0 to used - 1 do

begin

for j := 0 to used - 1 do

begin

if mt[j,i] = true then

sl.Add( '1' )

else

sl.Add( '0' );

end;

end;

sl.SaveToFile( fName );

end;

procedure TSmegnMatrix.swapcon(i, j: integer); //изменить значение ячейки

begin // матрицы(добавить - убрать)

i := i - OFFSET;

j := j - OFFSET;

i := trunc(i / 24);

j := trunc( j / 24 );

if ( i < used ) and ( j < used ) and ( j >= 0 ) and ( i >= 0 ) then

begin

mt[j,i] := not mt[j,i]; end; end; end.

Лабораторная работа 9

Задание. Графы

• Реализовать АТД «Ориентированный взвешенный граф»

– Представление графа - в виде списка смежности

– Исходные данные о графе хранятся в текстовом файле

• Операции:

– Создание и инициализация

– Добавить вершину

– Добавить дугу

– Удалить вершину

– Удалить дугу

– «Распечатать» граф

Логика работы:

Этот способ задания графов подразумевает, что для каждой вершины будет указан список всех смежных с нею вершин (для орграфа - список вершин, являющихся концами исходящих дуг).

Список смежности содержит для каждой вершины графа список смежных ей вершин.

Каждый элемент такого списка является записью, содержащей в одном поле номер вершины графа, во втором - указатель на следующую запись в списке (ясно, что для последней записи в списке поле указателя содержит Nil).

unit MainForm; //главный модуль, работа со списком через окно формы

interface

uses

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

Dialogs, SmegnGraph, StdCtrls, ComCtrls;

type

TfrmMain = class(TForm)

btAddHost: TButton;

btConAdd: TButton;

cbFrom: TComboBox;

cbTo: TComboBox;

Label1: TLabel;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

btClear: TButton;

btSave: TButton;

btLoad: TButton;

btExit: TButton;

sdf: TSaveDialog;

odf: TOpenDialog;

edCost: TEdit;

Label5: TLabel;

Memo1: TMemo;

procedure FormCreate(Sender: TObject); //создать список из 1 вершины

procedure btExitClick(Sender: TObject); //выход из программы

procedure btClearClick(Sender: TObject); //очистить список

procedure btAddHostClick(Sender: TObject); //добавление вершины

procedure btDelHostClick(Sender: TObject); //удаление вершины

procedure btConAddClick(Sender: TObject); //добавить связь

procedure btConDelClick(Sender: TObject); //удалить связь

procedure btSaveClick(Sender: TObject); //сохранение в файл

procedure btLoadClick(Sender: TObject); //загрузка из файла

procedure edCostKeyPress(Sender: TObject; var Key: Char); //установка веса

private

graph : TSmegnGraph;

id : integer;

procedure updateData;

public

{ Public declarations }

end;

var

frmMain: TfrmMain;

implementation

{$R *.dfm}

procedure TfrmMain.FormCreate(Sender: TObject); //создать список из 1 вершины

begin

graph := TSmegnGraph.Create();

id := 1;

invalidate;

updateData();

end;

//выход из программы

procedure TfrmMain.btExitClick(Sender: TObject);

begin

close();

end;

procedure TfrmMain.btClearClick(Sender: TObject); //очистить список

begin

graph.clear;

updateData();

end;

procedure TfrmMain.updateData; //вывод списка на форму в мемо

begin

graph.import( memo1 );

graph.import( cbFrom );

graph.import( cbTo );

end;

procedure TfrmMain.btAddHostClick(Sender: TObject); //добавление вершины

begin

graph.addHost( id );

inc( id );

updateData();

end;

procedure TfrmMain.btDelHostClick(Sender: TObject); //удаление вершины

begin

{ try

if ( treeview1.Selected.Text <> '' ) then

begin

graph.delHost( strtoint( treeview1.Selected.Text ) );

updateData();

end;

except

on EAccessViolation do ;

end;}

end;

procedure TfrmMain.btConAddClick(Sender: TObject); //добавить связь

var

s, s1 : string;

begin

s := cbFrom.Text;

s1 := cbTo.Text;

if ( s <> '' ) and ( s1 <> '' ) then

begin

graph.connect( strtoint(s), strtoint(s1), strtoint( edCost.text ));

end;

updateData();

end;

procedure TfrmMain.btConDelClick(Sender: TObject); //удалить связь