program Project1 type Тип основных данных TData Integer Указатель на э

  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
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
program Project1;
type
{Тип основных данных.}
TData = Integer;
{Указатель на элемент списка.}
TPElem = ^TElem;
{Элемент списка.}
TElem = record
Data : TData; {Основные данные.}
PNext : TPElem; {Указатель на следующий элемент.}
end;
{Список.}
TDList = record
PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
end;
TListVisitor = procedure (Node: TPElem);
{Процедура инициализации списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка. Иначе, произойдёт утечка памяти.}
procedure Create(var aL : TDList; const N:integer);
var
PElem: TPElem;
I:integer;
begin
aL.PFirst := nil;
aL.PLast := nil;
for I := 1 to N do
begin
New(PElem);
PElem^.Data := random (100);
PElem^.PNext := nil;
{Если список пуст, то новый элемент становится единственным элементом списка.}
if aL.PFirst = nil then
aL.PFirst := PElem
{Если список непустой, то новый элемент прикрепляем за последним элементом списка.}
else
aL.PLast^.PNext := PElem;
aL.PLast := PElem;
end;
end;
procedure Add2(Node: TPElem);
begin
Node.Data:=Node.Data+2;
end;
procedure Traverse (Head: TDList; Visitor: TListVisitor);
var
PElem: TPElem;
begin
PElem:=Head.PFirst;
while PElem<>nil do
begin
Add2(PElem);
PElem:=PElem^.PNext;
end;
end;
{Добавление элемента в конец списка.}
procedure Insert(var aL : TDList; const aData : TData);
var
PElem : TPElem;
begin
New(PElem);
PElem^.Data := aData;
PElem^.PNext := aL.PFirst;
aL.PFirst := PElem;
end;
{Освобождение памяти, занятой под список.}
procedure Kill(var aL : TDList);
var
PElem, PDel : TPElem;
begin
PElem := aL.PFirst; {Указатель на первый элемент списка.}
while PElem <> nil do
begin
PDel := PElem; {Указатель на удаляемый элемент.}
PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
Dispose(PDel); {Освобождение памяти, занятой под удаляемый элемент.}
end;
Create(aL,0);
end;
{Распечатка всего списка.}
procedure LWriteln(var aL : TDList);
var
PElem : TPElem;
begin
PElem := aL.PFirst; {Указатель на первый элемент списка.}
if PElem = nil then
Write('Список пуст.')
else
while PElem <> nil do
begin
if PElem <> aL.PFirst then
Write(', ');
Write(PElem^.Data);
PElem := PElem^.PNext; {Указатель на следующий элемент списка.}
end;
Writeln;
end;
{Удаление из списка элементов с заданным значением.}
function Remove(var aL : TDList; const aData : TData) : Integer;
var
PElem, PPrev, PDel : TPElem;
Cnt : Integer;
begin
Cnt := 0; {Счётчик удалённых элементов.}
PPrev := nil; {Указатель на предыдущий элемент.}
PElem := aL.PFirst; {Указатель на текущий элемент.}
while PElem <> nil do
if PElem^.Data = aData then {Если обнаружен элемент, который требуется удалить.}
begin
{Если удаляемый элемент является первым элементом списка, то первым
элементом списка назначаем следующий элемент.}
if PElem = aL.PFirst then
aL.PFirst := PElem^.PNext
{Если удаляемый элемент не является первым элементом списка, то поле
PNext предыдущего элемента теперь должно указывать на элемент, который
является следующим относительно PElem.}
else
PPrev^.PNext := PElem^.PNext;
{Если удаляемый элемент является последним элементом списка, то последним
элементом списка назначаем предыдущий элемент.}
if PElem = aL.PLast then
aL.PLast := PPrev;
PDel := PElem; {Указатель на удаляемый элемент.}
PElem := PElem^.PNext; {Указатель на следующий элемент.}
Dispose(PDel);{Освобождение памяти, занятой под элемент.}
Inc(Cnt); {Подсчитываем удалённый элемент.}
end
else {Переход к следующему элементу списка.}
begin
PPrev := PElem;
PElem := PElem^.PNext;
end;
Remove := Cnt; {Количество удалённых элементов.}
end;
function Search(var aL : TDList; const aData : TData ):integer;
var
PElem: TPElem;
position:integer;
begin
position:=1;
PElem:=aL.PFirst;
while PElem<>nil do
begin
if PElem.Data = aData then
begin
Search:=position;
Exit();
end
else
position:=position+1;
PElem:=PElem^.PNext;
end;
Search:=0;
end;
function Length(var aL : TDList):integer;
var
PElem: TPElem;
L:integer;
begin
L:=0;
PElem:=aL.PFirst;
while PElem<>nil do
begin
L:=L+1;
PElem:=Pelem^.PNext;
end;
Length:=L;
end;
var
L : TDList;
Data : TData;
Cmd, Code, Cnt,N : Integer;
S : String;
begin
repeat
{Меню.}
Writeln('Выберите действие:');
Writeln('1: Создать список');
Writeln('2: Распечатка всего списка.');
Writeln('3: Проверка списка на пустоту.');
Writeln('4: Удаление элементов по условию.');
Writeln('5: Очистка списка.');
Writeln('6: Последовательный поиск.');
Writeln('7: Длина списка.');
Writeln('8: Добавление элемента в начало списка');
Writeln('9: Traverse');
Writeln('10: Выход.');
Write('Задайте команду: ');
Readln(Cmd);
case Cmd of
1:
begin
writeln('Введите количество элементов');
readln(N);
Create(L,N);
end;
2:
begin
Writeln('Содержимое списка:');
LWriteln(L);
end;
3:
if L.PFirst = nil then
Writeln('Список пуст.')
else
Writeln('Список непустой.');
4:
begin
Writeln('Элементы с заданным значением будут удалены из списка.');
Writeln('Чтобы отменить операцию оставьте пустую строку и нажмите Enter.');
repeat
Write('Значение: ');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Cnt := Remove(L, Data);
Writeln('Количество удалённых элементов: ', Cnt);
end
else
Writeln('Неверный ввод. Повторите.');
end;
until S = '';
Writeln('Диалог удаления завершён.')
end;
5, 10:
begin
Kill(L);
Writeln('Список удалён из памяти (очищен).');
if Cmd = 7 then
Writeln('Работа программы завершена.');
end;
6:
begin
Writeln('Последовательныц поиск. Введите элемент для поиска.');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Cnt := Search(L, Data);
Writeln('Позиция элемента(0-элемент не найден): ', Cnt);
end
else
Writeln('Неверный ввод. Повторите.');
end;
end;
7:
begin
Cnt := Length(L);
Writeln('Количество элементов списка: ', Cnt);;
end;
8:
begin
Writeln('Добавление элемента в список. Введите данные.');
Readln(S);
if S <> '' then
begin
Val(S, Data, Code);
if Code = 0 then
begin
Insert(L,Data);
end
else
Writeln('Неверный ввод. Повторите.');
end;
end;
9:
begin
Writeln('Traverse');
Traverse(L,Add2);
end;
else
Writeln('Незарегистрированная команда. Повторите ввод.');
end;
Writeln('Для продолжения нажмите Enter.');
Readln;
until Cmd = 10;
end.