Cod sursa(job #1026848)

Utilizator baolaptrinhbaolaptrinh baolaptrinh Data 12 noiembrie 2013 04:16:30
Problema Count Scor 20
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.33 kb
Type
        mat=array [1..2000,1..2000] of boolean;
Var     a:mat;
        d,c:array [1..100000] of longint;
        n,m,res3,res4:longint;
        fi,fo:text;

Procedure Doc;
        Var i:longint;
        Begin
                Read(fi,n,m);
                For i:=1 to m do
                 Begin
                        Read(fi,d[i],c[i]);
                        a[d[i],c[i]]:=true;
                        a[c[i],d[i]]:=true;
                 end;
        end;

Procedure Lam;
        Var i,j:longint;
        Begin
                For i:=1 to m do
                 For j:=1 to n do
                  If a[j,d[i]] and a[j,c[i]] then inc(res3);
                For i:=1 to m do
                 For j:=i+1 to m do
                  If a[d[i],c[j]] and a[d[i],d[j]] and a[c[i],d[j]] and a[c[i],c[j]] then
                   inc(res4);
                If (res3=0) and (res4=0) then Write(fo,2,' ',m)
                else If res4=0 then Write(fo,3,' ',res3 div 3)
                else Write(fo,4,' ',res4);
        end;

Procedure Inkq;
        Begin
        end;

        Begin
                Assign(fi,'count.in');Reset(fi);
                Assign(fo,'count.out');Rewrite(fo);
                        Doc;
                        Lam;
                        Inkq;
                Close(fo);Close(fi);
        end.