Cod sursa(job #105318)

Utilizator ionescu88alex ionescu ionescu88 Data 17 noiembrie 2007 15:06:35
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.57 kb
function search( pat: string; text: ansistring ): integer;
const B = 3;
var hpat, htext, Bm,  m, n: int64;
    j:longint;
    found: boolean;
begin
     found := FALSE; search := 0;
     m := length(pat);
     if m=0 then begin
        search := 1;  found := TRUE; end;
     Bm := 1;
     hpat := 0;  htext := 0;
     n := length(text);
     if n >= m then                {*** preprocessing ***}
        for j := 1 to m do begin
            Bm := Bm*B;
            hpat := hpat*B + ord(pat[j]);
            htext := htext*B + ord(text[j]);
           end;
     j := m;                         {*** search ***}
     while not found do begin
         if (hpat = htext) and (pat = copy(text,j-m+1,m)) then
            begin search := j-m+1;  found := TRUE; end;
            if j < n then begin
               j := j+1;
               htext := htext*B - ord(text[j-m])*Bm + ord(text[j]);
              end
           else found := TRUE;
       end;
end;
var cuv,solutie:string;
    sir,sir2:ansistring;
    fi,fo:text;
    i,ct2,ct3,cont:longint;
begin
     assign(fi,'abc2.in'); reset(fi);
     assign(fo,'abc2.out'); rewrite(fo);
     readln(fi,sir); sir2:='';
     while not eof(fi) do
        begin
             readln(fi,cuv);
             sir2:=sir2+cuv+'d'; end;
     ct2:=length(cuv); ct3:=length(sir); cont:=0;
     for i:=1 to ct3-3 do
        begin
             solutie:=copy(sir,1,ct2);
             if search(solutie,sir2)<>0 then inc(cont);
             delete(sir,1,1);
        end;
     writeln(fo,cont);
     close(fi);
     close(fo);
end.