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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
| program Project1;
type
//Тип основных данных.
TData = Integer;
//Указатель на элемент стека.
TPElem = ^TElem;
//Элемент стека.
TElem = record
Data : TData; //Основные данные.
PNext : TPElem; //Указатель на следующий элемент.
end;
//Для самого стека отдельный тип можно не создавать. Стек будет представлен в виде
//указателя на элемент, расположенный на вершине стека. Поэтому, переменная,
//представляющая стек, будет иметь тип TPElem.
//Добавление элемента на вершину стека.
procedure Push(var aPStack : TPElem; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := aPStack;
aPStack := PElem;
end;
//Изъятие элемента с вершины стека.
//Если стек не пуст, то с вершины стека изымается элемент и его значение
//(основные данные) возвращается через параметр aData. В этом случае, функция
//возвращает значение True. Если стек пуст, то операция отменяется, а функция
//возвращает значение False.
function Pop(var aPStack : TPElem; var aData : TData) : Boolean;
var
PElem : TPElem;
begin
Pop := False;
if aPStack = nil then Exit;
PElem := aPStack;
aPStack := PElem^.PNext;
aData := PElem^.Data;
Dispose(PElem);
Pop := True;
end;
//Освобождение памяти, занятой стеком (очистка стека).
procedure StackFree(var aPStack : TPElem);
var
Data : TData;
begin
while Pop(aPStack, Data) do;
end;
//Распечатка элементов стека в направлении вершина - дно.
procedure Print(var aPStack : TPElem);
var
PSt : TPElem;
Data : TData;
i : Integer;
begin
//Начальная инициализация вспомогательного стека.
PSt := nil;
//Переливаем элементы из стека aPStack в стек PSt.
i := 0;
while Pop(aPStack, Data) do begin
Push(PSt, Data);
Inc(i);
if i > 1 then Write(', ');
Write(Data);
end;
Writeln;
//Возвращаем элементы из стека PSt в aPStack.
while Pop(PSt, Data) do Push(aPStack, Data);
end;
//Удаление из стека элементов с заданным значением.
//Функция возвращает количество удалённых элементов.
function Del(var aPStack : TPElem; const aData : TData) : Integer;
var
PSt : TPElem;
Data : TData;
Cnt : Integer;
begin
Del := 0;
if aPStack = nil then Exit;
//Начальная инициализация вспомогательного стека.
PSt := nil;
//Переливаем из стека aPStack в стек PSt элементы, значение которых
//отличается от aData.
Cnt := 0;
while Pop(aPStack, Data) do
if Data <> aData then
Push(PSt, Data)
else
Inc(Cnt);
//Возвращаем элементы из стека PSt в aPStack.
while Pop(PSt, Data) do Push(aPStack, Data);
Del := Cnt;
end;
//Диалог добавления элементов в стек.
procedure WorkAdd(var aPStack : TPElem);
var
S : String;
Data : TData;
Code : Integer;
begin
Writeln('Добавление элементов в стек.');
Writeln('Ввод каждого значения завершайте нажатием Enter.');
Writeln('Чтобы прекратить ввод оставьте пустую строку и нажмите Enter.');
repeat
Write('Значение: ');
Readln(S);
if S = '' then begin
Writeln('Ввод элемента отменён.');
Code := 0;
end else begin
Val(S, Data, Code);
if Code = 0 then begin
Push(aPStack, Data);
Writeln('Элемент добавлен.');
Code := 1;
end else
Writeln('Неверный ввод. Повторите.');
end;
until Code = 0;
Writeln('Ввод элементов стека завершён.');
end;
var
PSt : TPElem;
Data : TData;
Cmd, Code, Cnt : Integer;
S : String;
begin
//Начальная инициализация стека.
PSt := nil;
repeat
//Меню
Writeln('Выберите действие:');
Writeln('1: Добавление элементов в стек.');
Writeln('2: Распечатка стека.');
Writeln('3: Проверка стека на пустоту.');
Writeln('4: Удаление элементов по условию.');
Writeln('5: Удаление стека (очистка).');
Writeln('6: Выход.');
Write('Введите команду: ');
Readln(Cmd);
case Cmd of
1: WorkAdd(PSt);
2:
if PSt = nil then
Writeln('Стек пуст.')
else begin
Writeln('Содержимое стека (вершина - дно):');
Print(PSt);
end;
3:
if PSt = nil then
Writeln('Стек пуст.')
else
Writeln('Стек не пуст.');
4:
begin
Writeln('Элементы с заданным значением будут удалены из стека.');
repeat
Write('Задайте значение: ');
Readln(S);
Val(S, Data, Code);
if Code <> 0 then
Writeln('Неверный ввод. Повторите.');
until Code = 0;
Writeln('Удалить элементы с заданным значением? д/н, y/n: ');
Readln(S);
if (S <> '') and (S[1] in ['Д', 'д', 'Y', 'y']) then begin
Cnt := Del(PSt, Data);
Writeln('Стек обработан. Количество удалённых элементов: ', Cnt);
end else
Writeln('Операция отменена.');
end;
5, 6:
begin
StackFree(PSt);
Writeln('Стек удалён из памяти (очищен).');
end;
else
Writeln('Незарегистрированная команда. Повторите ввод.');
end;
until Cmd = 6;
Writeln('Работа программы завершена. Для выхода нажмите Enter.');
Readln;
end. |
(
Сообщение было отмечено как решение
Сообщение от KathrineY
