179 条题解

  • 0
    @ 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

  • 0
    @ 2009-07-13 16:32:15

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

  • 0
    @ 2009-06-29 20:54:40

    并查集30分...

  • 0
    @ 2009-06-21 22:44:32

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

  • 0
    @ 2009-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.

  • 0
    @ 2009-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.

  • 0
    @ 2009-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.

  • 0
    @ 2009-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.

  • 0
    @ 2009-04-04 17:07:02

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

    代码不到40行···

  • 0
    @ 2009-03-25 17:39:13

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

  • 0
    @ 2009-03-18 15:58:51

    Floyd+Floodfill

  • 0
    @ 2009-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 有效耗时: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

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

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

  • 0
    @ 2009-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.

  • 0
    @ 2009-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.

  • 0
    @ 2009-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

  • 0
    @ 2009-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

    同样程序可过两题,难得啊!

  • 0
    @ 2009-01-18 19:17:45

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

  • 0
    @ 2009-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.

  • 0
    @ 2008-12-28 09:06:33

    同样的题目交两遍

  • 0
    @ 2008-12-12 21:34:36

    把1022的程序直接copy过来的。

    就是图的遍历问题!!!

    不要想太复杂了!!!

    难度应该改为一级的才对嘛!

    水题一道!!!!!!

信息

ID
1023
难度
4
分类
图结构 | 强连通分量 点击显示
标签
递交数
4321
已通过
1972
通过率
46%
被复制
13
上传者