poj 2762 tarjan缩点+拓扑序

2013-09-08 10:00

var

    m, n                :longint;

    t                   :longint;

    f, last             :array[0..20100] of longint;

    pre, other          :array[0..160100] of longint;

    l, time             :longint;

    dfn, low            :array[0..20100] of longint;

    tot                 :longint;

    stack               :array[0..20100] of longint;

    flag, fs            :array[0..20100] of boolean;

    i                   :longint;

    key                 :array[0..20100] of longint;

    kk                  :longint;

    que                 :array[0..20100] of longint;

    count               :longint;

 

function min(a,b:longint):longint;

begin

    if a>b then min:=b else min:=a;

end;

 

procedure connect(x,y:longint);

begin

    inc(l);

    pre[l]:=last[x];

    last[x]:=l;

    other[l]:=y;

    f[y]:=x;

end;

 

procedure init;

var

    i                   :longint;

    x, y                :longint;

begin

    read(n,m);

    for i:=1 to m do

    begin

        read(x,y);

        connect(x,y);

    end;

end;

 

procedure dfs(x:longint);

var

    p, q, cur           :longint;

begin

    inc(time);

    dfn[x]:=time;

    low[x]:=time;

    inc(tot);

    stack[tot]:=x;

    fs[x]:=true;

    flag[x]:=true;

    q:=last[x];

    while q<>0 do

    begin

        p:=other[q];

        if p<>x then

        begin

            if not flag[p] then

            begin

                dfs(p);

                low[x]:=min(low[x],low[p]);

            end else

            if fs[p] then

            begin

                low[x]:=min(low[x],dfn[p]);

            end;

        end;

        q:=pre[q];

    end;

    p:=-1;

    if low[x]=dfn[x] then

    begin

        inc(kk);

        while p<>x do

        begin

            p:=stack[tot];

            fs[p]:=false;

            key[p]:=kk;

            dec(tot);

            inc(count);

        end;

    end;

 

end;

 

function bfs(x:longint):boolean;

var

    i                   :longint;

    t, h, p, q          :longint;

    cur                 :longint;

    d                   :array[0..2020] of longint;

 

begin

        fillchar(flag,sizeof(flag),0);

        fillchar(d,sizeof(d),0);

        h:=0; t:=1;

        que[1]:=x;

        d[x]:=1;

        while h<t do

        begin

            inc(h);

            cur:=que[h];

            q:=last[cur];

            while q<>0 do

            begin

                p:=other[q];

                inc(t);

                que[t]:=p;

                d[p]:=d[cur]+1;

                q:=pre[q];

            end;

        end;

        if d[que[t]]=kk-n then exit(true) else exit(false);

end;

 

procedure main;

var

    i                   :longint;

    x                   :longint;

    q, p                :longint;

begin

    l:=1;

    fillchar(last,sizeof(last),0);

    time:=0;

    fillchar(f,sizeof(f),0);

    fillchar(low,sizeof(low),0);

    fillchar(dfn,sizeof(dfn),0);

    fillchar(flag,sizeof(flag),false);

    fillchar(stack,sizeof(stack),0);

    tot:=0;

    fillchar(fs,sizeof(fs),false);

    fillchar(key,sizeof(key),0);

    count:=0;

    init;

    x:=0;

    kk:=n;

    for i:=1 to n do

        if (f[i]=0) then

        begin

            if x<>0 then

            begin

                writeln('No');

                exit;

            end;

            x:=i;

        end;

    if x=0 then x:=1;

    dfs(x);

 

    if count<>n then

    begin

        writeln('No');

        exit;

    end;

 

    for i:=1 to n do

    begin

        q:=last[i];

        while q<>0 do

        begin

            p:=other[q];

            if key[i]<>key[p] then connect(key[i],key[p]);

            q:=pre[q];

        end;

    end;

    x:=0;

    for i:=n+1 to kk do

    begin

        if f[i]=0 then

        begin

            if x<>0 then

            begin

                writeln('No');

                exit;

            end;

            x:=i;

        end;

    end;

 

    if x=0 then x:=1;

    if bfs(x) then writeln('Yes') else writeln('No');

end;

 

begin

    read(t);

    for i:=1 to t do main;

end.

 

你可能感兴趣的:(tar)