Cod sursa(job #383658)

Utilizator ktalyn93Catalin ktalyn93 Data 17 ianuarie 2010 16:09:06
Problema Perle Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.45 kb
var n,i,j,li,l,nr:integer;
    a:array['A'..'C',1..3] of string;
    ch:char;
    s,c:string;
    gasit,inloc:boolean;
    f,g:text;
begin
     assign(f,'perle.in');
     assign(g,'perle.out');
     reset(f);
     rewrite(g);
     readln(f,n);
     a['A',1]:='1';
     a['A',2]:='2';
     a['A',3]:='3';
     a['B',1]:='2B';
     a['B',2]:='1A3AC';
     a['C',1]:='2';
     a['C',2]:='3BC';
     a['C',3]:='12A';
     for i:=1 to n do
     begin
              read(f,li);
              read(f,nr);
              str(nr,c);
              gasit:=true;
              if(li=1) then
                 gasit:=true
                else
              if li=2 then
                begin
                 gasit:=false;
                 readln(f);
                end
              else
              begin
              for ch:='B' to 'C' do
                       for l:=1 to 3 do
                           if pos(c,a[ch,l])=1 then
                               if (length(a[ch,l])>1)and(length(a[ch,l])<=li) then s:=s+a[ch,l];

              for j:=2 to li do
                 begin
                      read(f,nr);
                      str(nr,c);
                       if (s[j]<>c) and ((s[j]<'A') or (s[j]>'C')) then
                          begin
                               gasit:=false;
                               break;
                          end
                          else
                       begin
                       if s[j]=c then inloc:=true
                                 else begin
                                 inloc:=false;
                       for l:=1 to 3 do
                          if pos(c,a[s[j],l])=1 then
                               if (length(s)-1+length(a[s[j],l])<=li) then begin
                                   ch:=s[j];
                                   delete(s,j,1);
                                   insert(a[ch,l],s,j);
                                   inloc:=true;
                                end;end;
             if(inloc=false) then
                                      begin
                                           gasit:=false;
                                           break;
                                      end;
                       end;
              end;

     end;
     if(gasit=false) then
                              writeln(g,0)
              else
              writeln(g,1);
     end;
         close(f);
         close(g);
end.