 |
 |
Скачать программы Все программы автора
ПЕЩЕРА
Гном Торин нашел план покинутой пещеры, в которой жил горный король Норус. На плане обозначено место, где находятся огромный клад. Горный король защитил свое богатство от искателей кладов, для чего расположил в пещере L каменных блоков, которые двигаются и могут раздавить искателя, и которые останавливаются, когда сокровища найдены. План задан в виде прямоугольной целочисленной матрицы MxN, элементами которой могут быть: -2 (клад), -1 (стена), 0 (пустое место), положительное число K (элемент K–го блока). K–й блок состоит из всех элементов, обозначенных числом K. Блок не обязательно связный, но все его элементы движутся синхронно. Нули в крайних строках или столбцах матрицы обозначают входы в пещеру. Отдельно указано начальное направление движения каждого блока (1 – вверх, 2 – направо, 3 – вниз, 4 – влево). Гном занимает клетку-вход. После этого он движется по таким правилам: на протяжении каждой секунды первым перемещается гном на пустую клетку из 4-х соседних (вверх, вниз, влево или направо) или остается на месте. Потом, на протяжении той же секунды, перемещается каждый блок на одну клетку (вверх, вниз, влево или направо): сначала первый, за ним второй и т.д. Если перед каким-нибудь элементом в направлении его движения находится стена, край пещеры, клад или другой блок, то на этом ходе блок не движется, а направление его движения изменяется на противоположное. Если блок во время движения попал в клетку с гномом, то гном гибнет.
Задание. Написать программу CAVE для поиска безопасного пути, который приведет к кладу за наименьшее время, считая, что такой путь существует.
Входные данные. Входной текстовый файл CAVE.DAT в первой строке содержит два числа M, N та L—количество блоков (3£M£75, 3£N£75, 0£L£1000). В следующих M строках содержаться N целых чисел — план пещеры. В следующих L строках заданы начальные направления их движения в порядке увеличения номеров.
Пример входных данных
4 5 1
-1 -1 -1 -1 -1
-1 0 1 0 -1
0 0 0 -2 -1
-1 -1 -1 -1 -1
1
Выходные данные. Выходной текстовый файл CAVE.SOL в первой строке должен содержать число K — время прохождения пути в секундах. В следующих K+1 строках — координаты положения гнома в каждую секунду (начиная с координат входа). Координаты должны быть заданы в порядке "строка столбец". Если существует несколько путей, достаточно указать один из них.
Пример выходных данных
5
3 1
3 2
2 2
2 3
2 4
3 4
program Treasure;
const
num = 75;
type
plist=^tlist;
tlist=record
x,y:byte;
next:plist;
end;
psplist=^tsplist;
tsplist=record
time:integer;
x,y:byte;
next:psplist;
end;
wall=record
direct:byte;
data:plist;
end;
var
fi,fo:text;
m,n,l,i,j:integer;
arr:array [1..num,1..num] of record
data:integer;
list:psplist;
end;
walls:array [1..1000] of wall;
curtime:integer;
procedure add(var list:plist;x,y:byte);
var p:plist;
begin
new(p);
p^.x:=x;p^.y:=y;
p^.next:=list;
list:=p;
end;
procedure addsp(var list:psplist;time:integer;x,y:byte);
var p:psplist;
begin
new(p);
p^.time:=time;p^.x:=x;p^.y:=y;
p^.next:=list;
list:=p;
end;
procedure disposesplist(var list:psplist);
var cur:psplist;
begin
while list<>nil do
begin
cur:=list^.next;
dispose(list);
list:=cur;
end;
end;
procedure disposelist(var list:plist);
var cur:plist;
begin
while list<>nil do
begin
cur:=list^.next;
dispose(list);
list:=cur;
end;
end;
procedure readwalls;
begin
for i:=1 to m do
for j:=1 to n do if arr[i,j].data>0 then
add(walls[arr[i,j].data].data,i,j);
end;
procedure findpath(x,y:byte);
var i,j:byte;
list,cur:plist;
cur1:psplist;
begin
writeln(fo,curtime);
list:=nil;i:=x;j:=y;
add(list,i,j);inc(curtime);
repeat
dec(curtime);
while curtime<arr[i,j].list^.time do
begin
cur1:=arr[i,j].list^.next;dispose(arr[i,j].list);arr[i,j].list:=cur1;
end;
if curtime=arr[i,j].list^.time then
begin
add(list,arr[i,j].list^.x,arr[i,j].list^.y);
x:=arr[i,j].list^.x;y:=arr[i,j].list^.y;
cur1:=arr[i,j].list^.next;dispose(arr[i,j].list);arr[i,j].list:=cur1;
i:=x;j:=y;
end else add(list,i,j);
until curtime=1;
cur:=list;
while cur<>nil do
begin
writeln(fo,cur^.x,' ',cur^.y);
cur:=cur^.next;dispose(list);list:=cur;
end;
for i:=1 to l do disposelist(walls[i].data);
for i:=1 to m do for j:=1 to n do disposesplist(arr[i,j].list);
close(fo);
end;
procedure count;
begin
for i:=1 to m do
for j:=1 to n do
if (arr[i,j].data>=1001) and (arr[i,j].data<curtime+1001) then
begin
if (i<m) and (arr[i+1,j].data=-2) then
begin
addsp(arr[i+1,j].list,curtime,i,j);
findpath(i+1,j);halt;
end;
if (i<m) and (arr[i+1,j].data=0) then
begin
arr[i+1,j].data:=curtime+1001;
addsp(arr[i+1,j].list,curtime,i,j);
end;
if (i>1) and (arr[i-1,j].data=-2) then
begin
addsp(arr[i-1,j].list,curtime,i,j);
findpath(i-1,j);halt;
end;
if (i>1) and (arr[i-1,j].data=0) then
begin
arr[i-1,j].data:=curtime+1001;
addsp(arr[i-1,j].list,curtime,i,j);
end;
if (j<n) and (arr[i,j+1].data=-2) then
begin
addsp(arr[i,j+1].list,curtime,i,j);
findpath(i,j+1);halt;
end;
if (j<n) and (arr[i,j+1].data=0) then
begin
arr[i,j+1].data:=curtime+1001;
addsp(arr[i,j+1].list,curtime,i,j);
end;
if (j>1) and (arr[i,j-1].data=-2) then
begin
addsp(arr[i,j-1].list,curtime,i,j);
findpath(i,j-1);halt;
end;
if (j>1) and (arr[i,j-1].data=0) then
begin
arr[i,j-1].data:=curtime+1001;
addsp(arr[i,j-1].list,curtime,i,j);
end;
end;
end;
function check(x,y,direct:byte):integer;
begin
case direct of
4:if y>1 then check:=arr[x,y-1].data else check:=-100;
2:if y<n then check:=arr[x,y+1].data else check:=-100;
1:if x>1 then check:=arr[x-1,y].data else check:=-100;
3:if x<m then check:=arr[x+1,y].data else check:=-100;
end;
end;
function checkwalls(list:plist; direct:byte):boolean;
var cur:plist;
begin
cur:=list;checkwalls:=false;
while cur<>nil do
begin
if (check(cur^.x,cur^.y,direct)>=1001)
or (check(cur^.x,cur^.y,direct)=0) then cur:=cur^.next
else exit;
end;
checkwalls:=true;
end;
procedure clearwalls(list:plist);
var cur:plist;
begin
cur:=list;
while cur<>nil do
begin
arr[cur^.x,cur^.y].data:=0;
cur:=cur^.next;
end;
end;
procedure changewalls(list:plist;direct:byte);
var cur:plist;
begin
cur:=list;
while cur<>nil do
begin
case direct of
1:dec(cur^.x);
2:inc(cur^.y);
3:inc(cur^.x);
4:dec(cur^.y);
end;
cur:=cur^.next;
end;
end;
procedure drawwalls(list:plist;number:integer);
var cur:plist;
begin
cur:=list;
while cur<>nil do
begin
arr[cur^.x,cur^.y].data:=number;
cur:=cur^.next;
end;
end;
procedure incwalls;
var i,j:integer;
begin
for i:=1 to l do
begin
if not checkwalls(walls[i].data,walls[i].direct) then
begin
case walls[i].direct of
1:walls[i].direct:=3;
2:walls[i].direct:=4;
3:walls[i].direct:=1;
4:walls[i].direct:=2;
end;
end else
begin
clearwalls(walls[i].data);
changewalls(walls[i].data,walls[i].direct);
drawwalls(walls[i].data,i);
end;
end;
end;
begin
assign(fi,'cave.dat');reset(fi);assign(fo,'cave.sol');rewrite(fo);
readln(fi,m,n,l);
for i:=1 to m do
begin
for j:=1 to n do
begin
read(fi,arr[i,j].data);
arr[i,j].list:=nil;
end;
readln(fi);
end;
for i:=1 to l do readln(fi,walls[i].direct);readwalls;
close(fi);
for i:=1 to m do if arr[i,1].data=0 then
begin arr[i,1].data:=1001;addsp(arr[i,1].list,0,0,0);end;
for i:=1 to m do if arr[i,n].data=0 then
begin arr[i,n].data:=1001;addsp(arr[i,n].list,0,0,0);end;
for j:=1 to n do if arr[1,j].data=0 then
begin arr[1,j].data:=1001;addsp(arr[1,j].list,0,0,0);end;
for j:=1 to n do if arr[m,j].data=0 then
begin arr[m,j].data:=1001;addsp(arr[m,j].list,0,0,0);end;
curtime:=0;
repeat
inc(curtime);
count;
incwalls;
until false;
end.
|
|
