Pagini recente » Cod sursa (job #1663936) | Cod sursa (job #607469) | Cod sursa (job #3193046) | Cod sursa (job #105051) | Cod sursa (job #104850)
Cod sursa(job #104850)
var fi,fo:text;
sir:ansistring;
cuv:array[0..50000]of string[21];
solutii:array[1..10000000]of string[21];
cont,i,ct1,ct,ct2,ct3:longint;
procedure heapsort2(n:longint);
var i,j,k:longint;
aux:string[21];
begin
for i:=1 to n do
begin
j:=i;
while (j shr 1<>0) and (cuv[j shr 1]<cuv[j]) do
begin
aux:=cuv[j shr 1];
cuv[j shr 1]:=cuv[j];
cuv[j]:=aux;
j:=j shr 1;
end;
end;
i:=n;
while i>1 do
begin
aux:=cuv[1];
cuv[1]:=cuv[i];
cuv[i]:=aux;
dec(i);
j:=1;
while (j>0) do
begin
k:=2*j;
if (k>i) then break;
if (k+1<=i) and (cuv[k+1]>cuv[k]) then inc(k);
if cuv[j]>=cuv[k] then break;
aux:=cuv[j];
cuv[j]:=cuv[k];
cuv[k]:=aux;
j:=k;
end;
end;
end;
function find(x:longint; aux:string[21]):boolean;
var st,dr,mij:longint;
begin
st:=1; dr:=x; find:=false;
while st<=dr do
begin
mij:=(st+dr) shr 1;
if (cuv[mij]=aux) then begin find:=true; exit; end
else
if cuv[mij]>aux then dr:=mij-1
else st:=mij+1;
end;
end;
begin
assign(fi,'abc2.in'); reset(fi);
assign(fo,'abc2.out'); rewrite(fo);
readln(fi,sir); ct:=0;
while not eof(fi) do
begin
inc(ct);
readln(fi,cuv[ct]);
end;
heapsort2(ct);
ct2:=length(cuv[1]); ct3:=length(sir); cont:=0;
for i:=1 to ct3-3 do
begin
solutii[i]:=copy(sir,1,ct2);
if find(ct,solutii[i]) then inc(cont);
delete(sir,1,1);
end;
writeln(fo,cont);
close(fi);
close(fo);
end.