坎坷的做题旅程
先用bfs码了一个计算绕森林最小路程
找到最上点，最右点，最下点，最左点。利用凸包特性去写。
const z:array[1..8,1..2]of -1..1=((0,1),(1,1),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1));
var i,j,k:longint;
m,n:longint;
x,y:array[0..10000]of longint;
fax,fay:array[0..100,0..100]of longint;
a,b:array[0..100,0..100]of boolean;
fx,fy,h,t:longint;
x1,y1:longint;
ch:char;
limx,limy:array[1..4]of longint;
can:array[1..4,1..8]of boolean;
now:array[0..10000]of longint;
ans:longint;
function pd(x,y,x1,y1:longint):boolean;
var i:longint;
begin
for i:=1 to 8 do
if i mod 2=1 then
if (x+z[i,1]=x1) and (y+z[i,2]=y1) then exit(true);
exit(false);
end;
begin
for i:=1 to 3 do//每种可以走的方向
can[1,i]:=true;
for i:=3 to 5 do
can[2,i]:=true;
for i:=5 to 7 do
can[3,i]:=true;
for i:=7 to 8 do
can[4,i]:=true;
can[4,1]:=true;
readln(m,n);
for i:=1 to m do
begin
for j:=1 to n do
begin
read(ch);
if ch='X' then
begin
a[i][j]:=true;
if limx[1]=0 then
begin
limx[1]:=i;
limy[1]:=j;
end;
limx[3]:=i;
limy[3]:=j;
if(j>limy[2])or(limx[2]=0)
then
begin
limx[2]:=i;
limy[2]:=j;
end;
if(j<limy[4])or(limx[4]=0)
then
begin
limx[4]:=i;
limy[4]:=j;
end;
end
else b[i,j]:=true;
if ch='*' then
begin
fx:=i;
fy:=j;
end;
end;
readln;
end;
h:=1;
t:=1;
x[1]:=limx[1]-1;
y[1]:=limy[1];
now[1]:=1;
repeat
if (now[t]=4) and (x[t]+1=limx[1]) and (y[t]=limy[1]) then//到终点
begin
break;
end;
if (now[t]=1) and (x[t]=limx[2]) and (y[t]-1=limy[2]) then//改变
begin
now[t]:=2;
end;
if (now[t]=2) and (x[t]-1=limx[3]) and (y[t]=limy[3]) then//改变
begin
now[t]:=3;
end;
if (now[t]=3) and (x[t]=limx[4]) and (y[t]+1=limy[4]) then//改变
begin
now[t]:=4;
end;
for i:=1 to 8 do//八个方向查找
if can[now[t],i] then
if b[x[t]+z[i,1],y[t]+z[i,2]] then
begin
inc(h);
b[x[t]+z[i,1],y[t]+z[i,2]]:=false;
x[h]:=x[t]+z[i,1];
y[h]:=y[t]+z[i,2];
fax[x[h],y[h]]:=x[t];//记录father
fay[x[h],y[h]]:=y[t];
now[h]:=now[t];
end;
inc(t);
until h<t;
for i:=1 to m do
for j:=1 to n do
a[i,j]:=true;
x1:=x[t];
y1:=y[t];
x[0]:=x1;
y[0]:=y1;
x1:=fax[x[0],y[0]];
y1:=fay[x[0],y[0]];
while (x1<>limx[1]-1)or(y1<>limy[1]) do//倒退找路径
begin
a[x1,y1]:=false;
x[0]:=x1;
y[0]:=y1;
x1:=fax[x[0],y[0]];
y1:=fay[x[0],y[0]];
inc(ans);
end;
a[limx[1]-1,limy[1]]:=false;
h:=1;
t:=1;
x[1]:=fx;
y[1]:=fy;
now[1]:=0;
for i:=1 to m do
for j:=1 to n do
b[i,j]:=true;
b[fx,fy]:=false;
repeat
if not a[x[t],y[t]] then//找到解
begin
write(ans+now[t]+2);//凑
exit;//30分
end;
for i:=1 to 8 do
if b[x[t]+z[i,1],y[t]+z[i,2]] then
begin
inc(h);
x[h]:=x[t]+z[i,1];
y[h]:=y[t]+z[i,2];
b[x[h],y[h]]:=false;
now[h]:=now[t]+1;
end;
inc(t);
until t>h;
end.
又改进了一下
const z:array[1..8,1..2]of -1..1=((0,1),(1,1),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1));
var i,j,k:longint;
m,n:longint;
x,y:array[0..10000]of longint;
fax,fay:array[0..100,0..100]of longint;
min:array[0..100,0..100]of longint;
a,b,c,d:array[0..100,0..100]of boolean;
fx,fy,h,t:longint;
x1,y1:longint;
ch:char;
limx,limy:longint;
can:array[1..8]of boolean;
now:array[0..10000]of longint;
ans:longint;
sum:longint;
x2,y2:longint;
procedure dfs(x,y:longint);
var i:longint;
begin
if not c[x,y] then exit;
c[x,y]:=false;
a[x,y]:=true;
for i:=1 to 8 do
if min[x+z[i,1],y+z[i,2]]=min[x,y]-1 then
dfs(x+z[i,1],y+z[i,2]);
end;
begin
readln(m,n);
for i:=1 to m do
begin
for j:=1 to n do
begin
read(ch);
if ch='*' then
begin
fx:=i;
fy:=j;
end;
if ch='X' then
begin
if limx=0 then
begin
limx:=i-1;
limy:=j;
end;
end
else b[i,j]:=true;
end;
readln;
end;
c:=b;
d:=b;
x[1]:=limx;
y[1]:=limy;
sum:=0;
x2:=limx;
y2:=limy;
while x2>0 do
begin
x2:=x2-1;
inc(sum);
min[x2,y2]:=sum;
b[x2,y2]:=false;
end;
h:=1;
t:=1;
now[1]:=0;
can[1]:=true;
can[2]:=true;
can[8]:=true;
for i:=1 to 8 do
if can[i] then
if b[x[t]+z[i,1],y[t]+z[i,2]] then
begin
b[x[t]+z[i,1],y[t]+z[i,2]]:=false;
inc(h);
x[h]:=x[t]+z[i,1];
y[h]:=y[t]+z[i,2];
min[x[h],y[h]]:=now[t]+1;
now[h]:=now[t]+1;
fax[x[h],y[h]]:=limx;
fay[x[h],y[h]]:=limy;
end;
inc(t);
repeat
if (x[t]=limx) and (y[t]=limy) then
break;
for i:=1 to 8 do
if b[x[t]+z[i,1],y[t]+z[i,2]] and
(((x[t]+z[i,1])<>fax[x[t],y[t]])
or ((y[t]+z[i,2])<>fay[x[t],y[t]])) then
begin
inc(h);
x[h]:=x[t]+z[i,1];
y[h]:=y[t]+z[i,2];
now[h]:=now[t]+1;
min[x[h],y[h]]:=now[h];
b[x[h],y[h]]:=false;
end;
inc(t);
until t>h;
dfs(limx,limy);
x[1]:=fx;
y[1]:=fy;
t:=1;
h:=1;
now[1]:=0;
repeat
if a[x[t],y[t]] then
begin
write(now[t]+min[limx,limy]);
exit;
end;
for i:=1 to 8 do
if d[x[t]+z[i,1],y[t]+z[i,2]] then
begin
inc(h);
x[h]:=x[t]+z[i,1];
y[h]:=y[t]+z[i,2];
now[h]:=now[t]+1;
d[x[h],y[h]]:=false;
end;
inc(t);
until h<t;
end.
因为路径不止一条，这个可以把所有都找出来
这时才发现题目看错了QAQ
不过，还好，很快就AC了
const z:array[1..8,1..2]of -1..1=((0,1),(1,1),(1,0),(1,-1),(0,-1),(-1,-1),(-1,0),(-1,1));
var i,j,k:longint;
m,n:longint;
x,y:array[0..10000]of longint;
fax,fay:array[0..100,0..100]of longint;
min:array[0..100,0..100]of longint;
a,b,c,d:array[0..100,0..100]of boolean;
fx,fy,h,t:longint;
x1,y1:longint;
ch:char;
limx,limy:longint;
can:array[1..8]of boolean;
now:array[0..10000]of longint;
ans:longint;
sum:longint;
x2,y2:longint;//很多变量没用，只是懒得删，顺便见证一下坎坷的做题旅途
function small(m,n:longint):longint;//min用掉了
begin
if m>n then exit(n) else exit(m);
end;
begin
readln(m,n);
for i:=1 to m do
begin
for j:=1 to n do
begin
read(ch);
if ch='*' then//起点
begin
fx:=i;
fy:=j;
end;
if ch='X' then
begin
if limx=0 then
begin
limx:=i-1;
limy:=j;
end;
min[i,j]:=9999999;//永远也到不了
end
else b[i,j]:=true;
end;
readln;
end;
c:=b;
d:=b;
x2:=limx;
y2:=limy;
sum:=0;
b[limx,limy]:=false;
while x2>0 do//把环打破,一边的加另一边便是最优解
begin
x2:=x2-1;
inc(sum);
min[x2,y2]:=sum;
b[x2,y2]:=false;
end;
h:=1;//队列
t:=1;
now[1]:=0;
x[1]:=fx;
y[1]:=fy;
repeat
for i:=1 to 8 do
if b[x[t]+z[i,1],y[t]+z[i,2]] then
begin
inc(h);
x[h]:=x[t]+z[i,1];
y[h]:=y[t]+z[i,2];
now[h]:=now[t]+1;
min[x[h],y[h]]:=now[h];
b[x[h],y[h]]:=false;
end;
inc(t);
until t>h;
write(small(min[limx,limy-1],min[limx+1,limy-1])+small(min[limx,limy+1]{左边最优解},min[limx+1,limy+1]){同理，右边最优解}+2{其中漏算的两个点});//最优解必然在这些位置
end.
呀AC了
做题之路一路坎坷