Cod sursa(job #42186)

Utilizator andrewgPestele cel Mare andrewg Data 28 martie 2007 22:34:21
Problema Triplete Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.81 kb
const maxn = 4100;

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

var f:text;
    n,m,i,j,len:longint;
    sol:longint;
    c:array[1..maxn]of list;
    ok,fol:array[1..maxn]of boolean;
    st:array[1..2*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
      new(c[i]);
      ok[i]:=false;
   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
      begin
         if len>2 then
         begin
            if (nod=st[len-2]) and (fol[nod]=false) then
            begin
               inc(sol);
               exit;
            end
               else exit;
         end
            else  exit;
      end;
   end;
   inc(len);
   st[len]:=nod;
   new(x);
   x^:=c[nod]^;
   ok[nod]:=true;
   while x<>nil do
   begin
      if (ok[x^.nod]=false) or ((st[len-2]=x^.nod) and (len>2)) then
      begin
         DF(x^.nod);
      end;
      x:=x^.next;
   end;
   fol[nod]:=true;
   st[len]:=0;
   ok[nod]:=false;
   dec(len);
end;

procedure solve;
begin
   sol:=0;
{   for i:=1 to n do
   begin}
      len:=0;
      fillchar(ok,sizeof(ok),false);
      DF(1);
{   end;}
end;

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

begin
   readdata;
   solve;
   writedata;
end.