Cod sursa(job #265321)

Utilizator philipPhilip philip Data 23 februarie 2009 19:43:05
Problema Potrivirea sirurilor Scor 40
Compilator fpc Status done
Runda Arhiva educationala Marime 1.77 kb
 type pnod=^nod;
      nod=record
        inf:longint;
        adr:pnod;
      end;

 var f,g:text;
     a,b:array [1..2000001] of char;
     c:array[1..1001] of longint;
     i,j,m,n,k,s:longint;
     nou,ultim,prim,p:pnod;

 procedure citire;
   begin
     assign(f,'strmatch.in');
     reset(f);
     n:=0;
     m:=0;
     while not eoln(f) do begin
       m:=m+1;
       read(f,b[m]);
     end;
     readln(f);
     while not eoln(f) do begin
       n:=n+1;
       read(f,a[n]);
     end;
     close(f);
   end;

 procedure strmeci;
   begin
     i:=1;
     new(prim);
     prim^.inf:=1;
     prim^.adr:=nil;
     ultim:=prim;
     p:=prim;
     repeat
       if a[i]=b[1] then begin
         new(p);
         p^.inf:=0;
         p^.adr:=prim^.adr;
         prim^.adr:=p;
       end;
       p:=prim^.adr;
       while p<>nil do begin
         if a[i]=b[p^.inf+1] then begin
          p^.inf:=p^.inf+1;
          if p^.inf=m then begin
           s:=s+1;
           if s<=1000 then c[s]:=i-m;
           nou:=p;
           p:=prim;
           while p^.adr<>nou do p:=p^.adr;
           p^.adr:=nou^.adr;
           dispose(nou);
          end;
         end
           else begin
             nou:=p;
             p:=prim;
             while p^.adr<>nou do p:=p^.adr;
             p^.adr:=nou^.adr;
             dispose(nou);
           end;

         p:=p^.adr;
       end;
       i:=i+1;
     until i=n+1;
   end;

 procedure afisare;
   begin
     assign(g,'strmatch.out');
     rewrite(g);
       writeln(g,s);
       if s>1000 then for i:=1 to 1000 do write(g,c[i],' ')
         else for i:=1 to s do write(g,c[i],' ');
     close(g);
   end;

 begin
   citire;
   strmeci;    write(n,' ',m,' ',j);
   afisare;
 end.