Cod sursa(job #171931)

Utilizator GavrilaVladGavrila Vlad GavrilaVlad Data 5 aprilie 2008 13:54:10
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.14 kb
var t,x:array[0..10001000]of shortint;
    v:array[0..21,0..5100]of longword;
    h:array[0..21]of longword;
    a:array[0..5100]of longword;
    q,m,d,e,f,n,i,j,k,l,b,c1,c2,pc:longword;
    p:longword;
    s:string;
    c:char;
    w:text;
procedure merge(p,r:longint);
var q:longint;
begin
   q:=(p+r)div 2;
   if p<q then merge(p,q);
   if q+1<r then merge(q+1,r);
   for i:=p to r do
   a[i]:=v[k,i];
   d:=p;
   e:=p;
   f:=q+1;
   while(e<=q)and(f<=r)do
   if(a[e]<a[f])then begin v[k,d]:=a[e];
                           e:=e+1;
                           d:=d+1;
                     end
                else begin v[k,d]:=a[f];
                           f:=f+1;
                           d:=d+1;
                     end;
   for i:=e to q do
   begin
   v[k,d]:=a[e];
   e:=e+1;
   d:=d+1;
   end;
   for i:=f to r do
   begin
   v[k,d]:=a[f];
   f:=f+1;
   d:=d+1;
   end;
end;
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;
   h[l]:=h[l]+1;
   for i:=1 to l do
   p:=p*3;
   for i:=1 to l do
   begin
   p:=p div 3;
   if s[i]='b' then v[l,h[l]]:=v[l,h[l]]+p
               else
   if s[i]='c' then v[l,h[l]]:=v[l,h[l]]+2*p;
   end;
   end;
   close(w);
   p:=1;
   for k:=1 to 20 do
   begin
   p:=p*3;
   if h[k]>0 then
   begin
   merge(1,h[k]);
   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;
   c1:=1;
   c2:=h[k];
   while c2-c1>1 do
   begin
   q:=(c1+c2)div 2;
   if v[k,q]>b then c2:=q
               else c1:=q;
   end;
   if(v[k,c1]=b)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.