Cod sursa(job #173459)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 7 aprilie 2008 19:45:26
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.42 kb
var t,x:array[0..10001000]of longint;
    v,lo:array[0..666013,0..100]of longword;
    h:array[0..666013]of longword;
    q,m,e,f,d,n,p,l,b,c1,c2,pc,i,j,k,a: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;
   h[a mod 666013]:=h[a mod 666013]+1;
   v[a mod 666013,h[a mod 666013]]:=a;
   lo[a mod 666013,h[a mod 666013]]:=l;
   end;
   close(w);
   p:=1;
   for k:=1 to 20 do
   begin
   p:=p*3;
   b:=0;
   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;
   for j:=1 to h[b mod 666013] do
   if(v[b mod 666013,j]=b)and(lo[b mod 666013,j]=k)then if(x[i-k+1]=0)then begin pc:=pc+1;
                                                       x[i-k+1]:=1;
                                                 end;
   end;
   end;
   assign(w,'abc2.out');
   rewrite(w);
   writeln(w,pc);
   close(w);
end.