Cod sursa(job #552977)

Utilizator diadinisDinis Diana diadinis Data 13 martie 2011 12:02:36
Problema Perle Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.31 kb
type vector=array[1..10000] of byte;
var n,li,i,j,k,h,l:word;
    a,b,c: vector;
    f,g:text;
    ok:boolean;


procedure transformb1(var k:word);
begin
b[k]:=2;b[k+1]:=20;
k:=k+2;
end;


procedure transformb2(var k:word);
begin
b[k]:=1;
b[k+1]:=10;
b[k+2]:=3;
b[k+3]:=10;
b[k+4]:=30;
k:=k+5;
end;


procedure transformc1(var k: word);
begin
b[k]:=2;
k:=k+1;
end;


procedure transformc2(var k: word);
begin
b[k]:=3;
b[k+1]:=20;
b[k+2]:=30;
k:=k+3;
end;


procedure transformc3(var k:word);
begin
b[k]:=1;
b[k+1]:=2;
b[k+2]:=10;
k:=k+3;
end;


procedure save;
var ch:word;
begin
ch:=h+1;
l:=1;
while b[ch]<>0 do
   begin
    c[l]:=b[ch];
    ch:=ch+1;
    l:=l+1;
   end;
end;


procedure paste;
var m:word;
begin
m:=1;
while c[m]<>0 do
   begin
    b[k]:=c[m];
    k:=k+1;
    m:=m+1;
   end;
end;


procedure clrvec(var a:vector);
begin
j:=1;
while a[j]<>0 do
   begin
     a[j]:=0;
      j:=j+1;
   end;
end;


procedure shir (var ok:boolean);
begin
h:=1;
while ok and ((a[h]<>0) or(b[h]=0)) do
   begin
   h:=h+1;
   if b[h]=10 then b[h]:=a[h];
   if b[h]=20 then if a[h]=1
      then begin
            save;
            k:=k-l;
            transformb2(k);
            paste;
            clrvec(c);
           end
      else if a[h]=2
              then begin
                    save;
                    k:=k-l;
                    transformb1(k);
                    paste;
                    clrvec(c);
                   end
              else if a[h]=3 then ok:=false;
   if b[h]=30 then if a[h]=1
      then begin
            save;
            k:=k-l;
            transformc3(k);
            paste;
            clrvec(c);
           end
      else if a[h]=2
              then  begin save;k:=k-l;transformc1(k);paste;clrvec(c);end
              else if a[h]=3 then
                   begin
                    save;
                    k:=k-l;
                    transformc2(k);
                    paste;
                    clrvec(c);
                   end;
   if (b[h]<>a[h]) then ok:=false;
   end;


end;





begin
assign(g, 'perle.out');
rewrite(g);
assign(f, 'perle.in');
reset(f);
read(f,n);
for i:= 1 to n do
   begin
      k:=1;
      clrvec(b);
      clrvec(a);
      ok:=true;
      readln(f);
      read(f,li);
      if li=1
         then writeln(g,'1')
         else if li=2
            then writeln(g,'0')
            else if li=3 then
                    begin
                     for j:= 1 to li do
                     read(f,a[j]);
                     if ((a[1]=1) and (a[2]=2) and (a[3]=1)) or ((a[1]=1) and (a[2]=2) and (a[3]=2)) or ((a[1]=1) and (a[2]=2) and (a[3]=3))
                        then writeln (g, '1')
                        else writeln (g, '0');
                    end
               else begin
                     for j:= 1 to li do
                     read(f,a[j]);

                     if a[1]=1 then begin transformb2(k); shir(ok); end;
                     if a[1]=2 then begin transformb1(k); shir(ok); end;
                     if a[1]=3 then begin transformc2(k); shir(ok); end;

                     if ok then writeln(g, '1')
                           else writeln(g, '0');
                    end;




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