Консультация № 187693
24.12.2013, 21:40
95.44 руб.
0 1 1
Здравствуйте! Прошу помощи в следующем вопросе:
Написать программу на PascalNETABC
Составить программу, отыскивающую проход по лабиринту. Лабиринт представляется в виде матрицы, состоящей из квадратов. Каждый квадрат либо открыт, либо закрыт. Вход в закрытый квадрат запрещен. Если квадрат открыт, то вход в него возможен со стороны, но не с угла. Каждый квадрат определяется его координатами в матрице.

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

Обсуждение

давно
Старший Модератор
31795
6196
26.12.2013, 18:32
общий
это ответ
Здравствуйте, Печников Александр Васильевич!

Смотрите приложение. Программа не ищет кратчайший путь.
ps:вопросы задавайте в мини-форум.
Удачи!

Приложение:
const
{размер массива лабиринта}
n=10;
{массив лабиринта}
Map:array [1..n, 1..n] of Byte =
(
(0, 0, 1, 0, 0, 0, 0, 0, 0, 0),
(1, 0, 0, 0, 0, 1, 0, 0, 1, 0),
(0, 0, 0, 1, 1, 1, 0, 0, 1, 1),
(0, 1, 0, 0, 0, 1, 0, 0, 1, 0),
(0, 0, 0, 0, 1, 1, 1, 0, 1, 0),
(0, 0, 1, 1, 1, 0, 1, 0, 0, 0),
(0, 0, 0, 1, 0, 0, 1, 0, 0, 0),
(1, 1, 0, 1, 0, 0, 1, 1, 1, 0),
(0, 1, 0, 0, 0, 0, 1, 0, 0, 0),
(0, 1, 0, 0, 0, 0, 1, 0, 0, 0)
);
type
pList=^tList;
tList=record
w:integer;{статус текущей позиции}
x:integer;{координата Х}
y:integer;{координата У}
z:pList;{указатель на предыдущий элемент списка}
end;
var
mapa:array[1..n,1..n]of byte;{рабочий массив лабиринта}
x,y:integer;{координаты выхода}
head,job:pList;{переменные для работы со списком}
{функция проверки диапозона координат}
function range(a:integer):boolean;
begin
range:=(a>0)and(a<=n);
end;
{процедура ввода координат}
procedure Enter(a:string;var b,c:integer);
begin
repeat
writeln(a);
repeat
write('X:');
readln(b);
until range(b);
repeat
write('Y:');
readln(c);
until range(c);
until Map[b,c]=0;
end;
{процедура проверки следующего шага}
procedure OneStep(var a:pList;b,c:integer);
var
d:pList;
begin
if range(a^.x+b)and range(a^.y+c)and(mapa[a^.x+b,a^.y+c]=0)then
begin{следующий шаг возможен-создаем новый элемент списка}
new(d);
d^.x:=a^.x+b;{новая координата по Х}
d^.y:=a^.y+c;{новая координата по У}
mapa[d^.x,d^.y]:=2;{отмечаем поле как занятое}
d^.w:=4;{статус по умолчанию}
d^.z:=a;{связываем список}
a:=d;{новый указатель списка}
end
else dec(a^.w);{следующего хода нет изменяем статус}
end;
{рекурсивная впроцедура вывода пути и освобождения памяти}
procedure show(a:pList);
begin
if a^.z<>nil then show(a^.z);{проверка условия рекурсии}
writeln(a^.x,':',a^.y);{выводим путь}
dispose(a);{освобождаем память}
end;
begin
{копируем лабиринт}
for x:=1 to n do
for y:=1 to n do mapa[x,y]:=Map[x,y];
{создаем точку входа в лабиринт}
new(head);
head^.z:=nil;{конец списка}
head^.w:=4;{статус по умолчанию}
Enter('Enter start point',head^.x,head^.y);{вводим точку входа}
mapa[head^.x,head^.y]:=2;{маркируем позицию как занятую}
Enter('Enter stop point',x,y);{вводим точку останова}
{основной цикл поиска}
repeat
case head^.w of
0:{варианты перебраны удаляем координату}
begin
job:=head;
head:=head^.z;
dispose(job);
end;
1:OneStep(head,1,0);{x+1}
2:OneStep(head,-1,0);{x-1}
3:OneStep(head,0,1);{y+1}
4:OneStep(head,0,-1);{y-1}
end;
until(head^.x=x)and(head^.y=y)or(head=nil);
if head=nil then writeln('wrong path')
else
begin
writeln('current path');
show(head);{рекурсивный вызов}
end;
end.
Об авторе:
Мне безразлично, что Вы думаете о обо мне, но я рад за Вас - Вы начали думать.

Форма ответа