Cod sursa(job #70551)

Utilizator mlazariLazari Mihai mlazari Data 6 iulie 2007 13:25:18
Problema Perle Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.77 kb
Program Perle;
var n,li,pst,i : integer;
    L : array[1..10000] of integer;
    St : array[1..10020] of integer;
    posibil : boolean;
    Intrare,Iesire : text;

procedure DeschideFisiere;
begin
  assign(Intrare,'perle.in');
  assign(Iesire,'perle.out');
  reset(Intrare);
  rewrite(Iesire);
end;

procedure Citeste;
var i : integer;
begin
  read(Intrare,li);
  for i:=1 to li do read(Intrare,L[i]);
end;

procedure Scrie(p : boolean);
begin
  if p then writeln(Iesire,1) else writeln(Iesire,0);
end;

procedure Push(el : integer);
begin
  pst:=pst+1;
  St[pst]:=el;
end;

procedure Extract;
var el : integer;
begin
  el:=St[pst];
  pst:=pst-1;
  if el<4 then posibil:=(L[i]=el)
   else
    case el of
     5: if L[i]=3 then posibil:=false
         else
          if L[i]=1 then
          begin
            push(6);
            push(4);
            push(3);
            push(4);
          end
          else pst:=pst+1;
     6: if L[i]=3 then
         begin
           push(6);
           push(5);
         end
          else
           if L[i]=1 then
            begin
              push(4);
              push(2);
            end;
    end;
  i:=i+1;
end;

procedure Init;
begin
  if (li=1) or ((li=3) and (L[i]=1) and (L[i]=2)) then i:=4
   else
    if L[1]=3 then push(6) else push(5);
end;

procedure Procesare;
var j : integer;
begin
  readln(Intrare,n);
  for j:=1 to n do
   begin
     Citeste;
     posibil:=true;
     i:=1;
     pst:=0;
     Init;
     while posibil and (i<=li) do Extract;
     if pst<>0 then posibil:=false;
     Scrie(posibil);
   end;
end;

procedure InchideFisiere;
begin
  close(Intrare);
  close(Iesire);
end;

begin
  DeschideFisiere;
  Procesare;
  InchideFisiere;
end.