Извлечение элемента из стека

В результате выполнения этой операции некоторой переменной i должно быть присвоено значение первого элемента стека и значение указателя на начало списка должно быть перенесено на следующий элемент стека.

Procedure readStack(Var u: EXST; Var i: integer);

Var

x: EXST;

Begin

i:= u^.Data; {считываем значение поля данных в переменную}

x:= u; {запоминаем адрес вершины стека}

u:= u^.Next; {переносим вершину стека на следующий элемент}

dispose(x); {освобождаем память, занятую уже ненужным элементом стека}

End.

Недостатком описанной процедуры является предположение о том, что стек не пуст. Для его исправления следует разработать логическую функцию проверки пустоты обрабатываемого стека.

Function FreeStack(u: EXST): boolean;

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

Чтобы наглядно рассмотреть работу стека, наберите следующую программу.

Program Demidenko;

Uses

Crt, Graph;

Type

sp=^spis;

ecord

elem: byte;

next: sp;

End;

Var

a, b: byte;

s: string;

gd, gm, c: integer;

head, some, x: sp;

bol: boolean;

ch: char;

Procedure OutX(x, y: integer);

Begin

Line(x+50,y+10,x+70,y+10);

Line(x+50,y+10,x+55,y+10-3);

Line(x+50,y+10,x+55,y+10+3);

Line(x+55,y+13,x+55,y+10-3);

OutTextXY(x+70,y+10,'x');

End;

Procedure Wiv (x, y: integer; ss: sp);

Begin

Line(x,y,x+50,y);

Line(x,y,x,y+20);

Line(x,y+20,x+50,y+20);

Line(x+50,y,x+50,y+20);

Line(x+30,y,x+30,y+20);

if some=ss

then

Begin

Line(x+50,y+10,x+70,y+10);

Line(x+50,y+10,x+55,y+10-3);

Line(x+50,y+10,x+55,y+10+3);

Line(x+55,y+13,x+55,y+10-3); End;

Str(ss^.elem, s);

OutTextXY(x+10,y+10,s);

if (ss^.next<>nil)

then

Begin

Line(x+40,y+10,x+40,y+40);

Line(x+40,y+40,x+37,y+40-5);

Line(x+40,y+40,x+43,y+40-5);

Line(x+43,y+40-5,x+37,y+40-5);

Wiv(x,y+40,ss^.next);

End

else

Begin

Line(x+40,y+10,x+40,y+30);

Line(x+40,y+30,x+37,y+25);

Line(x+40,y+30,x+43,y+25);

Line(x+43,y+25,x+37,y+25);

Line(x+35,y+32,x+45,y+32);

Line(x+36,y+35,x+44,y+35);

Line(x+38,y+38,x+42,y+38);

End;

End;

Procedure Insertsp(x: byte);

Begin

Cleardevice;

OutTextXY(50,20,'NEW(X)');

new(some);

Line(20,100,20+50,100);

Line(20,100,20,100+20);

Line(20,100+20,20+50,100+20);

Line(20+50,100,20+50,100+20);

Line(20+30,100,20+30,100+20);

Outx(20,100);

if head<>nil

then

Wiv(20,140,head);

Delay(1000);

Cleardevice;

OutTextXY(50,20,'X^.NEXT:=TAIL');

OutTextXY(50,40,'TAIL:=X');

some^.next:=head;

head:=some;

Wiv(20,100,head);

Delay(1000);

Cleardevice;

Str(x,s);

OutTextXY(50,20,'SOME^.ELEM:='+s);

some^.elem:=x;

Wiv(20,100,head);

Delay(1000);

End;

Procedure DelSp;

Begin

Cleardevice;

if head=nil

then

Begin

Y(50,20,'Элемент не существует!');

Delay(1000);

End

else

if head^.next<>nil

then

Begin

OutTextXY(50,20,'X:=TAIL');

OutTextXY(50,40,'TAIL:=TAIL^.NEXT');

some:=some^.next;

Wiv(20,100,head);

OutX(20,100);

Delay(1000);

Cleardevice;

OutTextXY(50,20,'DISPOSE(X)');

Wiv(20,100,head);

OutX(20,100);

Setcolor(red);

Line(20,90,70,130);

Line(70,90,20,130);

Setcolor(white);

Delay(1000);

Cleardevice;

head:=head^.next;

some:=head;

Wiv(20,100,head);

End

else

Begin

OutTextXY(50,20,'DISPOSE(TAIL)');

Wiv(20,100,head);

Setcolor(red);

Line(20,90,70,130);

Line(70,90,20,130);

Setcolor(white);

Delay(1000);

ClearDevice;

head:=nil;

some:=head;

End;

End;

Begin

ClrScr;

bol:=false;

gD:= Detect;

InitGraph(gD, gM,'c:\tp7\bgi\');

TextBackGround(black);

Setbkcolor(black);

Head:=nil;

Some:=head;

Repeat

OutTextXY(250,200,'1 * Добавить элемент');

OutTextXY(250,220,'2 * Удалить элемент');

OutTextXY(250,240,'Esc Выход');

ch:=readkey;

case ch of

'1': Begin

OutTextXY(250,260,'Введите число:');

gotoxy(48,17);

readln(b);

InsertSp(b);

End;

'2': delsp;

#27: Begin

CloseGraph;

Halt;

End;

End;

until bol;

CloseGraph;

End.

Примеры решения задач.

Пример 1. Используя стек, напечатать содержимое текстового файла, выписывая литеры каждой его строки в обратном порядке.

Program MordovskihK;

Type

EXST = ^ST;

ST = record

Data: char;

Next: EXST;

End;

Var

Stack: EXST; {Текущая переменная}

i: integer;

f: text;

Stroka: string;

c: char;

Procedure writeStack(Var u: EXST; Simvol: char);

Var

x: EXST;

Begin

new(x);

x^.Data:= Simvol;

x^.Next:= u;

u:= x;

End;

Procedure Print(Var u: EXST);

Begin

while u <> Nil

Begin

write (u^.Data);

u:= u^.Next;

End;

End;

Begin

Stack:= Nil;

Assign(f, 'c:\autoexec.bat');

Reset(f);

while Not Eof(f) do

Begin

readln (f, Stroka);

For i:= 1 to Length(Stroka) do

writeStack(Stack, Stroka[i]);

End;

close(f);

Print(Stack);

End.

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

Для решения задачи определим стек, элементами которого являются символы:

Type

EXST = ^ST;

ST = record

Data: char;

Next: EXST;

End;

Будем двигаться по строке а: string до ее конца. Если в процессе просмотра встретится одна из закрывающихся скобок ({, (, [), занесем ее в стек. При обнаружении закрывающейся скобки, соответствующей скобке, находящейся в вершине стека, последняя удаляется. При несоответствии скобок выдается сообщение об ошибке.

Пусть факт наличия ошибки хранится в переменной логического типа f, то есть f=True, пока ошибка не найдена и f=False в противном случае. Тогда условие работы цикла будет выглядеть так:

while (i<>Length(a)) and f do...

Осталось выяснить, как определить, соответствует ли очередная закрывающаяся скобка скобке, находящейся в вершине стека. Можно заметить, что коды соответствующих друг другу скобок отличаются не более чем на 2, что можно проверить с помощью функции Ord(x)):

{ } 123–125

[ ] 91–93

() 40–41

Причем код открывающейся скобки меньше. То есть можно записать следующее условие соответствия:

if (Ord(a[i]–Ord(stack^.Data))<=2

then

...

А теперь просмотрите полный текст программы:

Program Skobki;

Type

EXST = ^ST;

ST = record

Data: char;

Next: EXST;

end;

Var

a: string;

f: boolean;

i: integer;

Procedure writeStack(Var x1: EXST; c: integer);

Var

u: EXST;

Begin

new(u); {создание нового элемента стека}

u^,Data:= c;

u^.Next:= x1;

x1:= u; {созданный элемент определить как вершину стека}

End;

Procedure DelStack(Var x1: EXST); {процедура удаления верхнего элемента стека}

Var

u: EXST;

Begin

u:= x1;

x1:= x1^.Next;

dispose(u);

End.

Procedure Solve(a: string); {процедура правильности расстановки скобок}

Var

Stack: EXST;

Begin

Stack:= Nil;

i:= 1;

while (i<=Length(a)) and f do

begin

if (a[i]='(') or (a[i]='{') or (a[i]='[')

then

writeStack(Stack, a[i])

else

if (a[i]=')') or (a[i]='}') or (a[i]=']')

then

if Ord(Stack ^.Data)–Ord(a[i])<=2

then

DelStack(Stack)

else

f:= False;

Inc(i);

end;

End.

Begin

writeln('Введите строку');

readln(a);

f:= True;

if a<>' '

then

begin

Solve(a);

if f

then

writeln('Все скобки расставлены верно')

else

writeln('Скобка ',a[i-1],' закрыта преждевременно');

end

else

writeln('Строка пуста');

readln;

End.

Задание. Объясните учителю алгоритмы решения предложенных задач.

Не нашли, что искали? Воспользуйтесь поиском: