контрольная работа №2 часть 2

program lr2_2;
type
//Тип основных данных.
TData = Integer;

//Указатель на элемент стека.
TPElem = ^TElem;
//Элемент стека.
TElem = record
Data : TData;
PNext : TPElem;
end;

//Добавление элемента на вершину стека.
procedure StackPush(var aPStack, aPElem : TPElem);
begin
if aPElem = nil then Exit;
aPElem^.PNext := aPStack;
aPStack := aPElem
end;

//Изъятие элемента с вершины стека.
//Если стек не пуст, то с вершины стека изымается элемент и возвращается
//через параметр aPElem. В этом случае, функция возвращает значение True.
//Если стек пуст, то операция отменяется, а функция возвращает значение False.
function StackPop(var aPStack, aPElem : TPElem) : Boolean;
begin
Result := False;
if aPStack = nil then Exit;
aPElem := aPStack;
aPStack := aPElem^.PNext;
Result := True;
end;

//Удаление стека из памяти (очистка стека).
procedure StackFree(var aPStack : TPElem);
var
PElem : TPElem;
begin
while StackPop(aPStack, PElem) do Dispose(PElem);
end;

//Распечатка стека.
procedure StackPrint(var aPStack : TPElem);
var
PSt, PElem : TPElem;
i : Integer;
begin
if aPStack = nil then begin
Writeln('Стек пуст.');
Exit;
end;
//Начальная инициализация вспомогательного стека.
PSt := nil;
//Переливаем все элементы стека aPStack в стек PSt и выполняем распечатку.
i := 0;
while StackPop(aPStack, PElem) do begin
StackPush(PSt, PElem);
Inc(i);
if i > 1 then Write(', ');
Write(PElem^.Data);
end;
Writeln;
//Возвращаем элементы из стека PSt в стек aPStack. При этом, элементы
//в стеке aPStack окажутся в том же порядке, в каком они были до распечатки.
while StackPop(PSt, PElem) do StackPush(aPStack, PElem);
end;

const
//Количество элементов, с которым мы будем работать.
M = 10;
var
PSt1, PSt2,PStemp, PElem : TPElem;
i : Integer;
S : String;
begin

//Начальная инициализация стеков.
PSt1 := nil;
PSt2 := nil;

repeat
//Формируем содержимое стека.
Randomize;
for i := 1 to M do begin
New(PElem);
PElem^.Data := Random(10); //0..9.
StackPush(PSt1, PElem);
end;

//Распечатка стеков.
Writeln('Первый стек:');
StackPrint(PSt1);


//Переливаем все элементы стека PSt1 в стек PStemp.
while StackPop(PSt1, PElem) do begin if (PElem^.Data)mod 2=0
then StackPush(PStemp, PElem) else Dispose(PElem) ; end;
//Переливаем все элементы стека PStemp в стек PSt2.
while StackPop(PStemp, PElem) do StackPush(PSt2, PElem) ;

//Распечатка стеков.

Writeln('Второй стек:');
StackPrint(PSt2);

//Удаление стеков из памяти.
StackFree(PSt1);
StackFree(PSt2);
Writeln('Работа завершена. Стеки удалёны из памяти.');

Writeln('Повторить - Enter. Выход - любой символ + Enter.');
Readln(S);
until S <> '';
end.