问题
S在迷宫中找A,找到A之后就把它同化,也会帮着S找剩下的A。。就是这样。。给你的是一个字符组成的图……
分析
正常人会想到搜索……当然,但是只是搜索很难实现,仔细读题,我们发现,其实质是在求最小生成树!!!
那么用宽搜的方法计算每两点之间的距离,重新构图,prim即可。为了方便查找,开一个which数组。点的坐标做下标,对应第几个点是数组中的值。
数据特别恶心,读入长和宽之后会出现n多莫名其妙的空格,要单独读图的第一行!!!
code
![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
![](https://images.cnblogs.com/OutliningIndicators/ExpandedBlockStart.gif)
program
liukee;
type xz = record
x:longint;
y:longint;
z:longint;
end ;
var
d: array [ 1 .. 4 , 1 .. 2 ] of integer = (( 1 , 0 ),( - 1 , 0 ),( 0 , 1 ),( 0 , - 1 ));
x1,y1: array [ 1 .. 101 ] of longint;
map: array [ 0 .. 51 , 0 .. 51 ] of char;
which: array [ 0 .. 51 , 0 .. 51 ] of longint;
a: array [ 1 .. 101 , 1 .. 101 ] of longint;
mincost: array [ 1 .. 101 ] of longint;
zu,n,m,ans,tt,i:longint;
procedure init;
var
i,j:longint;
xxx:char;
s:string;
begin
tt: = 0 ;
readln(m,n);
readln(s);
for i: = 2 to n do
begin
for j: = 1 to m do
begin
read(map[i,j]);
xxx: = map[i,j];
if (map[i,j] = ' A ' ) or (map[i,j] = ' S ' ) then
begin
inc(tt);
which[i,j]: = tt;
x1[tt]: = i;
y1[tt]: = j;
end ;
end ;
readln;
end ;
for i: = 1 to m do
begin
map[ 1 ,i]: = s[i];
if (map[ 1 ,i] = ' A ' ) or (map[ 1 ,i] = ' S ' ) then
begin
inc(tt);
which[i,j]: = tt;
x1[tt]: = i;
y1[tt]: = j;
end ;
end ;
for i: = length(s) to m do
map[ 1 ,i]: = ' ' ;
end ;
procedure doit;
var
q: array [ 1 .. 100000 ] of xz;
v: array [ 1 .. 50 , 1 .. 50 ] of boolean;
i,l,r,xx,yy,j:longint;
begin
for i: = 1 to tt do
begin
fillchar(q,sizeof(q), 0 );
fillchar(v,sizeof(v), 0 );
l: = 0 ;
r: = 1 ;
q[ 1 ].x: = x1[i];
q[ 1 ].y: = y1[i];
q[ 1 ].z: = 0 ;
v[x1[i],y1[i]]: = true;
while l < r do
begin
inc(l);
for j: = 1 to 4 do
begin
xx: = q[l].x + d[j, 1 ];
yy: = q[l].y + d[j, 2 ];
if (xx > 0 ) and (yy > 0 ) and (xx <= n) and (yy <= m) and (map[xx,yy] <> ' # ' ) and ( not v[xx,yy]) then
begin
if which[xx,yy] <> 0 then
begin
a[i,which[xx,yy]]: = q[l].z + 1 ;
// a[which[xx,yy],i]: = q[l].z + 1 ;
end ;
inc(r);
q[r].x: = xx;
q[r].y: = yy;
q[r].z: = q[l].z + 1 ;
v[xx,yy]: = true;
end ;
end ;
end ;
end ;
end ;
procedure prim;
var
i,j,k,min:longint;
begin
for i: = 1 to tt do
for j: = 1 to tt do
if a[i,j] = 0 then a[i,j]: = maxlongint;
mincost[ 1 ]: = 0 ;
for i: = 2 to tt do
mincost[i]: = a[ 1 ,i];
for i: = 1 to tt - 1 do
begin
min: = maxlongint;
for j: = 1 to tt do
if (mincost[j] < min) and (mincost[j] <> 0 ) then
begin
min: = mincost[j];
k: = j;
end ;
inc(ans,min);
mincost[k]: = 0 ;
for j: = 1 to tt do
if mincost[j] > a[k,j] then mincost[j]: = a[k,j];
end ;
end ;
begin
readln(zu);
for i: = 1 to zu do
begin
ans: = 0 ;
fillchar(a,sizeof(a), 0 );
fillchar(which,sizeof(which), 0 );
fillchar(mincost,sizeof(mincost), 0 );
init;
doit;
prim;
writeln(ans);
end ;
end .
type xz = record
x:longint;
y:longint;
z:longint;
end ;
var
d: array [ 1 .. 4 , 1 .. 2 ] of integer = (( 1 , 0 ),( - 1 , 0 ),( 0 , 1 ),( 0 , - 1 ));
x1,y1: array [ 1 .. 101 ] of longint;
map: array [ 0 .. 51 , 0 .. 51 ] of char;
which: array [ 0 .. 51 , 0 .. 51 ] of longint;
a: array [ 1 .. 101 , 1 .. 101 ] of longint;
mincost: array [ 1 .. 101 ] of longint;
zu,n,m,ans,tt,i:longint;
procedure init;
var
i,j:longint;
xxx:char;
s:string;
begin
tt: = 0 ;
readln(m,n);
readln(s);
for i: = 2 to n do
begin
for j: = 1 to m do
begin
read(map[i,j]);
xxx: = map[i,j];
if (map[i,j] = ' A ' ) or (map[i,j] = ' S ' ) then
begin
inc(tt);
which[i,j]: = tt;
x1[tt]: = i;
y1[tt]: = j;
end ;
end ;
readln;
end ;
for i: = 1 to m do
begin
map[ 1 ,i]: = s[i];
if (map[ 1 ,i] = ' A ' ) or (map[ 1 ,i] = ' S ' ) then
begin
inc(tt);
which[i,j]: = tt;
x1[tt]: = i;
y1[tt]: = j;
end ;
end ;
for i: = length(s) to m do
map[ 1 ,i]: = ' ' ;
end ;
procedure doit;
var
q: array [ 1 .. 100000 ] of xz;
v: array [ 1 .. 50 , 1 .. 50 ] of boolean;
i,l,r,xx,yy,j:longint;
begin
for i: = 1 to tt do
begin
fillchar(q,sizeof(q), 0 );
fillchar(v,sizeof(v), 0 );
l: = 0 ;
r: = 1 ;
q[ 1 ].x: = x1[i];
q[ 1 ].y: = y1[i];
q[ 1 ].z: = 0 ;
v[x1[i],y1[i]]: = true;
while l < r do
begin
inc(l);
for j: = 1 to 4 do
begin
xx: = q[l].x + d[j, 1 ];
yy: = q[l].y + d[j, 2 ];
if (xx > 0 ) and (yy > 0 ) and (xx <= n) and (yy <= m) and (map[xx,yy] <> ' # ' ) and ( not v[xx,yy]) then
begin
if which[xx,yy] <> 0 then
begin
a[i,which[xx,yy]]: = q[l].z + 1 ;
// a[which[xx,yy],i]: = q[l].z + 1 ;
end ;
inc(r);
q[r].x: = xx;
q[r].y: = yy;
q[r].z: = q[l].z + 1 ;
v[xx,yy]: = true;
end ;
end ;
end ;
end ;
end ;
procedure prim;
var
i,j,k,min:longint;
begin
for i: = 1 to tt do
for j: = 1 to tt do
if a[i,j] = 0 then a[i,j]: = maxlongint;
mincost[ 1 ]: = 0 ;
for i: = 2 to tt do
mincost[i]: = a[ 1 ,i];
for i: = 1 to tt - 1 do
begin
min: = maxlongint;
for j: = 1 to tt do
if (mincost[j] < min) and (mincost[j] <> 0 ) then
begin
min: = mincost[j];
k: = j;
end ;
inc(ans,min);
mincost[k]: = 0 ;
for j: = 1 to tt do
if mincost[j] > a[k,j] then mincost[j]: = a[k,j];
end ;
end ;
begin
readln(zu);
for i: = 1 to zu do
begin
ans: = 0 ;
fillchar(a,sizeof(a), 0 );
fillchar(which,sizeof(which), 0 );
fillchar(mincost,sizeof(mincost), 0 );
init;
doit;
prim;
writeln(ans);
end ;
end .
反思
要仔分析题目,抽象成图论模型。不要被表面现象迷惑。