Работа с динамической памятью

program stack;
const n = 5;
type pnode = ^node;
     node = record                                { элемент стека }
         d : word;
         s : string;
         p : pnode;
     end;
var  top : pnode;                    { указатель на вершину стека }
     i   : word;
     s   : string;
const text : array [1 .. n] of string = ('one', 'two', 'three', 'four', 'five');
{ ------------------------------ занесение в стек --------------------------- }
function push(top : pnode; d : word; const s : string) : pnode;
var p : pnode;
begin
    new(p);
    p^.d := d; p^.s := s;  p^.p := top;
    push := p;
end;
{ ------------------------------ выборка из стека --------------------------- }
function pop(top : pnode; var d : word; var s : string) : pnode;
var p : pnode;
begin
    d := top^.d; s := top^.s;
    pop := top^.p;
    dispose(top);
end;
{ ------------------------------- главная программа ----------------------------- }
begin
    top := nil;
    for i := 1 to n do top := push(top, i, text[i]);        { занесение в стек: }
    while top <> nil do begin                               { выборка из стека: }
        top := pop(top, i, s);     writeln(i:2, s);
    end;
end.

Очереди

Очередь — это динамическая структура данных, добавление элементов в которую выполняется в один конец, а выборка — из другого конца. Другие операции с очередью не определены. При выборке элемент исключается из очереди. Говорят, что очередь реализует принцип обслуживания FIFO (first in — first out, первым пришел — первым обслужен). В программировании очереди применяются очень широко — например, при моделировании, буферизованном вводе-выводе или диспетчеризации задач в операционной системе.

Для работы с очередью используются указатели на ее начало и конец, а также вспомогательный указатель:

var beg, fin, p : pnode;

Тип указателей должен соответствовать типу элементов, из которых состоит очередь.

program queue;
const n = 5;
type pnode = ^node;
     node = record                                            { элемент очереди }
         d : word; 
         s : string; 
         p : pnode;
     end;
var  beg, fin : pnode;                    { указатели на начало и конец очереди }
    i         : word; 
    s         : string;
const text : array [1 .. n] of string = ('one', 'two', 'three', 'four', 'five');
{ ------------------ начальное формирование очереди --------------------------- }
procedure first(var beg, fin : pnode; d : word; const s : string);
begin
    new(beg);
    beg^.d := d; beg^.s := s;  beg^.p := nil;
    fin := beg;
end;
{ --------------------- добавление элемента в конец --------------------------- }
procedure add(var fin : pnode; d : word; const s : string);
var p : pnode;
begin
    new(p);
    p^.d := d; p^.s := s;  p^.p := nil;
    fin^.p := p;
    fin := p;
end;
{ ---------------------- выборка элемента из начала --------------------------- }
procedure get(var beg : pnode; var d : word; var s : string);
var p : pnode;
begin
    d := beg^.d; s := beg^.s;
    p := beg; beg := beg^.p; 
    dispose(p);
end;
{ ------------------------------- главная программа --------------------------- }
begin
    { занесение в очередь: }
    first(beg, fin, 1, text[1]); 
    for i := 2 to 5 do add(fin, i, text[i]);
    { выборка из очереди: }
    while beg <> nil do begin
        get(beg, i, s);
        writeln(i:2, s);
    end;
end.

program linked_list;
const n = 5;
type pnode = ^node;
     node = record                                             { элемент списка }
         d : word; 
         s : string;
         p : pnode;
     end;
var beg    : pnode;                                { указатель на начало списка }
    i, key : word;
    s      : string;
    option : word;
const text: array [1 .. n] of string = ('one', 'two', 'three', 'four', 'five');
{ -------------- добавление элемента в конец списка --------------------------- }
procedure add(var beg : pnode; d : word; const s : string);
var p : pnode;                               { указатель на создаваемый элемент }
    t : pnode;                                 { указатель для просмотра списка }
begin
    new(p);                                                 { создание элемента }
    p^.d := d; p^.s := s;                                 { заполнение элемента }
    p^.p := nil;
    if beg = nil then beg := p                                { список был пуст }
    else begin                                                 { список не пуст }
        t := beg;
        while t^.p <> nil do                        { проход по списку до конца }
            t := t^.p;            
        t^.p := p;                      { привязка нового элемента к последнему }
    end
end;
{ ------------------------- поиск элемента по ключу --------------------------- }
function find(beg : pnode; key : word; var p, pp : pnode) : boolean;
begin
    p := beg;
    while p <> nil do begin                                                 { 1 }
        if p^.d = key then begin                                            { 2 }
            find := true; exit end;
        pp := p;                                                            { 3 }
        p := p^.p;                                                          { 4 }
    end;
    find := false;
end;

{ -------------------------------- вставка элемента --------------------------- }
procedure insert(beg : pnode; key, d : word; const s : string);
var p    : pnode;                            { указатель на создаваемый элемент }
    pkey : pnode;                                { указатель на искомый элемент }
    pp   : pnode;                             { указатель на предыдущий элемент }
begin
    if not find(beg, key, pkey, pp) then begin
        writeln(' вставка не выполнена'); exit; end;
    new(p);                                                                 { 1 }
    p^.d := d; p^.s := s;                                                   { 2 }
    p^.p := pkey^.p;                                                        { 3 }
    pkey^.p := p;                                                           { 4 }
end;
{ ------------------------------- удаление элемента --------------------------- }
procedure del(var beg : pnode; key : word);
var p  : pnode;         { указатель на удаляемый элемент }
    pp : pnode;         { указатель на предыдущий элемент }
begin
    if not find(beg, key, p, pp) then begin 
        writeln(' удаление не выполнено'); exit; end; 
    if p = beg then beg := beg^.p                   { удаление первого элемента }
    else pp^.p := p^.p;
    dispose(p);
end;
{ ------------------------------------ вывод списка --------------------------- }
procedure print(beg : pnode);
var p : pnode;                                 { указатель для просмотра списка }
begin
    p := beg;
    while p <> nil do begin                                    { цикл по списку }
        writeln(p^.d:3, p^.s);                                 { вывод элемента }
        p := p^.p                        { переход к следующему элементу списка }
    end;
end;
{ ------------------------------- главная программа --------------------------- }
begin
    for i := 1 to 5 do add(beg, i, text[i]);
    while true do begin 
        writeln('1 - вставка, 2 - удаление, 3 - вывод, 4 - выход');
        readln(option);
        case option of
            1: begin                                                  { вставка }
                writeln('Ключ для вставки?');
                readln(key);
                writeln('Вставляемый элемент?');
                readln(i); readln(s);
                insert(beg, key, i, s);
            end;
            2: begin                                                 { удаление }
                writeln('Ключ для удаления?');   
                readln(key);
                del(beg, key);
            end;
            3: begin                                                    { вывод }
                writeln('Вывод списка:');
                print(beg);
            end;
            4: exit;                                                    { выход }
        end
        writeln;
    end
end.

Функция поиска элемента find возвращает true, если искомый элемент найден, и false в противном случае. Поскольку одного факта отыскания элемента недостаточно, функция также возвращает через список параметров два указателя: на найденный элемент p и на предшествующий ему pp. Последний требуется при удалении элемента из списка, поскольку при этом необходимо связывать предыдущий и последующий по отношению к удаляемому элементы.

Сначала указатель p устанавливается на начало списка, и организуется цикл просмотра списка (оператор 1). Если поле данных очередного элемента совпало с заданным ключом (оператор 2), формируется признак успешного поиска и функция завершается. В противном случае перед переносом указателя на следующий элемент списка (он хранится в поле p текущего элемента, оператор 4) его значение запоминается в переменной pp (оператор 3) для того, чтобы при следующем проходе цикла в ней находился указатель на предыдущий элемент.

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

Вставка элемента выполняется после элемента с заданным ключом (процедура insert ). Если с помощью функции find место вставки определить не удалось, выводится сообщение и процедура завершается (в этом случае можно было использовать и другой алгоритм — добавлять элемент к концу списка, это определяется конкретным предназначением программы). Если элемент найден, указатель на него заносится в переменную pkey.

Под новый элемент выделяется место в динамической памяти (оператор 1), и информационные поля элемента заполняются переданными в процедуру значениями (оператор 2). Новый элемент ).

(рис 5.4) Вставка элемента в список

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

program bintree;
uses crt;
type pnode = ^node;
     node = record
         data  : word;        { ключ }
         left  : pnode;       { указатель на левое поддерево }
         right : pnode        { указатель на правое поддерево }
     end;
var root   : pnode;
    key    : word;
    option : word;
{ ------------------------------------ вывод дерева --------------------------- }
procedure print_tree(p : pnode; level : integer);
var i : integer;
begin
    if p = nil then exit;
    with p^ do begin
        print_tree(right, level + 1);
        for i := 1 to level do write('     ');
        writeln(data);
        print_tree(left, level + 1);
    end
end;
{ ------------------------------- поиск по дереву – см. рис. 5.5----------- }
function find(root : pnode; key : word; var p, parent : pnode) : boolean;
{ ---------------------------- включение в дерево ----------------------------- }
procedure insert(var root : pnode; key : word);
var p, parent : pnode;
begin
    if find(root, key, p, parent) then begin
        writeln(' такой элемент уже есть'); exit; end;
    new(p);                                          { создание нового элемента }
    p^.data  := key;
    p^.left  := nil;
    p^.right := nil;
    if root = nil then root := p                               { первый элемент }
    else                                { присоединение нового элемента к дереву}
        if key < parent^.data
            then parent^.left  := p
            else parent^.right := p;
end;
{ ------------------------------ удаление из дерева - см. учебник     --------- }
procedure del(var root : pnode; key : word); 
{ ------------------------------- главная программа --------------------------- }
begin
    root := nil;
    while true do begin
        writeln('1 - вставка, 2 - удаление, 3 - вывод, 4 - выход');
        readln(option);
        case option of
            1: begin                                                  { вставка }
                    writeln('Введите ключ для вставки: '); readln(key);
                    insert(root, key);
                end;
            2: begin                                                 { удаление }
                    writeln('Введите ключ для удаления: '); readln(key);
                    del(root, key);
                end;
            3: begin                                                    { вывод }
                    clrscr;
                    if root = nil then writeln ('дерево пустое')
                    else print_tree(root, 0);
                end;
            4: exit;                                                    { выход }
        end;
        writeln;
    end
end.