Cod sursa(job #277428)

Utilizator CrisstiHDCristian Holdunu CrisstiHD Data 11 martie 2009 18:43:00
Problema Perle Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.26 kb
var f,g:text;
    a:array[1..10001]of 1..3;
    s:string;
    t,n,i,p:integer;
    e:boolean;

procedure rez;
begin
read(f,n);
for i:=1 to n do read(f,a[i]);
readln(f);
e:=true;
if n=1 then writeln(g,1)
       else
if n=2 then writeln(g,0)
       else
begin
if a[1]=1 then if n<4 then s:='C'
                      else s:='B'
          else if a[1]=2 then s:='B'
                         else s:='C';
p:=1;
while (length(s)>0)and e do begin
   if s[1] in ['1'..'3'] then if ord(s[1])-ord('0')=a[p] then begin
                                                          p:=p+1;
                                                          delete(s,1,1);
                                                          end
                                                     else e:=false
                     else if s[1]='A' then begin
                                           delete(s,1,1);
                                           p:=p+1;
                                           end
                     else if s[1]='B' then begin
                                           if a[p]=2 then p:=p+1
                                                     else
                                           if a[p]=1 then if n-p<3 then e:=false
                                                                   else begin
                                                                        delete(s,1,1);
                                                                        insert('A3AC',s,1);
                                                                        p:=p+1
                                                                        end
                                                     else
                                           if a[p]=3 then e:=false;
                                           end
                     else if s[1]='C' then begin
                                           if a[p]=1 then begin
                                                          p:=p+1;
                                                          delete(s,1,1);
                                                          insert('2A',s,1);
                                                          end
                                                     else
                                           if a[p]=2 then begin
                                                          delete(s,1,1);
                                                          p:=p+1;
                                                          end
                                                     else
                                           if a[p]=3 then begin
                                                          p:=p+1;
                                                          delete(s,1,1);
                                                          insert('BC',s,1);
                                                          end
                                           end;
   if p=n+1 then if length(s)>0 then e:=false;
end;
if e then if p=n+1 then writeln(g,1)
                   else writeln(g,0)
     else writeln(g,0);
end;
end;

begin
assign(f,'perle.in');
reset(f);
readln(f,t);
assign(g,'perle.out');
rewrite(g);
for t:=1 to t do rez;
close(g);
end.