Cod sursa(job #173506)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 7 aprilie 2008 20:03:34
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.5 kb
var t,x:array[0..10001000]of shortint;
    v:array[0..666013,0..10]of longword;
    lo:array[0..666013,0..10]of shortint;
    h:array[0..666013]of shortint;
    pol:array[0..50]of shortint;
    q,m,e,f,d,n,p,l,b,c1,c2,pc,i,j,k,a,mo:longword;
    s:string;
    c:char;
    w:text;
begin
   m:=0;
   assign(w,'abc2.in');
   reset(w);
   while not eoln(w) do
   begin
   m:=m+1;
   read(w,c);
   if c='a' then t[m]:=0
            else
   if c='b' then t[m]:=1
            else
   if c='c' then t[m]:=2;
   end;
   readln(w);
   n:=0;
   while not eof(w)do
   begin
   n:=n+1;
   readln(w,s);
   l:=length(s);
   p:=1;
   for i:=1 to l do
   p:=p*3;
   a:=0;
   for i:=1 to l do
   begin
   p:=p div 3;
   if s[i]='b' then a:=a+p
               else
   if s[i]='c' then a:=a+2*p;
   end;
   mo:=a mod 666013;
   h[mo]:=h[mo]+1;
   v[mo,h[mo]]:=a;
   lo[mo,h[mo]]:=l;
   pol[l]:=1;
   end;
   close(w);
   p:=1;
   for k:=1 to 20 do
   begin
   p:=p*3;
   b:=0;
   if pol[k]=1 then begin
   for i:=1 to k-1 do
   begin
   b:=b*3;
   b:=b+t[i];
   end;
   for i:=k to m do
   begin
   b:=b*3;
   b:=b+t[i];
   b:=b-t[i-k]*p;
   mo:=b mod 666013;
   for j:=1 to h[mo] do
   if(v[mo,j]=b)and(lo[mo,j]=k)and(x[i-k+1]=0)then begin pc:=pc+1;
                                                         x[i-k+1]:=1;
                                                   end;
   end;
   end;
   end;
   assign(w,'abc2.out');
   rewrite(w);
   writeln(w,pc);
   close(w);
end.