Cod sursa(job #14404)

Utilizator andrei_infoMirestean Andrei andrei_info Data 8 februarie 2007 22:11:56
Problema Triplete Scor 40
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.57 kb
//triplete

const nmax= 4096;
type pnod = ^tnod;
     tnod = record
                x:integer;
                next:pnod;
                end;
     rr = record
        head,last:pnod;
        end;
     xx =record
        x,y:integer;
        end;
var nod : array[1..nmax] of rr;
    ok : array[1..nmax] of boolean;
    edge : array[1..65540]of xx;
    rez,n,m:longint;


procedure addlist(x:integer; var r:rr);
var p:pnod;
begin
new(p); p^.x:=x; p^.next:=nil;
if r.head=nil then r.head:=p
else r.last^.next:=p;
r.last:=p;
end;

procedure citire;
var i:longint;
    x,y:integer;
begin
assign(input,'triplete.in'); reset(input);
readln(n,m);
for i:=1 to m do
        begin
        readln(x,y);
        addlist(x,nod[y]);
        addlist(y,nod[x]);
        edge[i].x:=x; edge[i].y:=y;
        end;
close(input);
end;

procedure fill(x:integer);
var p:pnod;
begin
p:=nod[x].head;
fillchar(ok,sizeof(ok),false);
while p <> nil do
        begin
        ok[p^.x]:=true;
        p:=p^.next;
        end;
end;

function numara(x:integer):integer;
var p:pnod;
    r:integer;
begin
p:=nod[x].head; r:=0;
while p<> nil do
        begin
        if ok[p^.x] then inc(r);
        p:=p^.next;
        end;
numara:=r;
end;

procedure calc;
var p:pnod;
    i:integer;
begin

for i:=1 to m do
        begin
                        fill(edge[i].x);
                        rez:=rez+numara(edge[i].y);
        end;
end;

begin
citire;
calc;
assign(output,'triplete.out'); rewriTe(output);
writeln(rez div 3);
close(output);
end.