MESSAGE - Truyền tin

Tác giả: flashmt

Ngôn ngữ: Pascal

const fi='';
      fo='';
      maxn=800;
var n,m,re,res,dem,last:longint;
    a:array[1..maxn,1..maxn] of longint;
    d,low,st,r,st1:array[1..maxn] of longint;
    free:array[1..maxn] of boolean;

procedure rf;
var i,j,x,y:longint; 
begin
     assign(input,fi); reset(input);
     readln(n,m);
     for i:=1 to m do
     begin
          readln(x,y); a[x,y]:=1;
     end;
     close(input);
end;

procedure push(i:longint);
begin
     inc(last); st[last]:=i;
end;

function pop:longint;
begin
     pop:=st[last];
     dec(last);
end;

function min(t,u:longint):longint;
begin
     if t<u then min:=t else min:=u;
end;

procedure visit(i:longint);
var k,j,sl:longint; kt:boolean;
begin
     inc(dem); d[i]:=dem; low[i]:=d[i];
     push(i);
     for j:=1 to n do
         if free[j] and (a[i,j]=1) then
            if d[j]>0 then low[i]:=min(low[i],d[j])
            else
            begin
                 visit(j);
                 low[i]:=min(low[i],low[j]);
            end;
     if d[i]=low[i] then
     begin
          inc(re); sl:=0;
          repeat
                j:=pop; inc(sl); st1[sl]:=j;
                free[j]:=false;
                r[j]:=re;
          until j=i;
          for j:=1 to n do
              if r[j]<>re then
              begin
                 kt:=true;
                 for k:=1 to sl do
                     if a[j,st1[k]]=1 then 
                     begin 
                          kt:=false; break;
                     end;
                 if not kt then break;
              end;
          if kt then inc(res);
     end;
end;

procedure pr;
var i:longint;
begin
     last:=0; dem:=0; re:=0;
     fillchar(free,sizeof(free),true);
     for i:=1 to n do
         if d[i]=0 then visit(i);
end;

procedure wf;
var i:longint;
begin
     assign(output,fo); rewrite(output);
     writeln(res);
     close(output);
end;

begin
     rf;
     pr;
     wf;
end.

Download