Реализация стека в Паскале

Реализация стека в Паскале


Для тех кто не знает, что такое стек:информация на википедии и статья о стеке в С++ .

Теперь перейдем непосредственно к реализации. Храниться стек будет в массиве, самый нижний элемент стека будет находиться в 1 элементе.


var
  a : array[1..100] of integer;


Процедура Push(Добавление на вершину стека). Работает так: передвигаем указатель с последнего занятого элемента в массиве(верхнего в стеке) на первый свободный элемент массива(т.е. увеличиваем size на 1). Потом добавляем в эту пустую ячейку новый элемент. Таким образом size вновь указывает на верхний элемент стека.


procedure push(c :integer);
begin
  size := size + 1;
  a[size] := c;
end;


Процедура Pop(Удаление верхнего элемента стека). Просто уменьшаем текущий размер, ничего не делая с последним элементом. Этот последний элемент будет уже как бы вне массива, поэтому мешать не будет.

 
procedure pop;
begin
  size := size - 1;
end;


Функция Top(Получения значения верхнего элемента стека). Т.к. мы знаем индекс элемента, который находится на вершине стека(этот индекс size), то просто возвращаем элемент с данным индексом.


function top : integer;
begin
  top := a[size];
end;


Функцию проверки на пустоту отдельно реализовывать не будем. Чтобы проверить пуст ли стек нужно просто сравнить size с 1.

Пример:


var
a : array[1..100] of integer;
size, x, i : integer;

procedure push(c : integer);
begin
  size := size + 1;
  a[size] := c;
end;

procedure pop;
begin
  size := size - 1;
end;

function top : integer;
begin
  top := a[size];
end;

begin

  size := 0; {Изначально стек пуст}
  
  for i := 1 to 3 do begin {добавляем 3 введенных с клавиатуры элемента. Например 4 16 9}
    readln(x);
    Push(x);
  end;
  
  writeln(Top()); {Верхний элемент - 9. Поэтому на экран будет выведено 9}
  
  while size > 0 do  {Удаляем элементы пока стек не опустеет}
    Pop();

  writeln(size); {Стек пуст, поэтому выведется 0}

end.
Ключевые теги: стек pascal, стек паскаль
Понравилась новость? Добавь в закладки!
Хочешь получать свежие новости? Подпишись на обновления с сайта!
Рекомендуем посмотреть:
#1 | написал: Айнура | 6 января 2012 16:53 | ICQ: |

Группа: Гости
Публикаций: 0
Комментариев: 0

спасибо!! очень помогло


#2 | написал: ыавэанпоргжлд | 24 марта 2013 16:25 | ICQ: |

Группа: Гости
Публикаций: 0
Комментариев: 0
это не стек.
здесь я могу получить доступ к любому элементу,а в стеке только к крайнему.

#3 | написал: Topcoder | 27 марта 2013 15:41 | ICQ: | Пользователь offline

Группа: Администраторы
Публикаций: 14
Комментариев: 9
При помощи реализованных функций можно получить доступ как раз таки только к последнему элементу. Так что это стек.

#4 | написал: программюга | 4 февраля 2014 15:25 | ICQ: |

Группа: Гости
Публикаций: 0
Комментариев: 0
в ассемблере я тоже могу получить доступ к любому элементу стека, так что это стек

#5 | написал: Antonio | 9 апреля 2014 15:54 | ICQ: |

Группа: Гости
Публикаций: 0
Комментариев: 0
Не проходит задача дистанционно на сайте: http://informatics.mccme.ru/mod/statements/view.php?id=207
подскажите plis, что у меня не так?
var
a:array[0..100] of integer;
b:array[0..10]of integer;
siz,n,code,k,i,s2,m,t,d,sign : integer;
s1:string;
procedure push(n:integer);
begin
siz:=siz+1;
a[siz]:=n;
write('ok');
end;
procedure pop;
begin
siz:=siz-1;
end;
procedure back;
begin
write(a[siz]);
end;
procedure size;
begin
write(siz);
end;
procedure clear;
begin
while (siz>0) do siz:=siz-1;
end;
procedure ex;
begin
write('bye');
s1:='q';
end;
begin
siz:=0;
repeat
read(s1);
sign:=1;
if (s1[2]='u')then begin
m:=length(s1)-6;
t:=0;
for i:=6 to 6+m do begin
n:=ord(s1[i]);
if s1[i]='-' then begin sign:=-1; continue end;
case n of
48:n:=0;
49:n:=1;
50:n:=2;
51:n:=3;
52:n:=4;
53:n:=5;
54:n:=6;
55:n:=7;
56:n:=8;
57:n:=9
else begin write('error');exit; end;
end;
b[t]:=n;
t:=t+1;
end;
d:=1;s2:=0;
t:=t-1;
for i:=t downto 0 do begin
n:=b[i]*d;
s2:=s2+n;
d:=d*10;
end;
n:=sign*s2;
push(n);
end
else if s1[2]='o' then begin write(a[siz]);pop;end
else if s1[2]='a' then back
else if s1[2]='i' then size
else if s1[2]='l' then begin clear;write('ok');end
else if s1[2]='x' then ex;
until (s1='q');
end.

Добавление комментария

Ваше Имя:
Ваш E-Mail:
Полужирный Наклонный текст Подчеркнутый текст Зачеркнутый текст | Выравнивание по левому краю По центру Выравнивание по правому краю | Вставка смайликов Выбор цвета | Скрытый текст Вставка цитаты Вставка исходного кода Преобразовать выбранный текст из транслитерации в кириллицу Вставка спойлера

Введите два слова, показанных на изображении: