Стек на односвязанном списке. Элементы стека принадлежат перечисляемому типу.

@andrewrusin · Регистрация: 11.07.2011

Студворк — интернет-сервис помощи студентам

Mawrat, Помогите пожалуйста!
Структура односвязного списка: "Стек"
Тип информационного поля: "Перечисляемый тип"
Перемещение найденного элемента: "на место за 1-ым элементом"

@Mawrat · 22.10.2011, 20:33

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
program Project1;
 
type
  //Перечисляемый тип.
  //Num0 = 0, ..., Num5 = 5.
  TData = (Num0, Num1, Num2, Num3, Num4, Num5);
 
  //Указатель на элемент стека.
  TPElem = ^TElem;
  //Элемент стека.
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
 
//Добавление элемента на вершину стека.
procedure StackPush(var aPStack, aPElem : TPElem);
begin
  if aPElem = nil then Exit;
  aPElem^.PNext := aPStack;
  aPStack := aPElem
end;
 
//Изъятие элемента с вершины стека.
function StackPop(var aPStack, aPElem : TPElem) : Boolean;
begin
  Result := False;
  if aPStack = nil then Exit;
  aPElem := aPStack;
  aPStack := aPElem^.PNext;
  Result := True;
end;
 
//Удаление стека из памяти (очистка стека).
procedure StackFree(var aPStack : TPElem);
var
  PDel : TPElem;
begin
  while aPStack <> nil do begin
    PDel := aPStack;
    aPStack := aPStack^.PNext;
    Dispose(PDel);
  end;
end;
 
const
  //Глубина стека.
  M = 10;
  //Количество элементов, заданных в перечисляемом типе TData.
  N = 6;
var
  PSt1, PSt2, PElem, PElemF : TPElem;
  i, j, Ind : Word;
  S : String;
begin
  //Инициализация стеков.
  PSt1 := nil;
  PSt2 := nil;
 
  repeat
    if M < 2 then begin
      Writeln('Задана глубина стека: ', M);
      Writeln('Глубина стека должна быть больше, чем 2.');
      Readln;
      Exit;
    end;
 
    //Формируем содержимое первого стека.
    Randomize;
    for i := 1 to M do begin
      New(PElem);
      case (i - 1) mod 6 of
        0 : PElem^.Data := Num0;
        1 : PElem^.Data := Num1;
        2 : PElem^.Data := Num2;
        3 : PElem^.Data := Num3;
        4 : PElem^.Data := Num4;
        5 : PElem^.Data := Num5;
      end;
      StackPush(PSt1, PElem);
    end;
 
    //Распечатка и переливание из первого стека во второй стек.
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      StackPush(PSt2, PElem);
      if i > 1 then Write(', ');
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
    end;
    Writeln;
    //Переливаем элементы из второго стека обратно - в первый стек.
    while StackPop(PSt2, PElem) do StackPush(PSt1, PElem);
 
    Writeln('Задайте индекс элемента, который надо переставить на второе место:');
    repeat
      Write('Индекс ', 1, '...', M, ': ');
      Readln(Ind);
    until (Ind >= 1) and (Ind <= M);
 
    case Ind of
      1 :
      begin
        //Чтение первого и второго элементов.
        StackPop(PSt1, PElemF);
        StackPop(PSt1, PElem);
        //Запись первого элемента.
        StackPush(PSt1, PElemF);
        //Запись второго элемента.
        StackPush(PSt1, PElem);
      end;
      2 : Writeln('Перестановка не требуется.');
      else begin
        //Переливаем (Ind - 1) элементов из первого стека во второй.
        //В результате этого, элемент, который был на вершине первого стека,
        //окажется на дне второго стека. А элемент с заданным индексом (Ind)
        //окажется на вершине первого стека.
        i := 0;
        j := Ind - 1;
        while i < j do begin
          Inc(i);
          StackPop(PSt1, PElem);
          StackPush(PSt2, PElem);
        end;
        //Берём с вершины первого стека искомый элемент.
        StackPop(PSt1, PElemF);
        //Теперь возвращаем из второго стека в первый стек все элементы, кроме
        //того, который лежит на дне второго стека.
        i := 0;
        j := Ind - 2;
        while i < j do begin
          Inc(i);
          StackPop(PSt2, PElem);
          StackPush(PSt1, PElem);
        end;
        //Добавляем в первый стек элемент, который мы запомнили.
        StackPush(PSt1, PElemF);
        //Возвращаем оставшийся элемент из второго стека в первый стек.
        StackPop(PSt2, PElem);
        StackPush(PSt1, PElem);
      end;
    end;
 
    //Распечатка элементов первого стека. При этом, первый стек очищается.
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      if i > 1 then Write(', ');
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
    end;
    Writeln;
 
    //Удаление стеков из памяти.
    StackFree(PSt1);
    StackFree(PSt2);
    Writeln('Работа завершена. Стеки удалены из памяти.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

@andrewrusin · 22.10.2011, 20:51 **[ТС]**

Спасибо большое!)

@Mawrat · 24.10.2011, 16:28

В продолжение переписки в ЛС.
Вот код, в котором можно вводить любое количество элементов:

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
program Project1;
 
type
  //Перечислимый тип.
  //Num0 = 0, ..., Num5 = 5.
  TData = (Num0, Num1, Num2, Num3, Num4, Num5);
 
  //Указатель на элемент стека.
  TPElem = ^TElem;
  //Элемент стека.
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
 
//Добавление элемента на вершину стека.
procedure StackPush(var aPStack, aPElem : TPElem);
begin
  if aPElem = nil then Exit;
  aPElem^.PNext := aPStack;
  aPStack := aPElem
end;
 
//Изъятие элемента с вершины стека.
function StackPop(var aPStack, aPElem : TPElem) : Boolean;
begin
  Result := False;
  if aPStack = nil then Exit;
  aPElem := aPStack;
  aPStack := aPElem^.PNext;
  Result := True;
end;
 
//Удаление стека из памяти (очистка стека).
procedure StackFree(var aPStack : TPElem);
var
  PDel : TPElem;
begin
  while aPStack <> nil do begin
    PDel := aPStack;
    aPStack := aPStack^.PNext;
    Dispose(PDel);
  end;
end;
 
const
  //Количество элементов, заданных в перечислимом типе TData.
  N = 6;
var
  PSt1, PSt2, PElem, PElemF : TPElem;
  i, j, Ind, StSize : Integer;
  S : String;
begin
  //Инициализация стеков.
  PSt1 := nil;
  PSt2 := nil;
 
  repeat
    //Формируем содержимое первого стека.
    Writeln('Задайте перечень элементов со значениями 0..5.');
    Writeln('Следует ввести не менее двух значений.');
    Writeln('Для завершения ввода нажмите Enter без ввода числа.');
    StSize := 0; //Глубина стека.
    j := -1;
    repeat
      repeat
        Write('Элемент №', StSize + 1, ': ');
        Readln(S);
        if S = '' then Break;
        Val(S, j, i);
        if (i <> 0) or not (j in [0..5]) then begin
          Writeln('Неверный ввод. Повторите.');
          S := '';
        end;
      until S <> '';
      if S = '' then Break;
      Inc(StSize);
      New(PElem);
      PElem^.Data := TData(j);
      StackPush(PSt1, PElem);
    until False;
 
    if StSize < 2 then begin
      StackFree(PSt1); //Удаление стека из памяти.
      Writeln('Глубина стека меньше, чем 2. Действие отменено.');
      Writeln('Повторить - Enter. Выход - любой символ + Enter.');
      Readln(S);
      Continue;
    end;
 
    //Распечатка и переливание из первого стека во второй стек.
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      StackPush(PSt2, PElem);
      if i > 1 then Write(', ');
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
    end;
    Writeln;
    //Переливаем элементы из второго стека обратно - в первый стек.
    while StackPop(PSt2, PElem) do StackPush(PSt1, PElem);
 
    Writeln('Задайте индекс элемента, который надо переставить на второе место:');
    repeat
      Write('Индекс ', 1, '...', StSize, ': ');
      Readln(Ind);
    until (Ind >= 1) and (Ind <= StSize);
 
    case Ind of
      1 :
      begin
        //Чтение первого и второго элементов.
        StackPop(PSt1, PElemF);
        StackPop(PSt1, PElem);
        //Запись первого элемента.
        StackPush(PSt1, PElemF);
        //Запись второго элемента.
        StackPush(PSt1, PElem);
      end;
      2 : Writeln('Перестановка не требуется.');
      else begin
        //Переливаем (Ind - 1) элементов из первого стека во второй.
        //В результате этого, элемент, который был на вершине первого стека,
        //окажется на дне второго стека. А элемент с заданным индексом (Ind)
        //окажется на вершине первого стека.
        i := 0;
        j := Ind - 1;
        while i < j do begin
          Inc(i);
          StackPop(PSt1, PElem);
          StackPush(PSt2, PElem);
        end;
        //Берём с вершины первого стека искомый элемент.
        StackPop(PSt1, PElemF);
        //Теперь возвращаем из второго стека в первый стек все элементы, кроме
        //того, который лежит на дне второго стека.
        i := 0;
        j := Ind - 2;
        while i < j do begin
          Inc(i);
          StackPop(PSt2, PElem);
          StackPush(PSt1, PElem);
        end;
        //Добавляем в первый стек элемент, который мы запомнили.
        StackPush(PSt1, PElemF);
        //Возвращаем оставшийся элемент из второго стека в первый стек.
        StackPop(PSt2, PElem);
        StackPush(PSt1, PElem);
      end;
    end;
 
    //Распечатка элементов первого стека. При этом, первый стек очищается.
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      if i > 1 then Write(', ');
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
    end;
    Writeln;
 
    //Удаление стеков из памяти.
    StackFree(PSt1);
    StackFree(PSt2);
    Writeln('Работа завершена. Стеки удалены из памяти.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

Если требуется элементы распечатывать в виде чисел, тогда код распечатки стека надо заменить:
Заменить:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      if i > 1 then Write(', ');
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
    end;
    Writeln;

На:

Pascal
1
2
3
4
5
6
7
8
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      if i > 1 then Write(', ');
      Write(i, ':', Integer(PElem^.Data));
    end;
    Writeln;

Окончательный код:

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
program Project1;
 
type
  //Перечислимый тип.
  //Num0 = 0, ..., Num5 = 5.
  TData = (Num0, Num1, Num2, Num3, Num4, Num5);
 
  //Указатель на элемент стека.
  TPElem = ^TElem;
  //Элемент стека.
  TElem = record
    Data : TData;
    PNext : TPElem;
  end;
 
//Добавление элемента на вершину стека.
procedure StackPush(var aPStack, aPElem : TPElem);
begin
  if aPElem = nil then Exit;
  aPElem^.PNext := aPStack;
  aPStack := aPElem
end;
 
//Изъятие элемента с вершины стека.
function StackPop(var aPStack, aPElem : TPElem) : Boolean;
begin
  Result := False;
  if aPStack = nil then Exit;
  aPElem := aPStack;
  aPStack := aPElem^.PNext;
  Result := True;
end;
 
//Удаление стека из памяти (очистка стека).
procedure StackFree(var aPStack : TPElem);
var
  PDel : TPElem;
begin
  while aPStack <> nil do begin
    PDel := aPStack;
    aPStack := aPStack^.PNext;
    Dispose(PDel);
  end;
end;
 
const
  //Количество элементов, заданных в перечислимом типе TData.
  N = 6;
var
  PSt1, PSt2, PElem, PElemF : TPElem;
  i, j, Ind, StSize : Integer;
  S : String;
begin
  //Инициализация стеков.
  PSt1 := nil;
  PSt2 := nil;
 
  repeat
    //Формируем содержимое первого стека.
    Writeln('Задайте перечень элементов со значениями 0..5.');
    Writeln('Следует ввести не менее двух значений.');
    Writeln('Для завершения ввода нажмите Enter без ввода числа.');
    StSize := 0; //Глубина стека.
    j := -1;
    repeat
      repeat
        Write('Элемент №', StSize + 1, ': ');
        Readln(S);
        if S = '' then Break;
        Val(S, j, i);
        if (i <> 0) or not (j in [0..5]) then begin
          Writeln('Неверный ввод. Повторите.');
          S := '';
        end;
      until S <> '';
      if S = '' then Break;
      Inc(StSize);
      New(PElem);
      PElem^.Data := TData(j);
      StackPush(PSt1, PElem);
    until False;
 
    if StSize < 2 then begin
      StackFree(PSt1); //Удаление стека из памяти.
      Writeln('Глубина стека меньше, чем 2. Действие отменено.');
      Writeln('Повторить - Enter. Выход - любой символ + Enter.');
      Readln(S);
      Continue;
    end;
 
    //Распечатка и переливание из первого стека во второй стек.
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      StackPush(PSt2, PElem);
      if i > 1 then Write(', ');
      (* Если надо распечатать в соответствии с заданным перечисляемым типом.
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
      *)
      Write(i, ':', Integer(PElem^.Data));
    end;
    Writeln;
    //Переливаем элементы из второго стека обратно - в первый стек.
    while StackPop(PSt2, PElem) do StackPush(PSt1, PElem);
 
    Writeln('Задайте индекс элемента, который надо переставить на второе место:');
    repeat
      Write('Индекс ', 1, '...', StSize, ': ');
      Readln(Ind);
    until (Ind >= 1) and (Ind <= StSize);
 
    case Ind of
      1 :
      begin
        //Чтение первого и второго элементов.
        StackPop(PSt1, PElemF);
        StackPop(PSt1, PElem);
        //Запись первого элемента.
        StackPush(PSt1, PElemF);
        //Запись второго элемента.
        StackPush(PSt1, PElem);
      end;
      2 : Writeln('Перестановка не требуется.');
      else begin
        //Переливаем (Ind - 1) элементов из первого стека во второй.
        //В результате этого, элемент, который был на вершине первого стека,
        //окажется на дне второго стека. А элемент с заданным индексом (Ind)
        //окажется на вершине первого стека.
        i := 0;
        j := Ind - 1;
        while i < j do begin
          Inc(i);
          StackPop(PSt1, PElem);
          StackPush(PSt2, PElem);
        end;
        //Берём с вершины первого стека искомый элемент.
        StackPop(PSt1, PElemF);
        //Теперь возвращаем из второго стека в первый стек все элементы, кроме
        //того, который лежит на дне второго стека.
        i := 0;
        j := Ind - 2;
        while i < j do begin
          Inc(i);
          StackPop(PSt2, PElem);
          StackPush(PSt1, PElem);
        end;
        //Добавляем в первый стек элемент, который мы запомнили.
        StackPush(PSt1, PElemF);
        //Возвращаем оставшийся элемент из второго стека в первый стек.
        StackPop(PSt2, PElem);
        StackPush(PSt1, PElem);
      end;
    end;
 
    //Распечатка элементов первого стека. При этом, первый стек очищается.
    Writeln('Содержимое стека:');
    i := 0;
    while StackPop(PSt1, PElem) do begin
      Inc(i);
      if i > 1 then Write(', ');
      (* Если надо распечатать в соответствии с заданным перечисляемым типом.
      Write(i, ':');
      case PElem^.Data of
        Num0 : Write('Num0');
        Num1 : Write('Num1');
        Num2 : Write('Num2');
        Num3 : Write('Num3');
        Num4 : Write('Num4');
        Num5 : Write('Num5');
      end;
      *)
      Write(i, ':', Integer(PElem^.Data));
    end;
    Writeln;
 
    //Удаление стеков из памяти.
    StackFree(PSt1);
    StackFree(PSt2);
    Writeln('Работа завершена. Стеки удалены из памяти.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.

Новые блоги и статьи Все статьи Все блоги /
Автозаполнение реквизита при выборе элемента справочника Maks 27.03.2026 Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. При выборе "Спецтехники" (Тип Справочник. Спецтехника), заполняется. . .	Сумматор с применением элементов трёх состояний. Hrethgir 26.03.2026 Тут. https:/ / fips. ru/ EGD/ ab3c85c8-836d-4866-871b-c2f0c5d77fbc Первый документ красиво выглядит, но без схемы. Это конечно не даёт никаких плюсов автору, но тем не менее. . . всё может быть. . .	Автозаполнение реквизитов при создании документа Maks 26.03.2026 Программный код из решения ниже размещается в модуле объекта документа, в процедуре "ПриСозданииНаСервере". Алгоритм проверки заполнения реализован для исключения перезаписи значения реквизита,. . .	Команды формы и диалоговое окно Maks 26.03.2026 1. Команда формы "ЗаполнитьЗапчасти". Программный код из решения ниже на примере нетипового документа "ЗаявкаНаРемонтСпецтехники" разработанного в конфигурации КА2. В качестве источника данных. . .
Кому нужен AOT? DevAlt 26.03.2026 Решил сделать простой ланчер Написал заготовку: dotnet new console --aot -o UrlHandler var items = args. Split(":"); var tag = items; var id = items; var executable = args;. . .	Отправка уведомления на почту при создании или изменении элементов справочника Maks 24.03.2026 Программная отправка письма электронной почты на примере типового справочника "Склады" в конфигурации БП3. Перед реализацией необходимо выполнить настройку системной учетной записи электронной. . .	модель ЗдравоСохранения 5. Меньше увольнений- больше дохода! anaschu 24.03.2026 Теперь система здравосохранения уменьшает количество увольнений. 9TO2GP2bpX4 a42b81fb172ffc12ca589c7898261ccb/ https:/ / rutube. ru/ video/ a42b81fb172ffc12ca589c7898261ccb/ Слева синяя линия -. . .	Midnight Chicago Blues kumehtar 24.03.2026 Такой Midnight Chicago Blues, знаешь?. . Когда вечерние улицы становятся ночными, а ты не можешь уснуть. Ты идёшь в любимый старый бар, и бармен наливает тебе виски. Ты смотришь на пролетающие. . .

@andrewrusin 1 / 1 / 0 Регистрация: 11.07.2011 Сообщений: 23

	Стек на односвязанном списке. Элементы стека принадлежат перечисляемому типу. 20.10.2011, 15:31. Показов 1202. Ответов 3 Метки нет (Все метки) Mawrat, Помогите пожалуйста! Структура односвязного списка: "Стек" Тип информационного поля: "Перечисляемый тип" Перемещение найденного элемента: "на место за 1-ым элементом" 0

@andrewrusin 1 / 1 / 0 Регистрация: 11.07.2011 Сообщений: 23
	22.10.2011, 20:51 [ТС]
	Спасибо большое!) 0