Cod sursa(job #251982)

Utilizator chelaru_t_achelaru traian andrei chelaru_t_a Data 3 februarie 2009 18:35:49
Problema Perle Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.87 kb
var st:array [1..10002] of char;
    y:array [1..10002] of integer;
    n,l,vf,ok,i:integer;
    f,g:text;

 procedure citire;
  var i:integer;
  begin
  ok:=1;
  read(f,l);
  for i:=1 to l do read(f,y[i]);
  if l=1 then
    begin
    writeln(g,1);
    ok:=0;
    end
  else
    if l=2 then
      begin
      writeln(g,0);
      ok:=0;
      end
    else
      if y[1]=2 then
        begin
        st[1]:='2';
        st[2]:='B';
        st[3]:='C';
        vf:=3;
        end
      else
       if y[1]=3 then
         begin
         st[1]:='3';
         st[2]:='B';
         st[3]:='C';
         end
       else
         if (y[1]=1) and (y[3]=3) then
           begin
           st[1]:='1';
           st[2]:='A';
           st[3]:='3';
           st[4]:='A';
           st[5]:='C';
           vf:=5;
           end
         else
           if (y[1]=1) and (y[2]=2) then
             begin
             st[1]:='1';
             st[2]:='2';
             st[3]:='3';
             vf:=3;
             end;
  end;

 procedure sir;
  var i,j:integer;
  begin
   for i:=1 to vf do
     if st[i]='B' then
       begin
       if y[1]=1 then
         begin
         for j:=vf+4 downto i+4 do st[j]:=st[j-4];
         st[i]:='1';
         st[i+1]:='A';
         st[i+2]:='3';
         st[i+3]:='A';
         st[i+4]:='C';
         vf:=vf+4;
         end
       else
         if y[i]=2 then
           begin
           for j:=vf+1 downto i+1 do st[j]:=st[j-1];
           st[i]:='2';
           st[i+1]:='B';
           vf:=vf+1;
           end;
       end
     else
       if st[i]='C' then
         begin
         if y[i]=3 then
           begin
           for j:=vf+2 downto i+2 do st[j]:=st[j-2];
           st[i]:='3';
           st[i+1]:='B';
           st[i+1]:='C';
           vf:=vf+2;
           end
         else
           if y[i]=1 then
             begin
             for j:=vf+2 downto i+2 do st[j]:=st[j-2];
             st[i]:='1';
             st[i+1]:='2';
             st[i+2]:='A';
             vf:=vf+2;
             end
           else
             if y[i]=2 then st[i]:='2';
         end;
  end;

 procedure verifica;
  var x,i,ok,cod:integer;
  begin
   if vf<>l then writeln(g,0)
   else
     begin
     ok:=1;
     i:=0;
     while (i<l) and (ok=1) do
       if (st[i]='B') or (st[i]='C') then ok:=0
       else
         if st[i]<>'A' then
           begin
           val(st[i],x,cod);
           if x<>y[i] then ok:=0;
           end;
     if ok=1 then writeln(g,1)
     else writeln(g,0);
     end;
  end;

begin
  assign(f,'perle.in');
  assign(g,'perle.out');
  reset(f);
  rewrite(g);
  readln(f,n);
  vf:=0;
  for i:=1 to n do
    begin
    citire;
    if ok=1 then
      begin
      sir;
      verifica;
      end;
    vf:=0;
    end;
  close(f);
  close(g);
end.