2

Лицей №1

«Решение задач при помощи структур данных (стеки, очереди)»

Выполнила Майдобурова С.А.

Барановичи

2004 г.

Введение

Структуры данных стеки и очереди используются для решения задач в курсе 10 - 11 класса с углубленным изучением информатики. Во-первых, в отличие от базового курса информатики, здесь все задачи решаются через блочную структуру программ, с использованием разработанных процедур и функций (а для этого нужно хорошо понимать, как их правильно написать). Во-вторых, многие олимпиадные задачи можно решать, используя эти структуры данных (в частности задача про «нулевые зоны» часто появляется на олимпиадах городского уровня). При этом логика реализации такой программы достаточно понятна ученикам и служит подготовкой для перехода к реализации решения этих же задач не с помощью массивов, а с помощью типа указатель. Учащиеся, усвоившие логику работы с такими структурами данных практически не испытывают никаких затруднений, изучая программирование на первых курсах ВУЗов, где есть такой предмет.

Очереди

Очередь (queue) - структура данных, в которой обработка (удаление) её элементов производится в зависимости от порядка их поступления (добавления). Т.е. из двух добавленных элементов раньше будет удалён тот, который был раньше добавлен. Так что, очередью в общем случае будем считать структуру данных, для которой определены операции добавления и удаления элементов и элементы которой организованы таким образом, что их удаление (если это необходимо) будет осуществляться точно в таком же порядке, в каком происходило их добавление.

в очередь из очереди

Есть несколько способов реализации такой структуры. Простейшей является реализация при помощи массива и двух переменных-указателей, один из которых определяет то место массива, куда элемент будет добавляться, и называется концом очереди (УК), а другой - определяет то место массива, откуда элемент будет удаляться, и называется началом очереди (УН). Если УК<>УН, то в очереди есть элементы, при этом элемент с меньшим номером считается поступившим в очередь раньше, чем элемент с большим номером.

Допустим, в очередь помещён элемент А, потом В, потом С. Тогда очередь имеет вид:



УН УК

Когда потребуется удалить элемент, то первым обязан будет удалиться элемент А.

УН УК

Теперь первым элементом в очереди будет В, а последним - С. Удаление происходит путём перемещения указателя УН, при этом элемент А остаётся в массиве (но не в очереди).

Если нужно добавить новый элемент D в очередь, то он будет помещён в конец очереди, определяемый указателем УК, при помещении нового элемента значение этого указателя изменяется, т.е. получим следующее:

УН УК

Если нужно будет удалить какой-нибудь средний элемент очереди (например, С), сначала нужно удалить элементы, идущие до него (элемент В).

Из-за этого структуру очередь называют ещё структурой FIFO (First In, First Out) - «первым пришёл, первым ушёл».

Очередь, где нет ни одного элемента, называют пустой. В этом случае УК=УН.

Реализация очереди с помощью массива.

Операции над очередями и их реализация.

В программе для реализации структуры очередь будем использовать массив Q. В качестве указателя УН возьмём переменную n, а в качестве УК - переменную k. В самом начале переменным n и k присваивается значение 1. Условие n=k говорит о том, что очередь пуста.

Для работы с очередью определим четыре элементарные операции:

Pusto - создаёт пустую очередь.

Proverka - возвращает значение true, если очередь пуста, и false в противном случае.

Dobav - добавляет элемент в конец очереди.

Udalen - удаляет элемент из начала очереди.

При реализации программ на языке Pascal будем придерживаться следующих замечаний:

1. Т.к. будет использоваться массив, то в переменную max лучше описать в разделе констант (задать её значение).

2. В разделе type сделать запись

Q = array [1..max] of real;

3. Затем создадим пустую очередь, выполнив процедуру Pusto.

Procedure Pusto (var a:Q; var n,k:integer);

Begin

n: =1;

k: =1;

End;

4. Операция Proverka используется для проверки очереди на «пустоту».

Function Proverka (var p:Q; var n,k:integer):Boolean;

Begin

if n = k then Proverka: = true else Proverka: = false;

End;

5. Операция Dobav может быть выполнена всегда, кроме случая, когда очередь уже полна. Поэтому, прежде чем вставить элемент в очередь, необходимо проверить массив на наличие свободного места. Значит, нам понадобится переменная с, значение которой будет равно 0, если операция добавления элемента не выполнена из-за отсутствия места в очереди, и равно 1 - если операция добавления прошла успешно.

Procedure Dobav (var p:Q; var n,k:integer; var c:integer; x:real);

Begin

if k>max then begin c: = 0; exit; end

else begin p[k]: = x; k: = k +1; c: = 1; end;

6. Операция удаления элемента из очереди Udalen может выполняться в том случае, если очередь не пуста. Поэтому сначала нужно убедиться, что очередь не пуста, и только потом можно удалять элемент из очереди. Значение переменной с будет равно 2, что означает, что операция удаления элементов невозможна из-за отсутствия таковых.

Procedure Udalen (var p:Q; var n,k:integer; var c:integer; x:real);

Begin

if Pusto(p,n,k) then begin c: = 2; exit; end

else begin x: = p[k]; n: = n + 1; c: = 1; end;

Замечания и некоторые возможные усовершенствования процедур.

Недостатком приведённой реализации является то, что при многократном использовании операций добавления и удаления элементов в очереди будет находиться небольшое количество элементов, в то время как сам массив, используемый для очереди, будет весь заполнен. Ведь размер массива ограничен, а указатели УК и УН просто перемещаются вдоль порядковых номеров массива.

Чтобы избежать такой ситуации, можно рассматривать кольцевую очередь. Для этого нужно обеспечить, чтобы в массиве после элемента с номером max следовал элемент с номером 1. Тогда возможна ситуация, когда УН>УК. А при УН=УК может быть две ситуации: когда очередь пуста и когда очередь полна. Значит, необходимо знать тип последней операции: было добавление или удаление элемента. Используем переменную Ор, значение которой будет равно 1 при добавлении элемента, и 0 - при удалении.

В таком случае, процедуры добавления и вставки элемента будут такими:

Procedure Dobav (var p:Q; var n,k:integer; var c,Op:integer; x:real);

Begin

if (Op = 1) and (n = k) then begin c: = 0; {Очередь полна}

exit;

end

else begin Op: = 1;

p[k]: = x;

k: = k + 1;

if k > max then begin k: = 1; c: = 1 end;

end;

End;

Procedure Udalen (var p:Q; var n,k:integer; var c,Op:integer; x:real);

Begin

if (Op = 0) and (n = k) then begin c: = 2; {Очередь пуста}

exit;

end

else begin Op: = 0;

x: = p[k];

n: = n + 1;

if n > max then begin n: = 1; c: = 1; end;

end;

End;

Решение задач с помощью очереди.

Пример 1.

Из листа клетчатой бумаги размером M x N удалили некоторые клетки размером 1 х 1. Определите, на сколько связных кусков распадается оставшаяся часть листа. К - количество удалённых клеток, (х1; у1), …, (хk; yk) - координаты удалённых клеток.

Для решения данной задачи рассмотрим двумерный массив M x N, где удалённые клетки имеют значение -1, а неудалённые - 0.

В нашем алгоритме мы будем находить первую клетку со значением 0, помечаем её определённым образом, а потом находим и помечаем клетки, имеющие общую сторону с найденной клеткой и к тому же со значением 0. Потом находим и помечаем «нулевых» соседей последних найденных клеток и т.д. Процесс заканчивается, когда никаких новых клеток не удаётся найти. Значит, мы получили единый кусок листа.

Далее выбираем новую начальную клетку и опять повторяем процесс нахождения её «соседей», равных 0.

Алгоритм закончится, когда на «листе» не останется клеток со значением 0.

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

Для примера рассмотрим лист размером 4 х 5, где удалёнными (со значением -1) считаются клетки с координатами (1;5), (4;5), (3;4), (2;3), (2;2), (1;1), (3;1). Итак,

i \ j	1	2	3	4
1	-1	0	-1	0
2	0	-1	0	0
3	0	-1	0	0
4	0	0	-1	0
5	-1	0	0	-1

Теперь найдём первую клетку со значением 0 и занесём её координаты в очередь. При этом в матрицу на соответствующее место ставится номер куска, который рассматривается (в данном случае 1). Первой найдена клетка с координатами (1;2).

Индексы	1	2	3	4	5	6	7	8	9	10	11	12	13	14
i	1
j	2

УН = УК

i \ j	1	2	3	4
1	-1	1	-1	0
2	0	-1	0	0
3	0	-1	0	0
4	0	0	-1	0
5	-1	0	0	-1

Рядом с этой клеткой нет других, со значением 0. Удаляем эту клетку из очереди, при этом УН становится опять равным УК. Потом ищем следующую начальную клетку. Это будет клетка с координатами (1;4). Её в таблице помечаем номером 2 (второй кусок). В очередь вносим её координаты и координаты её нулевых «соседей»-клеток, а потом их «соседей», и т.д. Получим следующее:

Индексы	1	2	3	4	5	6	7	8	9	10	11	12	13	14
i	1	1	2	2	3	3	3	4
j	2	4	4	3	4	3	4	4

УН = УК

На каждом шаге после проверки элемента на наличие нужных «соседей» и его пометке в массиве, удаляем его из очереди. Продолжаем процесс до тех пор, пока очередь не станет пуста.

Массив-лист примет следующий вид:

i \ j	1	2	3	4
1	-1	1	-1	2
2	0	-1	2	2
3	0	-1	2	2
4	0	0	-1	2
5	-1	0	0	-1

Следующий начальный нулевой элемент с координатами (2;1) будет уже помечаться номером 3 (третий кусок). Вносим его координаты в очередь, и действуем по знакомому алгоритму.

Индексы	1	2	3	4	5	6	7	8	9	10	11	12	13	14	15	16
i	1	1	2	2	3	3	3	4	2	2	3	4	4	5	5
j	2	4	4	3	4	3	4	4	3	1	1	1	2	2	3

УН=УК

Массив примет вид:

i \ j	1	2	3	4
1	-1	1	-1	2
2	3	-1	2	2
3	3	-1	2	2
4	3	3	-1	2
5	-1	3	3	-1

Больше нулевых элементов нет. Поэтому алгоритм будет завершен. Количество кусков равно 3.

Реализация алгоритма на языке Pascal.

Program Kuski;

uses crt;

const max = 100;

type

p = array[1..2,1..max] of byte;

var

m,n,i,j,x,y:integer;

w,c,d,l,k,s:integer;

a:array[1..10,1..10] of shortint;

q:p;

Procedure Pusto(var q:p;var c,d:integer);

begin

c:=1; d:=1;

end;

Function Prover(var q:p;var c,d:integer):boolean;

begin

if c=d then Prover:=true else Prover:=false;

End;

Procedure Dobav(var q:p;var c,d:integer; var s:integer;

var a,b:integer);

begin

if d>max then begin s:=0; exit; end;

q[1,d]:=a; q[2,d]:=b;

d:=d+1;

s:=1;

End;

Procedure Udalen(var q:p;var c,d:integer; var s:integer);

begin

if Prover(q,c,d) then begin s:=0; exit; end;

c:=c+1;

s:=2;

End;

BEGIN clrscr;

write('m='); readln(m);

write('n='); readln(n);

for i:=1 to m do

for j:=1 to n do begin

write('a[',i,',',j,']=');

readln(a[i,j]); end;

Pusto(q,c,d);

k:=0;

for i:=1 to m do

for j:=1 to n do

if a[i,j]=0 then begin

k:=k+1;

Dobav(q,c,d,s,i,j);

a[i,j]:=k;

while c<>d do

for l:=c to d do begin

x:=q[1,l]; y:=q[2,l];

if (x>1) and (a[x-1,y]=0) then begin w:=x-1; Dobav(q,c,d,s,w,y);

a[w,y]:=k;



end;

if (x<m) and (a[x+1,y]=0) then begin w:=x+1;

Dobav(q,c,d,s,w,y);

a[x+1,y]:=k;

end;

if (y>1) and (a[x,y-1]=0) then begin w:=y-1;

Dobav(q,c,d,s,x,w);

a[x,y-1]:=k;

end;

if (y<n) and (a[x,y+1]=0) then begin w:=y+1;

Dobav(q,c,d,s,x,w);

a[x,y+1]:=k;

end;

Udalen(q,c,d,s);

end;

end;

writeln('Количество кусков k=',k);

readln;

END.

Пример 2.

Имеется план местности, разбитой на квадраты, заданный матрицей размером M x N. Каждый квадрат имеет одно из обозначений: 0, если в квадрате твёрдая почва, и -1, если в квадрате болото. Необходимо определить, имеется ли в маршрут робота из позиции (ХС, УС) в позицию (ХФ, УФ), если робот может двигаться только по ровной местности и только в горизонтальном и вертикальном направлениях. При этом вдоль границ квадратов двигаться нельзя.

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

1) нам не нужно больше искать все куски по которым ходит робот, перемещаться нужно будет только в пределах одного куска;

2) необходимо сделать проверку исходной точки - старта робота, и конечной - финиша, не являются ли они координатами болота. Если это так - нет смысла искать маршрут.

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

program Robot;

uses crt;

const max=100;

type p=array[1..3,1..max] of byte;

var

m,n,i,j,x,y,z,nx,ny,kx,ky:integer;

w,c,d,l,k,s,h:integer;

a:array[1..10,1..10] of shortint;

q,v:p;

Procedure Pusto(var q:p;var c,d:integer);

begin

c:=1;

d:=1;

End;

Function Prover(var q:p;var c,d:integer):boolean;

begin

if c=d then Prover:=true else Prover:=false;

End;

Procedure Dobav(var q:p;var c,d:integer; var s:integer;

var a,b:integer;var k:integer);

begin

if d>max then begin s:=0; exit; end;

q[1,d]:=a;

q[2,d]:=b;

q[3,d]:=k;

d:=d+1;

s:=1;

End;

Procedure Udalen(var q:p;var c,d:integer; var s:integer);

begin

if Prover(q,c,d) then begin s:=0; exit; end;

c:=c+1; s:=2;

End;

BEGIN

clrscr;

write('m='); readln(m);

write('n='); readln(n);

writeln('Введите значения клеток');

for i:=1 to m do

for j:=1 to n do begin

write('a[',i,',',j,']=');

readln(a[i,j]); end;

write('nx=');readln(nx);

write('ny=');readln(ny);

if a[nx,ny]=-1 then begin writeln('Робот не будет начинать свой путь в болоте!!!'); readln; exit; end;

write('kx=');readln(kx);

write('ky=');readln(ky);

if a[kx,ky]=-1 then begin writeln('Робот не должен заканчивать свой путь в болоте!!!'); readln; exit; end;

Pusto(q,c,d);

k:=1;

Dobav(q,c,d,s,nx,ny,k);

a[nx,ny]:=k;

while c<>d do

for i:=c to d do begin

x:=q[1,i];

y:=q[2,i];

h:=q[3,i];

if (x>1) and (a[x-1,y]=0) then begin w:=x-1; k:=h+1;

Dobav(q,c,d,s,w,y,k);

a[w,y]:=k;

end;

if (x<m) and (a[x+1,y]=0) then begin w:=x+1; k:=h+1;

Dobav(q,c,d,s,w,y,k);

a[x+1,y]:=k;

end;

if (y>1) and (a[x,y-1]=0) then begin w:=y-1; k:=h+1;

Dobav(q,c,d,s,x,w,k);

a[x,y-1]:=k;

end;

if (y<n) and (a[x,y+1]=0) then begin w:=y+1; k:=h+1;

Dobav(q,c,d,s,x,w,k);

a[x,y+1]:=k;

end;

Udalen(q,c,d,s);

end;

{ writeln('k=',k); }

for i:=1 to 3 do begin

for j:=1 to d-1 do

write(q[i,j]:3);

writeln;

end;

writeln;

h:=0;



for j:=1 to d-1 do

if (q[1,j]=kx) and (q[2,j]=ky) then begin h:=j; k:=q[3,j]; end;

if h<>0 then begin

writeln('Путь пройден за ',k-1,' шаг(-ов)!');

v[1,k]:=q[1,h];

v[2,k]:=q[2,h];

v[3,k]:=q[3,h];

i:=k;

for j:=h-1 downto 1 do begin

x:=q[1,j];

y:=q[2,j];

z:=q[3,j];

if (v[3,i]-z=1) and (((abs(x-v[1,i])=1) and (y=v[2,i])) or ((x=v[1,i]) and (abs(y-v[2,i])=1)))

then begin i:=i-1;

v[1,i]:=x;

v[2,i]:=y;

v[3,i]:=z;

end; end;

for i:=1 to 2 do ?????

for j:=1 to k do

write(v[i,j]:3);

writeln;

????

end

else writeln('Такого пути нет!');

readln;

END.

Стеки.

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

Помещение в стек в порядке: A, B, C, D, E, F.

Извлечение из стека в порядке: F, E, D, C, B, A.

Итак, стек - это такая последовательность данных, доступ к элементам которой осуществляется только с одного конца. Этот элемент традиционно находится сверху и это место называется вершиной стека vs.

Стек часто обозначают аббревиатурой LIFO (Last In, First Out) - «последний пришёл, первый ушёл», а для его моделирования с помощью массива достаточно одного указателя.

Вопросы «на закуску»:

1. Можете ли вы привести примеры стека из повседневной жизни.

2. Сколько необходимо указателей для стека?

3. Что определяет указатель стека?

Операции над стеками.

Структура данных Стек может быть реализована с помощью массива и указателя. Указатель определяет индекс последнего добавленного элемента и называется вершиной стека.

Для стека определены 4 элементарные операции:

1) эта процедура создаёт пустой стек; указательvs приравниваем к 0, в стеке s ещё ничего не записано:

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

2) эта функция возвращает значение true, если стек пуст и false в обратном случае:

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

3) при помощи этой процедуры добавляем элемент в стек; в случае успешного добавления переменная с = 1, неудачи (массив заполнен до отказа, т.е. vs = max) - с=0:

Procedure Dobav(var s:stack;var vs:integer; var c:integer; var x:integer);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[vs]:=x;

c:=1;

End;

4) эта процедура удаляет элемент из стека; в случае удачного удаления переменная с = 2, неудачи (массив пуст - удалять нечего!) - с = 0:

Procedure Udal(var s:stack;var vs:integer; var c:integer; var x:integer);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[vs];

vs:=vs-1;

c:=2;

End;

Решение задач при помощи стека.

Пример 1.

Рассмотрим математическое выражение, в котором имеется несколько уровней вложенных круглых скобок, например

7 - ((Х * ((Х + Y) / (J - 3)) + Y) / (4 - 2,5)).

Убедиться, что скобки расставлены правильно.

Решение:

Скобки расставлены правильно, если 1) КОЛ-ВО `(` = КОЛ-ВО `)`.

2) Каждой скобке `(` соответствует своя `)`.

Например, первое условие нарушено в выражении: (A - (B + C) - D / (A + C),

а второе условие нарушено в выражении: (A - B) + C) - (D / (A + C).

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

program Skobki;

var

s:string;

i,k:byte;

BEGIN

writeln(`Введите арифметическое выражение со скобками');

readln(s);

k:=0; {количество скобок}

i:=1; {порядковый номер рассматриваемого символа строки арифм. выражения}

while (i<=length(s)) and (k>0) do begin

if s[i]='(' then k:=k+1

else if s[i]=')' then k:=k-1;

i:=i+1;

end;

if (k=0)and(i=length(s)+1) then writeln(`Скобки расставлены верно')

else writeln(`Скобки расставлены неверно');

readln;

END.

Пример 2.

Допустим, что в математическом выражении встречаются скобки трёх типов: круглые «(«, «)», квадратные «[», «]» и фигурные «{», «}». Необходимо проверить, выполняется ли баланс скобок, учитывая, что закрывающаяся скобка должна быть того же типа, что и предшествующая ей открывающаяся.

Пример неправильного выражения: (A - [B + C ] }- D / {A + C).

Задача усложнена, по сравнению с предыдущей, из-за типов скобок.

Алгоритм наших действий тогда будет таким: ПОКА СТРОКА НЕ ЗАКОНЧИЛАСЬ - ДЕЛАЙ:

Рассмотрим действие этих команд на примере:

{x+(y-[a+b])*c-[(d+e)]}/(h-(j-(k-[1-n]))).

]

]

)

[

)

(

[

)

(

]

(

(

(

)

{

{

(

(

[

[

[

}

(

(

(

(

(

{

{

{

{

{

{

(

(

(

(

(

(

а)

б)

в)

г)

д)

е)

ж)

з)

и)

к)

л)

м)

н)

о)

р)

Реализация программы на Pascal:

program Skobki;

const

max=20;

type

stack=array[1..max] of char;

var

x:char;

p:string;

s:stack;

d,i,c,vs:integer;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer; var x:char);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[vs]:=x;

c:=1;

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer; var x:char);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[vs];

vs:=vs-1;

c:=0;

End;

BEGIN

Pusto(s,vs);

writeln('Введите арифметическое выражение с разными типами скобок');

readln(p);

d:=length(p);

i:=1;

while i<=d do

begin

x:=p[i];

case x of

'(','[','{': Dobav(s,vs,c,x);

')':if (vs-1>=0) and (s[vs]='(') then Udal(s,vs,c,x)

else begin writeln('Ошибка'); readln; exit end;

']':if (vs-1>=0) and (s[vs]='[') then Udal(s,vs,c,x)

else begin writeln(' Ошибка '); readln; exit end;

'}':if (vs-1>=0) and (s[vs]='{') then Udal(s,vs,c,x)

else begin writeln(' Ошибка '); readln; exit end;

end;

i:=i+1;

end;

if vs<>0 then writeln(' Ошибка ')

else writeln('Выражение составлено правильно');

readln;

End.

Перед рассмотрением третьего примера, следует сказать, что существует несколько способов записи арифметических выражений. Пусть для операндов А и В выполняется сложение. Мы привыкли это записывать в виде: А+В. Такая форма записи называется инфиксной (наверное, подразумевается что приставочка «ин-» говорит о расположении знака внутри). А ещё существуют префиксная(+АВ) и постфиксная(АВ+) формы записи. Отличают они друг от друга положением знака операции по отношению к операндам. Потренируемся в переходах от одной формы записи к другой.

Пусть дано выражение А + В * С. Умножение имеет высший приоритет, чем сложение, поэтому не будет ошибкой (выражение не изменится), если запишется так: А + (В * С). Для записи постфиксного выражения преобразуем сначала ту часть выражения, которая вычисляется первой: А + (ВС *). Осталось записать в постфиксной форме операцию сложения между операндами А и (ВС *): А(ВС*)+ или же АВС * +.

Порядок преобразования в префиксную форму (без комментариев, т.к. аналогично):

1) А + (В * С)

2) А + (* ВС)

3) + А(*ВС)

4) + * АВС

Ещё потренируемся. Дано выражение: (А + В) * С. В постфиксной форме:

(АВ +) * С; (АВ +) С *; АВ + С *.

Попробуйте ещё потренироваться в примерах из первой колонки приведённых примеров, для проверки заглядывая в две другие: (символом ^ изображается операция возведения в степень). И ещё: надеюсь, вы заметили, что префиксная форма не является зеркальным отображением постфиксной.

Инфиксная форма	Префиксная форма	Постфиксная форма
А + В	+ AB	AB +
А + В - С	- + ABC	AB + C -
(А + В) * (С - D)	* + AB - CD	AB + CD - *
A ^ B * C - D + E / F / (G + H)	+ - * ABCD / EF + GH	AB ^ C * D - EF / GH + / +
((A + B) * (D - E)) ^ (F + G)	^ * + AB - DE + FG	FB + DE - * FG + ^
A - B / (C * D ^ E)	- A / B * C ^ DE	ABCDE ^ * / -

Пример 3.

Пусть задано выражение a + b * c + (d * e + f) * g. Записать это выражение в постфиксной форме. (Для проверки, правильным ответом будет: abc * + de * f + g * +).

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

1) Если нам встретился операнд (буква-переменная), то поместим его в специально подготовленную для этого строку.

2) Если встретилась открывающаяся скобка, то помещаем её в стек.

3) Если встретилась закрывающаяся скобка, то выталкиваем из стека в строку все операторы до тех пор, пока из стека не появится открывающаяся скобка. Но ни открывающуюся, ни закрывающуюся скобку в строку помещать не надо.

4) Если нам встретился оператор (арифметический знак), то из стека следует вытолкнуть все операторы, приоритет которых не выше (ниже или такой же) нашего оператора. После этого в стек записываем наш оператор. (Написано туманно, но далее следует пример, где всё станет понятным).

При достижении конца строки всё, что осталось в стеке, помещаем в выходную строку.

Рассмотрим пошагово, что и как должно происходить.

Итак, дана строка р = «a + b * c + (d * e + f) * g». Заведём строку v, куда будем помещать результирующее выражение. Стек - s.

Первый символ - а. Это операнд, помещаем его в строку v.

Далее идёт «+». Это оператор, помещаем его в стек s под номером 1.

Следующий символ - b. Это операнд, он попадает в строку v.

На данный момент ситуация такая:

Стек s	Строка v
+	ab

Следующий символ «*». Это оператор. Элемент в вершине стека имеет более низкий приоритет, чем «*», поэтому в строку v ничего не помещаем, а «*» помещаем в стек.

Далее идёт символ с. Поместим его в строку v.

Теперь ситуация такая:

Стек s	Строка v
* +	abс

Потом встречаем символ «+». Это оператор. Но в вершине стека находится «*», у которой более высокий приоритет. Поэтому извлекаем этот элемент из стека и помещаем в строку v (“abc*”). Следующий элемент стека «+». Он имеет тот же приоритет, что и текущий символ строки v. Следовательно, тоже извлекаем его из стека и помещаем в строку v. А текущий «+» помещаем в стек. В итоге:

Стек s	Строка v
+	abс*+

В данной нам строке следующим символом будет «(«. У него самый высокий приоритет, помещаем его в стек.

За ним следует символ d; это операнд, который мы поместим в строку v.

Стек s	Строка v
) +	abс*+d

Потом добираемся до символа «*». Открывающаяся скобка имеет высший приоритет, поэтому из стека её извлечь нельзя до того, как мы встретим закрывающуюся скобку. Значит, «*» просто помещаем в стек.

За ним следует символ е. Этот операнд помещается в строку v. На этом этапе:



Стек s	Строка v
* ( +	abс*+de

Следующий прочитанный символ «+». Элемент стека «*» имеет более высокий приоритет, значит извлекаем его из стека в выходную строку, а символ «+» помещаем в стек.

На очереди символ f. Его поместим в строку v.

Стек s	Строка v
+ ( +	abс*+de*f

А вот теперь мы встречаем закрывающуюся скобку. В этом случае все элементы стека до «(« включительно помещаем в строку v. Но символ «(« туда не попадает, он просто игнорируется (свою роль он уже сыграл).

Стек s	Строка v
+	abc*+de*f+

Читаем символ «*», он попадает в стек.

Следующий символ g - отправляем в строку v.

Стек s	Строка v
* +	abc*+de*f+g

Строка, из которой мы читали символы, исчерпана. Значит, осталось извлечь в выходную строку все символы. Результат наших действий:

Стек s	Строка v
	abc*+de*f+g*+

А теперь реализация этих действий на языке Pascal:

program Vyrazhenie;

const

max=10;

type

stack=array[1..2,1..max] of string[5];

var

t,x,y,z,e,p,v:string;

s:stack;

w,i,d,f,c,vs:integer;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer; var x,z:string);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[1,vs]:=x;

s[2,vs]:=z;

c:=1;

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer; var x,z:string);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[1,vs];

z:=s[2,vs];

vs:=vs-1;

c:=0;

End;

BEGIN

writeln('Введите арифметическое выражение в инфиксной форме');

readln(p);

d:=length(p);

i:=1;

v:='';

t:='';

f:=5;

e:='';

while i<=d do begin

x:=p[i];

if x='(' then w:=1 else

if x=')' then w:=2 else

if (x='+') or (x='-') then w:=3 else

if (x='*') or (x='/') then w:=4 else w:=5;

case w of

1:begin

if (f=5) and (t<>'') then begin v:=v+t+' ';t:='';end;

e:='0';f:=1;

Dobav(s,vs,c,x,e);

end;

2:begin

if (f=5) and (t<>'') then begin v:=v+t+' ';t:='';end;

while s[1,vs]<>'(' do begin

Udal(s,vs,c,y,z);

v:=v+y+' ';

end;

Udal(s,vs,c,y,z);

e:='0'; f:=2;

end;

3:begin

if (f=5) and (t<>'') then begin v:=v+t+' ';t:=''; end;

e:='1'; f:=3;

while (s[2,vs]>=e) and (s[2,vs]<>'0') do

begin Udal(s,vs,c,y,z);

v:=v+y+' ';

end;

Dobav(s,vs,c,x,e);

end;

4:begin

if (f=5) and (t<>'') then begin v:=v+t+' ';t:='';end;

e:='2'; f:=4;

while (s[2,vs]>=e) and (s[2,vs]<>'0') do

begin

Udal(s,vs,c,y,z);

v:=v+y+' ';

end;

Dobav(s,vs,c,x,e);

end;

5:begin t:=t+x;f:=5;end;

else writeln('Mistake');

end;

i:=i+1;

end;

if t<>'' then v:=v+t+' ';

while vs<>0 do begin

Udal(s,vs,c,y,z);

v:=v+y+' '; end;

writeln(`В постфиксной форме выражение выглядит так: ',v);

readln;

End.

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

Решение:

В постфиксной форме записи каждая операция относится к двум предшествующим операндам. Причём один из этих операндов может быть результатом предыдущего действия. Каждый встретившийся операнд будем записывать в стек. При встрече операции, будем производить действие с двумя верхними элементами стека, а результат поместим опять в стек. Рассмотрим всё это на таком примере.

Пусть задано выражение в постфиксной форме: А=”6523+8*+3+*”. Сначала организуем пустой стек. Первые четыре символа-цифры - это операнды, читаем и помещаем их в стек (Рис.1)

Следующий элемент «+». Извлекаем из стека «2» и «3», выполним действие 3+2, результат «5» помещаем в стек (Рис. 2)

Рис.3 Рис.4 Рис.5 Рис.6 Рис.7

Далее в стек помещаем число «8» (Рис.3)

Далее в строке идёт знак операции «*». Извлекаем из стека «8» и «5», выполняем действие 8*5, а результат «40» помещаем в стек (Рис. 4)

Следующим символом в исходной строке будет «+». Из стека забираем «40» и «5», выполняем 40+5, результат 45 помещаем в стек (Рис.5)

Читаем и помещаем в стек очередной операнд «3» (Рис.6)

Следующий символ входной строки «+». Поэтому извлекаем из стека операнды для этой операции («3» и «45»), выполняем сложение, результат «48» помещаем в стек (Рис. 7)

Последний символ - «*». Операндами для этой операции берём «48» и «6», выполняем умножение, результат «288» помещаем в стек. Значение заданного выражения найдено.

Реализация этого примера на Pascal:

program Poschitay;

const

max=10;

type

stack=array[1..max] of string[10];

var

p,t,x:string;

s:stack;

vs2,w,i,d,f,c,vs:integer;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer; var x:string);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[vs]:=x;

c:=1;

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer; var x:string);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[vs];

vs:=vs-1;

c:=2;

End;

procedure Deystvie(var s:stack; var vs2:integer);

var

q,r,z:string;

w,c,c1,c2:integer;

q1,r1:word;

Begin

if x='+' then w:=1 else

if x='-' then w:=2 else

if x='/' then w:=3 else

if x='*' then w:=4;

Udal(s,vs,c,q);Udal(s,vs,c,r);

val(q,q1,c1);val(r,r1,c1);

case w of

1:r1:=q1+r1;

2:r1:=r1-q1;

3:r1:=r1 div q1;

4:r1:=q1*r1;

end;

str(r1,x);

Dobav(s,vs,c2,x);

End;

BEGIN

writeln('Введите выражение в постфиксной форме');

readln(p);

d:=length(p);

i:=1;

while i<=d do begin

x:=p[i];

if (x='+') or (x='-') or (x='*') or (x='/') then Deystvie(s,vs)

else Dobav(s,vs,c,x);

i:=i+1; end;

writeln(s[vs]);

readln;

End.

Пример 5. Скобочное арифметическое выражение вводится в виде строки символов. В выражении могут участвовать открывающиеся и закрывающиеся круглые скобки, знаки операций сложения, вычитания, умножения и деления, а также цифры от 0 до 9. Найти значение этого выражения.

Решение:

Очевидно, решение этой задачи можно получить исходя из решений примеров 3 и 4. Поэтому привожу только текст программы на Pascal, с пояснением, для чего взята та или иная переменная.

program Poschitay;

const

max=10;

type

stack=array[1..2,1..max] of string[10];

var

t,x,y,z,e,p,v:string;

st,s:stack;

vs2,w,i,d,c,vs:integer;

f:Boolean;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer; var x,z:string);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[1,vs]:=x;

s[2,vs]:=z;

c:=1;

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer; var x,z:string);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[1,vs];

z:=s[2,vs];

vs:=vs-1;

c:=0;

End;

procedure Deystvie(var s,st:stack; var vs:integer;var vs2:integer);

var

q,r,x,z:string;

w,c,c1,c2:integer;

q1,r1:real;

Begin

Udal(s,vs,c,x,z);

if x='+' then w:=1 else

if x='-' then w:=2 else

if x='/' then w:=3 else

if x='*' then w:=4;

Udal(st,vs2,c,q,z);Udal(st,vs2,c,r,z);

val(q,q1,c1);val(r,r1,c1);

case w of

1:r1:=q1+r1;

2:r1:=r1-q1;

3:r1:=r1/q1;

4:r1:=q1*r1;

end;

str(r1,x);

if w=3 then begin c2:=pos('.',x); delete(x,c2,1);Insert('.',x,c2-1); end;

Dobav(st,vs2,c2,x,z);

End;

BEGIN

writeln('Ввведите арифм. выражение с употреблением знаков +, -, *, /, скобок «(» и «)», цифр');

readln(p);

d:=length(p);

i:=1;

v:='';

t:='';

f:=true;

e:='';

while i<=d do begin

x:=p[i];

if x='(' then w:=1 else

if x=')' then w:=2 else

if (x='+') or (x='-') then w:=3 else

if (x='*') or (x='/') then w:=4 else w:=5;

case w of

1:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:='';end;

e:='0';f:=false;

Dobav(s,vs,c,x,e);

end;

2:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:='';end;

while s[1,vs]<>'(' do Deystvie(s,st,vs,vs2);

Udal(s,vs,c,y,z);

e:='0'; f:=false;

end;

3:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:=''; end;

e:='1'; f:= false;

while (s[2,vs]>=e) and (s[2,vs]<>'0') do

Deystvie(s,st,vs,vs2);

Dobav(s,vs,c,x,e);

end;

4:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:='';end;

e:='2'; f:= false;

while (s[2,vs]>=e) and (s[2,vs]<>'0') do Deystvie(s,st,vs,vs2);

Dobav(s,vs,c,x,e);

end;

5:begin t:=t+x;f:=true;end;

else writeln('Mistake');

end;

i:=i+1;

end;

if t<>'' then Dobav(st,vs2,c,t,e);

while vs<>0 do

Deystvie(s,st,vs,vs2);

writeln(st[1,vs2]);

readln;

End.

Пример 6.

Вычислить значение выражения, в котором могут участвовать знаки «+», «-», «/», «*», скобки «(» и «)», целые и дробные числа, причём десятичные записываются через знак «.», а обыкновенные дроби, к примеру, так: 7/12 или 5 1/3.

Решение: Согласна, что следующую программу ещё можно усовершенствовать, но привожу её так, как она работает в данный момент.

program Poschitay;

const

max=10;

type

stack=array[1..2,1..max] of string[10];

var

t,x,y,z,e,p,v:string;

st,s:stack;

vs2,w,i,d,c,vs:integer;

f:boolean;

procedure NOD(var a,b,c,d:longint);

begin

c:=a;

d:=b;

while a<>b do

if a>b then a:=a-b else b:=b-a;

c:=c div a;

d:=d div b;

end;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer; var x,z:string);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[1,vs]:=x;

s[2,vs]:=z;

c:=1;

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer; var x,z:string);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[1,vs];

z:=s[2,vs];

vs:=vs-1;

c:=0;

End;

procedure Chislo(var ch:string);

var

i,j,a,b,c:byte;

m,n,k:string;

m1,n1,k1:longint;

z:integer;

begin

a:=pos('.',ch);

b:=pos(' ',ch);

c:=pos('/',ch);

if (a=0) and (b=0) and (c=0) then ch:=ch+'/1'

else if a<>0 then begin Delete(ch,a,1);

a:=length(ch)+1-a;

while ch[1]='0' do

ch:=copy(ch,2,length(ch)-1);

ch:=ch+'/1';

for j:=1 to a do

ch:=ch+'0';

end

else if (b<>0) and (c<>0) then

begin

m:=copy(ch,1,b-1);

n:=copy(ch,b+1,c-b-1);

k:=copy(ch,c+1,length(ch)-c+1);

val(m,m1,z);

val(n,n1,z);

val(k,k1,z);

m1:=m1*k1+n1;

str(m1,ch);

ch:=ch+'/'+k;

end;

End;

procedure Summa(var x,y,z:string);

var

f:shortint;

k,l,m,n:string;

c:integer;

a,b:byte;

k1,k2,l1,m1,n1:longint;

begin

if (x='0') and (y<>'0') then z:=y else

if (y='0') and (x<>'0') then z:=x else

if (x='0') and (y='0') then z:='0' else

begin

a:=pos('/',x);

b:=pos('/',y);

k:=copy(x,1,a-1);

l:=copy(x,a+1,length(x)-a);

m:=copy(y,1,b-1);

n:=copy(y,b+1,length(y)-b);

val(k,k1,c);

val(l,l1,c);

val(m,m1,c);

val(n,n1,c);

k1:=k1*n1+l1*m1;

f:=0;

if k1=0 then z:='0' else begin

if k1<0 then f:=-1;

k2:=abs(k1);

l1:=l1*n1;

Nod(k2,l1,m1,n1);

str(m1,x);str(n1,y);

z:=x+'/'+y;

if f=-1 then z:='-'+z; end;

end;

End;

procedure Raznost(var x,y,z:string);

var

f:shortint;

k,l,m,n:string;

c:integer;

a,b:byte;

k1,k2,l1,m1,n1:longint;

begin

if (x='0') and (y<>'0') then z:=y else

if (y='0') and (x<>'0') then z:=x else

if (x='0') and (y='0') then z:='0' else

begin

a:=pos('/',x);

b:=pos('/',y);

k:=copy(x,1,a-1);

l:=copy(x,a+1,length(x)-a);

m:=copy(y,1,b-1);

n:=copy(y,b+1,length(y)-b);

val(k,k1,c);

val(l,l1,c);

val(m,m1,c);

val(n,n1,c);

k1:=k1*n1-l1*m1;

f:=0;

if k1=0 then z:='0' else begin

if k1<0 then f:=-1;

k2:=abs(k1);

l1:=l1*n1;

Nod(k2,l1,m1,n1);

str(m1,x);str(n1,y);

z:=x+'/'+y;

if f=-1 then z:='-'+z; end;

end;

End;

procedure Umn(var x,y,z:string);

var

f:shortint;

k,l,m,n:string;

c:integer;

a,b:byte;

k1,k2,l1,m1,n1:longint;

begin

if (x='0') or (y='0') then z:='0' else

begin

a:=pos('/',x);

b:=pos('/',y);

k:=copy(x,1,a-1);

l:=copy(x,a+1,length(x)-a);

m:=copy(y,1,b-1);

n:=copy(y,b+1,length(y)-b);

val(k,k1,c);

val(l,l1,c);

val(m,m1,c);

val(n,n1,c);

k1:=k1*m1;

l1:=l1*n1;

f:=0;

if k1<0 then f:=-1;

k2:=abs(k1);

Nod(k2,l1,m1,n1);

str(m1,x);str(n1,y);

z:=x+'/'+y;

if f=-1 then z:='-'+z;

end;

End;

procedure Delenie(var x,y,z:string);

var

f:shortint;

k,l,m,n:string;

c:integer;

a,b:byte;

k1,k2,l1,l2,m1,n1:longint;

begin

if x='0' then z:='0' else

if y='0' then begin writeln('Деление на 0!!!!!'); exit end

else begin

a:=pos('/',x);

b:=pos('/',y);

k:=copy(x,1,a-1);

l:=copy(x,a+1,length(x)-a);

m:=copy(y,1,b-1);

n:=copy(y,b+1,length(y)-b);

val(k,k1,c);

val(l,l1,c);

val(m,m1,c);

val(n,n1,c);

k1:=k1*n1;

l1:=l1*m1;

f:=1;

if k1<0 then f:=-1;

k2:=abs(k1);

if l1<0 then f:=f*(-1);

l2:=abs(l1);

Nod(k2,l2,m1,n1);

str(m1,x);str(n1,y);

z:=x+'/'+y;

if f=-1 then z:='-'+z;

end;

End;

procedure Cel_chast(var n,k:string);

var

f:shortint;

c:integer;

a,b:string[9];

p,a1,a2,b1,t,r:longint;

begin

p:=pos('/',n);

f:=0;

a:=copy(n,1,p-1); val(a,a1,c);

if a1<0 then f:=-1;

a2:=abs(a1);

b:=copy(n,p+1,length(n)-p); val(b,b1,c);

t:=a2 div b1;

r:=a2 mod b1;

if t=0 then k:='' else str(t,k);

if r<>0 then begin if k<>'' then k:=k+' ';

str(r,a); k:=k+a+'/'+b end;

if f=-1 then k:='-'+k;

end;

procedure Deystvie(var s,st:stack; var vs:integer;var vs2:integer);

var

y,u,o,o1,q,r,x,z:string;

w,c,c1,c2:integer;

q1,r1:real;

Begin

Udal(s,vs,c,x,z);

Udal(st,vs2,c,u,z); Chislo(u);

Udal(st,vs2,c,y,z); Chislo(y);

if x='+' then begin write(y,'+',u,'='); Summa(y,u,o); Cel_chast(o,o1);writeln(o1) end else

if x='-' then begin write(y,'-',u,'=');Raznost(y,u,o); Cel_chast(o,o1);writeln(o1) end else

if x='/' then begin write(y,':',u,'=');Delenie(y,u,o); Cel_chast(o,o1);writeln(o1) end else

if x='*' then begin write(y,'*',u,'=');Umn(y,u,o); Cel_chast(o,o1);writeln(o1) end;

Dobav(st,vs2,c,o,z);

End;

BEGIN

writeln('Введите пример, в котором можно использовать скобки и 4 арифметических знака: +, -, *, /.');

readln(p);

if copy(p,1,1)='-' then p:='0'+p;

d:=pos('(-',p);

while d<>0 do begin

Insert('0',p,d+1);

d:=pos('(-',p);

end;

d:=length(p);

i:=1;

v:='';

t:='';

f:=true;

e:='';

while i<=d do begin

x:=p[i];

if x='(' then w:=1 else

if x=')' then w:=2 else

if (x='+') or (x='-') then w:=3 else

if (x='*') or (x='/') then w:=4 else

if x=' ' then w:=6 else w:=5;

case w of

1:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:='';end;

e:='0';f:=false;

Dobav(s,vs,c,x,e);

end;

2:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:='';end;

while s[1,vs]<>'(' do Deystvie(s,st,vs,vs2);

Udal(s,vs,c,y,z);

e:='0'; f:=false;

end;

3:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:=''; end;

e:='1'; f:=false;

while (s[2,vs]>=e) and (s[2,vs]<>'0') do Deystvie(s,st,vs,vs2);

Dobav(s,vs,c,x,e);

end;

4:begin

if f and (t<>'') then begin Dobav(st,vs2,c,t,e);t:='';end;

e:='2'; f:=false;

while (s[2,vs]>=e) and (s[2,vs]<>'0') do Deystvie(s,st,vs,vs2);

Dobav(s,vs,c,x,e);

end;

5:begin t:=t+x;f:=true;end;

6:begin while p[i]<>'/' do

begin

t:=t+p[i];

i:=i+1;

end;

t:=t+p[i];

f:=true;

end;

else writeln('Mistake');

end;

i:=i+1;

end;

if t<>'' then Dobav(st,vs2,c,t,e);

while vs<>0 do

Deystvie(s,st,vs,vs2);

z:=st[1,vs2];

Cel_chast(z,x);

writeln(x);

readln;

End.

Использование структур стек и очередь при решении задач

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

Задача 1. «Грядки». Садовый участок разбит на квадратные клетки со стороной 1 метр и имеет размер М*N метров. На участке вскопаны грядки, представляющие собой прямоугольные конфигурации, не соприкасающиеся ни по вертикали, ни по горизонтали. Определить общее количество грядок и количество квадратных грядок. Грядки, совпадающие по диагонали, считаются разными грядками.

Структура очередь.

Program Gryadki;

{uses crt; }

const max = 100;

type

p = array[1..2,1..max] of shortint;

var

m,n,i,j,x,y:integer;

w,c,d,l,k,s:integer;

f,kvadr,kol:byte;

a:array[1..10,1..10] of shortint;

q:p;

Procedure Pusto(var q:p;var c,d:integer);

begin

c:=1; d:=1;

end;

Function Prover(var q:p;var c,d:integer):boolean;

begin

if c=d then Prover:=true else Prover:=false;

End;

Procedure Dobav(var q:p;var c,d:integer; var s:integer;

var a,b:integer);

begin

if d>max then begin s:=0; exit; end;

q[1,d]:=a; q[2,d]:=b;

d:=d+1;

s:=1; {добавили успешно}

End;

Procedure Udalen(var q:p;var c,d:integer; var s:integer);

begin

if Prover(q,c,d) then begin s:=0; exit; end;

c:=c+1;

s:=2; {удаление прошло успешно}

End;

BEGIN {clrscr;}

kol:=0;

write('m='); readln(m);

write('n='); readln(n);

writeln('если в этой позиции грядки нет - (-1), иначе - 0');

for i:=1 to m do

for j:=1 to n do begin

write('a[',i,';',j,']=');

readln(a[i,j]); end;

Pusto(q,c,d);

k:=0; {номер грядки}

for i:=1 to m do

for j:=1 to n do

if a[i,j]=0 then begin

kvadr:=0;

k:=k+1;

Dobav(q,c,d,s,i,j);

a[i,j]:=k;

kvadr:=kvadr+1;

while c<>d do

for l:=c to d do begin

x:=q[1,l]; y:=q[2,l];

if (x>1) and (a[x-1,y]=0) then begin w:=x-1;

Dobav(q,c,d,s,w,y);

a[w,y]:=k;

kvadr:=kvadr+1;

end;

if (x<m) and (a[x+1,y]=0) then begin w:=x+1;

Dobav(q,c,d,s,w,y);

a[x+1,y]:=k;

kvadr:=kvadr+1;

end;

if (y>1) and (a[x,y-1]=0) then begin w:=y-1;

Dobav(q,c,d,s,x,w);

a[x,y-1]:=k;

kvadr:=kvadr+1;

end;

if (y<n) and (a[x,y+1]=0) then begin w:=y+1;

Dobav(q,c,d,s,x,w);

a[x,y+1]:=k;

kvadr:=kvadr+1;

end;

Udalen(q,c,d,s);

end;

if sqrt(kvadr)=round(sqrt(kvadr))

then begin f:=1;

for w:=i to i+round(sqrt(kvadr))-1 do

for l:=j to j+round(sqrt(kvadr))-1 do

if a[i,j]<>a[w,l] then f:=2;

if f=1 then kol:=kol+1;

end; end;

writeln('Количество грядок k=',k);

writeln('Количество квадратных грядок ',kol);

readln;

END.

Задача 2. «Шахматы». Имеется шахматная доска. Некоторые поля на ней заняты белыми и черными фигурами и пешками. Каждое занятое поле белыми фигурами и пешками определяется числом -1, черными фигурами определяется числом 1. Необходимо определить маршрут белого коня с поля (Хн,Ун) на поле (Хк,Ук), при котором количество ходов минимально. Сбивание черной фигуры или пешки считается как два хода.

Структура очередь.

program Kon;

{uses crt;}

const max=100;

type p=array[1..3,1..max] of shortint;

var

m,n,i,j,x,y,z,nx,ny,kx,ky:integer;

w1,w,c,d,k,s,h,l:integer;

a:array[1..10,1..10] of shortint;

q,v:p;

Procedure Pusto(var q:p;var c,d:integer);

begin

c:=1; d:=1;

end;

Function Prover(var q:p;var c,d:integer):boolean;

begin

if c=d then Prover:=true else Prover:=false;

end;

Procedure Dobav(var q:p;var c,d:integer; var s:integer; var a,b,e:integer);

begin

if d>max then begin s:=0; exit; end;

q[1,d]:=a; q[2,d]:=b;

q[3,d]:=e;

d:=d+1;

s:=1;

End;

Procedure Udalen(var q:p;var c,d:integer; var s:integer);

begin

if Prover(q,c,d) then begin s:=0; exit; end;

c:=c+1; s:=2;

End;

BEGIN

{clrscr;}

write('m='); readln(m);

write('n='); readln(n);

writeln('Введите значения клеток:0-свободная,1-с чёрной фигурой,-1-с белой фигурой');

for i:=1 to m do

for j:=1 to n do begin

write('a[',i,',',j,']=');

readln(a[i,j]); end;

write('nx=');readln(nx);

write('ny=');readln(ny);

if a[nx,ny]<>0 then begin writeln('Конь не будет начинать свой путь в занятой клетке!'); readln; exit; end;

write('kx=');readln(kx);

write('ky=');readln(ky);

if a[kx,ky]=-1 then begin writeln('Конь не будет заканчивать свой путь в занятой белой фигурой клетке!'); readln; exit; end;

Pusto(q,c,d);

l:=0;

Dobav(q,c,d,s,nx,ny,l);

a[nx,ny]:=-1;

z:=0;

while c<>d do begin

x:=q[1,c];

y:=q[2,c];

l:=m*n;

for i:=1 to d-1 do

if (q[1,i]=x) and (q[2,i]=y) then

if l>q[3,i] then l:=q[3,i];

a[x,y]:=-1;

q[3,c]:=l;

h:=q[3,c];

if (x>1) and (y>2) and (a[x-1,y-2]<>-1)

then begin

w:=x-1;

w1:=y-2;

if a[x-1,y-2]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

if (x>2) and (y>1) and (a[x-2,y-1]<>-1)

then begin

w:=x-2;

w1:=y-1;

if a[x-2,y-1]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

if (x<m) and (y<n-1) and (a[x+1,y+2]<>-1)

then begin

w:=x+1;

w1:=y+2;

if a[x+1,y+2]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

 if (x<m-1) and (y<n) and (a[x+2,y+1]<>-1)

then begin

w:=x+2;

w1:=y+1;

if a[x+2,y+1]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

if (x>1) and (y<n-1) and (a[x-1,y+2]<>-1)

then begin

w:=x-1;

w1:=y+2;

if a[x-1,y+2]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

if (x>2) and (y<n) and (a[x-2,y+1]<>-1)

then begin

w:=x-2;

w1:=y+1;

if a[x-2,y+1]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

if (x<m-1) and (y>1) and (a[x+2,y-1]<>-1)

then begin

w:=x+2;

w1:=y-1;

if a[x+2,y-1]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

if (x<m) and (y>2) and (a[x+1,y-2]<>-1)

then begin

w:=x+1;

w1:=y-2;

if a[x+1,y-2]=1 then k:=h+2 else k:=h+1;

Dobav(q,c,d,s,w,w1,k);

end;

Udalen(q,c,d,s);

l:=m*n;

for i:=1 to d-1 do

if (q[1,i]=kx) and (q[2,i]=ky) then begin

z:=1;

if l>q[3,i] then l:=q[3,i];

end;

end;

if z<>0 then writeln(l,' шаг(-ов,-а)') else writeln('Такого пути нет!');

{ for i:=1 to 3 do begin

for j:=1 to d-1 do

write(q[i,j]:3);

writeln; end;}

readln;

END.

Задача 3. Баланс скобок.

1. В строке расположена последовательность символов. Среди символов имеются символы скобки [({,})], расставленные с соблюдением баланса. Необходимо записать в новой строке все символы, расположенные вне скобок, а затем в обратном порядке символы, заключенные в скобки.

Пример: Исходная информация - ABC{D(E)F}KLM{Z[H]O}BN

Результирующая строка - ABCKLMBNOHZFED

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

Примечание: Скобки могут быть вложенными. ASD{G{H[(J)K]}VB}XCV. Для отслеживания скобок использовать стек.

program Skobki;

const

max=20;

type

stack=array[1..max] of char;

var

x:char;

v,t,p:string;

s:stack;

k,d,i,c,vs:integer;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0;

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false;

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer;

var x:char);

Begin

if vs=max then begin c:=0; exit; end;

vs:=vs+1;

s[vs]:=x;

c:=1;

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer;

var x:char);

Begin

if Prover(vs) then begin c:=0; exit; end;

x:=s[vs];

vs:=vs-1;

c:=0;

End;

BEGIN

Pusto(s,vs);

writeln('Введите выражение со скобками');

readln(p);

d:=length(p);

i:=1;

k:=0;

while i<=d do begin

x:=p[i];

case x of

'(','[','{':begin Dobav(s,vs,c,x); k:=k+1 end;

')':begin Dobav(s,vs,c,x); k:=k-1 end;

']':begin Dobav(s,vs,c,x); k:=k-1 end;

'}':begin Dobav(s,vs,c,x); k:=k-1 end;

'A'..'Z':if k=0 then v:=v+x else Dobav(s,vs,c,x);

end;

i:=i+1;

end;

while vs<>0 do begin

case s[vs] of

'A'..'Z':v:=v+s[vs];

end;

vs:=vs-1;

end;

writeln('Полученное выражение ',v);

readln;

End.

Задача 4.Корректировка текста

В строке-предложении со стандартным набором разделителей между словами (' ',:; -) встречается корректирующий символ *. Предложение заканчивается точкой. Если он встречается четное количество раз, то из строки удаляется аналогичное количество предшествующих ему символов; если он встречается нечетное количество раз, то из строки удаляется предшествующее им аналогичное количество слов. Скорректировать строку и вывести ее в обратном порядке.

program predl;

const

max=100;

type

stack=array[1..max] of char;

var

x,x1:char;

v,p:string;

g,s:stack;

k,d,i,j,c,vs:integer;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer;

var x:char);

Begin

if vs=max then begin c:=0; exit end;

vs:=vs+1;

s[vs]:=x;

c:=1

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer;

var x:char);

Begin

if Prover(vs) then begin c:=0; exit end;

x:=s[vs];

vs:=vs-1;

c:=0

End;

BEGIN

Pusto(s,vs);

writeln('Введите предложение, где могут встречаться знаки * один или несколько раз:');

readln(p);

d:=length(p);

i:=1;

k:=0;

while i<=d do

begin

x:=p[i];

case x of

'*': k:=k+1;

else

if k mod 2=0 then begin

for j:=1 to k do

Udal(s,vs,c,x1);

Dobav(s,vs,c,x);

k:=0

end

else begin

for j:=1 to k do begin

Udal(s,vs,c,x1);

while (x1<>' ') and (x1<>'-') and

(x1<>',') and (x1<>';') and

(x1<>':') do

Udal(s,vs,c,x1);

Dobav(s,vs,c,x1);

Dobav(s,vs,c,x) end;

k:=0

end

end;

i:=i+1

end;

for i:=vs downto 1 do

v:=v+s[i];

writeln(v);

readln

END.

Задача 5. Чередование

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

program glasn_soglasn;

const

max=20;

type

stack=array[1..max] of char;

var

x:char;

v,p:string;

g,s:stack;

d,i,c,vs,vg:integer;

Procedure Pusto(var s:stack;var vs:integer);

begin

vs:=0

End;

Function Prover(vs:integer):boolean;

Begin

if vs=0 then Prover:=true else Prover:=false

End;

Procedure Dobav(var s:stack;var vs:integer; var c:integer;

var x:char);

Begin

if vs=max then begin c:=0; exit end;

vs:=vs+1;

s[vs]:=x;

c:=1

End;

Procedure Udal(var s:stack;var vs:integer; var c:integer;

var x:char);

Begin

if Prover(vs) then begin c:=0; exit end;

x:=s[vs];

vs:=vs-1;

c:=0

End;

BEGIN

Pusto(s,vs);

Pusto(g,vg);

writeln('Введите строку, состоящую из больших латинских букв');

readln(p);

d:=length(p);

i:=1;

while i<=d do

begin

x:=p[i];

case x of

'A','E','I','O','U','Y': Dobav(g,vg,c,x)

else Dobav(s,vs,c,x)

end;

i:=i+1

end;

v:='';

if vs>vg then i:=vg else i:=vs;

for d:=1 to i do

v:=v+g[d]+s[d];

if i=vg then

for d:=vg+1 to vs do

v:=v+s[d]

else

for d:=vs+1 to vg do

v:=v+g[d];

writeln(v);

readln

END.

Задача 6. Ищу путь

Имеется лабиринт, представленный матрицей размером N*M, где 0 означает проходимая клетка, а 1 - непроходимая клетка. Найти выход из лабиринта, используя стратегию «держусь за стенку» (конечной клеткой может быть любая крайняя клетка матрицы). В решении использовать стек.

program labirint;

const

max=100;

type

stack=array[1..2,1..max] of integer;

var

a:array[1..20,1..20] of byte;

s:stack;

k,xn,yn,n,m,i,j,c,vs:integer;

Procedure Pusto(var s:stack;var vs:integer);