Cod sursa(job #324094)

Utilizator DeadEyeNaiba Mihai Lucian DeadEye Data 14 iunie 2009 18:05:21
Problema Triplete Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.06 kb
var f,g:text;
    n,m,i,j,x,y,nt,k,nr:longint;
    a:array[1..4096,1..4096] of byte;
    b:array[1..4096,1..512] of byte;
begin
    assign(f,'triplete.in'); reset(f);
    assign(g,'triplete.out'); rewrite(g);
    readln(f,n,m);
    for i:=1 to n do
       for j:=1 to n do a[i,j]:=0;
    for i:=1 to m do
       begin
          readln(f,x,y);
          a[x,y]:=1; a[y,x]:=1;
       end;
    close(f);
    for i:=1 to n do
       for j:=1 to (n div 8)+1 do
          b[i,j]:=a[i,j*8]*128+a[i,j*8-1]*64+a[i,j*8-2]*32+a[i,j*8-3]*16
                 +a[i,j*8-4]*8+a[i,j*8-5]*4+a[i,j*8-6]*2+a[i,j*8-7];
    nt:=0;
    for k:=1 to (n div 8)+1 do
       begin
          for i:=1 to n-1 do
             for j:=i+1 to n do
                if a[i,j]=1 then
                begin
                   x:=b[i,k] and b[j,k];
                   nr:=0;
                   repeat
                      inc(nr); x:=x and (x-1);
                   until x=0;
                   nt:=nt+nr;
                end;
       end;
    writeln(g,nt div 3);
    close(g);
end.