poj 2762 tarjan缩点+拓扑序

2013-09-08 10:00

var
    m, n                :longint;
    t                   :longint;
    f, last             :array[..] of longint;
    pre, other          :array[..] of longint;
    l, time             :longint;
    dfn, low            :array[..] of longint;
    tot                 :longint;
    stack               :array[..] of longint;
    flag, fs            :array[..] of boolean;
    i                   :longint;
    key                 :array[..] of longint;
    kk                  :longint;
    que                 :array[..] 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:= 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<> 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:=-;
    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[..] of longint;

begin
        fillchar(flag,sizeof(flag),);
        fillchar(d,sizeof(d),);
        h:=; t:=;
        que[]:=x;
        d[x]:=;
        while h<t do
        begin
            inc(h);
            cur:=que[h];
            q:=last[cur];
            while q<> do
            begin
                p:=other[q];
                inc(t);
                que[t]:=p;
                d[p]:=d[cur]+;
                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:=;
    fillchar(last,sizeof(last),);
    time:=;
    fillchar(f,sizeof(f),);
    fillchar(low,sizeof(low),);
    fillchar(dfn,sizeof(dfn),);
    fillchar(flag,sizeof(flag),false);
    fillchar(stack,sizeof(stack),);
    tot:=;
    fillchar(fs,sizeof(fs),false);
    fillchar(key,sizeof(key),);
    count:=;
    init;
    x:=;
    kk:=n;
    for i:= to n do
        if (f[i]=) then
        begin
            if x<> then
            begin
                writeln('No');
                exit;
            end;
            x:=i;
        end;
    if x= then x:=;
    dfs(x);

    if count<>n then
    begin
        writeln('No');
        exit;
    end;

    for i:= to n do
    begin
        q:=last[i];
        while q<> do
        begin
            p:=other[q];
            if key[i]<>key[p] then connect(key[i],key[p]);
            q:=pre[q];
        end;
    end;
    x:=;
    for i:=n+ to kk do
    begin
        if f[i]= then
        begin
            if x<> then
            begin
                writeln('No');
                exit;
            end;
            x:=i;
        end;
    end;

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

begin
    read(t);
    for i:= to t do main;
end.