Cod sursa(job #1024919)

Utilizator hungntnktpHungntnktp hungntnktp Data 9 noiembrie 2013 12:24:10
Problema Count Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 4.72 kb
program SUBGRAPH;
Const
        fi='count.in';
        fo='count.out';
Var     N,m,u,v,i,j,khop,cau,dem,top,max:longint;
        next,adj:array[-100100..100100] of longint;
        head:array[-10100..10100] of longint;
        Mark:array[1..10100] of boolean;
        free:array[-100100..100100] of boolean;
        st,num,nc,low,parent:array[1..100100] of longint;
        a:array[1..2010,1..2010] of boolean;
        dd,cx:array[1..1000100] of longint;

        procedure input;
        Var f:Text;
        begin
                 Assign(f,fi);Reset(f);
                 Readln(f,N,M);
                 Fillchar(a,Sizeof(a),false);
                 For i:=1 to M do
                 begin
                        Readln(f,u,v);
                        a[u,v]:=true;a[v,u]:=true;
                        adj[i]:=v;next[i]:=head[u];head[u]:=i;
                        adj[-i]:=u;next[-i]:=head[v];head[v]:=-i;
                 end;
                 close(f);
        end;

        procedure Push(x:longint);
        begin
                 inc(top);
                 st[top]:=x;
        end;

        Function min(x,y:longint):longint;
        begin
                 min:=x;
                 IF min>y then min:=y;
        end;

        procedure DFS(u:longint);
        Var i,v:longint;
        begin
                 inc(dem);num[u]:=dem;low[u]:=n+1;nc[u]:=0;
                 Push(u);
                 i:=head[u];
                 While i<>0 do
                 begin
                         v:=adj[i];
                         If free[i] then
                         begin
                                free[-i]:=false;
                                IF num[v]=0 then
                                begin
                                        parent[v]:=u;
                                        inc(nc[u]);
                                        DFS(v);
                                        If Low[v]>Num[u] then inc(cau);
                                        IF Low[v]>=Num[u] then Mark[u]:=true;
                                        Low[u]:=Min(Low[u],Low[v]);
                                end else Low[u]:=Min(Low[u],Num[v]);
                         end;
                         i:=next[i];
                 end;
        end;

        procedure DFS22(u:longint);
        Var i,v:longint;
        begin
                 free[u]:=false;inc(dem);cx[dem]:=u;
                 i:=head[u];
                 While i<>0 do
                 begin
                          v:=adj[i];
                          IF (free[v]) and (a[u,v]) then
                          begin
                                 DFS22(v);
                          end;
                          i:=next[i];
                 end;
        end;

        procedure Sol;
        Var i,j,p:longint;
            Ok:boolean;
        begin
                 Fillchar(free,Sizeof(free),true);
                 Fillchar(Mark,Sizeof(mark),false);
                 Fillchar(Num,Sizeof(num),0);
                 dem:=0;cau:=0;khop:=0;
                 For i:=1 to N do
                 IF num[i]=0 then
                 begin
                          parent[i]:=-1;
                          DFS(i);
                          If nc[i]<2 then Mark[i]:=false;
                 end;
                 For i:=1 to N do
                 begin
                         j:=parent[i];
                         IF (j<>-1) and (Low[i]>=Num[i]) then
                         begin
                                 a[i,j]:=false;a[i,j]:=false;
                         end;
                 end;
                 max:=-maxlongint;
                 For i:=1 to N do
                 begin
                        dem:=0;
                        Fillchar(cx,Sizeof(cx),0);
                        DFS22(i);
                        Ok:=true;
                        For j:=1 to dem-1 do
                        begin
                          For p:=j+1 to dem do
                          IF a[cx[j],cx[p]]=false then
                          begin
                                  Ok:=false;
                                  break;
                          end;
                          If ok=false then break;
                        end;
                        IF Ok then
                        begin
                                 IF dem>max then max:=dem;
                                 inc(dd[dem]);
                        end;
                 end;
        end;

        procedure output;
        Var f:text;
        begin
                 Assign(f,fo);Rewrite(f);
                 Write(f,max,' ',dd[max]);
                 close(f);
        end;

BEGIN
        input;
        Sol;
        output;
END.