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

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

Задача 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; {номер грядки}

f or 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))

t hen 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

E nd;

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);

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,y:integer);

Begin

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

vs:=vs+1;

s[1,vs]:=x;

s[2,vs]:=y;

c:=1

End;

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

Begin

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

vs:=vs-1;

c:=0

End;

BEGIN

Pusto(s,vs);

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

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

for i:=1 to n do

for j:=1 to m do begin

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

readln(a[i,j]) end;

write('Введите xn, не вводить 1 и значение n ');readln(xn);

write('Введите yn, не вводить 1 и значение m ');readln(yn);

i :=xn;

j:=yn;

k:=1;

while (i<>1) and (i<>n) and (j<1) and (j<>m) do

case k of

1:if (a[i,j-1]=1) and (a[i+1,j]=0) then begin

i:=i+1;

Dobav(s,vs,c,i,j)

end

else if a[i,j-1]=0 then

begin

j:=j-1;

Dobav(s,vs,c,i,j);

k:=4

end

else

k:=2;

2:if (a[i+1,j]=1) and (a[i,j+1]=0) then begin

j:=j+1;

Dobav(s,vs,c,i,j)

end

else if a[i+1,j]=0 then

b egin

i:=i+1;

Dobav(s,vs,c,i,j);

k:=1

end

else

k:=3;

3:if (a[i,j+1]=1) and (a[i-1,j]=0) then begin

i:=i-1;

Dobav(s,vs,c,i,j)

end

else if a[i,j+1]=0 then

b egin

j:=j+1;

Dobav(s,vs,c,i,j);

k:=2

end

else

k:=4;

4:if (a[i,j-1]=0) and (a[i-1,j]=1) then begin

j:=j-1;

Dobav(s,vs,c,i,j)

end

else if a[i-1,j]=0 then

begin

i:=i-1;

Dobav(s,vs,c,i,j);

k:=3

end

else

k:=1

end;

Writeln('Координаты пути:');

for i:=1 to 2 do begin

for j:=1 to vs do

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

writeln

end;

readln

END.

readln

END.

Задача 7. «Кладоискатель». Лабиринт задается матрицей 10*10, элементы которой равны 1 или 0. Клетка считается проходимой, если она содержит 0 и непроходимой, если она содержит 1. Начальное положение кладоискателя задается координатами одной из крайних клеток. Кладоискатель может перемещаться из одной проходимой клетки в другую, если они имеют общую сторону. Составить программу поиска и вывода кратчайшего пути кладоискателя. Местонахождение клада задается координатами одной из проходимых клеток. (На мой взгляд, это задача про робота из раздела очереди. Только в той задаче добровольно, для удобства, был выведен маршрут робота, а тут его надо найти обязательно.)