Форум программистов, компьютерный форум, киберфорум
Наши страницы
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.70/842: Рейтинг темы: голосов - 842, средняя оценка - 4.70
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
1

Динамические структуры данных (списки, очереди, стеки, деревья)

21.12.2009, 04:41. Просмотров 152453. Ответов 8

Решил я начать писать мини FAQ по моим любимым Динамическим структурам данных.
Все программы я пишу на Turbo Pascal 7.0 версии, не проверяю их работоспособности на разновидностях компиляторов под Pascal, прошу принять это во внимание.

И начну я своё повествование со стеков.
И так, что же такое стек?
Стек (англ. stack — стопка) — структура данных с методом доступа к элементам LIFO (англ. Last In — First Out, «последним пришел — первым вышел»). Чаще всего принцип работы стека сравнивают со стопкой тарелок: чтобы взять вторую сверху, нужно взять верхнюю.
просвещаемся на википедии
По своей сути это структура, где мы не можем обратиться к элементу стоящему "ниже" вершины, если мы не "сняли" вершину. Но я решил писать программу так, как будто у нас "видно" весь стек и мы можем просматривать любой элемент в любое время (если будет не понятен этот момент, пишите в теме, я расскажу подробнее что поменяется тогда).
Я тут набросал программу, демонстрирующую работу со стеком, опишу процедуры и функции для ясности:
1) procedure AddElem(var stek1:List;znach1:TInf) - процедура добавление элемента в стек.
2) procedure Print(stek1:List) - вывод стека.
3) Procedure FreeStek(stek1:List) - освобождение памяти использованного под стек.
4) Function SearchElemZnach(stek1:List;znach1:TInf):List - поиск в стеке по значению, функция возвращает адрес найденного элемента.
5) Procedure DelElem(var stek1:List;tmp:List) - процедура удаления из стека элемента с адресом tmp.
6) procedure DelElemZnach(var Stek1:List;znach1:TInf) - удаление из стека элемента со значением znach1.
7) Procedure DelElemPos(var stek1:List;posi:integer) - удаление из стека элемента с порядковым номером posi.
8) procedure SortBublInf(nach:list) - сортировка стека "пузырьком" (самый простой вариант), с обменом данными между элементами.
9) procedure SortBublLink(nach:List)- сортировка стека "пузырьком" (самый простой вариант), с изменением лишь указателей на элементы.

Ну а вот и сам код проекта:
Pascal
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
Program Stek;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе стека}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент}
  end;
 
{Процедура добавляющая элемент в стек}
procedure AddElem(var stek1:List;znach1:TInf);
var
  tmp:List;
begin
  GetMem(tmp,sizeof(TList)); {выделяем в памяти место для нового элемента}
  tmp^.next:=stek1;  {указатель на следующий элемент "направляем" на вершину стека}
  tmp^.data:=znach1; {добавляем к элементу данные}
  stek1:=tmp; {вершина стека изменилась, надо перенести и указатели на неё}
end;
 
{Процедура вывода стека}
procedure Print(stek1:List);
begin
  if stek1=nil then {проверка на пустоту стека}
  begin
    writeln('Стек пуст.');
    exit;
  end;
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1:=stek1^.next  {и переносить указатель вглубь по стеку}
  end;
end;
 
{Процедура освобождения памяти занятой стеком}
Procedure FreeStek(stek1:List);
var
  tmp:List;
begin
  while stek1<>nil do {пока stek1 не станет указывать в "пустоту" делать}
  begin
    tmp:=stek1; {указатель tmp направим на вершину стека}
    stek1:=stek1^.next; {вершину стека перенесём на следующий за данной вершиной элемент}
    FreeMem(tmp,SizeOf(Tlist)); {освободим память занятую под старую вершину}
  end;
end;
 
{Поиск элемента в стеке по значению}
Function SearchElemZnach(stek1:List;znach1:TInf):List;
begin
  if stek1<>nil then {если стек не пуст, то}
    while (Stek1<>nil) and (znach1<>stek1^.data) do {пока stek1 не укажет в "пустоту" или пока мы не нашли нужный нам элемент}
      stek1:=stek1^.next; {переносить указатель}
  SearchElemZnach:=stek1;{функция возвращает указатель на найденный элемент}
end;         {в случае если элемент не найден, она вернёт nil}
 
{Процедура удаления элемента по указателю}
Procedure DelElem(var stek1:List;tmp:List);
var
  tmpi:List;
begin
  if (stek1=nil) or (tmp=nil) then {если стек пуст или указатель никуда не указывает, то выходим}
    exit;
  if tmp=stek1 then {если мы удаляем элемент который является вершиной стека, то}
  begin
    stek1:=tmp^.next;{следует перенести вершину и}
    FreeMem(tmp,SizeOf(TList)); {высвободить память из под элемента}
  end
  else {в случае, если удаляемый элемент не вершина стека, то}
  begin
    tmpi:=stek1; {ставим указатель на вершину стека}
    while tmpi^.next<>tmp do {доходим до элемента стоящего "перед" тем, который нам следует удалить}
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next; {указатель элемента переносим на следующий элемент за удаляемым}
    FreeMem(tmp,sizeof(TList)); {удаляем элемент}
  end;
end;
 
{Процедура удаления элемента по значению}
procedure DelElemZnach(var Stek1:List;znach1:TInf);
var
  tmp:List;
begin
  if Stek1=nil then {Если стек пуст, то выводим сообщение и выходим}
  begin
    Writeln('Стек пуст');
    exit;
  end;
  tmp:=SearchElemZnach(stek1,znach1); {tmp указывает на удаляемый элемент}
  if tmp=nil then {если элемент не был найден, то выводим сообщение и выходим}
  begin
    writeln('Элемент с искомым значением ' ,znach1, ' отсутствует в стеке.');
    exit;
  end;
  DelElem(stek1,tmp); {удаляем элемент из стека }
  Writeln('Элемент удалён.'); {сообщаем о выполнении действия}
end;
 
{Удаление элемента по порядковому номеру (вершина имеет номер 1)}
Procedure DelElemPos(var stek1:List;posi:integer);
var
  i:integer;
  tmp:List;
begin
  if posi<1 then {проверка на ввод информации}
    exit;
  if stek1=nil then {если стек пуст}
  begin
    Write('Стек пуст');
    exit
  end;
  i:=1; {будет считать позиции}
  tmp:=stek1;
  while (tmp<>nil) and (i<>posi) do {пока tmp не укажет в "пустоту" или мы не найдём искомый элемент}
  begin
    tmp:=tmp^.next; {переходим на следующий элемент}
    inc(i)   {увеличиваем значение счётчика}
  end;
  if tmp=nil then {если элемента нет выводим соответствующие сообщения и выходим}
  begin
    Writeln('Элемента с порядковым номером ' ,posi, ' нет в стеке.');
    writeln('В стеке ' ,i-1, ' элемента(ов).');
    exit
  end;
  DelElem(stek1,tmp); {если мы не вышли, то элемент есть и его следует удалить}
  Writeln('Элемент удалён.'); {сообщаем о выполнении действия}
end;
 
{Процедура сортировки "пузырьком" с изменением только данных}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist)); {выделяем память для рабочего "буфера" обмена}
  rab:=nach; {рабочая ссылка, становимся на вершину стека}
  while rab<>nil do {пока мы не дойдём до конца стека делать}
  begin
    tmp:=rab^.next; {перейдём на следующий элемент}
    while tmp<>nil do {пока не конец стека делать}
    begin
      if tmp^.data<rab^.data then {проверяем следует ли менять элементы}
      begin
        tmps:=tmp^.data; {стандартная замена в 3 операции}
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next {переход к следующему элементу}
    end;
    rab:=rab^.next {переход к следующему элементу}
  end
end;
 
{Процедура сортировки "пузырьком" с изменением только адресов}
procedure SortBublLink(nach:List);
var
  tmp,pered,pered1,pocle,rab:List; {все рабочие ссылки}
begin
  rab:=nach; {становимся на вершину стека}
  while rab<>nil do{пока не конец стека делать}
  begin
    tmp:=rab^.next; {переходим к следующему за сортируемым элементу}
    while tmp<>nil do {пока не конец стека делать}
    begin
      if tmp^.data<rab^.data then {если следует произвести замену, то}
      begin
        pered:=nach; {становимся в вершину стека}
        pered1:=nach; {становимся в вершину стека}
        if rab<>nach then {если мы не стоим на изменяемом элементе, то}
          while pered^.next<>rab do pered:=pered^.next; {станем на элементе перед изменяемым}
        while pered1^.next<>tmp do pered1:=pered1^.next; {станем на элементе перед изменяемым, который находится за
        первым изменяемым}
        pocle:=tmp^.next; {запоминаем адрес элемента после второго изменяемого}
        if rab^.next=tmp then {если элементы "соседи", то}
        begin
          tmp^.next:=rab; {меняем ссылки, тут если не понятно рисуйте на листочке}
          rab^.next:=pocle
        end
        else {в случае если элементы не соседи, то}
        begin
          tmp^.next:=rab^.next;{меняем ссылки, тут если не понятно рисуйте на листочке}
          rab^.next:=pocle;
        end;
        if pered1<>rab then{советую просмотреть на листочке}
          pered1^.next:=rab;
        if rab<>nach then{советую просмотреть на листочке}
          pered^.next:=tmp
        else{всё советую просмотреть на листочке}
          nach:=tmp;
        pered1:=tmp;{советую просмотреть на листочке}
        tmp:=rab;{советую просмотреть на листочке}
        rab:=pered1;{советую просмотреть на листочке}
      end;
      tmp:=tmp^.next; {переходим на следующий элемент}
    end;
    rab:=rab^.next;{переходим на следующий элемент}
  end;
end;
 
var
  Stk, {переменная, которая всегда будет указывать на "вершину" стека}
  tmpl:List; {рабочая переменная}
  znach:Tinf; {данные вводимые пользователем}
  ch:char; {для работы менюшки}
begin
    Stk:=nil;
    repeat {цикл для нашего меню}
    clrscr; {очистка экрана, далее идёт вывод самого меню}
    Write('Программа для работы со ');
    Textcolor(4);
    Writeln('стеком.');
    Textcolor(7);
    Writeln('Выберите желаемое действие:');
    Writeln('1) Добавить элемент.');
    Writeln('2) Вывод стека.');
    Writeln('3) Удаление элемента по значению.');
    Writeln('4) Удаление элемента по порядковому номеру.');
    Writeln('5) Поиск элемента по значению');
    Writeln('6) Сортировка стека методом "Пузырька", меняя только данные.');
    Writeln('7) Сортировка стека с изменением адресов.');
    Writeln('8) Выход.');
    writeln;
    ch:=readkey; {ожидаем нажатия клавиши}
    case ch of {выбираем клавишу}
      '1':begin
            write('Введите значение добавляемого элемента: ');
            readln(znach); {считываем значение добавляемого нового элемент}
            AddElem(Stk,znach);
          end;
      '2':begin
            clrscr; {очистка экрана}
            Print(Stk); {вызов процедуры вывода}
            readkey; {ожидаем нажатия клавиши}
          end;
      '3':begin
            Write('Введите значение удаляемого элемента: ');
            readln(znach); {ввод значения удаляемого элемента}
            DelElemZnach(Stk,znach); {вызов процедуры удаления элемента по значению}
            readkey;{ожидаем нажатия клавиши}
          end;
      '4':begin
            Write('Введите порядковый номер удаляемого элемента: ');
            readln(znach); {ввод позиции удаляемого файла}
            DelElemPos(Stk,znach);{вызов процедуры удаления элемента по значению}
            readkey;{ожидаем нажатия клавиши}
          end;
      '5':begin
            write('Введите значение искомого элемента: ');
            readln(znach); {ввод искомого значения}
            tmpl:=SearchElemZnach(Stk,znach); {вызываем процедуру поиска элемента по значению}
            if tmpl=nil then {проверяем найден ли элемент и выводим соответствующие сообщения}
              write('Искомый элемент отсутствует в стеке')
            else
              write('Элемент ',tmpl^.data,' найден');
            readkey;{ожидаем нажатия клавиши}
          end;
      '6':begin
            if Stk=nil then {проверяем не пустой ли стек}
            begin
              Write('Стек пуст.');
              readkey{ожидаем нажатия клавиши}
            end
            else
            begin
              SortBublInf(Stk);{вызов процедуры сортировки стека с изменением данных}
              Write('Стек отсортирован.');
              readkey;{ожидаем нажатия клавиши}
            end
          end;
      '7':begin
            if Stk=nil then{проверяем не пустой ли стек}
            begin
              Write('Стек пуст.');
              readkey{ожидаем нажатия клавиши}
            end
            else
            begin
              SortBublLink(Stk);{вызов процедуры сортировки стека с изменением адресов}
              Write('Стек отсортирован.');
              readkey;{ожидаем нажатия клавиши}
            end
          end;
    end;
  until ch='8';
  FreeStek(Stk); {освобождаем память занятую стеком}
end.
В дальнейшем в этой теме будут выложены программы по работе со списками (однонаправленными, двунаправленными (дек), кольцевыми), бинарными деревьями, очередями.

Готов выслушать критику относительно кода, материла и конечно же Ваши пожелания. (Я готов в самой этой теме дать пояснения что такое стек, списки, деревья, с картинками и моими разъяснениями, готов дописывать код, под какие-нибудь интересные задачи по работе с динамическими структурами).Все Ваши просьбы высылайте мне средствами ЛС (Личных Сообщений).

З.Ы. Работа с динамическими массивами рассматриваться не будет, т.к. она идентична работе со статическими массивами, разница лишь в выделении памяти во время работы программы.
З.Ы.Ы. Могу поискать информацию о том, где используются динамические структуры, хотя опять же всё есть в инете, не хочется повторяться.

С нетерпением жду ответов.
 Комментарий модератора 
Исправил кодировки. (Например: "Џа®Ја*¬¬*" -> "Программа").
47
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
21.12.2009, 04:41
Ответы с готовыми решениями:

Динамические структуры данных (списки, очереди, стеки, деревья)
создать программу на языке Паскаль для реализации операций над одной из...

Рaспeчaтaть слова, имeющие мaксимальную длинy (списки\стеки\очереди). Какое решение тут хотят?
Задача: Вроде не сложная, но она по теме списки\стеки\очереди. Как их тут...

Динамические структуры. Списки: Составить программу, которая переворачивает список L
Начали проходить динамические структуры и я ничего не понимаю. Какие-то списки,...

Динамические списки, стеки, очереди
Динамические списки: 1) Написать программу, которая удаляет из списка второй...

Динамические структуры данных. Списки
С клавиатуры вводится последовательность символов. Построить из них список....

8
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
22.12.2009, 03:21  [ТС] 2
Цитата Сообщение от Twic Посмотреть сообщение
а по чему Чере Кейс решил !????????????
В дальнейшем прошу не спрашивать в этой теме вопросы, не относящиеся к теме "Динамически структуры данных". На вопрос отвечу просто, т.к. для данной задачи (построить меню и организовать с ним работу) считаю что структура case подходить лучше всего.


И так, а теперь по делу. Рассмотрим работу со связным списком...
Для начала разберёмся что же это такое:
В информатике, cвя́зный спи́сок — структура данных, состоящая из узлов, каждый из которых содержит как собственные данные, так и одну или две ссылки («связки») на следующее и/или предыдущее поле. Принципиальным преимуществом перед массивом является структурная гибкость: порядок элементов связного списка может не совпадать с порядком расположения элементов данных в памяти компьютера, а порядок обхода списка всегда явно задаётся его внутренними связями.
вообщем читаем вот эти две страницы:
Википедия ссылка 1
Википедия ссылка 2
Это очень удобная структура, при помощи неё можно работать с Хеш таблицами, разряженными матрицами, да в общем то применений можно найти много, я очень уважаю списки, т.к. если правильно организовать с ними работу, то это просто приятно.
Опять же не буду много говорить, если что-то Вам не понятно, то спрашивайте, перейду сразу к программе реализованной мной, для работы со списками, пройдёмся по процедурам:
1) procedure AddElem(var spis1:List;znach1:TInf);
2) procedure Print(spis1:List);
3) Procedure FreeStek(spis1:List);
4) Function SearchElemZnach(spis1:List;znach1:TInf):List;
5) Procedure DelElem(var spis1:List;tmp:List);
6) procedure DelElemZnach(var Spis1:List;znach1:TInf);
7) Procedure DelElemPos(var spis1:List;posi:integer);
8) procedure SortBublInf(nach:list);
9) procedure SortBublLink(nach:List);
Все действия у этих процедур и функций аналогичны тем, которые я описывал для работы со стеком, ведь по сути разница между этими структурами, лишь в методе доступа к ним и добавлении элементов. (в стеке добавляется на вершину, т.е. перед "первым" элементом, а в списке после последнего элемента).
Вот и сам код:
Pascal
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
298
299
300
301
302
303
304
305
306
Program Spisok;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе списка}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент списка}
  end;
 
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var spis1:List;znach1:TInf);
var
  tmp:List;
begin
  if spis1=nil then {Проверяем не пуст ли список, если пуст, то }
  begin
    GetMem(spis1,sizeof(TList));  {создаём его первый элемент}
    tmp:=spis1;
  end
  else {в случае если список не пуст}
  begin
    tmp:=spis1;
    while tmp^.next<>nil do
      tmp:=tmp^.next; {ставим tmp на последний элемент списка}
    GetMem(tmp^.next,sizeof(TList)); {создаём следующий элемент}
    tmp:=tmp^.next;   {переносим tmp на новый элемент}
  end;
  tmp^.next:=nil; {зануляем указатель}
  tmp^.data:=znach1; {заносим значение}
end;
 
{процедура печати списка
полностью расписана при работе со стеком}
procedure Print(spis1:List);
begin
  if spis1=nil then
  begin
    writeln('Список пуст.');
    exit;
  end;
  while spis1<>nil do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next
  end;
end;
 
{процедура удаления списка
 полностью расписана при работе со стеком}
Procedure FreeStek(spis1:List);
var
  tmp:List;
begin
  while spis1<>nil do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
 
{процедура поиска в списке
 полностью расписана при работе со стеком}
Function SearchElemZnach(spis1:List;znach1:TInf):List;
begin
  if spis1<>nil then
    while (Spis1<>nil) and (znach1<>spis1^.data) do
      spis1:=spis1^.next;
  SearchElemZnach:=spis1;
end;
 
{процедура удаления элемента
 полностью расписана при работе со стеком}
Procedure DelElem(var spis1:List;tmp:List);
var
  tmpi:List;
begin
  if (spis1=nil) or (tmp=nil) then
    exit;
  if tmp=spis1 then
  begin
    spis1:=tmp^.next;
    FreeMem(tmp,SizeOf(TList));
  end
  else
  begin
    tmpi:=spis1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    FreeMem(tmp,sizeof(TList));
  end;
end;
 
{процедура удаления элемента по значению
 полностью расписана при работе со стеком}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
var
  tmp:List;
begin
  if Spis1=nil then
  begin
    Writeln('Список пуст');
    exit;
  end;
  tmp:=SearchElemZnach(spis1,znach1);
  if tmp=nil then
  begin
    writeln('Элемент с искомым значением ' ,znach1, ' отсутствует в списке.');
    exit;
  end;
  DelElem(spis1,tmp);
  Writeln('Элемент удалён.');
end;
 
{процедура удаления элемента по позиции
 полностью расписана при работе со стеком}
Procedure DelElemPos(var spis1:List;posi:integer);
var
  i:integer;
  tmp:List;
begin
  if posi<1 then
    exit;
  if spis1=nil then
  begin
    Write('Список пуст');
    exit
  end;
  i:=1;
  tmp:=spis1;
  while (tmp<>nil) and (i<>posi) do
  begin
    tmp:=tmp^.next;
    inc(i)
  end;
  if tmp=nil then
  begin
    Writeln('Элемента с порядковым номером ' ,posi, ' нет в списке.');
    writeln('В списке всего ' ,i-1, ' элемента(ов).');
    exit
  end;
  DelElem(spis1,tmp);
  Writeln('Элемент удалён.');
end;
 
{Процедура сортировки "пузырьком" с изменением только данных
 полностью расписана при работе со стеком}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.data<rab^.data then
      begin
        tmps:=tmp^.data;
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end
end;
 
{Процедура сортировки "пузырьком" с изменением только адресов
 полностью расписана при работе со стеком}
procedure SortBublLink(nach:List);
var
  tmp,pered,pered1,pocle,rab:List;
begin
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.data<rab^.data then
      begin
        pered:=nach;
        pered1:=nach;
        if rab<>nach then
          while pered^.next<>rab do pered:=pered^.next;
        while pered1^.next<>tmp do pered1:=pered1^.next;
        pocle:=tmp^.next;
        if rab^.next=tmp then
        begin
          tmp^.next:=rab;
          rab^.next:=pocle
        end
        else
        begin
          tmp^.next:=rab^.next;
          rab^.next:=pocle;
        end;
        if pered1<>rab then
          pered1^.next:=rab;
        if rab<>nach then
          pered^.next:=tmp
        else
          nach:=tmp;
        pered1:=tmp;
        tmp:=rab;
        rab:=pered1;
      end;
      tmp:=tmp^.next;
    end;
    rab:=rab^.next;
  end;
end;
 
var
  Spis,tmpl:List;
  znach:integer;
  ch:char;
begin
  Spis:=nil;
  repeat
    clrscr;
    Write('Программа для работы со ');
    TextColor(4);
    Writeln('списком.');
    TextColor(7);
    Writeln('Выберите желаемое действие:');
    Writeln('1) Добавить элемент.');
    Writeln('2) Вывод списка.');
    Writeln('3) Удаление элемента по значению.');
    Writeln('4) Удаление элемента по порядковому номеру.');
    Writeln('5) Поиск элемента по значению.');
    Writeln('6) Сортировка списка методом "Пузырька", меняя только данные.');
    Writeln('7) Сортировка списка с изменением адресов.');
    Writeln('8) Выход.');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin
            write('Введите значение добавляемого элемента: ');
            readln(znach);
            AddElem(Spis,znach);
          end;
      '2':begin
            clrscr;
            Print(Spis);
            readkey;
          end;
      '3':begin
            Write('Введите значение удаляемого элемента: ');
            readln(znach);
            DelElemZnach(Spis,znach);
            readkey;
          end;
      '4':begin
            Write('Введите порядковый номер удаляемого элемента: ');
            readln(znach);
            DelElemPos(Spis,znach);
            readkey;
          end;
      '5':begin
            write('Введите значение искомого элемента: ');
            readln(znach);
            tmpl:=SearchElemZnach(Spis,znach);
            if tmpl=nil then
              write('Искомый элемент отсутствует в списке')
            else
              write('Элемент ',tmpl^.data,' найден');
            readkey;
          end;
      '6':begin
            if Spis=nil then
            begin
              Write('Список пуст.');
              readkey
            end
            else
            begin
              SortBublInf(Spis);
              Write('Список отсортирован.');
              readkey;
            end
          end;
      '7':begin
            if Spis=nil then
            begin
              Write('Список пуст.');
              readkey
            end
            else
            begin
              SortBublLink(Spis);
              Write('Список отсортирован.');
              readkey;
            end
          end;
    end;
  until ch='8';
  FreeStek(Spis);
end.
 Комментарий модератора 
Исправил кодировки. (Например: "Џа®Ја*¬¬*" -> "Программа").
25
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
24.12.2009, 01:54  [ТС] 3
Цитата Сообщение от dean0572 Посмотреть сообщение
в упорядоченный двунаправленный список
В принципе ничего сложного, для начала я расскажу про двунаправленные списки, и если сегодня успею, то напишу процедуру для построения списка "вставками".Это будет отдельная процедура, которая может вызываться вместо той, которая будет описана мною ниже.

Приступим...
Что такое списки мы разобрали выше, материал для изучения не изменился, хотелось бы только оговорить, что следует никогда не забывать "занулять" указатели у элементов - т.к. это очень критично (многие циклы строятся на основе
Pascal
1
2
3
4
while a<>nil do a:=a^.next {где a - указатель на элемент}
{и если, мы удалим последний элемент,например, а не "занулим" указатель с предыдущего, 
то будет очень нехорошо, т.к. мы постараемся обратится к несуществующему элементу 
и можем испортить информацию хранящуюся по данному адресу}
А теперь пройдёмся по процедурам и функция реализованными мной:
1) procedure AddElem(var nach,ends:List;znach1:TInf);
2) procedure Print(spis1:List);
3) Procedure FreeStek(spis1:List);
4) Function SearchElemZnach(spis1:List;znach1:TInf):List;
5) Procedure DelElem(var spis1,spis2:List;tmp:List);
6) procedure DelElemZnach(var Spis1,spis2:List;znach1:TInf);
7) Procedure DelElemPos(var spis1,spis2:List;posi:integer);
8) procedure SortBublInf(nach:list);
9) procedure SortBublLink(var nach,ends:List);
10) Procedure Swap(var nach,ends:List;a,b,c:integer); - Берёт часть списка и вставляет в нужную позиицию
11) procedure AddElemVst(var nach,ends:List;znach1:TInf); - Процедура добавления нового элемента в двунаправленный список методом "вставок"

Все процедуры и функции выполняют те же роли что и в предыдущих сообщениях, их описание есть в первом сообщении темы.
Ну и непосредственно сам код:

Pascal
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
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
Program Spisok_dn;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе списка}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next,    {указатель на следующий элемент списка}
    prev:List;   {указатель на предыдущий элемент списка}
  end;
 
{Процедура добавления нового элемента в двунаправленный список}
procedure AddElem(var nach,ends:List;znach1:TInf);
begin
  if nach=nil then {не пуст ли список, если пуст, то}
  begin
    Getmem(nach,SizeOf(TList)); {создаём элемент, указатель nach уже будет иметь адрес}
    nach^.next:=nil; {никогда не забываем "занулять" указатели}
    nach^.prev:=nil; {аналогично}
    ends:=nach; {изменяем указатель конца списка}
  end
  else {если список не пуст}
  begin
    GetMem(ends^.next,SizeOf(Tlist)); {создаём новый элемент}
    ends^.next^.prev:=ends; {связь нового элемента с последним элементом списка}
    ends:=ends^.next;{конец списка изменился и мы указатель "переставляем"}
    ends^.next:=nil; {не забываем "занулять" указатели}
  end;
  ends^.data:=znach1; {заносим данные}
end;
 
procedure AddElemVst(var nach:List; var ends:List;znach1:TInf);
var
  tmp,tmpL:List;
  flag:boolean;
begin
  if nach=nil then {не пуст ли список, если пуст, то}
  begin
    Getmem(nach,SizeOf(TList)); {создаём элемент, указатель nach уже будет иметь адрес}
    nach^.next:=nil; {никогда не забываем "занулять" указатели}
    nach^.prev:=nil; {аналогично}
    ends:=nach; {изменяем указатель конца списка}
    tmp:=nach;
  end
  else {если список не пуст}
  begin
    tmpl:=nach;
    flag:=true;
    while tmpl^.data<znach1 do
    begin
      tmpl:=tmpl^.next;
      if tmpl=nil then
        break;
    end;
    if tmpl<>nil then
    begin
      tmpl:=tmpl^.prev;
      if tmpl=nach then
        flag:=false;
      if tmpl=nil then
        tmpl:=nach;
    end
    else
    begin
      tmpl:=ends;
      flag:=false
    end;
    GetMem(tmp,SizeOf(TList));
    if ends=nach then
      if ends^.data<znach1 then
      begin
        ends^.next:=tmp;
        tmp^.prev:=ends;
        tmp^.next:=nil;
        ends:=tmp;
      end
      else
      begin
        nach^.prev:=tmp;
        tmp^.prev:=nil;
        tmp^.next:=nach;
        nach:=tmp;
      end
    else
    if (tmpl=nach) and (flag) then
    begin
      nach^.prev:=tmp;
      tmp^.prev:=nil;
      tmp^.next:=nach;
      nach:=tmp;
    end
    else
      if (tmpl=nach) and not(flag) then
      begin
        tmp^.next:=nach^.next;
        nach^.next^.prev:=tmp;
        tmp^.prev:=nach;
        nach^.next:=tmp;
      end
      else
      if (tmpL=ends) and not (flag) then
      begin
        ends^.next:=tmp;
        tmp^.prev:=ends;
        tmp^.next:=nil;
        ends:=tmp;
      end
      else
      begin
        tmp^.next:=tmpl^.next;
        tmpl^.next^.prev:=tmp;
        tmp^.prev:=tmpl;
        tmpl^.next:=tmp;
      end;
  end;
  tmp^.data:=znach1; {заносим данные}
end;
 
{процедура печати списка
полностью расписана при работе со стеком}
procedure Print(spis1:List);
begin
  if spis1=nil then
  begin
    writeln('Список пуст.');
    exit;
  end;
  while spis1<>nil do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next
  end;
end;
 
{процедура удаления списка
 полностью расписана при работе со стеком}
Procedure FreeStek(spis1:List);
var
  tmp:List;
begin
  while spis1<>nil do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
 
{Функция поиска в списке
 полностью расписана при работе со стеком}
Function SearchElemZnach(spis1:List;znach1:TInf):List;
begin
  if spis1<>nil then
    while (Spis1<>nil) and (znach1<>spis1^.data) do
      spis1:=spis1^.next;
  SearchElemZnach:=spis1;
end;
 
{процедура удаления элемента в двунаправленном списке}
Procedure DelElem(var spis1,spis2:List;tmp:List);
var
  tmpi:List;
begin
  if (spis1=nil) or (tmp=nil) then
    exit;
  if tmp=spis1 then {если удаляемый элемент первый в списке, то}
  begin
    spis1:=tmp^.next; {указатель на первый элемент переставляем на следующий элемент списка}
    if spis1<>nil then {если список оказался не из одного элемента, то}
      spis1^.prev:=nil {"зануляем" указатель}
    else {в случае, если элемент был один, то}
      spis2:=nil; {"зануляем" указатель конца списка, а указатель начала уже "занулён"}
    FreeMem(tmp,SizeOf(TList));
  end
  else
    if tmp=spis2 then {если удаляемый элемент оказался последним элементом списка}
    begin
      spis2:=spis2^.prev; {указатель конца списка переставляем на предыдущий элемент}
      if spis2<>nil then {если предыдущий элемент существует,то}
        spis2^.next:=nil {"зануляем" указатель}
      else {в случае, если элемент был один в списке, то}
        spis1:=nil; {"зануляем" указатель на начало списка}
      FreeMem(tmp,SizeOf(TList));
    end
    else {если же удаляется список не из начали и не из конца, то}
    begin
      tmpi:=spis1;
      while tmpi^.next<>tmp do {ставим указатель tmpi на элемент перед удаляемым}
        tmpi:=tmpi^.next;
      tmpi^.next:=tmp^.next; {меняем связи}
      if tmp^.next<>nil then
        tmp^.next^.prev:=tmpi; {у элемента до удаляемого и после него}
      FreeMem(tmp,sizeof(TList));
    end;
end;
 
{процедура удаления элемента по значению
 полностью расписана при работе со стеком}
procedure DelElemZnach(var Spis1,spis2:List;znach1:TInf);
var
  tmp:List;
begin
  if Spis1=nil then
  begin
    Writeln('Список пуст');
    exit;
  end;
  tmp:=SearchElemZnach(spis1,znach1);
  if tmp=nil then
  begin
    writeln('Элемент с искомым значением ' ,znach1, ' отсутствует в списке.');
    exit;
  end;
  DelElem(spis1,spis2,tmp);
  Writeln('Элемент удалён.');
end;
 
{процедура удаления элемента по позиции
 полностью расписана при работе со стеком}
Procedure DelElemPos(var spis1,spis2:List;posi:integer);
var
  i:integer;
  tmp:List;
begin
  if posi<1 then
    exit;
  if spis1=nil then
  begin
    Write('Список пуст');
    exit
  end;
  i:=1;
  tmp:=spis1;
  while (tmp<>nil) and (i<>posi) do
  begin
    tmp:=tmp^.next;
    inc(i)
  end;
  if tmp=nil then
  begin
    Writeln('Элемента с порядковым номером ' ,posi, ' нет в списке.');
    writeln('В списке всего ' ,i-1, ' элементов.');
    exit
  end;
  DelElem(spis1,spis2,tmp);
  Writeln('Элемент удалён.');
end;
 
{Процедура сортировки "пузырьком" с изменением только данных
 полностью расписана при работе со стеком}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist));
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.data<rab^.data then
      begin
        tmps:=tmp^.data;
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end
end;
 
{Процедура сортировки "пузырьком" с изменением только адресов}
{Чтобы разобраться как она работает Вам точно понадобится листок
 с рисунком списка и связями между элементами. Внимательно следите
 за тем, что происходит в процедуре, описывать всё я не вижу смысла}
procedure SortBublLink(var nach,ends:List);
var
  tmp,pocle1,rab:List;
begin
  rab:=nach;
  while rab<>nil do
  begin
    tmp:=rab^.next;
    while tmp<>nil do
    begin
      if tmp^.data<rab^.data then
      begin
        pocle1:=tmp^.next;
        if rab^.next=tmp then
        begin
          if tmp^.next<>nil then
            tmp^.next^.prev:=rab;
          tmp^.next:=rab;
          tmp^.prev:=rab^.prev;
          if tmp^.prev<>nil then
            tmp^.prev^.next:=tmp;
          rab^.prev:=tmp;
          rab^.next:=pocle1;
        end
        else
        begin
          if rab^.prev<>nil then
            rab^.prev^.next:=tmp;
          tmp^.prev^.next:=rab;
          if tmp^.next<>nil then
            tmp^.next^.prev:=rab;
          rab^.next^.prev:=tmp;
          tmp^.next:=rab^.next;
          rab^.next:=pocle1;
          pocle1:=rab^.prev;
          rab^.prev:=tmp^.prev;
          tmp^.prev:=pocle1;
        end;
        if rab=nach then
        begin
          nach:=tmp;
          nach^.prev:=nil;
        end;
        if tmp=ends then
        begin
          ends:=rab;
          ends^.next:=nil
        end;
        pocle1:=rab;
        rab:=tmp;
        tmp:=pocle1;
      end;
      tmp:=tmp^.next;
    end;
    rab:=rab^.next;
  end;
end;
 
{процедура берёт часть списка и вставляет в нужную позицию списка}
Procedure Swap(var nach,ends:List;a,b,c:integer); {а-начало части, b-конец части, с-позиция}
var
  i:integer;
  yk,yk1,yk2,rab:List;
begin
  rab:=nach;
  i:=0;
  while rab<>nil do {цикл определяет количество элементов}
  begin
    inc(i);
    rab:=rab^.next
  end;
 {проверка на "нормальность" введённых данных}
  if (i+1<a) or (i+1<b) or (i+1<c) or ((c>=a) and (c<=b)) then
    exit;
  if a>b then {если "ошибочно" спутаны начало и конец части, то}
  begin
    a:=a xor b; {произведём замену переменных, т.е.}
    b:=b xor a; {значение из a поместим в b}
    a:=b xor a; {из b поместим в a}
  end;
  yk:=nach;
  for i:=1 to a-1 do
    yk:=yk^.next; {ставим указатель на нужный нам элемент}
  yk1:=nach;
  for i:=1 to b-1 do
    yk1:=yk1^.next;{ставим указатель на нужный нам элемент}
  yk2:=nach;
  for i:=1 to c-1 do
    yk2:=yk2^.next;{ставим указатель на нужный нам элемент}
  if yk=nach then {проверяем следует ли нам изменить начало списка}
  begin
   nach:=yk1^.next; {изменяем начало}
   nach^.prev:=nil; {"зануляем" указатель}
  end
  else {далее я советую смотреть по листочку}
  begin
    if yk1^.next<>nil then
      yk1^.next^.prev:=yk^.prev
    else
    begin
      ends:=yk^.prev;
      yk^.prev^.next:=nil;
    end;
    yk^.prev^.next:=yk1^.next;
  end;
  if yk2^.next=nil then
  begin
    yk1^.next:=nil;
    ends:=yk1;
  end
  else
  begin
    yk2^.next^.prev:=yk1;
    yk1^.next:=yk2^.next;;
  end;
  yk2^.next:=yk;
  yk^.prev:=yk2;
end;
 
var
  SpisNach, {указатель на начало списка и}
  SpisEnd,   {указатель на конец списка. Эти два указателя }
  tmpl:List; {неотъемлимая часть в двунаправленном списке}
  znach,a,b:integer;
  ch:char;
begin
  SpisNach:=nil;
  SpisEnd:=nil;
  repeat
    clrscr;
    Write('Программа для работы с ');
    TextColor(4);
    Writeln('двунаправленным списком.');
    TextColor(7);
    Writeln('Выберите желаемое действие:');
    Writeln('1) Добавить элемент.');
    Writeln('2) Вывод списка.');
    Writeln('3) Удаление элементов по значению.');
    Writeln('4) Удаление элементов по порядковому номеру.');
    Writeln('5) Поиск элементов по значению.');
    Writeln('6) Сортировка списка методом "Пузырька", меняя только данные.');
    Writeln('7) Сортировка списка с изменением адресов.');
    Writeln('8) Swap список.');
    Writeln('9) Выход.');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin
            write('Введите значение добавляемого элемента: ');
            readln(znach);
            AddElemVst(SpisNach,SpisEnd,znach);
            {AddElem(SpisNach,SpisEnd,znach);}
          end;
      '2':begin
            clrscr;
            Print(SpisNach);
            readkey;
          end;
      '3':begin
            Write('Введите значение удаляемого элемента: ');
            readln(znach);
            DelElemZnach(SpisNach,SpisEnd,znach);
            readkey;
          end;
      '4':begin
            Write('Введите порядковый номер удаляемого элемента: ');
            readln(znach);
            DelElemPos(SpisNach,SpisEnd,znach);
            readkey;
          end;
      '5':begin
            write('Введите значение искомого элемента: ');
            readln(znach);
            tmpl:=SearchElemZnach(SpisNach,znach);
            if tmpl=nil then
              write('Искомый элемент отсутствует в списке.')
            else
            begin
              write('Элемент ');
              TextColor(4);
              Write(tmpl^.data);
              TextColor(7);
              Write(' найден');
            end;
            readkey;
          end;
      '6':begin
            if SpisNach=nil then
            begin
              Write('Список пуст.');
              readkey
            end
            else
            begin
              SortBublInf(SpisNach);
              Write('Список отсортирован.');
              readkey;
            end
          end;
      '7':begin
            if SpisNach=nil then
            begin
              Write('Список пуст.');
              readkey
            end
            else
            begin
              SortBublLink(SpisNach,SpisEnd);
              Write('Список отсортирован.');
              readkey;
            end
          end;
      '8':begin
            Writeln('Список до изменений:');
            print(SpisNach);
            writeln;
            write('Введите начальную позицию: ');
            readln(a);
            Write('Введите конечную позицию: ');
            readln(b);
            write('Введите место куда вставлять: ');
            readln(znach);
            Writeln;
            swap(SpisNach,SpisEnd,a,b,znach);
            writeln;
            Writeln('Список после изменений:');
            print(SpisNach);
            readkey;
          end;
    end;
  until ch='9';
  FreeStek(SpisNach);
end.
Поправил процедуру добавления элементов в список методом вставок.
 Комментарий модератора 
Исправил кодировки. (Например: "Џа®Ја*¬¬* ¤«п а*Ў®вл б" -> "Программа для работы с").
15
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
29.12.2009, 01:28  [ТС] 4
Цитата Сообщение от dean0572
lexus_ilia, можно спросить вопрос по динамическим структурам данных, а именно про очередь, надеюсь она таковой является. Над очередью мы только можем производить операции добавления элемента в конец очереди, и удаления элемента из начала очереди, а просмотреть очередь нельзя получается? А поиск еще можно реализовать в очереди, или тоже не получится, так как
dean0572, вопрос хороший, следует на него ответить.
Пока отойдём от каких-либо структур. Для начала вспомним массивы. Все мы представляем массивы для себя по-разному, чаще всего, если массив одномерный, в виде строки элементов, если двумерный, в виде матрицы, если трёхмерный - в виде куба.
Я уже начинал говорить про этот вопрос:
Цитата Сообщение от lexus_ilia Посмотреть сообщение
Но я решил писать программу так, как будто у нас "видно" весь стек и мы можем просматривать любой элемент в любое время (если будет не понятен этот момент, пишите в теме, я расскажу подробнее что поменяется тогда).
И понимаю что следует раскрыть ответ.

Самое важное для чего Вы используете очередь, если это какая-то банковская программа и очередь у Вас реализована через класс, то конечно же ни в коем случае не следует писать метод (так называются функции и процедуры у классов) который выводил бы нам всю очередь. Так как я пишу программы для ознакомления со структурами, то я отхожу от некоторых принципов и реализую процедуры сортировки (с изменением данных, адресов), вывода данных (Print) - которые немного "искривляют" принципы доступа в той или иной структуре. Но я всегда придерживаюсь концепции структуры, т.е. если я пишу про стек, то элементы добавляются именно так, как это следует делать в стеке, если очередь, то так, как следует это делать для очереди, если бинарные деревья, то так, как это следует делать для них...

Вопрос как бы с подвохом. Когда я раньше ещё сдавал программы по "Динамическим структурам данных" преподавателям, то спрашивал у них, а для чего в задании про стеки написано: "Написать процедуру вывода стека?Ведь это означает, что мне придётся: "Брать элемент начиная с вершины, выводить его значение и удалять" - и так сделать пока не будет виден весь стек!" - на что получал вполне ясный ответ:"Мы изучаем структуры, выполняйте задание.". Т. к. я хочу иметь чистую совесть, то я представляю себе стек, как прозрачную колбу, в которую закидываются элементы и,если мы начнём смотреть через колбу с верхнего элемента, двигаясь вниз, то мы просмотрим все элементы, не вытягивая их из колбы. Очередь я представляю как живую очередь в магазине, ведь "наблюдатель" (указатель) всегда сможет пройтись с самого конца очереди в самое начало заглянув в каждого человека (элемент).

Из всего вышесказанного мной, следует:
- Т.к. программы пишутся исключительно для ознакомления со структурами, то способ доступа к структуре расширяется, т.е. мы оставляем основу (LIFO, FIFO...), но разрешаем и просмотр элементов, обращение к любого элементу с целью его "перестановки" с другим элементом.
15
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
07.01.2010, 19:52  [ТС] 5
Приступим к работе с кольцевыми списками.
И так, прочитав информацию на Википедии из предыдущих сообщений Вы уже имеете представление о том что такое список, почитайте ещё вот эту статейку ссылка на Википедию.
Хотелось бы сказать про небольшую особенность, т.к. у нас последний элемент указывает на первый - это означает, что все бывшие циклы, которые работают до nil, теперь приходится делать пока не встретится первый элемент.

А теперь пройдёмся по процедурам/функциям реализованными мной:
1) procedure AddElem(var nach,ends:List;znach1:TInf);
2) procedure Print(spis1:List);
3) Procedure FreeStek(spis1:List);
4) Function SearchElemZnach(spis1:List;znach1:TInf):List;
5) Procedure DelElem(var spis1,spis2:List;tmp:List);
6) procedure DelElemZnach(var Spis1,spis2:List;znach1:TInf);
7) Procedure DelElemPos(var spis1,spis2:List;posi:integer);
8) procedure SortBublInf(nach:list);

Описания действия выполняемыми процедурами/функциями описаны выше, в предыдущих постах.
Вот и сам код:
Pascal
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
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
Program Spisok_kolco;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе списка}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record  {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;  {указатель на следующий элемент списка}
  end;
 
{Процедура добавления нового элемента в двунаправленный список}
procedure AddElem(var nach:List;znach1:TInf);
var
  tmp,tmp1:List;
begin
  if nach=nil then {не пуст ли список, если пуст, то}
  begin
    Getmem(nach,SizeOf(TList)); {создаём элемент, указатель nach уже будет иметь адрес}
    nach^.next:=nach; {никогда не забываем "занулять" указатели}
    tmp:=nach;
  end
  else {если список не пуст}
  begin
    tmp:=nach;
    while tmp^.next<>nach do
      tmp:=tmp^.next;
    GetMem(tmp1,SizeOf(Tlist));
    tmp1^.next:=nach;
    tmp^.next:=tmp1;
    tmp:=tmp1;
  end;
  tmp^.data:=znach1; {заносим данные}
end;
 
{процедура печати списка
полностью расписана при работе со стеком}
procedure Print(spis1:List);
var
  nach:List;
begin
  if spis1=nil then
  begin
    writeln('Список пуст.');
    exit;
  end;
  nach:=spis1;
  Write(spis1^.data, ' ');
  spis1:=spis1^.next;
  while spis1<>nach do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next;
  end;
end;
 
{процедура удаления списка
 полностью расписана при работе со стеком}
Procedure FreeStek(spis1:List);
var
  tmp,nach:List;
begin
  if spis1=nil then
    exit;
  nach:=spis1;
  tmp:=spis1;
  spis1:=spis1^.next;
  dispose(tmp);
  while spis1<>nach do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
 
{Функция поиска в списке
 полностью расписана при работе со стеком}
Function SearchElemZnach(spis1:List;znach1:TInf):List;
var
  tmp:List;
begin
  tmp:=spis1;
  if spis1<>nil then
    if spis1^.data=znach1 then
      SearchElemZnach:=spis1
    else
    begin
      spis1:=spis1^.next;
      while (Spis1<>tmp) and (znach1<>spis1^.data) do
        spis1:=spis1^.next;
      if spis1=tmp then
        spis1:=nil;
    end;
  SearchElemZnach:=spis1;
end;
 
{процедура удаления элемента в двунаправленном списке}
Procedure DelElem(var spis1:List;tmp:List);
var
  tmpi:List;
begin
  if tmp=spis1 then
  begin
    tmpi:=tmp;
    while tmpi^.next<>spis1 do
      tmpi:=tmpi^.next;
    if tmpi=spis1 then
    begin
      spis1^.next:=nil;
      dispose(spis1);
      spis1:=nil
    end
    else
    begin
      tmpi^.next:=tmp^.next;
      spis1:=spis1^.next;
      dispose(tmp)
    end;
  end
  else
  begin
    tmpi:=spis1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    dispose(tmp);
  end;
end;
 
{процедура удаления элемента по значению
 полностью расписана при работе со стеком}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
var
  tmp:List;
begin
  tmp:=spis1;
  if znach1=tmp^.data then
  begin
    DelElem(spis1,tmp);
    exit;
  end;
  tmp:=tmp^.next;
  while tmp<>Spis1 do
  begin
    if tmp^.data=znach1 then
    begin
      DelElem(spis1,tmp);
      exit
    end;
    tmp:=tmp^.next;
  end;
end;
 
{процедура удаления элемента по позиции
 полностью расписана при работе со стеком}
Procedure DelElemPos(var spis1:List;posi:integer);
var
  i:integer;
  tmp:List;
begin
  if spis1=nil then
  begin
    writeln('Список пуст.');
    readkey;
    exit
  end;
  tmp:=spis1^.next;
  i:=1;
  while tmp<>spis1 do
  begin
    tmp:=tmp^.next;
    inc(i)
  end;
  if (posi<1) or (posi>i) then
  begin
    writeln('В списке ',i, ' элемента(ов).');
    writeln('Элемент ',posi,' отсутствует в списке.');
    readkey;
    exit
  end
  else
  begin
    i:=1;
    tmp:=spis1;
    while i<posi do
    begin
      tmp:=tmp^.next;
      inc(i)
    end;
    DelElem(spis1,tmp);
  end;
end;
 
{Процедура сортировки "пузырьком" с изменением только данных
 полностью расписана при работе со стеком}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist));
  rab:=nach;
  while rab^.next<>nach do
  begin
    tmp:=rab^.next;
    while tmp<>nach do
    begin
      if tmp^.data<rab^.data then
      begin
        tmps:=tmp^.data;
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next
    end;
    rab:=rab^.next
  end
end;
 
{procedure SortBublLink(var nach:List);
var
  tmp,pocle1,rab:List;
begin
  if nach=nil then
    exit;
  rab:=nach;
  while rab^.next<>nach do
  begin
    tmp:=rab^.next;
    while tmp<>nach do
    begin
      if tmp^.data<rab^.data then
      begin
 
      end;
      tmp:=tmp^.next;
    end;
    rab:=rab^.next;
  end;
end;}
 
var
  SpisNach, {указатель на начало списка и}
  tmpl:List; {неотъемлимая часть в двунаправленном списке}
  znach,a,b:integer;
  ch:char;
begin
  SpisNach:=nil;
  repeat
    clrscr;
    Write('Программа для работы с ');
    TextColor(4);
    Writeln('кольцевым списком.');
    TextColor(7);
    Writeln('Выберите желаемое действие:');
    Writeln('1) Добовить элемент.');
    Writeln('2) Вывод списка.');
    Writeln('3) Удаление элемента по значению.');
    Writeln('4) Удаление элемента по порядковому номеру.');
    Writeln('5) Поиск элемента по значению.');
    Writeln('6) Сортировка списка методом "Пузырька", меняя только данные.');
    Writeln('7) Выход.');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin
            write('Введите значение добавляемого элемента: ');
            readln(znach);
            AddElem(SpisNach,znach);
          end;
      '2':begin
            clrscr;
            Print(SpisNach);
            readkey;
          end;
      '3':begin
            Write('Введите значение удаляемого элемента: ');
            readln(znach);
            DelElemZnach(SpisNach,znach);
          end;
      '4':begin
            Write('Введите порядковый номер удаляемого элемента: ');
            readln(znach);
            DelElemPos(SpisNach,znach);
            readkey;
          end;
      '5':begin
            write('Введите значение искомого элемента: ');
            readln(znach);
            tmpl:=SearchElemZnach(SpisNach,znach);
            if tmpl=nil then
              write('Искомый элемент отсутствует в списке.')
            else
              write('Элемент ',tmpl^.data,' найден.');
            readkey;
          end;
      '6':begin
            if SpisNach=nil then
            begin
              Write('Список пуст.');
              readkey
            end
            else
            begin
              SortBublInf(SpisNach);
              Write('Список отсортирован.');
              readkey;
            end
          end;
    end;
  until ch='7';
  FreeStek(SpisNach);
end.
 Комментарий модератора 
Исправил кодировки. (Например: "Џа®Ја*¬¬*" -> "Программа").
15
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
16.01.2010, 12:23  [ТС] 6
Приступим к работе с очередью.
Работа с очередями похожа на работу со стеком, только лишь изменится способ удаления элементов.
И так, прочитав информацию на Википедии из предыдущих сообщений Вы уже имеете представление о том что такое стек, почитайте ещё вот эту статейку ссылка на Википедию.
Очередь строится также как и стек. Каждый элемент "видит" предшествующий ему элемент.

А теперь пройдёмся по процедурам и функция реализованными мной:
1) procedure AddElem(var nach,ends:List;znach1:TInf);
2) procedure Print(spis1:List);
3) Procedure FreeStek(spis1:List);
4) Function SearchElemZnach(spis1:List;znach1:TInf):List;
5) Procedure DelElem(var spis1,spis2:List;tmp:List);
6) procedure DelElemZnach(var Spis1,spis2:List;znach1:TInf);
7) Procedure DelElemPos(var spis1,spis2:List;posi:integer);
8) procedure SortBublInf(nach:list);
9) procedure SortBublLink(var nach,ends:List);

Описания действия выполняемыми процедурами/функциями описаны выше, в предыдущих постах.
Вот и сам код:
Pascal
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
Program Ochered;
uses
  crt; {Для использования readkey и clrscr}
type
  Tinf=integer; {тип данных, который будет храниться в элементе очереди}
  List=^TList;  {Указатель на элемент типа TList}
  TList=record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
    data:TInf;  {данные, хранимые в элементе}
    next:List;   {указатель на следующий элемент}
  end;
 
{Процедура добавляющая элемент в очередь}
procedure AddElem(var stek1:List;znach1:TInf);
var
  tmp:List;
begin
  GetMem(tmp,sizeof(TList)); {выделяем в памяти место для нового элемента}
  tmp^.next:=stek1;  {указатель на следующий элемент "направляем" на хвост очереди}
  tmp^.data:=znach1; {добавляем к элементу данные}
  stek1:=tmp; {хвост очереди изменился, надо перенести и указатели на неё}
end;
 
{Процедура вывода очереди начиная с хвоста}
procedure Print(stek1:List);
begin
  if stek1=nil then {проверка на пустоту очереди}
  begin
    writeln('Очередь пуста.');
    exit;
  end;
  while stek1<>nil do {пока указатель stek1 не станет указывать в пустоту}
  begin   {а это произойдёт как только он перейдёт по ссылке последнего элемента}
    Write(stek1^.data, ' '); {выводить данне}
    stek1:=stek1^.next  {и переносить указатель в начало очереди}
  end;
end;
 
{Процедура освобождения памяти занятой очередью}
Procedure FreeStek(stek1:List);
var
  tmp:List;
begin
  while stek1<>nil do {пока stek1 не станет указывать в "пустоту" делать}
  begin
    tmp:=stek1; {указатель tmp направим на хвост очереди}
    stek1:=stek1^.next; {хвост очереди перенесём на следующий за данным элементом элемент}
    FreeMem(tmp,SizeOf(Tlist)); {освободим память занятую под удаляемый элемент}
  end;
end;
 
{Поиск элемента в очереди по значению}
Function SearchElemZnach(stek1:List;znach1:TInf):List;
begin
  if stek1<>nil then {если стек не пуст, то}
    while (Stek1<>nil) and (znach1<>stek1^.data) do {пока stek1 не укажет в "пустоту" или пока мы не нашли нужный нам элемент}
      stek1:=stek1^.next; {переносить указатель}
  SearchElemZnach:=stek1;{функция возвращает указатель на найденный элемент}
end;         {в случае если элемент не найден, она вернёт nil}
 
{Процедура удаления элемента по указателю}
Procedure DelElem(var stek1:List;tmp:List);
var
  tmpi:List;
begin
  if (stek1=nil) or (tmp=nil) then {если очередь пуст или указатель никуда не указывает, то выходим}
    exit;
  if tmp=stek1 then {если мы удаляем элемент который является хвостом очереди, то}
  begin
    stek1:=tmp^.next;{следует перенести вершину и}
    FreeMem(tmp,SizeOf(TList)); {высвободить память из под элемента}
  end
  else {в случае, если удаляемый элемент не хвост очереди, то}
  begin
    tmpi:=stek1; {ставим указатель на хвост очереди}
    while tmpi^.next<>tmp do {доходим до элемента стоящего "перед" тем, который нам следует удалить}
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next; {указатель элемента переносим на следующий элемент за удаляемым}
    FreeMem(tmp,sizeof(TList)); {удаляем элемент}
  end;
end;
 
{Процедура удаления элемента по значению}
procedure DelElemZnach(var Stek1:List;znach1:TInf);
var
  tmp:List;
begin
  if Stek1=nil then {Если очередь пуста, то выводим сообщение и выходим}
  begin
    Writeln('Очередь пуста.');
    exit;
  end;
  tmp:=SearchElemZnach(stek1,znach1); {tmp указывает на удаляемый элемент}
  if tmp=nil then {если элемент не был найден, то выводим сообщение и выходим}
  begin
    writeln('Элемент с искомым значением ' ,znach1, ' отсутствует в очереди.');
    exit;
  end;
  DelElem(stek1,tmp); {удаляем элемент из очереди}
  Writeln('Элемент удалён.'); {сообщаем о выполнении действия}
end;
 
{Удаление элемента по порядковому номеру (хвост имеет номер 1)}
Procedure DelElemPos(var stek1:List;posi:integer);
var
  i:integer;
  tmp:List;
begin
  if posi<1 then {проверка на ввод информации}
    exit;
  if stek1=nil then {если очередь пуста}
  begin
    Write('Очередь пуста.');
    exit
  end;
  i:=1; {будет считать позиции}
  tmp:=stek1;
  while (tmp<>nil) and (i<>posi) do {пока tmp не укажет в "пустоту" или мы не найдём искомый элемент}
  begin
    tmp:=tmp^.next; {переходим на следующий элемент}
    inc(i)   {увеличиваем значение счётчика}
  end;
  if tmp=nil then {если элемента нет выводим соответствующие сообщения и выходим}
  begin
    Writeln('Элемента с порядковым номером ' ,posi, ' нет в очереди.');
    writeln('В очереди ' ,i-1, ' элементов(а).');
    exit
  end;
  DelElem(stek1,tmp); {если мы не вышли, то элемент есть и его следует удалить}
  Writeln('Элемент удалён.'); {сообщаем о выполнении действия}
end;
 
{Процедура сортировки "пузырьком" с изменением только данных}
procedure SortBublInf(nach:list);
var
  tmp,rab:List;
  tmps:Tinf;
begin
  GetMem(tmp,SizeOf(Tlist)); {выделяем память для рабочего "буфера" обмена}
  rab:=nach; {рабочая ссылка, становимся на хвост очереди}
  while rab<>nil do {пока мы не дойдём до конца стека делать}
  begin
    tmp:=rab^.next; {перейдём на следующий элемент}
    while tmp<>nil do {пока не конец очереди делать}
    begin
      if tmp^.data<rab^.data then {проверяем следует ли менять элементы}
      begin
        tmps:=tmp^.data; {стандартная замена в 3 операции}
        tmp^.data:=rab^.data;
        rab^.data:=tmps
      end;
      tmp:=tmp^.next {переход к следующему элементу}
    end;
    rab:=rab^.next {переход к следующему элементу}
  end
end;
 
{Процедура сортировки "пузырьком" с изменением только адресов}
procedure SortBublLink(nach:List);
var
  tmp,pered,pered1,pocle,rab:List; {все рабочие ссылки}
begin
  rab:=nach; {становимся на вершину стека}
  while rab<>nil do{пока не конец очереди делать}
  begin
    tmp:=rab^.next; {переходим к следующему за сортируемым элементу}
    while tmp<>nil do {пока не конец очереди делать}
    begin
      if tmp^.data<rab^.data then {если следует произвести замену, то}
      begin
        pered:=nach; {становимся на хвост очереди}
        pered1:=nach; {становимся на хвост очереди}
        if rab<>nach then {если мы не стоим на изменяемом элементе, то}
          while pered^.next<>rab do pered:=pered^.next; {станем на элементе перед изменяемым}
        while pered1^.next<>tmp do pered1:=pered1^.next; {станем на элементе перед изменяемым, который находится за
        первым изменяемым}
        pocle:=tmp^.next; {запоминаем адрес элемента после второго изменяемого}
        if rab^.next=tmp then {если элементы "соседи", то}
        begin
          tmp^.next:=rab; {меняем ссылки, тут если не понятно рисуйте на листочке}
          rab^.next:=pocle
        end
        else {в случае если элементы не соседи, то}
        begin
          tmp^.next:=rab^.next;{меняем ссылки, тут если не понятно рисуйте на листочке}
          rab^.next:=pocle;
        end;
        if pered1<>rab then{советую просмотреть на листочке}
          pered1^.next:=rab;
        if rab<>nach then{советую просмотреть на листочке}
          pered^.next:=tmp
        else{всё советую просмотреть на листочке}
          nach:=tmp;
        pered1:=tmp;{советую просмотреть на листочке}
        tmp:=rab;{советую просмотреть на листочке}
        rab:=pered1;{советую просмотреть на листочке}
      end;
      tmp:=tmp^.next; {переходим на следующий элемент}
    end;
    rab:=rab^.next;{переходим на следующий элемент}
  end;
end;
 
var
  Stk, {переменная, которая всегда будет указывать на "хвост" очереди}
  tmpl:List; {рабочая переменная}
  znach:Tinf; {данные вводимые пользователем}
  ch:char; {для работы с меню}
begin
  Stk:=nil;
  repeat {цикл для нашего меню}
    clrscr; {очистка экрана, далее идёт вывод самого меню}
    Writeln('Программа для работы с очередями.');
    Writeln('Выберите желаемое действие:');
    Writeln('1) Добавить элемент.');
    Writeln('2) Вывод очереди (начиная с головы).');
    Writeln('3) Удаление элемента по значению.');
    Writeln('4) Удаление элемента по порядковому номеру.');
    Writeln('5) Поиск элемента по значению.');
    Writeln('6) Сортировка очереди методом "Пузырька", меняя только данные.');
    Writeln('7) Сортировка очереди методом "Пузырька", меняя только адресс.');
    Writeln('8) Выход.');
    writeln;
    ch:=readkey; {ожидаем нажатия клавиши}
    case ch of {выбираем клавишу}
      '1':begin
            write('Введите значение добавляемого элемента: ');
            readln(znach); {считываем значение добавляемого нового элемент}
            AddElem(Stk,znach);
          end;
      '2':begin
            clrscr; {очистка экрана}
            Print(Stk); {вызов процедуры вывода}
            readkey; {ожидаем нажатия клавиши}
          end;
      '3':begin
            Write('Введите значение удаляемого элемента: ');
            readln(znach); {ввод значения удаляемого элемента}
            DelElemZnach(Stk,znach); {вызов процедуры удаления элемента по значению}
            readkey;{ожидаем нажатия клавиши}
          end;
      '4':begin
            Write('Введите порядковый номер удаляемого элемента: ');
            readln(znach); {ввод позиции удаляемого файла}
            DelElemPos(Stk,znach);{вызов процедуры удаления элемента по значению}
            readkey;{ожидаем нажатия клавиши}
          end;
      '5':begin
            write('Введите значение искомого элемента: ');
            readln(znach); {ввод искомого значения}
            tmpl:=SearchElemZnach(Stk,znach); {вызываем процедуру поиска элемента по значению}
            if tmpl=nil then {проверяем найден ли элемент и выводим соответствующие сообщения}
              write('Искомый элемент отсутствует в очереди.')
            else
              write('Элемент ',tmpl^.data,' найден.');
            readkey;{ожидаем нажатия клавиши}
          end;
      '6':begin
            if Stk=nil then {проверяем не пустой ли стек}
            begin
              Write('Очередь пуста.');
              readkey{ожидаем нажатия клавиши}
            end
            else
            begin
              SortBublInf(Stk);{вызов процедуры сортировки стека с изменением данных}
              Write('Очередь отсортирована.');
              readkey;{ожидаем нажатия клавиши}
            end
          end;
      '7':begin
            if Stk=nil then{проверяем не пустой ли стек}
            begin
              Write('Очередь пуста.');
              readkey{ожидаем нажатия клавиши}
            end
            else
            begin
              SortBublLink(Stk);{вызов процедуры сортировки стека с изменением адресов}
              Write('Очередь отсортирована.');
              readkey;{ожидаем нажатия клавиши}
            end
          end;
    end;
  until ch='8';
  FreeStek(Stk); {освобождаем память занятую очередью}
end.
Следующей будет выложена работа с бинарными деревьями.
 Комментарий модератора 
Исправил кодировки. (Например: "Џа®Ја*¬¬*" -> "Программа").
15
lexus_ilia
3050 / 710 / 69
Регистрация: 24.09.2008
Сообщений: 1,531
02.06.2010, 00:43  [ТС] 7
И вот пришло время добавить работу с деревьями.
Код любезно предоставлен пользователем lera8 (ссылка на страницу пользователя lera8)
Начнём с того, что же такое дерево. И как ни странно все Вы имеете представление о том, что такое дерево: давайте представим себе генеалогическое дерево (все знаю, что это такое), так вот деревья в программировании имеет по своей сути очень и очень схожее строение: есть какой-то корень (обычно он располагается в самом верху, т.е. дерево "растёт" вниз) и у него есть потомки, а у тех потомков свои потомки и т.д. В нашем случае рассматривается так называемое "Двоичное дерево поиска", ссылка на Википедию. Вы спросите почему? А потому, что оно очень часто используется для решения очень широкого круга задач, чаще всего для поиска и сортировки (при больших объёмах сортируемой информации, очень даже неплохие результаты показывает).

И так, опишем функции, которые реализованы:
1)procedure AddToTree (var Tree:PNode;x:integer); - добавление элемента в дерево
2)function Search(Tree:PNode;x:integer):PNode; - функция поиска в дереве
3)procedure Lkp(Tree:PNode); - обход дерева по принципу "Левле поддерево, корень, правое поддерево"
4)procedure DeleteTree(var Tree1:PNode ) - процедура удаления дерева

А вот и сам код:
Pascal
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
uses crt;
type
PNode=^Node;  {Указатель на узел}
 Node=record  {Тип запись в котором будет храниться информация}
   data:integer;
   left,right:PNode; {Ссылки на левого и правого сыновей}
end;
 
var
  Tree,p1:PNode; {Tree адрес корня дерева, p1-вспомогательная переменная}
  n,x,i:integer;
  ch:char; {для работы менюшки}
 
{Процедура добавления элемента }
procedure AddToTree (var Tree:PNode;x:integer); {Входные параметры - адрес корня дерева и добавл элемент }
begin
 if Tree=nil then  {Если дерево пустое то создаём его корень}
   begin
     New(Tree);   {Выделяем память }
     Tree^.data:=x;     {Добавляем данные }
     Tree^.left:=nil;     {Зануляем указатели на левого }
     Tree^.right:=nil;  {и правого сыновей }
      exit;
   end;
 if x < Tree^.data then   {Доб к левому или правому поддереву это завсит от вводимого элемента}
     AddToTree(Tree^.left,x)  {если меньше корня то в левое поддерево }
  else
    AddToTree(Tree^.right,x);  {если больше то в правое}
end;
 
{Функция поиска по дереву}
function Search(Tree:PNode;x:integer):PNode; {Возвращает адрес искомого элемента, nil если не найден}
var
p:PNode;   {вспомог переменнная }
begin
  if Tree=nil then   {если дерево пустое то}
     begin
       Search:=nil;  {присваеваем функции результат нил}
       exit; {и выходим }
     end;
  if x=Tree^.data then  {если искомый элемент равен корню дерева то }
    p:=Tree  {Пзапоминаем его адрес }
     else   {иначе}
       if x < Tree^.data then {если вводимый элемент менньше корня то }
          p:=Search(Tree^.left,x) {то ищем его в левом поддереве}
       else     {иначе }
         p:=Search(Tree^.right,x);  {ищем в правом поддереве }
  Search:=p; {присваеваем переменной с именем фугкции результат работы}
end;
 
{Обход дерева по принципу Левый-корень-правый }
procedure Lkp(Tree:PNode);
begin
  if Tree=nil then  {Если дерево пустое }
   exit;      {то выход }
  Lkp(Tree^.left);  {иначе начинаем обход с левого подднрева}
  write('  ',Tree^.data); {выводим данные }
  Lkp(Tree^.right);  {обходим правое поддерево}
end;
 
{Процедура удаления дерева}
procedure DeleteTree(var Tree1:PNode );
begin
        if Tree1 <> nil then
          begin
            DeleteTree (Tree1^.LEFT);
            DeleteTree (Tree1^.RIGHT);
            Dispose(Tree1);
          end;
end;
 {основная пограмма}
begin
 Tree:=nil;
 repeat {цикл для нашего меню}
 
    Writeln('Выберете действие ');
    Textcolor(2);
    Writeln('Доступны следующие пункты:');
    Writeln('1) Создание дерева поиска');
    Writeln('2) Поиск элемента в дереве');
    Writeln('3) Вывод дерева');
    Writeln('4) ‚Выход');
    writeln;
    readln(ch); {ожидаем нажатия клавиши}
    case ch of {выбираем клавишу}
      '1': begin
            writeln(' kolv elementov');
            readln(n);
              for i:=1 to n do
                begin
                  writeln('Введите число');
                  readln(x);
                  AddToTree(Tree,x);
                end;
           end;
       '2': begin
               writeln('Элемент для поиска');
               readln(x);
               p1:=Search(Tree,x);
                  if p1 <> nil then
                    writeln('Найден')
                  else writeln('Такого элемента нет!');
            end;
        '3': begin
              writeln('Само дерево');
              Lkp(Tree);
              writeln;
             end;
        end;
   until ch='4';
   DeleteTree(Tree);
end.
17
Светлана_1988
295 / 71 / 6
Регистрация: 23.11.2009
Сообщений: 25
19.08.2010, 16:52 8
Задание :
На основе процедуры обхода дерева снизу вверх реализовать операцию поиска узла с заданным значением в дереве, не являющемся деревом поиска. Из двух последовательностей символов построить два бинарных дерева минимальной высоты. В первом дереве найти элемент с заданным значением и подключить второе дерево в качестве его левого поддерева, если оно пусто, или левого поддерева первого из его крайних левых потомков, имеющих пустое левое поддерево.

Добавлено через 1 минуту
Программа на pascal:
Pascal
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
program tree;
uses crt;
 
type {описание узла дерева}
  PNode = ^TNode;
  TNode = record
    value: integer;
    left: PNode;
    right: PNode;
  end;
 
var {раздел описания переменных}
  BiTree1, BiTree2: PNode;
  Node1, Node2: PNode;
  n: integer;
 
function CreateRandomBinaryTree(count_node: integer): PNode;
{построение дерева минимальной высоты}
var
  nleft, nright: integer;
  node: pnode;
  x: integer;
Begin
  if count_node = 0 then
    node:=nil
  else begin
    nleft:= count_node div 2; {построение левого поддерева}
    nright:= count_node - nleft - 1; {построение правого поддерева}
    write('vvedite element dereva: ');
    read(x); {ввод  элементов дерева}
    new(node);
    node^.value:= x;
    node^.left:= CreateRandomBinaryTree(nleft);
    node^.right:= CreateRandomBinaryTree(nright);
  end;
  CreateRandomBinaryTree:= node;
End;
 
procedure DestroyBinaryTree(root: PNode);
Begin
  if root <> nil then begin
    DestroyBinaryTree(root^.left);
    DestroyBinaryTree(root^.right);
    Dispose(root);
  end;
End;
 
function FindNodeByValue(root: PNode; value: integer): PNode;
{поиск искомого элемента дерева}
var
  temp: PNode;
Begin
  if root = nil then
    FindNodeByValue:= nil
  else
    if root^.value = value then
      FindNodeByValue:= root
    else begin
      temp:= FindNodeByValue(root^.left, value);
      if temp = nil then
        temp:= FindNodeByValue(root^.right, value);
      FindNodeByValue:= temp;  
    end;
End;
 
function FindNodeWithLeftNil(root: PNode): PNode;
{проверка на то, пусто ли левое поддерево}
Begin
  if root^.left = nil then
    FindNodeWithLeftNil:= root
  else
    FindNodeWithLeftNil:= FindNodeWithLeftNil(root^.left);
End;
 
procedure PrintTree(root: PNode; h: integer); {печать дерева с отступом}
begin
 if root <> nil then begin
  Printtree(root^.right,h+2);
  writeln(' ':h, root^.value);
  PrintTree(root^.left, h+2);
 end;
end;
 
BEGIN {начало программы}
  clrscr; {очистка экрана}
  Write ('Kolichestvo uzlov 1 dereva: ');
  Readln(n); {ввод количества узлов первого дерева}
  writeln('Binarnoe derevo 1 minimalnoy visoti:');
  BiTree1:= CreateRandomBinaryTree(n);
 {построение первого дерева минимальной высоты}
  PrintTree(BiTree1, 0);
  readln; {переход на новую строку}
  Write ('Kolichestvo uzlov 2 dereva: ');
  Readln(n); {ввод количества узлов второго дерева}
  writeln('Binarnoe derevo 2 minimalnoy visoti:');
  BiTree2:= CreateRandomBinaryTree(n);
 {построение второго дерева минимальной высоты}
  PrintTree(BiTree2, 0);
  readln; {переход на новую строку}
  Write ('Iskomoe znachenie: ');
  Readln(n); {ввод искомого элемента первого дерева}
  Node1:= FindNodeByValue(BiTree1, n);
  if Node1 <> nil then begin
    Node2:= FindNodeWithLeftNil(Node1);
    Node2^.left:= BiTree2;
    PrintTree(BiTree1, 0);
  end
  else
    Write('Znachenie ne naideno');
  Readln;
  DestroyBinaryTree(BiTree1);
END. {конец программы}
Добавлено через 29 минут
Выложила программу, написала сама, может кому-нибудь понадобится. Там много хороших процедур, за ними часто обращаются в разделе.
11
63pHc
56 / 49 / 0
Регистрация: 25.08.2010
Сообщений: 43
27.10.2010, 22:31 9
Постановка задачи
Реализовать хранилище стеков, с операциями добавления, поиска, удаления стеков, а так же со всеми стандартными операциями внутри отдельного стека. Среда программирования Turbo Pascal 7.1.

Ход решения

1.Реализовать стек в ООП со всеми стандартными операциями: добавление элемента, взятие вершины, проверки на пустоту и заполнение, вывод содержимого стека на экран.

2.Реализовать список, в каждом узле которого содержится стек.

3.В основной программе реализовать меню, для удобства работы.

Стек

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

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

Стек (англ. stack — стопка) — структура данных с методом доступа к элементам LIFO (англ. Last In — First Out, «последним пришел — первым вышел»). Чаще всего принцип работы стека сравнивают со стопкой тарелок: чтобы взять вторую сверху, нужно взять верхнюю.

Стек – это дисциплина обработки данных, имеющая линейную структуру, доступ в которой разрешается только к последнему добавленному элементу( вершине стека). Стек работает по принципу LIFO (Last In, First Out. Последний вошёл, первый вышел ). Простым примером использования стека может послужить ситуация, когда мы просматриваем множество данных и составляем список особых данных, которые должны обрабатываться позднее. Когда первоначальное множество обработано, мы возвращаемся к этому списку и выполняем обработку, удаляя элементы, пока наш список не станет пустым. Например, рекурсивные функции, пока не обработан последний вызов, все предыдущие вызовы находятся в своеобразном стеке. Стек активно используется в архитектуре компьютера, в ней преобладает стековая адресация.

Рассмотрим основные функции обработки стека:

Push – добавление в вершину стека, в процедуру передаётся добавляемое значение.
Pop – взятие элемента из вершины стека, возвращает содержимое вершины
IsEmpty – проверка на пустоту, возвращает True или False.
IsFull – проверка на заполнение, максимальное число элементов в стеке определяет константа MaxStack, возвращает True или False.
Top – указатель на вершину стека

Рассмотрим структуру узла стека:

Pascal
1
2
3
4
5
6
7
8
type
    pStackEl = ^StackEl;
    data = Integer;
 
    StackEl = record
        Value:data;
        Prev:pStackEl;
    End;

Value – значение узла стека ( data = Integer; указывает, что стек числовой)
Prev – указатель на предыдущий элемент.

Для реализации хранилища стеков использован односвязный список с указателем на начало и конец. Рассмотрим узел списка:

Pascal
1
2
3
4
5
6
7
8
type
    pNode = ^listEl;
 
    ListEl = record
           Name:string;
           Stack:StackOfData;
           Next:pNode;
    End;
Name – имя стека
Stack – непосредственно стек, описанный как объект в модуле UStack.
Next – указатель на следующий элемент списка.

Рассмотрим функции обработки данного списка:

AddNode – добавление узла, в процедуру передаётся имя нового стека.
DelNode – удаление узла, в процедуру передаётся указатель на удаляемый узел
Find – поиск стека, возвращает указатель на узел
ChangeStack – процедура обработки отдельного стека, в процедуру передаётся указатель на узел с обрабатываемым стеком.

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

Процедура Find выводит все стеки, поиск осуществляется посредством активного меню, которое организованно следующим образом: считается количество стеков, далее с нажатием клавиш вверх и вниз, на экране передвигается стрелка, изменяется значение переменной m, которая указывает на порядковый номер стека в списке. Затем снова отсчитывается стек с порядковым номером m и возвращается указатель на него.

После добавлений и удалений стеков, которые происходит в основной программе, список изменяется.

Остальные функции обработки стеков и списка реализованы по стандартным алгоритмам.


Как работать с программой (этот пунк мы опустим)

!!!!! Программа написана в Turbo Pascal 7.1, чтобы подключить модули, нужно скопировать файлы UList.TPU и UStack.TPU в директорию компилятора BIN\.

Код программы.

Модуль «Стек»

Pascal
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
Unit UStack;
Interface
Const
     MaxStack = 7;
type
    pStackEl = ^StackEl;
    data = Integer;
 
    StackEl = record
        Value:data;
        Prev:pStackEl;
    End;
 
    StackOfData = object
    public
        procedure Create;
        function IsEmpty:boolean;
        function IsFull:boolean;
        procedure Push(val:data);
        function Pop:data;
        procedure Print;
    private
        Top:pStackEl;
    End;
Implementation
Var
    i : Integer;
    stack1:stackOfData;
{///////////////////////////////////////////////}
procedure StackOfData.Create;
Begin
     Top:=Nil;
End;
{///////////////////////////////////////////////}
function StackOfData.IsEmpty:boolean;
Begin
     If Top = Nil Then
        IsEmpty:=True
     Else
        IsEmpty:=False;
End;
{///////////////////////////////////////////////}
function StackOfData.IsFull:boolean;
Var
   count:Integer;
   PSE:PstackEl;
Begin
   PSE:=Top;
   count:=0;
   While PSE<>Nil Do
   Begin
        count:=count+1;
        PSE:=PSE^.Prev;
   End;
   If count>=MaxStack Then
        IsFull:=True
     Else
        IsFull:=False;
End;
{///////////////////////////////////////////////}
procedure StackOfData.Push(val:data);
Var
   NewStackEl:pStackEl;
Begin
   New(NewStackEl);
   NewStackEl^.value:=val;
   NewStackEl^.prev:=Top;
   Top:=NewStackEl;
End;
{///////////////////////////////////////////////}
function StackOfData.Pop:data;
Var
   PSE:pStackEl;
Begin
     Pop:=Top^.value;
     PSE:=Top;
     Top:=Top^.prev;
     Dispose(PSE);
End;
{////////////////////////////////////////////}
procedure StackOfData.Print;
Var
   PSE:PstackEl;
Begin
   PSE:=Top;
   While PSE<>Nil Do
   Begin
        Write(PSE^.Value,' ');
        PSE:=PSE^.Prev;
   End;
End;
{///////////////////////////////////////////////}
Begin
     
End.


Модуль «Список стеков»


Pascal
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
Unit UList;
Interface
Uses UStack,crt;
 
type
    pNode = ^listEl;
 
    ListEl = record
           Name:string;
           Stack:StackOfData;
           Next:pNode;
    End;
    ListOfStack = object
    public
        procedure Create;
        procedure AddNode(klox:string);
        procedure DelNode(var delEl:pNode);
        function Find:pNode;
        procedure ChangeStack(var ple:pNode);
   private
        head:pNode;
        tail:pNode;
    End;
 
Implementation
{////////////////////////////////////////////}
procedure ListOfStack.Create;
Begin
     head:=Nil;
     tail:=Nil;
End;
{////////////////////////////////////////////}
procedure ListOfStack.AddNode(klox:string);
var
    NewNode:pNode;
Begin
    If head<>Nil Then
    Begin
        New(NewNode);
        NewNode^.name:=klox;
        NewNode^.Stack.Create;
        NewNode^.next:=Nil;
        tail^.next:=NewNode;
        tail:=NewNode;
    End
    Else
    Begin
        New(head);
        head^.name:=klox;
        head^.Stack.Create;
        Head^.next:=Nil;
        tail:=head;;
    End;
End;
{////////////////////////////////////////////}
procedure ListOfStack.DelNode(var delEl:pNode);
var
    ple:pNode;
Begin
    If delEl<>Nil Then
    Begin
        If delEl=head Then
        Begin
           head:=head^.next;
           Dispose(delEl);
        End
        Else
        Begin
           ple:=head;
           While ((ple^.next<>delEl) and (ple <> Nil )) Do  ple:=ple^.next;
           If delEl=tail Then tail:=ple;
           ple^.next:=delEl^.next;
           Dispose(delEl);
        End;
    End;
End;
{////////////////////////////////////////////}
function ListOfStack.Find:pNode;
Var
    ple:pNode;
    c:char;
    count,m:Integer;
Begin
    ple:=head;
    count:=0;
    m:=0;
    writeln('->BACK');
    While ple<>Nil Do
    Begin
        writeln('  ',ple^.name);
        ple:=ple^.next;
        count:=count+1;
    End;
    writeln;
    repeat
        c := readkey;
        if ((c=#72) and (m>0)) Then
        Begin
             GoToXY(1,m+1);
             write('  ');
             m:=m-1;
             GoToXY(1,m+1);
             write('->');
        End;
        if ((c=#80) and (m<count)) Then
        Begin
             GoToXY(1,m+1);
             write('  ');
             m:=m+1;
             GoToXY(1,m+1);
             Write('->');
        End;
    until c=#13;
    If m = 0 Then
       Find:=Nil
    Else
    Begin
       ple:=head;
       While m>1 Do
       Begin
            ple:=ple^.next;
            m:=m-1;
       End;
       Find:=ple;
    End;
    clrscr;
End;
{////////////////////////////////////////////}
procedure ListOfStack.ChangeStack(var ple:pNode);
var
   m:Integer;
   c:char;
   val:data;
Begin
If ple<>Nil Then
Begin
m:=1;
While m<>0 Do
Begin
   clrscr;
   Writeln('->BACK');
   Writeln('  Push');
   Writeln('  Pop');
   Writeln('  Print');
   m:=0;
   repeat
        c := readkey;
        if ((c=#72) and (m>0)) Then
        Begin
             GoToXY(1,m+1);
             write('  ');
             m:=m-1;
             GoToXY(1,m+1);
             write('->');
        End;
        if ((c=#80) and (m<3)) Then
        Begin
             GoToXY(1,m+1);
             write('  ');
             m:=m+1;
             GoToXY(1,m+1);
             Write('->');
        End;
    until c=#13;
    clrscr;
    If m=1 Then
    Begin
         If Not ple^.Stack.IsFull Then
         Begin
              write('Please enter value: ');
              readln(Val);
              ple^.Stack.Push(val);
 
         End
         Else
         Begin
             Writeln('Stack is full!');
             readln;
         End;
    End;
    If m = 2 Then
    If Not ple^.Stack.IsEmpty Then
    Begin
       Writeln(ple^.Stack.Pop);
       readln;
    End
    Else
    Begin
       write('Stack is empty!');
       readln;
    End;
    If m = 3 Then
    Begin
         ple^.Stack.Print;
         readln;
    End;
End;
End;
End;
{////////////////////////////////////////////}
Begin
     
End.
Главное меню

Pascal
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
Program Multistack;
Uses UList,crt;
var
   i,m:Integer;
   c:char;
   klox:string;
   Node:pNode;
   List:ListOfStack;
Begin
   clrscr;
   List.Create;
   m:=1;
   While m<>0 Do
   Begin
   clrscr;
   Writeln('->EXIT');
   Writeln('  ADD STACK');
   Writeln('  DELETE STACK');
   Writeln('  CHANGE STACK');
   Writeln('  INFORMATION');
   m:=0;
   repeat
        c := readkey;
        if ((c=#72) and (m>0)) Then
        Begin
             GoToXY(1,m+1);
             write('  ');
             m:=m-1;
             GoToXY(1,m+1);
             write('->');
        End;
        if ((c=#80) and (m<4)) Then
        Begin
             GoToXY(1,m+1);
             write('  ');
             m:=m+1;
             GoToXY(1,m+1);
             Write('->');
        End;
    until c=#13;
    clrscr;
    Case m Of
    1:
    Begin
         Writeln('Please enter name: ');
         readln(klox);
         List.AddNode(klox);
         writeln('Stack is added!');
         readln;
    End;
    2:
    Begin
 
         clrscr;
         Node:=List.Find;
         List.DelNode(Node);
    End;
    3:
    Begin
         Node:=List.Find;
         If Node<>Nil Then
         List.ChangeStack(Node);
    End;
    4:
    Begin
 
         Writeln('MultiStack');
         Writeln('Chelyabinsk State University');
         Writeln('Faculty of Mathematics');
         Writeln(‘ xxx yyy’);
         Writeln('2010');
         readln;
    End;
 
    End;
    End;
End.
Заключение

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


Не по теме:

зы Это оригинальный текст написанный группой программистов для сдачи зачета( xDDD ),и впервые публикуется тут cyberforum.ru (28.10.10)
Если вы хотите опубликовать у себя наш пост или его фрагмент, делайте это без дополнительного разрешения при условии, что будет стоять активная ссылка на первоисточник. cyberforum.ru/

39
27.10.2010, 22:31
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
27.10.2010, 22:31

Динамические структуры данных: списки
Искал манул, не нашел путного ничего... Суть задачи такова &quot;Написать...

Стеки, списки, деревья, графы.
Прошу помощи в решении задач: 1. Используя очередь, решить следующую задачу....

Динамические структуры данных. Линейные списки
1. Сформировать список из N целочисленных случайных элементов (N – ...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
9
Закрытая тема Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru