Cod sursa(job #7040)

Utilizator adalLica Adela adal Data 21 ianuarie 2007 12:03:28
Problema Triplete Scor 40
Compilator fpc Status done
Runda preONI 2007, Runda 1, Clasa a 10-a Marime 1.1 kb
type point=^nod;
     nod=record
       inf:integer;
       leg:point;
       end;
      rec1=record
        s,d:integer;
      end;
var c:array[1..5000]of point;
    sel:array[0..5000]of boolean;
    p:point;
    a:array[1..66000] of rec1;
    n,i,j,m,nr,u,max:longint;
    f,g:text;

procedure creare ;
var i,j,x,y:integer;
begin
readln(f,n,m);
for i:=1 to n do c[i]:=nil;
for i:=1 to m do begin
            readln(f,x,y);
            a[i].s:=x; a[i].d:=y;
            new(p); p^.inf:=y; p^.leg:=c[x]; c[x]:=p;
            new(p); p^.inf:=x; p^.leg:=c[y]; c[y]:=p;

          end;
end;


begin
 assign(f,'triplete.in');
 assign(g,'triplete.out');
 reset(f);rewrite(g);
 creare;
 nr:=0;
 for i:= 1 to m do begin
   fillchar(sel,n+1,false);
   p:=c[a[i].s];
   if a[i].s<a[i].d then max:=a[i].d
                    else max:=a[i].s;
   while p<>nil do begin sel[p^.inf]:=true; p:=p^.leg; end;
   p:=c[a[i].d];
   while p<>nil do begin
      if (sel[p^.inf]=true) and(p^.inf>max) then
         inc(nr);
      p:=p^.leg;
   end;
 end;
  writeln(g,nr);
 close(f); close(g);
end.