最简单的题解！！！！！

用集合做！！！！！！！

program p1023(input,output);

type state=set of 1..200;

var

f:array[1..200] of state;

i,j,n,m,k:integer;

begin

readln(n);

for i:=1 to n do f[i]:=[i];

for i:=1 to n do

begin

while true do

begin

read(j);

if j=0 then begin readln; break; end;

f[i]:=f[i]+[j];

end;

end;

for i:=1 to n do

for j:=1 to n do

begin

if i in f[j] then f[j]:=f[i]+f[j];

if j in f[i] then f[i]:=f[i]+f[j];

end;

for i:=1 to n do

for j:=1 to n do

begin

if (f[j]

随机搜索啊。。。都能AC。。。

随机搜索真是考场混分。。vijos上混AC的必备利器啊。。

Program p1023;

const

test=100;

Type

sear=array[1..200]of boolean;

var

i,n,a,m:integer;

v:array[1..200,0..200]of integer;

s:sear;

Procedure Readin;

Begin

readln(n);

for i := 1 to n do

while true do begin

read(a);

if a = 0 then break;

inc(v);v[i,v]:=a;

end;

End;

Function Cover(x:integer):longint;

var i :integer;

Begin

Cover:=0;

s[x]:=true;inc(Cover);

for i := 1 to v[x,0] do

if not s[v[x,i]] then

Inc(Cover,Cover(v[x,i]));

End;

Procedure Work;

Var

i,t,ans,min:integer;

Begin

randomize; min:=n;

for i := 1 to test do begin

ans:=0;m:=0;

fillchar(s,sizeof(s),false);

while m

这一题数据水的不一般，我忘了把max的值更改都AC了，神啊！！！

并查集30分...

我没话了，这套题数据以水著称……

program vic2;

var

a:array[1..200,1..200] of longint;

f:array[1..200] of boolean;

i,j,n,k:longint;

procedure dfs(l:longint);

var i,j:longint;

begin

f[l]:=false;

for i:=1 to n do

if f[i] and (a[l,i]=1) then

dfs(i);

end;

begin

readln(n);

for i:=1 to n do

begin

read(k);

while k0 do

begin

a:=1;

read(k);

end;

end;

fillchar(f,sizeof(f),true);

k:=0;

for i:=1 to n do

if f[i] then

begin

dfs(i);

inc(k);

end;

writeln(k);

end.

type inf=record

　　　　 x,y:array[0..1000]of longint;

　　　　 top:longint;

　　 end;

var n:longint;way:inf;

　　bin:array[0..1000]of longint;

procedure init;

var i,z,k:longint;

begin

　　　　readln(n);

　　z:=0;

　　for i:=1 to n do

　　 begin

　　　　read(k);

　　　　while k0 do

　　　　 begin

　　　　　　inc(z);

　　　　　　way.x[z]:=i;

　　　　　　way.y[z]:=k;

　　　　　　read(k);

　　　　 end;

　　　　bin[i]:=i;

　　 end;

　　way.top:=z;

　　 end;

function getit(n:longint):longint;

begin

　　if n=bin[n] then getit:=n

　　else

　　 begin

　　　　bin[n]:=getit(bin[n]);

　　　　getit:=bin[n];

　　 end;

end;

procedure run;

var i,x1,x2:longint;

begin

　　for i:=1 to way.top do

　　 begin

　　　　x1:=getit(way.x[i]);

　　　　x2:=getit(way.y[i]);

　　　　if x1x2 then

　　　　 begin

　　　　　　bin[x1]:=bin[x2];

　　　　　　 end;

　　 end;

　　for i:=1 to n do

　　 begin

　　　　bin[i]:=getit(bin[i]);

　　 end;

end;

procedure outit;

var b:array[0..1000]of boolean;k,i:longint;

begin

　　　　fillchar(b,sizeof(b),0);

　　k:=0;

　　for i:=1 to n do if not(b[bin[i]]) then begin inc(k);b[bin[i]]:=true;end;

　　writeln(k);

　　 end;

begin

init;

run;

outit;

end.

var

vis:array[1..200,1..200]of boolean;

g:array[1..200]of boolean;

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

procedure sort(j:longint);

var

i:longint;

begin

g[j]:=false;

for i:=1 to n do

if (vis[j,i])and(vis)and(g[i]) then sort(i);

end;

begin

readln(n);

m:=0;

fillchar(vis,sizeof(vis),false);

fillchar(g,sizeof(g),true);

for i:=1 to n do

begin

repeat

read(j);

if j0 then vis:=true;

until j=0;

end;

for i:=1 to n do

for j:=1 to n do

for k:=1 to n do

if (vis)and(vis[j,k]) then vis:=true;

for i:=1 to n do

if g[i] then begin sort(i);inc(m);end;

write(m);

end.

经典解法:

图结构---|---|>树结构

{将强连通分支化为一个点}

再找入度为0的点。

数据太弱，所以可以随便写，当出现以下数据：

3

2 3 0

请君再试一试。

应输出：

1

经典解法代码：

const

maxn=200;

Inf='1023.in';

Ouf='1023.out';

type

ptr=^data;

data=record

d : integer;

next : ptr;

end;

pr=array[1..maxn] of integer;

var

ah,bh : array[1..maxn] of ptr;

a : pr;

be,f,ind : array[1..maxn] of integer;

v,w,wc : array[1..maxn] of boolean;

tot,k,ti,s,n : longint;

procedure Init;

var i,x : integer;

p : ptr;

begin

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

fillchar(w,sizeof(w),true);

readln(n);

for i:=1 to n do ah[i]:=nil;

bh:=ah;

for i:=1 to n do

begin

read(x);

while x0 do

begin

new(p);

p^.d:=x;

p^.next:=ah[i];

ah[i]:=p;

new(p);

p^.d:=i;

p^.next:=bh[x];

bh[x]:=p;

read(x);

end;

readln;

end;

tot:=0;

ti:=0;

end;

procedure Dfs(x:integer);

var p : ptr; u : integer;

begin

v[x]:=false;

p:=ah[x];

while pnil do

begin

u:=p^.d;

if v then Dfs(u);

p:=p^.next;

end;

inc(tot);

be[tot]:=x;

end;

procedure D1_D2;

begin

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

fillchar(wc,sizeof(wc),true);

fillchar(ind,sizeof(ind),0);

s:=0;

end;

procedure Dfs2(x:integer);

var p : ptr;

u : integer;

begin

v[x]:=false;

f[x]:=ti;

p:=bh[x];

while pnil do

begin

u:=p^.d;

if v then Dfs2(u);

p:=p^.next;

end;

end;

procedure Main;

var p : ptr;

i,u : integer;

begin

Init;

for i:=1 to n do

if v[i] then Dfs(i);

D1_D2;

for i:=n downto 1 do

if v[be[i]] then

begin

inc(ti);

Dfs2(be[i]);

end;

for i:=1 to n do

begin

p:=ah[i];

while pnil do

begin

u:=p^.d;

if ff[i] then inc(ind);

p:=p^.next;

end;

end;

for i:=1 to n do

if (ind[i]=0) and (wc[f[i]]) then

begin

inc(s);

wc[f[i]]:=false;

end;

end;

begin

Main;

writeln(s);

end.

..图的遍历···看多少次遍历完。

代码不到40行···

这道题可以用1022的代码AC!

Floyd+Floodfill

编译通过...

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

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

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

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

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

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

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

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

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

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

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

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

type inf=record

x,y:array[0..1000]of longint;

top:longint;

end;

var n:longint;way:inf;

bin:array[0..1000]of longint;

procedure init;

var i,z,k:longint;

begin

readln(n);

z:=0;

for i:=1 to n do

begin

read(k);

while k0 do

begin

inc(z);

way.x[z]:=i;

way.y[z]:=k;

read(k);

end;

bin[i]:=i;

end;

way.top:=z;

end;

function getit(n:longint):longint;

begin

if n=bin[n] then getit:=n

else

begin

bin[n]:=getit(bin[n]);

getit:=bin[n];

end;

end;

procedure run;

var i,x1,x2:longint;

begin

for i:=1 to way.top do

begin

x1:=getit(way.x[i]);

x2:=getit(way.y[i]);

if x1x2 then

begin

bin[x1]:=bin[x2];

end;

end;

for i:=1 to n do

begin

bin[i]:=getit(bin[i]);

end;

end;

procedure outit;

var b:array[0..1000]of boolean;k,i:longint;

begin

fillchar(b,sizeof(b),0);

k:=0;

for i:=1 to n do if not(b[bin[i]]) then begin inc(k);b[bin[i]]:=true;end;

writeln(k);

end;

begin

init;

run;

outit;

end.

Flag 　　 Accepted

题号 　　P1023

类型(?) 　　图结构

通过 　　1964人

提交 　　3298次

通过率 　　60%

难度 　　3

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

这样做的，感觉不是很好，希望大牛指点一二！

什么这叫难度3.......

BFS一下就过.......

program ex;

var i,j,n,total:integer;

a:array[1..200,1..200] of integer;

b:array[1..200] of integer;

d:array[1..200]of boolean;

procedure dfs(k:integer);

var i,j:integer;

begin

for i:=1 to b[k] do begin

if d[a[k,i]] then

begin

d[a[k,i]]:=false;

dfs(a[k,i]);

end;

end;

end;

begin

readln(n);

total:=0;

for i:=1 to n do begin

j:=1;

read(a);

while a0 do

begin

inc(j);

read(a);

end;

b[i]:=j-1;

readln;

end;

fillchar(d,sizeof(d),true);

for i:=1 to n do

begin

if d[i] then begin

d[i]:=false;

dfs(i);

inc(total);

end;

end;

writeln(total);

end.

var

slogan,s,d,a:array[0..1000,0..1000]of longint;

m,n:longint;

procedure init;

var

i:longint;

begin

read(n);

for i:=1 to n do

begin

readln(str);

while length(str)>0 do

begin

val(copy(str,1,pos(' ',str)-1),l,code));

delete(str,1,pos(' ',str))

a:=1;

end;

end;

end;

procedure main;

var

i,j,k:longint;

begin

for i:=1 to n do

for j:=1 to n do

for k:=1 to n do

if (ij)and(ik)and(jk) then

if (a=1)and(a=1)or(a[k,j]=1) then slogan:=1;

for i:=1 to n do

if s[i]0 then

begin

inc(count);s[i]:=count;

for j:=1 to n do if (slogan=1) and(slogan[j,i]=1) then s[j]:=count;

end;

for i:=1 to n do

for j:=1 to n do

if s[i]s[j] then

if a[s[i],s[j]]=1 then k[s[i],s[j]]:=1;

for i:=1 to count do

for j:=1 to count do

if k=1 then begin d:=1;d[j,2]:=1;end;

for i:=1 to count do

if d=1 then inc(m);

writeln(m);

end;

begin

init;

main;

end.

这个和p1022是一样的

但是p1022是要双向的

也就是要：if (f[i][j] && f[j][i]) used[j]=1;

但是p1023只要一个方向就可以了

也就是：if (f[i][j]) used[j]=1;

简单的ac

Victoria的舞會3 Victoria的舞會 系列

編譯通過...

├ 測試數據 01：答案正确... 0ms

├ 測試數據 02：答案正确... 0ms

├ 測試數據 03：答案正确... 0ms

├ 測試數據 04：答案正确... 0ms

├ 測試數據 05：答案正确... 0ms

├ 測試數據 06：答案正确... 0ms

├ 測試數據 07：答案正确... 0ms

├ 測試數據 08：答案正确... 0ms

├ 測試數據 09：答案正确... 0ms

├ 測試數據 10：答案正确... 0ms

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

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

同样程序可过两题，难得啊！

本人于并查集不懂，后来无聊想了一个奇异的dfs，倒也过了，不知题意如何

var

vis:array[1..200,1..200]of boolean;

g:array[1..200]of boolean;

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

procedure sort(j:longint);

var

i:longint;

begin

g[j]:=false;

for i:=1 to n do

if (vis[j,i])and(vis)and(g[i]) then sort(i);

end;

begin

readln(n);

m:=0;

fillchar(vis,sizeof(vis),false);

fillchar(g,sizeof(g),true);

for i:=1 to n do

begin

repeat

read(j);

if j0 then vis:=true;

until j=0;

end;

for i:=1 to n do

for j:=1 to n do

for k:=1 to n do

if (vis)and(vis[j,k]) then vis:=true;

for i:=1 to n do

if g[i] then begin sort(i);inc(m);end;

write(m);

end.

同样的题目交两遍