Cod sursa(job #280786)

Utilizator SzabiVajda Szabolcs Szabi Data 13 martie 2009 16:03:27
Problema Perle Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.73 kb
program sarkany;
type sor=array[1..1000] of 1..3;
var temp:sor;
    n,l,i,j,k:word;
    f,g:text;

function b(l:word;x:sor):boolean; forward;
function c(l:word;x:sor):boolean; forward;

function a(l,x:word):boolean;
var jo:boolean;
begin
    jo:=false;
    if (l=1) and ((x=1)or(x=2)or(x=3)) then jo:=true;


 a:=jo;
end;

function b(l:word;x:sor):boolean;
var jo:boolean;
    y:sor;

begin
    jo:=false;
    if l>=2 then begin
    for k:=2 to l do
    y[k-1]:=x[k];
    if (x[1]=2) and (b(l-1,y)) then jo:=true;
    end;

    if (not jo) and (l>=4) and (x[1]=1) and (x[3]=3) then begin
      for k:=5 to l do
      y[k-4]:=x[k];
      if (x[1]=1) and (a(1,x[2])) and (x[3]=3) and (a(1,x[4])) and (c(l-4,y)) then
      jo:=true;

    end;

 b:=jo;
end;


function c(l:word;x:sor):boolean;
var i:word;
    jo:boolean;
    y1,y2:sor;
begin
 jo:=false;

  if (l=1) and (x[1]=2) then jo:=true;

  if (l=3) and (x[1]=1) and (x[2]=2) and (a(1,x[3])) then jo:=true;


  if (not jo) and (l>=3) and (x[1]=3) then begin
     for k:=2 to l-1 do begin
       if not jo then begin
        for i:=2 to k do
        y1[i-1]:=x[i];
        for i:=k+1 to l do
        y2[i-k]:=x[i];
        if (b(k-1,y1)) and (c(l-k,y2)) then jo:=true;


      end;
     end;

  end;

c:=jo;

end;



begin
    assign(f,'perle.in');reset(f);
    assign(g,'perle.out');rewrite(g);
     readln(f,n);
     for i:=1 to n do begin
         read(f,l);
         for j:=1 to l do
         read(f,temp[j]);
         if ((l=1)and ((temp[1]=3)or(temp[1]=1)or(temp[1]=2))) or (b(l,temp)) or (c(l,temp)) then
         writeln(g,'1') else writeln(g,'0');
         readln(f);

     end;


    close(f);
    close(g);
end.