Cod sursa(job #254131)

Utilizator valytgjiu91stancu vlad valytgjiu91 Data 6 februarie 2009 20:30:11
Problema Episoade Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.15 kb
var f,g:text;
a:array[1..1001] of integer;
v:array[1..102] of integer;
t,k,l,i,j,m,n:integer;
c:char;
q:boolean;
begin
assign(f,'episoade.in');
reset(f);
assign(g,'episoade.out');
rewrite(g);
while not eoln(f) do
begin
k:=k+1;
read(f,c);
while (c<>'#')and(c<>'>') and (not eoln(f))do
begin
a[k]:=a[k]*10+ord(c)-48;
if not eoln(f) then
read(f,c);
end;
k:=k+1;
if c='>'then a[k]:=0
        else if c='#'then a[k]:=-1
                  else begin
                       k:=k-1;
                       a[k]:=a[k]*10+ord(c)-48;
                       end;
end;
readln(f,t,n);
for i:=1 to t do
   begin
    for j:=1 to n do
     read(f,v[j]);
    q:=true;
    for j:=1 to k do
      begin
        if a[j]=0 then
             for l:=1 to n do
                 if v[l]=a[j-1] then if v[l+1]<>a[j+1]then begin
                                                          q:=false;
                                                          break;
                                                          end;
        if q=false then break
        end;
     if q then writeln(g,'1')
            else writeln(g,'0');
     end;
close(g);
end.