Pagini recente » Cod sursa (job #700798) | Cod sursa (job #401228)
Cod sursa(job #401228)
var max,ct,k,ii,jj,i,j,n,m:longint;
a,b:array[1..500] of char;
t:string;
st:array[1..10000] of string;
f,g:text;
procedure load;
begin
assign(f,'subsir.in');
reset(f);
n:=0;m:=0;
while not eof(f) do
begin
while not eoln(f) do
begin
n:=n+1;
read(f,a[n]);
end;
readln(f);
while not eoln(f) do
begin
m:=m+1;
read(f,b[m]);
end;
end;
closE(f);
assign(g,'subsir.out');
rewrite(g);
end;
procedure find_sub;
begin
k:=0;
for i:=1 to n do
for j:=1 to m do
begin
if a[i]=b[j] then
begin
ii:=i;
jj:=j;
t:=a[i];
while (a[ii]=b[jj]) and (ii<=n) do
begin
ii:=ii+1;
jj:=jj+1;
if a[ii]=b[jj] then
t:=t+a[ii];
end;
k:=k+1;
st[k]:=t;
end;
end;
end;
procedure find_all_max;
begin
max:=length(st[1]);
for i:=2 to k do
if max<length(st[i]) then max:=length(st[i]);
ct:=0;
for i:=1 to k do
if length(st[i])=max
then
begin
ct:=ct+1;
for j:=i+1 to k do
if st[i]=st[j] then st[j]:=' ';
end;
end;
BEGIN
load;
find_sub;
find_all_max;
write(g,ct);
close(g);
END.