Помощь - Поиск - Пользователи - Календарь
Полная версия: Лабиринт
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
keng
Здравствуйте!Помогите пожалуйста с курсовым по Паскалю!Задание примерно состоит в том чтобы сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)Заранее спасибо!
PS Очень оЧЕНЬ надо А я в Паскале не бум бум)
TarasBer
1. Изучи основы Паскаля (время у тебя есть).
2. Изучи алгоритмы обхода лабиринта, в твоей задаче нужен поиск в ширину.
Lapp
Цитата(keng @ 11.09.2011 12:42) *
сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)

keng, давай начнем с описания лабиринта. Уточни - какой он? Двумерный? На квадратной сетке?
Есть у тебя хоть какие-то наработки или соображения? Высказывай, anything would do.
Когда уточнишь условия, можно будет начинать решать.

Ты не бойся, Pascal не кусается )). Давай вместе делать.
keng
Цитата(Lapp @ 12.09.2011 7:36) *

keng, давай начнем с описания лабиринта. Уточни - какой он? Двумерный? На квадратной сетке?
Есть у тебя хоть какие-то наработки или соображения? Высказывай, anything would do.
Когда уточнишь условия, можно будет начинать решать.

Ты не бойся, Pascal не кусается )). Давай вместе делать.

Мой руководитель практики просто сказал что моя тема выход из лабиринта!!!я спросил и что именно делать он сказал напиши программу которая ищет выход!одним словом пофиг еиу чо и что главное чтобы работала и чтобы я смог это объясить!ПРимерно нужно самую простейшую программу!Можетет решить?!
TarasBer
Ну на один вопрос ты ответил, ладно.
Остался второй:
> Есть у тебя хоть какие-то наработки или соображения? Высказывай, anything would do.

Ответ "я нифига не шарю помогите надо" не принимается. Короче, бери книгу (я советую http://win-web.ru/itbooks/open/faronov_tpaskal.html), читай, разбирайся, время есть, не торопись, не нервничай. Будет что непонятно - спрашивай. Только не так, что "сделайте за меня", тут так не принято.
keng
У меня есть некоторые мысли но нужно в одну их собрать(может кто поможет
Например, данный лабиринт можно описать в разделе CONST (описания констант) следующим образом:


const
lab: array[0..6,0..6] of byte =
((0, 0, 0, 0, 0, 0, 0),
(0, 0, 0, 1, 0, 0, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 0, 1, 0, 0, 1, 0),
(0, 1, 1, 1, 1, 1, 0),
(0, 1, 1, 0, 1, 1, 0),
(0, 0, 0, 0, 0, 0, 0));

Путь можно хранить в двумерном массиве, например

way: array[1..200,1..2] of integer;

Рекурсивная процедура выглядит примерно так:
procedure find(x,y: integer);
begin
if (x=xk)and(y=yk) then begin
writeln;
writeln('there is a way');
readkey halt
end;
lab[x,y]:=2;
if lab[x+1,y]=1 then find(x+1,y);
if lab[x-1,y]=1 then find(x-1,y);
if lab[x,y-1]=1 then find(x,y-1);
if lab[x,y+1]=1 then find(x,y+1);
lab[x,y]:=1
end;
Никак не могу это все объеденитьь!ПОмогите пожадуйста мне уже завтра сдавать(((
TarasBer
Надо дописать в начало процедуры вот это, иначе будет зависон: if lab[x,y] <> 1 then Exit;
И это сейчас у тебя обход в глубину, он не самый оптимальный.
Также советую тебе сделать find не процедурой, а функцией, чтобы он возвращал длину найденного пути до выхода (или -1, если нет прохода). То есть тебе придётся сделать так:


result := -1;
if lab[x+1,y]=1 then ChangeIfLess(result, find(x+1,y));
if lab[x-1,y]=1 then ChangeIfLess(result, find(x-1,y));
if lab[x,y-1]=1 then ChangeIfLess(result, find(x,y-1));
if lab[x,y+1]=1 then ChangeIfLess(result, find(x,y+1));



процедура ChangeIfLess такая:

procedure ChangeIfLess(var X: integer; C: integer);
begin
if (C>=0) and ((X<0) or (X>C)) then X:=C;
end;


Ещё осталась проблема в том, чтобы он записывал длину в путь.
Мы знаем, что для клетки (x,y) длина пути равна N. Тогда очевидно, что надо идти в клетку, для которой длина пути равна N-1.
В общем, это кое-как работать будет, для размера 7 на 7 проканает.
А вообще учи обход в ширину.

> ПОмогите пожадуйста мне уже завтра сдавать(((

На осень, что ли, долги оставил?
keng
Да оставил если не сдам отчислят((
А как это все оформить чтоб заработало!?ПОжалуйста выручите блиин очень важно cray.gif
TarasBer
Ну пишешь всё это и в конце пишешь


begin
xk := 5;
yk := 1;
x := 1;
y := 3;
n := Find(x,y);
дальше тут пишешь, куда двигаться, короче, сам разберись
end.



> ПОжалуйста выручите блиин очень важно

А весной это почему-то не было важным, да? Ты где был полгода, если ты
> в Паскале не бум бум
?
keng
uses wincrt;
label 1,2,3;
var f:text;
i,j,k,xn,jn,ik,jk,n:integer;
s:array[1..100] of string;
a:array[1..2,1..100] of integer;
begin
assign(f,'labirint.in');
reset(f);
while not eof(f) do
begin
i:=i+1;
readln(f,s[i]);
end;
n:=i;
for i:=1 to n do
for j:=1 to length(s[i]) do
begin
if s[i][j]='N' then
begin
xn:=i; jn:=j;
end;
if s[i][j]='K' then
begin
ik:=i; jk:=j;
end;
end;
close(f);
i:=xn; j:=jn; k:=0;
1:while (i<>ik) or (j<>jk) do
begin
if (s[i+2][j]<>'*') and (s[i+1][j]<>'*')
and ((a[1,k-1]<>i+2) or (a[2,k-1]<>j))
and (i+2<=n) and (j<=length(s[i]))
and (i>0) and (j>0) then
begin i:=i+2; k:=k+1; a[1,k]:=i; a[2,k]:=j; goto 1; end;

if (s[i][j+2]<>'*') and (s[i][j+1]<>'*')
and ((a[1,k-1]<>i) or (a[2,k-1]<>j+2))
and (i<=n) and (j+2<=length(s[i])) and (i>0) and (j>0) then
begin j:=j+2; k:=k+1; a[1,k]:=i; a[2,k]:=j; goto 1; end;

if (s[i-2][j]<>'*') and (s[i-1][j]<>'*')
and ((a[1,k-1]<>i-2) or (a[2,k-1]<>j))
and (i<=n) and (j<=length(s[i])) and (i-2>0) and (j>0) then
begin i:=i-2; k:=k+1; a[1,k]:=i; a[2,k]:=j; goto 1; end;

if (s[i][j-2]<>'*') and (s[i][j-1]<>'*')
and ((a[1,k-1]<>i) or (a[2,k-1]<>j-2))
and (i<=n) and (j<=length(s[i])) and (i>0) and (j-2>0) then
begin j:=j-2; k:=k+1; a[1,k]:=i; a[2,k]:=j; goto 1; end;

writeln('NO SOLUTION');
goto 2;
end;
3:writeln(jn,' ',xn);
for i:=1 to k do
writeln(a[2,i],' ',a[1,i]);
2:
end.


ВОт код!
..N..**...K
**.**......
...*..*....
...*****...
**........*
вот то что в файле но он не может найти фаил!что делать?!?!
Гость
uses
CRT;

const
mx=100; nx=100;
Left=1; Right=-1;
Trace=-1;

type
tLabyrinth=array[0..mx,0..nx]of integer;

var
m,n,m1,n1,x,y,dx,dy,k,l,x0,i,j:integer;
Lab:tLabyrinth;
f:text;
c:char;

procedure Show;
var
i,j:integer;
begin
for j:=0 to n1 do begin
for i:=0 to m1 do begin
l:=Lab[i,j];
if l>0 then begin
TextColor(l+7);
Write('*');
TextColor(7)
end
else if l=0 then Write(' ')
else Write('#');
end;
WriteLn
end
end;


procedure Turn(dir:integer; var x,y:integer);
var
z:integer;
begin
z:=x;
x:=dir*y;
y:=-dir*z
end;


procedure Step(var x,y,dx,dy:integer);
begin
Turn(Left,dx,dy);
while Lab[x+dx,y+dy]>0 do Turn(Right,dx,dy);
x:=x+dx;
y:=y+dy
end;


begin
{Read the data file}
Assign(f,'labyrinth_0_0.dat');
ReSet(f);
m1:=-1;
while not EoLn(f) do begin
Read(f,c);
Inc(m1);
case c of
'1',' ': Lab[m1,0]:=1;
'0': Lab[m1,0]:=0
end
end;
ReadLn(f);
n1:=0;
while not EoF(f) do begin
Inc(n1);
for i:=0 to m1 do begin
Read(f,c);
case c of
'1',' ': Lab[i,n1]:=1;
'0': Lab[i,n1]:=0
end
end;
ReadLn(f)
end;
m:=m1-1; n:=n1-1;
Close(f);

{Passing}
k:=0;
WriteLn('Labyrinth ',m,'x',n);
{Probing all the entries}
for x0:=m downto 1 do if Lab[x0,0]=0 then begin
Inc(k);
x:=x0;
y:=1;
dx:=0;
dy:=1;
while (y>0)and(y<n1) do begin
Inc(Lab[x,y],Trace);
Step (x,y,dx,dy);
end;
Write('Entry ',k,': ');
if y=0 then WriteLn('No way!') else WriteLn('Passed.');
for j:=1 to n do for i:=1 to m do if Lab[i,j]<0 then Lab[i,j]:=k+1;
Show;
Write('Press Enter..');
ReadLn;
WriteLn
end;
WriteLn('Done.')
end.


Это просто Гениальный лабиринт Lapp'a!МОжет кто нибудь описать что тут и как поисходит?!(что делают процедуры,и как самм программа работает)в каждой строчке)Я попробую сделать свой на подобие этого пожалуйста!
Lapp
Цитата(Гость @ 13.09.2011 15:24) *
Я попробую сделать свой

Ловлю на слове ).
Я думаю, можно даже упростить для начала. Если сделать только самое главное, прога будет вдвое меньше. И понять ее будет проще. Хорошо, я помогу.

Lapp
На всякую гениальную программу найдется еще более гениальная! - (С) Lapp ))
Вот, набросал еще один вариантик простейшего лабиринта (главным образом потому, что лень было разбираться с тем)).

На квадратной сетке, каждая ячейка есть либо стена, либо свободное пространство.
Фомируется случайным образом с заданной плотностью стен.
Принцип - правило одной руки (будем считать - левой). Реализовано оно тут примерно так.

Лабиринт - это массив m на n. Начальные значения задаются так:
0 - свободное пространство (а также - счетчик, сколько раз были на этой клетке).
Wall (тут равно 8) - стена.
При прохождении "свободное пространство" принимает значения от 0 до 4, увеличиваясь при каждом заходе на клетку. Суть в том, что если мы заходим на некоторую клетку более 4 раз (на самом деле, это может случиться только с начальной клеткой) - это значит, что лабиринт непроходим (т.к. мы уже перебрали все четыре пути, ведущие из нее).

Вот алгоритм:
1. Сначала входим на начальную клетку (она должна быть свободной) с произвольного направления (его можно выбирать случайно, но у меня просто постоянное).
2. Поворачиваемся налево.
3. Делаем шаг вперед.
4. Если оказались внутри стены (не пугайся, можешь считать, что ходишь по нарисованному лабиринту)), то поворачиваемся назад и переходим к п.3.
5. Если оказались в на свободном пространстве - проверяем, не финиш ли это (B).
6. Если финиш - подготавливаем сообщение и выходим из цикла.
7. Если не финиш - смотрим, сколько раз тут были (значение массива).
8. Если уже были тут 3 раза (то есть пришли в четвертый раз) - значит, лабиринт непроходим (подготавливаем сообщение и выходим из цикла).
9. Если меньше 3 раз, то увеличиваем значение массива.
10. Переходим к п.2

При плотности заполнения 35% получаются довольно интересные конфигурации иногда )). Вот, например, конфигурация непроходимая:
Running "c:\...\pas\fp\fp110911_keng\fp110911_keng_lapp-3.exe "
██████████████████████████████████████████████████████████████
█A█ ██ █ █ █ ██ █ ██ █ ██ ████ █ █ █ █ █ █ █
█ █ ██ █ █ █ ██ █ █ █ █████ █ █ ██
█ █ ██ █ █ ██ █ ███ █ █ █ █ ██ █ █
█ █ ███ ██ ██ █ ███ ██ █ ██ █ █ █ ██ █
███ █ ██████ ██████ █ █ █ ██ █ █ █ █ █ █ █
█ █ ██ █ █ █ █ █ █ █ ██ ██ ██ █ ██ █
█ █ █ █████ █ ██ ███ ██ ██ █ ██ █ █ █ ██
█ █ █ █ █ █ █ █ ███ █ ██ █ █ ██ █ █
█ ███ ███ █████ ██ █ █ █ █ █ █
██████ █ ████ █ █ █ ██ █ ██ ██ █ █ ██ █ ██
█ █ █ ██ █ █ █ █ ███ █ █ ██ ██ █
█ █ █ █ █ ██ █ █ █ ██ █ █ █ ██
█ █ █ █ ██ █ █ █ █ █ ███ █ █ ███ █ ██ █ █ █
█ █ ██ █ █ ██ ██ █ █ █ █ ██ █ █ █ █ █
█ █ ██ ██ ███ █ █ ██ █ █ ██ ███ █ █ ██ ███
███ █ █ █ ██ █ ██ █ █ ███ ██ █
███ █ ██ █ █ ███ █ ██ █ █ █ █ ██
█ █ █ █ ███ █ █ ████ █ █ █ █ █ █ █ █
█ █ ██ ███ █ █ ██ █ ██ ██ █ █ ███ █
██████ █ █ ██ █ ██ ████ █ █ █ ████ ██ █ █
███ █ █ █ █ ██ ██ █ █ █ ██ █ ██
█ █ ██ █ ███ █ █ ██ █ █ █ █ █
██ █ █ █ █ █ ██ ███ █ █ █ ████ ███ ██
███ ██ ██ ██ ██ █ █ █ █ █ ██ █ █ ██ █ B█
██████████████████████████████████████████████████████████████

No way.. :-( The mean Minotaur got me..

██████████████████████████████████████████████████████████████
█A█**██****█******█*█ ██ █**██*█**██**████*█***█ █***█ █ █ █
█***█****██** █ *█**█ ██***█*******█*█*****█████***█ █ ██
█*█*** ****██ █ *█***██*** *█*███***█**█* ****█***█*██ █*█
█***█ ███ ██ ██ ***█**███***██***█******* ██ **█**█***█ ██*█
███*█ ██████ ██████ *█****█******* █ ██ █*█ █*█****█*█*█
█***█ *** ██ █ █ ***█**█*█*█* █ ██ ██ *██****█*██***█
█* █ **█* █████ █ *██***███*** ██ ██ █*██* █**█ █**██
█*█ **█**█ █ █ █ █ ***███****█**██*** █**█**██ **█****█
█*****███* ███ █████ ***██**█*█****█* *█** █ ******█
██████**█*████ █ █ ***█ **██*█*██*██** █ *█* ██ *█**██
█**█*█****██ █ **█* **█*█***███*█** ****█** ██ **██ █
█****** █ █ █ *█***** *██***█******█* *█**██** █ █*█ ██
█**█* █ █ ██ █***█*█*█****█**███*█**█** **███*█*██ █ **█ █
█**█*██ █ *█*██**██**█ █****█***█*██ *****█*█ █****█ █
█*█**██ ██*███*****█**█***██*█*█**██ ███*█**█ *██**███
███* █ █ **█**██ **█***██****█** █ *** ███***██ █
███* █*** ██ ***█*******█**███*█*██** █ █ █ **█ ██
█***█**█* █ *███*█*█*████*█*******█*█ █ █ ***█ █ █
█*****█***********██*███ █ █*██****█*██** ██ █ █*███ █
██████***█**█*██*█***██*████****█*█****█**████ ██ ******█ █
███***█**█***█****█*****██****██ █*** **█* █*** **██***█ ██
█****█***██***█*****███**█* **█ ██**********█*****█**█***█ █
██*█*█* **█*█**█***██****** **███ █*█****█***████*****███ ██
███******██**██***██ ██*█*****█ █ █***█**██**█ █****██ █ B█
██████████████████████████████████████████████████████████████

- мы тут описали полный круг и вернулись в точку входа А.

А вот эта - проходимая, заканчивается в B. Довольно интересный случай, советую проследить детально )).
Running "c:\...\pas\fp\fp110911_keng\fp110911_keng_lapp-3.exe "
██████████████████████████████████████████████████████████████
█A ██ ██ █ ██ █ █ █ █ █ ███ ██ ██ █ █ ███
█ ██ █ █ █ █ █████ █ █ ██ █ █ █ ██ █
█ ███ █ ███ █ █ ██ ██ █ ██ █████ ██████ █
█ █ ███ ██ █ █ █ █ █ █ █ ██ █ █ █ █ █
███ ██ █ ███ █ █ ██ ██ █ ██ █ █ █ █
██ █ █ █ █ █ █ █ █████ █ █ █ ██ █
████ █ █ █ █ █ █ █ ██ █ █ █ █ ████
█ █ █ █ ██ ██ █ ███ █ ██ █ ██ █ █ █ ██ █
█ ███ █ █ █ █ ██ ████ █ ██ █ ██ █ █ ██
███ █ █ ██ ██ █ ████ ██ ██ █ ███ █ █ ███
██ █ ██ █ █ █ ███ ██ █ █ █ ██ █ █████ █ ██
█ █ ██ █ ██ █ █ █ ██ █ █ █ ██ █ █ ███
█ █ █ █ █ ██ ██ █ █ █ █ █ ██ █ ███ █ ██ █ █
██ █ ██ █ █ ██ █ ██ ██ █ █ ██ █ ██ ███████ ████
█ █ ███ █ █ █ █ █ █ █ █ ███ █ █ █ ███
█ █ █ █ █ ██ ██ █ ██ █ ██ █ █ █ █ █
██ ██ █ █ ███ ██ ██ ██ █ ██
█ ███ █ █ █ ██ █ ██ █ █ ████ ██ ███ █ ██
█ █ █ █ █ █ █ █ ███ █ ███ ██ █ ██ █ ██
█ █████ █ ██ ████ █ █ █ █ █
█ ██ █ ██ ██ █████ █ █ █ █ █ █ █
█ ██ █ ██ ██ ███ █ █ █ ██ █ █ ██ █ ██
█ ██ ██ ███ █ █ ██ █ ███ █ ███ █ █
█ █ █ █ █ █ █ █ ██ █ █ ██ ███ █ █ ██ █ ██ █ █B█
██████████████████████████████████████████████████████████████

Escaped! :-) Hei stupid Minotaur - kiss my ass!

██████████████████████████████████████████████████████████████
█A****██****██**█***██ █****█******█*█**█**███*██ ██ █ █ ███
█ ██*█ █*█*█*******█████** ****█***█****██*******█ █ █ ██ █
█ *███**█**███ █**█**██***██***█*** *██*█████***██████ █
█ █*███**██* █ █ **█*█***█*█*█*██********█****█*******█ █ █
███ *██******█ ███ *****█****█ ██ ██*█**██**█ **█ █ █
██ █*█** █ █ █ *█ █ █████*****█ █ **█*██ █
████*** █ █ █ █ ******█ █ █ ██**█*█** █****█****████
█ █ █ █ ██ ██ █ **███***█ ██ █***██*█****█***█*██ █
█ ███ █ **█**█*█*██ ████*█***██*█*██****█ █ ██
███ █ █ ██ *██*█****████ ██ ██**█***███*** █**█ ███
██ █ ██ █ █ █ ███*██**█**█ █**██ █ █████****** **█ ██
█ █ ██ █****██*█*█*█***██ █ █ █* *██***█**█ ███
█ █ █ █ █ ██ ***██*█**█*█ █ █ ██ █****███*█*██ █ █
██ █ ██ █ █ ██ █ ██ ██****█**█*██ █ ██*███████*****████
█ █ ███ █ █ █ █***█***█ █ █**███*█ █***█*███
█ █ █ █ █ ██ ██ █ *****██ █ ██**█***█ █****█ █
██ ██ █ █ *███ ██ ██**** **██** █**██
█ ███ █ █ █ ██ █ ██ █ █***████*██*** *███* █ *██
█ █ █ █ █ █ █ █ ███ █ *███****██*█ **██* █ *██
█ █████ █ ██ ████ **█*** █**** ****█ █ **█
█ ██ █ ██ ██ █████ **█**█ █ █ █ █ **█
█ ██ █ ██ ██ ███ *█**█ █ ██ █ █ ██ █ *██
█ ██ ██ ███ █ █ ██ *** █ ███ █ ███ █**█
█ █ █ █ █ █ █ █ ██ █ █ ██ ███ █ █ ██ █ ██ █ █B█
██████████████████████████████████████████████████████████████



А вот код. Пока без комментов )).
Давай договоримся так: попробуй сначала разобраться сам (используя алгоритм, приведенный выше). Можешь сделать свои комменты - я посмотрю, правильно или нет. Если не сможешь разобраться - задавай вопросы.
// The Simplest Maze Ever
// Wall Follower, or one-hand rule
// by Lapp, forum.pascal.net.ru
// Sep 13, 2011

const
m= 24;
n= 60;
x1= 1;
y1= 1;
x2= m;
y2= n;
Wall= 8;
Chars: array[0..Wall] of char= ' **** '+Chr(219);

var
Maze: array[1..m,1..n] of integer;

procedure Show;
var
i,j: integer;
begin
WriteLn;
for i:=0 to m+1 do begin
for j:=0 to n+1 do begin
if (i=0) or (i>m) or (j=0) or (j>n) then Write(Chr(219))
else if (i=x1) and (j=y1) then Write('A')
else if (i=x2) and (j=y2) then Write('B')
else Write(Chars[Maze[i,j]])
end;
Writeln
end;
WriteLn
end;

var
x,y,dx,dy,b: integer;
s: string;

begin
Randomize;
for x:=1 to m do for y:=1 to n do
if Random(100)<36 then Maze[x,y]:= Wall else Maze[x,y]:= 0;
Maze[x1,y1]:= 0;
Show;
x:= x1;
y:= y1;
dx:= 0;
dy:= 1;
repeat
if (x<1) or (y<1) or (m<x) or (n<y) or (Maze[x,y]=Wall) then begin
dx:= -dx;
dy:= -dy
end
else if (x=x2) and (y=y2) then begin
s:= 'Escaped! :-) Hei stupid Minotaur - kiss my ass!';
break
end
else if Maze[x,y]=4 then begin
s:= 'No way.. :-( The mean Minotaur got me..';
break
end
else begin
Inc(Maze[x,y]);
b:= dx;
dx:= -dy;
dy:= b
end;
x:= x+dx;
y:= y+dy
until false;
Writeln(s);
Show;
Readln
end.
keng
Все таки вот этот меня зацепил чем то)Я попробывал прокоментировать :

uses
CRT; //ПОдключаем модуль с текстом

const
mx=100; nx=100;//задаем максимальный размер лабиринта
Left=1; Right=-1;//как вот это обозвать не знаю((
Trace=-1;

type
tLabyrinth=array[0..mx,0..nx]of integer;//Создаем тип лабиринт

var
m,n,m1,n1,x,y,dx,dy,k,l,x0,i,j:integer;//Описываем переменные
Lab:tLabyrinth;//привсваеваем Lab наш тип
f:text;//переменная файла
c:char;//символ

procedure Show;//процедура вывода на экран
var
i,j:integer;
begin
for j:=0 to n1 do begin
for i:=0 to m1 do begin//считываем матрицу
l:=Lab[i,j];//присваеваем переменной L каждый елемент массива
if l>0 then begin//если L больше нуля тогда закрашиваем этот елемент и рисуем звездочку
TextColor(l+7);
Write('*');
TextColor(7)
end
else if l=0 then Write(' ')\\если равно нулю то осавляем пустое место
else Write('#');//если больше нуля то пишем решетку
end;
WriteLn
end
end;


procedure Turn(dir:integer; var x,y:integer);//процедура поворота как она работает!?
var
z:integer;
begin
z:=x;//
x:=dir*y;//дир в будующем является const я правильно понимаю?!
y:=-dir*z
end;


procedure Step(var x,y,dx,dy:integer);//ПРоцедура шага
begin
Turn(Left,dx,dy);//идем на лево
while Lab[x+dx,y+dy]>0 do Turn(Right,dx,dy);//пока элементы не равны нулю (мы ходим только по нулям) поворачиваем вправо вправо
x:=x+dx;
y:=y+dy \\ эти две переменные для шага вперед при повороте правильно?
end;


begin
{Read the data file}
Assign(f,'labyrinth_0_0.dat');
ReSet(f);//считываем из файла лабиринт
m1:=-1;// у нас лабиринт окружен бордюрами поэтому ставим минус один
while not EoLn(f) do begin
Read(f,c);
Inc(m1);\\тут определяется количество столбцов
case c of
'1',' ': Lab[m1,0]:=1;
'0': Lab[m1,0]:=0
end
end;
ReadLn(f);
n1:=0;
while not EoF(f) do begin
Inc(n1);//определяем количество столбцов
for i:=0 to m1 do begin
Read(f,c);
case c of
'1',' ': Lab[i,n1]:=1;
'0': Lab[i,n1]:=0
end
end;
ReadLn(f)
end;//заполняем массив
m:=m1-1; n:=n1-1;//это тоже для бордюров или как?!
Close(f);

{Passing}
k:=0;//это переменная означет какой именно вход по счету
WriteLn('Labyrinth ',m,'x',n);
{Probing all the entries}


ВОт тут ваще запара))
for x0:=m downto 1 do if Lab[x0,0]=0 then begin ///мы ищем все входы в лабиринт
Inc(k);
x:=x0;
y:=1;
dx:=0;
dy:=1;\\\Объясните пожалуйста зачем мы вот это присваеваем все
while (y>0)and(y<n1) do begin\\\тут я так понимаю мы делаем так чтобы он просмотривал все лабиринты
Inc(Lab[x,y],Trace);\\\тут чтобы они не пересекались
Step (x,y,dx,dy);///действуем согласно основному алгоритму процедуры Step
end;
Write('Entry ',k,': ');\\\выводим номер лабиринта
if y=0 then WriteLn('No way!') else WriteLn('Passed.');\\\\ПОчему ве зависит от Y?????
for j:=1 to n do for i:=1 to m do if Lab[i,j]<0 then Lab[i,j]:=k+1;\\\это делается для выведения(для Show) а что именно тут происходит?
Show;\\выводим
Write('Press Enter..');
ReadLn;
WriteLn
end;
WriteLn('Done.')
end.




Люди помогите разобраться очень хочеться)))я конечно понимаю что половина моих коментариев полный бред прошу не судить строго))
TarasBer
> //дир в будующем является const

Чего?

Процедура Turn сделана по аналогии с процедурой обмена двух чисел:

procedure Swap(var x,y: integer);
var
z: integer;
begin
z:=x;
x:=y;
y:=z;
end;


Только в ней ещё и множитель ввели.
Короче, просто прогони эту процедуру для dir=1 и для dir=-1, и всё будет понятно:

procedure Turn(dir:integer; var x,y:integer);
var
z:integer;
begin
z:=x;
x:=dir*y;
y:=-dir*z
end;


Для dir=1 у нас получется (x,y) -> (y,-x) это поворот против часовой стрелки
Для dir=-1 получается (x,y) -> (-y,x) это поворот по часовой стрелке
keng
TarasBer Спасибо!Теперь это мне понятно!А как на счет остального!?)
Lapp
Послушай, keng, это же совсем (ну, хорошо, не совсем - но весьма) другая задача! Зачем тебе она?
Говорю тебе, разберись с моей последней прогой.

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

Разберись с последнй прогой. Сделай попытку, я поправлю. Давай.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.