Cod sursa(job #18539)

Utilizator andrewgPestele cel Mare andrewg Data 18 februarie 2007 12:34:09
Problema Culori Scor 0
Compilator fpc Status done
Runda preONI 2007, Runda 2, Clasa a 10-a Marime 1.76 kb
const maxn = 260;

var f:text;
    n,m,i,j,len,q:longint;
    sol:longint;
    a,st:array[1..2*maxn]of longint;
    fol:array[1..maxn]of boolean;
    p,t,c:array[1..maxn]of longint;

procedure readdata;
begin
   assign(f,'culori.in');
   reset(f);
   readln(f,n);
   for i:=1 to 2*n-1 do read(f,a[i]);
   close(f);
end;

procedure add(k:longint);
begin
   inc(len);
   if k=1 then inc(q);
   c[k]:=a[len];
   if p[k]=0 then p[k]:=len;
   st[len]:=k;
end;

procedure sub;
var k:longint;
begin
   k:=st[len];
   if p[k]=len then
   begin
      c[k]:=0;
      t[k]:=0;
      p[k]:=0;
   end;
   if k=1 then dec(q);
   if t[st[len-1]]=k then fol[st[len-1]]:=false;
   st[len]:=0;
   dec(len);
end;

procedure DF(k:longint);
var i:longint;
begin
   add(k);
   if (len>1) and ((t[st[len-1]]<>k) or ((t[k]=0) and (k<>1))) then t[k]:=st[len-1];
   if t[st[len-1]]=k then
   begin
      fol[st[len-1]]:=true;
   end;
   if len<2*n-1 then
   begin
      for i:=1 to n do
      begin
         if ((c[i]=0) or (c[i]=a[len+1])) and (fol[i]=false) then
         begin
            if ((c[i]<>0) and (t[k]<>i)) and (k<>1) then
            begin
            end
               else
            begin
               DF(i);
               if k=1 then break;
            end;
         end;
      end;
   end;
   if len=2*n-1 then
   begin
      if (st[1]=st[2*n-1]) then
      begin
         sol:=(sol+1) mod 9901;
      end;
   end;
   sub;
end;

procedure solve;
begin
   sol:=0;
   if a[1]<>a[2*n-1] then
   begin
      sol:=0;
      exit;
   end;
   DF(1);
end;

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

begin
   readdata;
   solve;
   writedata;
end.