Cod sursa(job #98635)

Utilizator MDanFMI - Dan Moldovan MDan Data 10 noiembrie 2007 15:20:15
Problema Abc2 Scor 0
Compilator fpc Status done
Runda Happy Coding 2007 Marime 1.63 kb
var s:array [1..10000000] of char;
    aux,s1:string[20];
    f,g:text;
    total,ai,n,bi,ci,i,k,j:longint;
    c1:char;
    a,b,c:array [1..50000] of string[20];
begin
assign (f,'abc2.in');
assign (g,'abc2.out');
reset (f);
rewrite (g);
i:=0;
while not eoln(f) do
begin
i:=i+1;
read(f,c1);
s[i]:=c1;
end;
readln (f);
ai:=0;
bi:=0;
ci:=0;
while not eof(f) do
begin
     readln (f,s1);
     if s1[1]='a'
     then
         begin
         ai:=ai+1;
         a[ai]:=s1;
         end
     else
         if s1[1]='b'
         then
             begin
             bi:=bi+1;
             b[bi]:=s1;
             end
         else
             begin
             ci:=ci+1;
             c[ci]:=s1;
             end;
end;
n:=length(s1);
aux:='';
for j:=1 to n do
aux:=aux+s[j];


for j:=1 to i-n do
begin
     if aux[1]='a'
     then
         begin
         for k:=1 to ai do
         if a[k]=aux
         then
             begin
             total:=total+1;
             break;
             end;
         end
     else
         if aux[1]='b'
         then
             begin
             for k:=1 to bi do
             if b[k]=aux
             then
                 begin
                 total:=total+1;
                 break;
                 end;
             end
         else
             begin
             for k:=1 to ci do
             if c[k]=aux
             then
                 begin
                 total:=total+1;
                 break;
                 end;
             end;
delete (aux,1,1);
aux:=aux+s[n+j];
end;


writeln (g,total);



close(f);
close(g);
end.