Cod sursa(job #100244)

Utilizator icetTamas Radu icet Data 12 noiembrie 2007 00:13:29
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.03 kb
 program abc2_infoarena;
 type vect = array[1..10000000] of char;
      mat = array[1..50] of string[20];
 var a: vect;
     c: mat;
     i,j,n,m,nr: longword;
     f: text;

 procedure pos1(cuv: string; l:byte);
 var i,j: longword;
     ok: boolean;
 begin

   i:=1;
   while i<=n-l do begin

     ok:=true; j:=1;

     while (j<=l) and ok do begin

       if a[i+j-1] <> cuv[j] then ok := false;
       inc(j);

     end;

    if ok then begin
      inc(nr);
      i:=i+l-1;
    end;
    inc(i);
   end;

 end;

 begin
  assign(f,'abc2.in'); reset(f);
   n:=0; m:=-1; nr:=0;

   while not seekeoln(f) do begin
     inc(n);
     read(f,a[n]);
   end;


   while not seekeof(f) do begin
     inc(m);
     readln(f,c[m]);
     i:=1;
     while i<m do begin
       if (c[m] = c[i]) and (i>1) then begin i:=m+1; dec(m); end;
       inc(i);
     end;
   end;
   Close(f);

   for i:=1 to m do
     pos1(c[i],length(c[i]));

   assign(f,'abc2.out'); rewrite(f);
     write(f,nr);
   Close(f);
 end.