MESSAGE - Truyền tin

Tác giả: ladpro98

Ngôn ngữ: Pascal

program messageVOJ;
uses    math;
const   maxn=888;
        maxm=sqr(maxn);
        oo=123456789;
        fi='';

type    e=record
        v,link:longint;
        end;
var     adj,assc,rassc:array[1..maxm] of e;
        head,hssc,rhssc,num,low,stack,ssc,topo:array[1..maxn] of longint;
        avail:array[1..maxn] of boolean;
        n,m,count,ls,cs,dssc,drssc,i,res:longint;

procedure input;
var     inp:text;
        i,x,y:longint;
begin
        assign(inp,fi);
        reset(inp);
        readln(inp,n,m);
        for i:=1 to m do
        begin
                readln(inp,x,y);
                adj[i].v:=y;
                adj[i].link:=head[x];
                head[x]:=i;
        end;
        close(inp);
end;

procedure TarjanDfs(u:longint);
var     i:longint;
        v:e;
begin
        inc(count);num[u]:=count;low[u]:=oo;
        inc(ls);stack[ls]:=u;
        i:=head[u];
        while i<>0 do
        begin
                v:=adj[i];
                if avail[v.v] then
                begin
                        if num[v.v]>0 then
                                low[u]:=min(low[u],num[v.v])
                        else
                        begin
                                TarjanDfs(v.v);
                                low[u]:=min(low[u],low[v.v]);
                        end;
                end;
                i:=v.link;
        end;
        if low[u]>=num[u] then
        begin
                inc(cs);
                repeat
                        i:=stack[ls];dec(ls);
                        ssc[i]:=cs;
                        avail[i]:=false;
                until i=u;
        end;
end;

procedure makeGssc;
var     i,j:longint;
begin
        for i:=1 to n do
        begin
                j:=head[i];
                while j<>0 do
                begin
                        if ssc[adj[j].v]<>ssc[i] then
                        begin
                                inc(dssc);
                                assc[dssc].v:=ssc[adj[j].v];
                                assc[dssc].link:=hssc[ssc[i]];
                                hssc[ssc[i]]:=dssc;
                                inc(drssc);
                                rassc[drssc].v:=ssc[i];
                                rassc[drssc].link:=rhssc[ssc[adj[j].v]];
                                rhssc[ssc[adj[j].v]]:=drssc;
                        end;
                        j:=adj[j].link;
                end;
        end;
end;

procedure topoDfs(v:longint);
var     i:longint;
begin
        avail[v]:=false;
        i:=rhssc[v];
        while i<>0 do
        begin
                if avail[rassc[i].v] then
                        topoDfs(rassc[i].v);
                i:=rassc[i].link;
        end;
        inc(count);
        topo[count]:=v;
end;

procedure dfs(u:longint);
var     i:longint;
begin
        avail[u]:=false;
        i:=hssc[u];
        while i>0 do
        begin
                if avail[assc[i].v] then
                        dfs(assc[i].v);
                i:=assc[i].link;
        end;
end;

begin
        input;
        for i:=1 to n do avail[i]:=true;
        for i:=1 to n do if avail[i] then
                TarjanDfs(i);
        makeGssc;
        for i:=1 to cs do avail[i]:=true;
        count:=0;
        for i:=1 to cs do if avail[i] then
                topoDfs(i);
        for i:=1 to cs do avail[i]:=true;
        for i:=1 to count do if avail[topo[i]] then
        begin
                inc(res);
                dfs(topo[i]);
        end;
        write(res);
end.

Download