В результате выполнения этой операции некоторой переменной 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; {созданный элемент определить как вершину стека}
