Cod sursa(job #253786)

Utilizator radupoenaruPoenaru Radu Constantin radupoenaru Data 6 februarie 2009 12:27:48
Problema Episoade Scor 20
Compilator fpc Status done
Runda Stelele Informaticii 2009, clasele 9-10, ziua 1 Marime 2.9 kb
var i,j,l,n,m,nr,k,nr1,nr2,er:integer;
    ok:boolean;
    xx:string;
    x:char;
    v:array[1..1000] of string[4];
    a:array[1..1000] of integer;
    f,g:text;
begin
assign(f,'episoade.in');reset(f);
i:=0;
ok:=true;
while not eoln(f) do begin
                     i:=i+1;
                     read(f,x);
                     v[i]:=x;
                     if (v[i-1]<>'>') and (v[i-1]<>'#') and (i<>1)
                         and(v[i]<>'>') and (v[i]<>'#') then begin
                                                             v[i-1]:=v[i-1]+v[i];
                                                             i:=i-1;
                                                             end;
                     if v[i]='>' then ok:=false;
                     end;
l:=i;                           
read(f,n,m);
nr:=1;
assign(g,'episoade.out');rewrite(g);
while nr<=n do begin
               for i:=1 to m do read(f,a[i]);
               j:=1;
               if ok then writeln(g,'1')
                     else begin
                          while j<l do begin
                                    val(v[j],nr1,er);
                                    val(v[j+2],nr2,er);
                                    if (v[j+1]='>') and (nr1<>a[j div 2+1]) then begin
                                                                                 writeln(g,'0');
                                                                                 break;
                                                                                 end
                                       else if (v[j+1]='#') and ((nr1<>a[j div 2+1])
                                                            and (nr2<>a[j] div 2+1))
                                                                                   then begin
                                                                                        writeln(g,'0');
                                                                                        break;
                                                                                        end
                                       else if nr2=a[j div 2+1] then begin
                                            xx:=v[j];
                                            for k:=j+2 to l do begin
                                                               v[k-2]:=v[k];
                                                               if v[k]='#' then break;
                                                               end;
                                            v[k-1]:='#';
                                            v[k]:=xx;
                                            end
                                       else j:=j+2;
                          end;
                          if j=l then writeln(g,'1');
                          end;
               inc(nr);
               end;
close(f);
close(g);
end.