出错了出错了，各位大牛小牛大菜小菜帮帮忙，我都要疯了~~~~~谢谢咯

const

f:array[0..1,1..12] of integer=((-2,-1,-1,-1, 0, 0,0,0, 1,1,1,2),

( 0,-1, 0, 1,-2,-1,1,2,1,0,1,0));

var

n,m,i,j,sum:longint;

a:array[1..100,1..100] of 0..1;

st:string;

q:array[1..10000,0..1] of longint;

procedure work(xx,yy:longint);

var i,open,closed,x,y:longint;

begin

inc(sum);

a[xx,yy]:=0;

open:=1; closed:=1;

q[1,0]:=xx; q[1,1]:=yy;

repeat

for i:=1 to 12 do

begin

x:=q[open,0]+f[0,i]; y:=q[open,1]+f[1,i];

if (x0)and(y0) and(a[x,y]=1) then

begin

inc(closed);

q[closed,0]:=x; q[closed,1]:=y;

a[x,y]:=0;

end;

end;

inc(open);

until open>closed;

end;

begin

fillchar(a,sizeof(a),0);

fillchar(q,sizeof(q),0);

readln(n,m); sum:=0;

for i:=1 to n do

begin

readln(st);

for j:=1 to m do

if st[j]='-' then a:=0 else a:=1;

end;

for i:=1 to n do

for j:=1 to m do

if a=1 then work(i,j);

writeln(sum);

end.

强哥的牛逼答案

！！！！！！！！！！！！！！！！！！！！！

千万不要抄！！

const

d:array[1..12,1..2]of integer=(( 1, 0),

( 2, 0),

(-1, 0),

(-2, 0),

( 0, 1),

( 0, 2),

( 0,-1),

( 0,-2),

( 1, 1),

( 1,-1),

(-1, 1),

(-1,-1));

var

c:array[1..100,1..100]of char;

n,m,s:integer;

procedure init;

var i,j:integer;

begin

readln(n,m);

for i:=1 to n do

begin

for j:=1 to m do

read(c);

readln

end;

end;

procedure dfs(x,y:integer);

var

i,u,v:integer;

begin

for i:=1 to 12 do

begin

u:=x+d; v:=y+d;

if (1

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

[red]├ 测试数据 10：运行时错误...|错误号: 202[/red]

---|---|---|---|---|---|---|---|-

Unaccepted 有效得分：90 有效耗时：0ms

帮小弟一下啊；

提了n次了

都是最后一个[red]202[/red];

const

d:array[1..12,1..2]of integer=((1,0),(2,0),(-1,0),(-2,0),(0,1),(0,2),(0,-1),(0,-2),(1,1),(1,-1),(-1,1),(-1,-1));

var n,m,i,j,t:integer;

map:array[-1..1001,-1..1001]of char;

procedure dfs(x,y:integer);

var o,u,v:integer;

begin

for o:=1 to 12 do

begin

u:=x+d[o,1];v:=y+d[o,2];

if (u>=1)and(u=1)and(v

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

const

dx:array[1..12] of longint=(-2,-1,-1,-1,0,0,0,0,1,1,1,2);

dy:array[1..12] of longint=(0,-1,0,1,-2,-1,1,2,-1,0,1,0);

type

sh=record

x,y:longint;

end;

var

que:array[0..10000] of sh;

v:array[-2..100,-2..100] of boolean;

map:array[-2..100,-2..100] of char;

n,m,i,j,start,tail,ans,k,f:longint;

procedure deal;

var

x,y:longint;

begin

ans:=0;

fillchar(v,sizeof(v),true);

for i:=1 to n do

for j:=1 to m do

if (map='#')and(v) then

begin

fillchar(que,sizeof(que),0);

ans:=ans+1;

x:=i;

y:=j;

start:=0;

tail:=1;

que[1].x:=x;

que[1].y:=y;

v[x,y]:=false;

repeat

for k:=1 to 12 do

begin

x:=que[start].x+dx[k];

y:=que[start].y+dy[k];

if (x0) then

if (map[x,y]='#') and (v[x,y]) then

begin

inc(tail);

que[tail].x:=x;

que[tail].y:=y;

v[que[tail].x,que[tail].y]:=false;

end;

end;

inc(start);

until start>tail;

end;

writeln(ans);

end;

begin

readln(n,m);

for i:=1 to n do

begin

for j:=1 to m do

read(map);

readln;

end;

deal;

end.

CNMB!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

for i:=1 to n do

for j:=1 to n(应该是m) do

一直没发现，后来模拟了一遍搜索过程才发现这等无知错误，真想拿头撞墙、

以后对搜索没信心了...

水题啊

一次AC

记录#的坐标 转化成图 搜有几棵树就行了 简洁深搜 39行

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

Program P1051;

Var n,m,i,j:integer;

sum:longint;

map:array[-1..102,-1..102] of 0..1;

Procedure init;

Var i,j:integer;

temp:char;

Begin

readln(n,m);

for i:=1 to n do

begin

for j:=1 to m do

begin

read(temp);

if temp='-' then map:=0

else map:=1;

end;

readln;

end;

End;

Procedure work(x,y:integer);

Begin

map[x,y]:=0;

if map[x-1,y-1]=1 then work(x-1,y-1);

if map[x-1,y]=1 then work(x-1,y);

if map[x-2,y]=1 then work(x-2,y);

if map[x-1,y+1]=1 then work(x-1,y+1);

if map[x,y-2]=1 then work(x,y-2);

if map[x,y-1]=1 then work(x,y-1);

if map[x,y+1]=1 then work(x,y+1);

if map[x,y+2]=1 then work(x,y+2);

if map[x+1,y-1]=1 then work(x+1,y-1);

if map[x+1,y]=1 then work(x+1,y);

if map[x+2,y]=1 then work(x+2,y);

if map[x+1,y+1]=1 then work(x+1,y+1);

End;

Begin

fillchar(map,sizeof(map),-1);

init;

sum:=0;

for i:=1 to n do

for j:=1 to m do

if map=1 then

begin

sum:=sum+1;

work(i,j);

end;

writeln(sum);

End.

请教大牛，这个是深搜吧？

fillflood

http://chengchen2008.blog.163.com/blog/static/2834647520097207256587/

我用dfs会202

只好bfs

var

i,j,k,s,m,n:longint;

a:array[0..1000,0..1000] of char;

procedure dd(t1,t2:longint);

var

i,j:longint;

begin

a[t1,t2]:='-';

if t1+1=1 then if a[t1-2,t2]='#' then dd(t1-2,t2);

if t2+1=1 then if a[t1,t2-2]='#' then dd(t1,t2-2);

if (t1+1=1) then

if a[t1-1,t2-1]='#' then dd(t1-1,t2-1);

end;

begin

readln(n,m);

for i:=1 to n do

begin

for j:=1 to m do

read(a);

readln;

end;

k:=0;

for i:=1 to n do

for j:=1 to m do

if a='#' then

begin

inc(k);

dd(i,j);

end;

writeln(k);

end.

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

秒杀！！！！！！绝对正确

我看出来了，要用深搜或广搜！！！

但是，我都不太熟......

谁教一下......

const

u:array[1..12] of integer=(-2,-1,0,1,2,1,0,-1,-1,0,1,0);

v:array[1..12] of integer=(0,1,2,1,0,-1,-2,-1,0,1,0,-1);

var

a:array[0..100,0..100] of char;

n,m:integer;

i,j:integer;

ans:integer;

visited:array[0..100,0..100]of boolean;

procedure init;

var

i,j:integer;

begin

readln(n,m);

for i:=1 to n do

begin

for j:=1 to m do read(a);

readln;

end;

end;

procedure work(x,y:integer);

type

quene=record

data:array[0..10000] of record

x,y:integer

end;

head,tail:integer;

end;

var

i:integer;

q:quene;

begin

visited[x,y]:=true;

fillchar(q.data,sizeof(q.data),0);

q.head:=1;

q.tail:=1;

q.data[q.head].x:=x;

q.data[q.head].y:=y;

while q.head0)and(q.data[q.head].x+u[i]0)and(q.data[q.head].y+v[i]

我用深搜，给202了！

555——

做了n+1次才AC……

前n次把-2写成了-1……

总体来说还是比较简单的，1个dfs即可AC，定义一个常量数组，用来表示这个点周围曼哈顿距离小于等于2的点，每次深搜计一次数就OK了。

具体程序如下：

program temp;const mv:array [1..12,1..2] of integer =((0,2),(-1,1),(0,1),(1,1),(-2,0),(-1,0), (1,0),(2,0),(-1,-1),(0,-1),(1,-1),(0,-2));var bd:array [1..100,1..100] of char; n,m,i,j,ct:integer;procedure dfs(x,y:integer);var j:integer;begin bd[x,y]:='-'; for j:=1 to 12 do if (bd[x+mv[j,1],y+mv[j,2]]='#') and (x+mv[j,1]>0) and (x+mv[j,1]0) and (y+mv[j,2]

dfs

var i,j,m,n,sum:longint;

a:Array[-100..310,-100..310]of integer;

p:char;

move1:array[1..12]of integer=(-2,-1,-1,-1,0,0,0,0,1,1,1,2);

move2:array[1..12]of integer=(0,-1,0,1,-2,-1,1,2,-1,0,1,0);

procedure pai(step1,step2:integer);

var i:integer;

begin

a[step1,step2]:=-1;

for i:=1 to 12 do

begin

if (a[step1+move1[i],step2+move2[i]]=1) then

pai(step1+move1[i],step2+move2[i]);

end;

end;

procedure search;

var i,j,l,ll:integer;

begin

for i:=1 to n do

for j:=1 to m do

if a=1 then

begin

pai(i,j);

inc(sum);

end;

end;

begin

readln(n,m);

fillchar(a,sizeof(a),0);

for i:=1 to n do

begin

for j:=1 to m do

begin

read(p);

if p='#' then a:=1 else a:=0;

end;

readln;

end;

sum:=0;

search;

writeln(sum);

end.

看完题解，发现真简单 BFS就过了

1.readln 小心读入回车符

2.数组开到-2..202，fillchar，这样就不用判断边界了

并查集怎么做呢？

为何一定要有边界条件？？？？？

编译通过...

├ 测试数据 01：答案正确... 0ms

├ 测试数据 02：答案正确... 0ms

├ 测试数据 03：答案正确... 0ms

├ 测试数据 04：答案正确... 0ms

├ 测试数据 05：答案正确... 0ms

├ 测试数据 06：答案正确... 0ms

├ 测试数据 07：答案正确... 0ms

├ 测试数据 08：答案正确... 0ms

├ 测试数据 09：答案正确... 0ms

├ 测试数据 10：答案正确... 0ms

---|---|---|---|---|---|---|---|-

Accepted 有效得分：100 有效耗时：0ms

从此发誓：

暴力

是我 的 信仰！

其实只要把数组的边界设为-1..102，在dd的时候就不用判