Cod sursa(job #383670)

Utilizator ktalyn93Catalin ktalyn93 Data 17 ianuarie 2010 16:51:04
Problema Perle Scor 60
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.87 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
              begin
                 gasit:=true;
              end
                else
              if li=2 then
                begin
                 gasit:=false;
                end
              else
              begin
              inloc:=true;
              for ch:='B' to 'C' do
              begin
                       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
                               begin
                                    s:=s+a[ch,l];
                                    inloc:=false;
                                    break;
                               end;
              if inloc=false then
                        break;
              end;

              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;
                                   break;
                                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);
     readln(f);
     s:='';
     end;
         close(f);
         close(g);
end.