Cod sursa(job #100744)

Utilizator CezarMocanCezar Mocan CezarMocan Data 12 noiembrie 2007 17:43:54
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.27 kb
const m=10000019;
var c:char;
    s:string;
    i,j,n,nr,t,p,rez:longint;
    v:array[0..10000050]of boolean;
    x:array[1..10000010]of char;

begin
assign(input,'abc2.in');reset(input);
assign(output,'abc2.out');rewrite(output);
readln(x);
p:=1;
while ord(x[p])<>0 do
        inc(p);
dec(p);
readln(s);
n:=length(s);
for i:=1 to n do
        begin
        nr:=nr*3+ord(s[i])-97;
        while nr>=m do
                nr:=nr-m;
        end;
v[nr]:=true;
nr:=0;
while not eof do
        begin
        readln(s);
        for i:=1 to n do
                begin
                nr:=nr*3+ord(s[i])-97;
                while nr>=m do
                        nr:=nr-m;
                end;
        v[nr]:=true;
        nr:=0;
        end;
t:=1;
for i:=1 to n-1 do
        t:=(t*3) mod m;
for i:=1 to n do
        begin
        nr:=nr*3+ord(x[i])-97;
        while nr>=m do
                nr:=nr-m;
        end;
if v[nr] then
        inc(rez);
for i:=n+1 to p do
        begin
        nr:=nr-t*(ord(x[i-n])-97);
        if nr<0 then
                nr:=nr+m;
        nr:=nr*3+ord(x[i])-97;
        while nr>=m do
                nr:=nr-m;
        if v[nr] then
                inc(rez);
        end;
writeln(rez);
close(input);close(output);
end.