Файл: Лекции СД.doc

3. 3. Моделирование работы стека

Модуль содержит вариант реализации стека на структуре данных «вектор». Стек расширяется в сторону уменьшения адресов. Указатель стека всегда указывает на первый свободный элемент. Перед использованием модуля должен быть определен предельный размер стека и структура элемента данных стека.

unit Stack;

Interface

const stsize = 10; { предельный размер стека }

type data = ...; { элементы могут иметь любой тип }

procedure StackInit;

procedure StackClr;

function StackPush(a: data): Boolean;

function StackPop(var a: data): Boolean;

function StackSize: Integer;

Implementation

var sta: array[1..stsize] of data; { данные стека }

{ Указатель на вершину стека,

работает на префиксное вычитание }

top: Integer;

{ инициализация - на начало }

procedure StackInit;

begin

top:=stsize;

end;

{ очистка = инициализация }

procedure StackClr;

begin

top:=stsize;

end;

{ занесение элемента в стек }

function StackPush(a: data): Boolean;

begin

if top = 0 then

StackPush:=False else

begin

{ занесение, затем - коррекция указателя }

sta[top]:=a;

top:=top-1;

StackPush:=True;

end;

end;

{ выборка элемента из стека }

function StackPop(var a: data): Boolean;

begin

if top = stsize then

StackPop:=False else

begin

{ коррекция указатель, затем - выборка }

top:=top+1;

a:=sta[top];

StackPop:=True;

end;

end;

function StackSize: Integer; { определение размера }

begin

StackSize:=stsize-top;

end;

end.

Модуль содержит вариант реализации стека на односвязном линейном списке.

unit stack;

Interface

type data = ...; { элементы могут иметь любой тип }

procedure StackInit;

procedure StackClr;

function StackPush(a: data): Boolean;

function StackPop(var a: data): Boolean;

function StackSize: Integer;

Implementation

type

stptr = ^stit; { указатель на элемент списка }

stit = record { элемент списка }

inf : data; { данные }

next: stptr; { указатель на следующий элемент }

end;

var

top: stptr; { указатель на вершину стека }

stsize: LongInt; { размер стека }

{ инициализация - список пустой }

procedure StackInit;

begin

top:=nil;

stsize:=0;

end;

{ очистка - освобождение всей памяти }

procedure StackClr;

var x: stptr;

begin

{ перебор элементов до конца списка и их уничтожение }

while top <> nil do

begin

x:=top;

top:=top^.next;

Dispose(x);

end;

stsize:=0;

end;

function StackPush(a: data): Boolean; { занесение в стек }

var x: stptr;

begin

{ если нет больше свободной памяти –

отказ; использовать только для BP 7.0 }

if MaxAvail < SizeOf(stit) then

StackPush:=False else

{ выделение памяти для элемента и заполнение информационной части }

begin

New(x);

x^.inf:=a;

{ новый элемент помещается в голову списка }

x^.next:=top;

top:=x;

stsize:=stsize+1; { коррекция размера }

StackPush:=True;

end;

end;

function StackPop(var a: data): Boolean; { выборка элемента из стека }

var x: stptr;

begin

{ список пуст - стек пуст }

if top = nil then

StackPop:=False else

begin

{ выборка информации из первого элемента списка }

a:=top^.inf;

{ первый элемент исключается из списка, освобождается память }

x:=top;

top:=top^.next;

Dispose(x);

stsize:=stsize-1; { коррекция размера }

StackPop:=True;

end;

end;

function StackSize: Integer; { определение размера стека }

begin

StackSize:=stsize;

end;

end.

4. 4. Создание и редактирование бинарных деревьев

Пример демонстрирует способ создания и элементарные операции по изменению и просмотру структуры бинарного дерева.

program BinTree;

{$APPTYPE CONSOLE}

type

PNode = ^TNode;

TNode = record

Name: string;

Left, Right: Pointer;

end;

var

n: Integer;

s: string;

pnt, Current: PNode;

pnt_s, Current_s, Root: Pointer;

{ Сменить текущий узел }

procedure NodeSearch(pnt_s: Pointer; var Current_s: Pointer);

var pnt_n: PNode;

begin

pnt_n:=pnt_s;

if pnt_n^.Name <> s then

begin

if pnt_n^.Left <> nil then

NodeSearch(pnt_n^.Left,Current_s);

if pnt_n^.Right <> nil then

NodeSearch(pnt_n^.Right,Current_s);

end else

Current_s:=pnt_n;

end;

{ Вывод списка всех узлов дерева }

procedure NodeList(pnt_s: Pointer);

var pnt_n: PNode;

begin

pnt_n:=pnt_s;

WriteLn(pnt_n^.Name);

if pnt_n^.Left <> nil then

NodeList (pnt_n^.Left);

if pnt_n^.Right <> nil then

NodeList(pnt_n^.Right);

end;

{ Удаление узла и всех его потомков в дереве }

procedure NodeDispose(pnt_s: Pointer);

var pnt_n: PNode;

begin

if pnt_s <> nil then

begin

pnt_n:=pnt_s;

WriteLn(pnt_n^.Name);

if pnt_n^.Left <> nil then

NodeDispose(pnt_n^.Left);

if pnt_n^.Right <> nil then

NodeDispose(pnt_n^.Right);

Dispose(pnt_n);

end;

end;

begin

New(Current);

Root:=Current;

Current^.Name:='Root';

Current^.Left:=nil;

Current^.Right:=nil;

repeat

WriteLn('Current node - ',Current^.Name);

WriteLn('1 - Set name for left descendant');

WriteLn('2 - Set name for right descendant');

WriteLn('3 - Change current node');

WriteLn('4 - Show node list');

WriteLn('5 - Delete descendantes of current node');

WriteLn('0 - Exit');

Read(n);

{ Создание левого потомка }

if n = 1 then

begin

if Current^.Left = nil then

New(pnt) else

pnt:=Current^.Left;

WriteLn('Left name ?');

ReadLn;

Read(s);

pnt^.Name:=s;

pnt^.Left:=nil;

pnt^.Right:=nil;

Current^.Left:=pnt;

end;

{ Создание правого потомка }

if n = 2 then

begin

if Current^.Right = nil then

New(pnt) else

pnt:=Current^.Right;

WriteLn('Right name ?');

ReadLn;

Read(s);

pnt^.Name:=s;

pnt^.Left:=nil;

pnt^.Right:=nil;

Current^.Right:=pnt;

end;

{ Сменить текущий узел }

if n = 3 then

begin

WriteLn('New current node ?');

ReadLn;

Read(s);

Current_s:=nil;

NodeSearch(Root, Current_s);

if Current_s <> nil then

Current:=Current_s else

WriteLn('Node '''+s+''' not found');

end;

{ Вывод списка узлов }

if n = 4 then NodeList(Root);

{ Удаление поддерева }

if n = 5 then

begin

WriteLn('l,r ?');

ReadLn;

Read(s);

if (s = 'l') then

{ Удаление левого поддерева }

begin

pnt_s:=Current^.Left;

Current^.Left:=nil;

NodeDispose(pnt_s);

en d else

{ Удаление правого поддерева }

begin

pnt_s:=Current^.Right;

Current^.Right:=nil;

NodeDispose(pnt_s);

end;

end;

until n = 0

end.

5. 5. Создание и редактирование сильноветвящихся деревьев

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

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

program dirtree;

{$APPTYPE CONSOLE}

uses SysUtils;

type

TNode = record

name: string[50]; { Имя каталога/файла }

size: LongInt; { Размер файла (байт) }

node_type: Char; { Тип узла (файл - 'f' / каталог-'c') }

up, down: Pointer; { Указатели на предка и список потомков }

last, next: Pointer; { Указатели на соседние узлы }

end;

var

n, i, l, error: Integer;

current_root: Pointer;

pnt, current: ^TNode;

str: string;

{ Отображение физического оглавления диска в логическую структуру }

procedure CreateTree(local_root:Pointer);

var s: TSearchRec; local_node, local_r_node, local_last: ^TNode;

{ Создание нового узла в дереве каталогов и файлов }

procedure NewNode;

begin

New(local_node);

local_node^.last:=local_last;

if local_last <> nil then

local_last^.next:=local_node;

local_node^.next:=nil;

local_node^.down:=nil;

local_node^.up:=local_r_node;

if local_r_node^.down = nil then

local_r_node^.down:=local_node;

local_node^.name:=local_r_node^.name+'\'+s.name;

if faDirectory = 0 then

local_node^.node_type:='f' else

local_node^.node_type:='c';

local_node^.size:=s.size;

local_last:=local_node;

end;

{ Собственно процедура }

begin

local_r_node:=local_root;

local_last:=nil;

error:=FindFirst(local_r_node^.name+'\*.*',faAnyFile,s);

if error = 0 then

begin

if (s.name<>'.') and (s.name<>'..') then NewNode;

while error = 0 do

begin

error:=FindNext(s);

if (error = 0) and (s.name<>'.') and (s.name<>'..') then NewNode;

end;

end;

if local_r_node^.down <> nil then

begin

local_node:=local_r_node^.down;

repeat

{ Рекурсивный вызов }

if local_node^.node_type = 'c' then CreateTree(local_node);

local_node:=local_node^.next

until local_node = nil;

end;

end;

{ Вывод оглавления текущего каталога }

procedure CurrentList;

begin

current:=current_root;

WriteLn('Current directory - ', current^.name);

if current^.node_type = 'c' then

begin

pnt:=current^.down;

i:=1;

{ Проходим каталог в дереве }

repeat

WriteLn(i:4,'-',pnt^.name);

pnt:=pnt^.next;

Inc(i);

until pnt = nil;

end;

end;

{ Навигация в дереве каталогов. Перемещение на один уровень вниз }

procedure MoveDown;

begin

current:=current_root;

if current^.down <> nil then

begin

current:=current^.down;

WriteLn('Id in list');

Read(l);

i:=1;

while (i < l) and (current^.next <> nil) do

begin

current:=current^.next;

Inc(i);

end;

if (current^.node_type = 'c') and (current^.down <> nil)

then current_root:= current;

end;

end;

{ Навигация в дереве каталогов. Перемещение на один уровень вверх }

procedure MoveUp;

begin

current:=current_root;

if current^.up <> nil then

current_root:=current^.up;

end;

{ Подсчет числа файлов и подкаталогов иерархической структуры каталога }

procedure Count;

var n_files, n_cats: Integer;

procedure count_in(local_root: Pointer);

var local_node, local_r_node: ^TNode;

begin

local_r_node:=local_root;

if local_r_node^.down <> nil then

begin

local_node:=local_r_node^.down;

repeat

if local_node^.node_type = 'f' then

Inc(n_files) else

begin

Inc(n_cats);

count_in(local_node);

end;

local_node:=local_node^.next

until local_node = nil;

end;

end;

{ Собственно процедура }

begin

n_files:=0; n_cats:=0;

count_in(current_root);

WriteLn('files : ',n_files, ' directories: ', n_cats);

end;

{ Расчет физического объема иерархической структуры каталога }

procedure CountMem;

var mem: LongInt;

procedure count_m_in(local_root: Pointer);

var local_node, local_r_node: ^TNode;

begin

local_r_node:=local_root;

if local_r_node^.down <> nil then

begin

local_node:=local_r_node^.down;

repeat

if local_node^.node_type = 'f' then

mem:=mem+local_node^.size else

count_m_in(local_node);

local_node:=local_node^.next;

until local_node = nil;

end;

end;

{ Собственно процедура }

begin