Cod sursa(job #42217)

Utilizator andrewgPestele cel Mare andrewg Data 28 martie 2007 23:08:28
Problema Triplete Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.71 kb
const maxn = 4200;

type list = ^lista;
     lista = record
        nod:longint;
        next:list;
     end;

var f:text;
    n,m,i,len:longint;
    sol:longint;
    c:array[1..maxn]of list;
    ok,fol:array[1..maxn]of boolean;
    st:array[1..maxn]of longint;

procedure add(x,y:longint);
var aux:list;
begin
   new(aux);
   aux^:=c[y]^;
   c[y]^.nod:=x;
   c[y]^.next:=aux;
   if ok[y]=false then
   begin
      c[y]^.next:=nil;
      ok[y]:=true;
   end;
end;

procedure readdata;
var x,y:longint;
begin
   assign(f,'triplete.in');
   reset(f);
   readln(f,n,m);
   for i:=1 to n do
   begin
      ok[i]:=false;
      new(c[i]);
   end;
   for i:=1 to m do
   begin
      readln(f,x,y);
      add(x,y);
      add(y,x);
   end;
   close(f);
end;

procedure DF(nod:longint);
var x:list;
begin
   if len<>0 then
   begin
      if (nod<=st[len]) then exit;
   end;
   inc(len);
   st[len]:=nod;
   new(x);
   x^:=c[nod]^;
   ok[nod]:=true;
   while x<>nil do
   begin
      if (ok[x^.nod]=false) then
      begin
         DF(x^.nod);
      end
         else
      begin
         if (len>2) then
         begin
            if (st[len-2]=x^.nod) and (fol[x^.nod]=false) then
            begin
               inc(sol);
            end;
         end;
      end;
      x:=x^.next;
   end;
   fol[nod]:=true;
   st[len]:=0;
   ok[nod]:=false;
   dec(len);
end;

procedure solve;
begin
   sol:=0;
   len:=0;
   fillchar(ok,sizeof(ok),false);
   fillchar(fol,sizeof(fol),false);
   DF(1);
end;

procedure writedata;
begin
   assign(f,'triplete.out');
   rewrite(f);
   writeln(f,sol);
   close(f);
end;

begin
   readdata;
   solve;
   writedata;
end.