Cod sursa(job #20607)

Utilizator coderninuHasna Robert coderninu Data 21 februarie 2007 20:15:23
Problema Culori Scor 4
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.12 kb
program culori;
var f,g:text;
    n,i,j,aux:byte;
    x:array[1..511] of byte;
    nr:integer;

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

function ok(a,b:byte):boolean;
var adev:boolean;
    k,vi,vf:byte;
begin
 adev:=true;
 vi:=a-b;
 vf:=a-1;
 k:=vi;
 while (k<=vf) and adev do
  begin
  if x[k]<>x[2*a-k] then
   adev:=false;
  inc(k);
  end;
 ok:=adev;
end;

function min(a:byte):byte;
var t1,t2:byte;
begin
 t1:=n-a;
 t2:=a-1;
 if t1<t2 then min:=t1
 else min:=t2;
end;

function putere(b:byte):byte;
var l,t:byte;
begin
 t:=1;
 for l:=1 to b do
  t:=t*2;
 putere:=t;
end;

function calcul(c:byte):integer;
var m,temp:integer;
begin
 temp:=0;
 for m:=1 to c do
  temp:=temp+putere(m-1);
 calcul:=temp;
end;

procedure afis;
begin
 assign(g,'culori.out'); rewrite(g);
 write(g,nr);
 close(g);
end;


begin
 citire;
 if ok(n,n-1) then
  begin
  nr:=1;
  aux:=n-1;
  for i:=2 to aux do
   for j:=1 to min(i) do
    if ok(i,j) then
     inc(nr);
  end
 else
  nr:=0;
 afis;
end.