Pagini recente » Cod sursa (job #2294246) | Cod sursa (job #2684420) | Cod sursa (job #2757037) | Cod sursa (job #1805112) | Cod sursa (job #101828)
Cod sursa(job #101828)
var f1,f2:text;
c:array[1..10000000] of char;
s:array[1..50010] of string[21];
i,j,n,m,nm,nr,dimh,h:longint;
str:string[21];
procedure repair(i:longint);
var l,r,max:longint;
aux:string[21];
begin
l:=2*i;
r:=l+1;
max:=i;
if (l<=dimh)and(s[l]>s[max]) then
max:=l;
if (r<=dimh)and(s[r]>s[max]) then
max:=r;
if max<>i then
begin
aux:=s[i];
s[i]:=s[max];
s[max]:=aux;
repair(max);
end;
end;
procedure buildheap;
var i:longint;
begin
for i:=n div 2 downto 1 do
repair(i);
end;
procedure heapsort;
var i:longint;
aux:string[21];
begin
buildheap;
for i:=n downto 2 do
begin
aux:=s[1];
s[1]:=s[i];
s[i]:=aux;
dec(dimh);
repair(1);
end;
end;
procedure search(li,ls:integer);
begin
m:=(li+ls) div 2;
if str=s[m] then
inc(nr)
else if li<ls then
if str<s[m] then
search(li,m-1)
else search(m+1,ls);
end;
begin
assign(f1,'abc2.in');
reset(f1);
assign(f2,'abc2.out');
rewrite(f2);
while not eoln(f1) do
begin
inc(i);
read(f1,c[i]);
end;
nm:=i;
readln(f1);
i:=0;
while not eof(f1) do
begin
inc(i);
readln(f1,s[i]);
end;
n:=i;
h:=length(s[i]);
dimh:=n;
heapsort;
str:='0';
for i:=1 to h-1 do
str:=str+c[i];
for i:=h to nm do
begin
delete(str,1,1);
str:=str+c[i];
search(1,n);
end;
writeln(f2,nr);
close(f1);
close(f2);
end.