Cod sursa(job #533377)

Utilizator tundeKorodi Tunde tunde Data 13 februarie 2011 20:20:42
Problema Perle Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.79 kb
type sorozat=array [1..10000] of 1..3;
var f,g:text;
    a:sorozat;
    n,i,j,k:integer;
function vizsgal(a:sorozat; n:integer):byte;
var s1,s:ansistring;
    i,p,p1:integer;
    jo:boolean;
begin
     if n=1 then vizsgal:=1
            else if (n=3) and (a[1]=1) and (a[2]=2) then vizsgal:=1
            else begin
                 if a[1]=1 then s:='1a3ac' else if a[1]=2 then s:='2b'
                    else s:='3bc';
                 repeat
                       jo:=true;
                       for i:=1 to length(s) do
                           if not (s[i] in ['b','c']) then begin
                           str(a[i],s1);
                           if not((s[i]=s1) or (s[i]='a')) then jo:=false;
                       end;
                       p:=pos('b',s);
                       if p<>0 then begin if a[p]=1 then begin delete(s,p,1);
                                                         insert('1a3ac',s,p);
                                                   end
                                              else if a[p]=2 then begin
                                                   delete(s,p,1);
                                                   insert('2b',s,p);
                                              end; end else begin
                       p:=pos('c',s);
                       if p<>0 then if a[p]=1 then begin delete(s,p,1);
                                                         insert('12a',s,p);
                                                   end
                                              else if a[p]=2 then begin
                                                   delete(s,p,1);
                                                   insert('2',s,p);
                                              end else if a[p]=3 then begin
                                                   delete(s,p,1);
                                                   insert('3bc',s,p);
                                               end;         end;
                 until (not jo) or (length(s)>=n);
                 jo:=true;
                       for i:=1 to length(s) do begin
                           if s[i]='b' then jo:=false
                           else if (s[i]='c') and (a[i]<>2) then jo:=false else begin
                           str(a[i],s1);
                           if not((s[i]=s1) or (s[i]='a')) then jo:=false; end;
                       end;
                 if jo and (length(s)=n) then vizsgal:=1 else vizsgal:=0;
                 end;
end;

begin
     assign(f,'perle.in'); reset(f);
     assign(g,'perle.out'); rewrite(g);
     readln(f,k);
     for i:=1 to k do begin
         read(f,n);
         for j:=1 to n do read(f,a[j]);
         readln(f);
         writeln(g,vizsgal(a,n));
     end;
     close(f); close(g);
end.