Лабиринт

[keng]

Здравствуйте!Помогите пожалуйста с курсовым по Паскалю!Задание примерно состоит в том чтобы сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)Заранее спасибо
PSочень очень надо

[fizteh]

Готов помочь, за небольшую плату.
icq: 265879269
e-mail: stic55@mail.ru

[TinMan]

Сообщение от fizteh

Готов помочь, за небольшую плату.
icq: 265879269
e-mail: stic55@mail.ru

Ты не заметил, что раздел - не фриланс? некрасиво. А еще физтех..

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

[WorldMaster]

Сообщение от keng

Здравствуйте!Помогите пожалуйста с курсовым по Паскалю!Задание примерно состоит в том чтобы сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)Заранее спасибо
PSочень очень надо

Есть готовая курсовая работа реализующая функции:
1. Генерация случайного лабиринта.
2. Поиск выхода различными методами.
3. Графическое отображение процесса поиска.

Единственное что он написан наверноена С++ ... точно не помню.

Начните решение с чего-нибудь, а дальше поможем.

[denisbrain]

Сообщение от keng

Здравствуйте!Помогите пожалуйста с курсовым по Паскалю!Задание примерно состоит в том чтобы сделать программу которая ищет выход из лабиринта.Самому простейшему варианту буду очень рад(желательно с комментариями)Заранее спасибо
PSочень очень надо

могу сделать, пиши в аську или на почту

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

Никак не могу это все объеденитьь!ПОмогите пожадуйста мне уже завтра сдавать(((


________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[eoln]

Выкладывал пару раз простенький лабиринт для небольшого размера.По ноликам ходим, 1-стена. Решение ужасно не оптимальное, зато короткое )

const mas:array[0..9,0..9]of integer=(
 (1,1,0,1,1,1,1,1,1,1)
,(1,1,0,1,1,1,1,1,1,1)
,(1,1,0,0,1,0,0,0,1,1)
,(1,1,1,0,0,0,1,0,1,1)
,(1,0,1,1,1,0,0,0,1,1)
,(1,0,0,0,0,0,1,1,1,1)
,(1,1,1,1,1,0,1,1,1,1)
,(1,1,1,1,1,0,0,0,1,1)
,(1,1,1,1,1,1,1,1,1,1)
,(1,1,1,1,1,1,1,1,1,1));

X1=5; Y1=1; x2=2; y2=2;

function inttostr(a:integer):string;
var s: string;
begin str(a, s); inttostr:=s end;

procedure MakeList(x, y: integer; s:string);
begin
    s:=s+'['+inttostr(x)+','+inttostr(y)+']-';
    if (x=X2) and (y=Y2) then
    begin
        writeln(s);
        exit
    end;
    if (x > 0) then if (mas[x - 1][y] = 0) then begin inc(mas[x][y],3); MakeList(x-1, y, s); dec(mas[x][y],3) end;
    if (x < 9) then if (mas[x + 1][y] = 0) then begin inc(mas[x][y],3); MakeList(x+1, y, s); dec(mas[x][y],3) end;
    if (y > 0) then if (mas[x][y - 1] = 0) then begin inc(mas[x][y],3); MakeList(x, y-1, s); dec(mas[x][y],3) end;
    if (y < 9) then if (mas[x][y + 1] = 0) then begin inc(mas[x][y],3); MakeList(x, y+1, s); dec(mas[x][y],3) end;
end;

begin
    MakeList(x1, y1, '');
    readln
end.

[jetyb]

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

[WorldMaster]

Сообщение от jetyb

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

Радиальный метод.

[TinMan]

До кучи, выкладываю реализацию алгоритма "одной руки", левой или правой, как хотите.. )) Еще он называется Wall Follower (преследующий стену). Конечно, он далеко не самый оптимальный. Более того, он находит только один путь и не в состоянии найти кратчайший. Но тоже короткий в реализации, причем даже без рекурсии )).

В проге лабиринт заполняется случайным образом с заданной плотностью заполнения стенами. Вывод картинки в тектовой моде. Алгоритм (словесный) могу добавить по запросу.

// Wall Follower, or one-hand rule
// by TinMan, programmersforum.ru

const
  m= 24;
  n= 60;
  Fill= 35;  // плотность заполнения
  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)<=Fill 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.