179 条题解
-
0453844077 LV 10 @ 2009-07-15 11:59:50
随机搜索啊。。。都能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 -
02009-07-13 16:32:15@
这一题数据水的不一般,我忘了把max的值更改都AC了,神啊!!!
-
02009-06-29 20:54:40@
并查集30分...
-
02009-06-21 22:44:32@
我没话了,这套题数据以水著称……
-
02009-06-06 21:55:31@
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. -
02009-05-21 16:26:54@
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. -
02009-05-07 12:51:51@
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. -
02009-04-24 21:17:38@
经典解法:
图结构---|---|>树结构
{将强连通分支化为一个点}
再找入度为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. -
02009-04-04 17:07:02@
..图的遍历···看多少次遍历完。
代码不到40行··· -
02009-03-25 17:39:13@
这道题可以用1022的代码AC!
-
02009-03-18 15:58:51@
Floyd+Floodfill
-
02009-02-18 17:53:16@
编译通过...
├ 测试数据 01:答案正确... 0ms
├ 测试数据 02:答案正确... 0ms
├ 测试数据 03:答案正确... 0ms
├ 测试数据 04:答案正确... 0ms
├ 测试数据 05:答案正确... 0ms
├ 测试数据 06:答案正确... 0ms
├ 测试数据 07:答案正确... 0ms
├ 测试数据 08:答案正确... 0ms
├ 测试数据 09:答案正确... 0ms
├ 测试数据 10:答案正确... 0ms
---|---|---|---|---|---|---|---|-
Accepted 有效得分:100 有效耗时:0mstype 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---|---|---|---|---|---|---|---|--
这样做的,感觉不是很好,希望大牛指点一二! -
02009-02-16 21:16:41@
什么这叫难度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. -
02009-02-12 20:54:21@
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. -
02009-01-26 22:51:40@
这个和p1022是一样的
但是p1022是要双向的
也就是要:if (f[i][j] && f[j][i]) used[j]=1;
但是p1023只要一个方向就可以了
也就是:if (f[i][j]) used[j]=1;
简单的ac -
02009-01-19 22:49:50@
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同样程序可过两题,难得啊!
-
02009-01-18 19:17:45@
本人于并查集不懂,后来无聊想了一个奇异的dfs,倒也过了,不知题意如何
-
02009-01-17 20:46:17@
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. -
02008-12-28 09:06:33@
同样的题目交两遍
-
02008-12-12 21:34:36@
把1022的程序直接copy过来的。
就是图的遍历问题!!!
不要想太复杂了!!!
难度应该改为一级的才对嘛!
水题一道!!!!!!