Cod sursa(job #105210)

Utilizator mlazariLazari Mihai mlazari Data 17 noiembrie 2007 12:40:20
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 3.23 kb
Program Abc2;
const Th : array[0..19] of int64=(1,3,9,27,81,243,729,2187,6561,19683,59049,
                                    177147,531441,1594323,4782969,14348907,
                                    43046721,129140163,387420489,1162261467);
type Cuvint=string[20];
     Dictionar=array[1..50000] of int64;
     Litera='a'..'c';
var D : Dictionar;    {Dictionarul}
    T : array[0..10000000] of byte; {Textul antic codificat ternar}
    n,m,p : longint; {n-lungimea textului; m-numarul de cuvinte;
                                    p-numarul de pozitii candidat}
    l : byte; {Lungimea unui cuvint}

function Cod(cuv : Cuvint) : int64;
var code : int64;
    i,j : byte;
begin
  code:=0;
  j:=0;
  for i:=l downto 1 do
   begin
     code:=code+Th[j]*(ord(cuv[i])-97);
     j:=j+1;
   end;
  Cod:=code;
end;

procedure Citeste;
var Intrare : text;
    lit : Litera;
    cuv : Cuvint;
begin
  assign(Intrare,'abc2.in');
  reset(Intrare);
  T[0]:=0;
  n:=0;
  while not eoln(Intrare) do
   begin
     n:=n+1;
     read(Intrare,lit);
     T[n]:=ord(lit)-97;
   end;
  readln(Intrare);
  m:=1;
  readln(Intrare,cuv);
  l:=length(cuv);
  D[1]:=Cod(cuv);
  while not eof(Intrare) do
   begin
     m:=m+1;
     readln(Intrare,cuv);
     D[m]:=Cod(cuv);
   end;
  close(Intrare);
end;

procedure Schimb(var a,b : int64);
{ Interschimba a cu b }
var aux : int64;
begin
  aux:=a;
  a:=b;
  b:=aux;
end;

{procedure SorteazaCuvinte;
var i,j,imin : longint;
begin
  for i:=1 to m-1 do
   begin
     imin:=i;
     for j:=i+1 to m do
      if D[j]<D[imin] then imin:=j;
     Schimb(D[i],D[imin]);
   end;
end;}

procedure SorteazaCuvinte(i,j : longint);
var st,dr : longint;
    v : int64;
begin
  if j-i>0 then
   begin
     v:=D[i];
     st:=i;
     dr:=j;
     while st<dr do
      begin
        while (D[st+1]<=v) and (st<dr) do
         begin
           D[st]:=D[st+1];
           st:=st+1;
         end;
        while (D[dr]>=v) and (st<dr) do
         dr:=dr-1;
        if st<dr then Schimb(D[st+1],D[dr]);
      end;
     D[st]:=v;
     SorteazaCuvinte(i,st-1);
     SorteazaCuvinte(st+1,j);
   end;
end;

function ExistaInDictionar(cuv : int64) : boolean;
var i,j,mij : longint;
begin
  i:=1;
  j:=m;
  mij:=i+(j-i) div 2;
  while D[mij]<>cuv do
   if i=j then break
    else
     begin
       if mij=i then
        begin
          i:=j;
          mij:=j;
        end
        else
         if cuv<D[mij] then
          begin
            j:=mij;
            mij:=i+(j-i) div 2;
          end
          else
           begin
             i:=mij;
             mij:=i+(j-i) div 2;
           end;
     end;
  ExistaInDictionar:=(D[mij]=cuv);
end;

procedure Calculeaza;
var i,j : longint;
    cuv : int64;
begin
  SorteazaCuvinte(1,m);
  p:=0;
  Cuv:=0;
  j:=0;
  for i:=l-1 downto 1 do
   begin
     Cuv:=Cuv+T[i]*Th[j];
     j:=j+1;
   end;
  for i:=l to n do
   begin
     Cuv:=(Cuv-Th[l-1]*T[i-l])*3+T[i];
     if ExistaInDictionar(Cuv) then p:=p+1;
   end;
end;

procedure Scrie;
var Iesire : text;
begin
  assign(Iesire,'abc2.out');
  rewrite(Iesire);
  write(Iesire,p);
  close(Iesire);
end;

begin
  Citeste;
  Calculeaza;
  Scrie;
end.