STABLE - VOI10 - Ổn định

Tác giả: ladpro98

Ngôn ngữ: Pascal

program stable;
uses    math;
type    e=record
        x,y:longint;
        end;
const   maxm=55555;
        maxn=10005;
        fi='';
var
        head,d,way:array[1..maxn] of longint;
        check,done:array[1..maxn] of boolean;
        q,adj,link,st:array[1..maxm] of longint;
        n,m,s:longint;

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

procedure bfs;
var     i,l,r,u,top,v:longint;

begin
        l:=1;r:=1;
        q[1]:=s;
        check[s]:=true;
        way[s]:=1;
        while l<=r do
        begin
                u:=q[l];inc(l);
                i:=head[u];
                top:=0;
                while i>0 do
                begin
                        v:=adj[i];
                        if not done[v] then
                        begin
                                inc(top);
                                st[top]:=v;
                                done[v]:=true;
                                if not check[v] then
                                begin
                                        check[v]:=true;
                                        inc(r);
                                        q[r]:=v;
                                        d[v]:=d[u]+1;
                                        way[v]:=way[u];
                                end
                                else
                                begin
                                        if d[u]+1=d[v] then
                                        inc(way[v],way[u]);
                                        if way[v]>1 then way[v]:=2;
                                end;
                        end;
                        i:=link[i];
                end;
                for i:=1 to top do
                done[st[i]]:=false;
        end;
end;

procedure output;
var     i,res:longint;
begin
        res:=0;
        for i:=1 to n do
        if way[i]>1 then inc(res);
        write(res);
end;

begin
        input;
        bfs;
        output;
end.

Download