Дата Jul 19 2004, 18:54
А людям до сих пор BP преподают... No comments
program Z12;
//Uses crt;
//var i,j,N,k1,k,e,m,z,q,max:byte;
// A,C:array[1..60]of string[100];
// B,B1,D:array[1..60]of integer;
// inp:text;S:array[1..60,1..60]of char;
BEGIN
clrscr;
N:=0;
Assign(inp,'v1z4.in');reset(inp);
while not(eof(inp)) do begin
N:=N+1;
readln(inp,A[N])
end;
close(inp);
m:=1;q:=0;
for i:=1 to N do
begin
k1:=1;
for j:=1 to length(A[i]) do
if (ord(A[i,j])>31)and(ord(A[i,j])<64)or(j=length(A[i])) then
begin
if j=k1 then begin
k1:=k1+1;
continue
end;
for z:=1 to m do
begin
for k:=k1 to j-1 do
if (A[i,k]<>C[z,k-k1+1])or((ord(C[z,j-k1+2])>64)and
(ord(C[z,j-k1+2])<91)or(ord(C[z,j-k1+2])>97)and
(ord(C[z,j-k1+2])<123)or(ord(C[z,j-k1+2])>127)) then
begin
e:=e+1;
q:=1;
break
end;
if q=0 then B[z]:=B[z]+1;
q:=0
end;
if e=m then begin
for k:=k1 to j-1 do
begin
C[m,k-k1+1]:=A[i,k];
write(C[m,k-k1+1])
end;
m:=m+1; writeln;
end;
k1:=j+1;
e:=0;
end;
end;
m:=m-1;
for i:=1 to m do B[i]:=B[i]+1;
for i:=1 to m do B1[i]:=B[i];
for i:=1 to m-1 do
begin
max:=B1[i];q:=i;
for j:=i+1 to m do
if B1[j]>max then begin
max:=B1[j];
q:=j
end;
B1[q]:=B1[i];
B1[i]:=max
end;
writeln;
for i:=1 to m do
begin
D[i]:=0;
if B[i]=1 then D[i]:=1
end;
for i:=1 to m do
for j:=1 to m do
if (B1[i]=B[j])and(D[j]=0) then
begin
for z:=1 to 20 do
if ((ord(C[j,z])>64)and(ord(C[j,z])<91)or(ord(C[j,z])>97)
and(ord(C[j,z])<123)or(ord(C[j,z])>127)) then write(C[j,z]);
write(': ',B1[i]);writeln;
D[j]:=1
end;
for j:=1 to m do
if B1[j]>1 then
begin
i:=B1[1];
for z:=1 to B1[j] do
begin
S[i,j]:=chr(178);
i:=i-1
end
end;
writeln;
for i:=1 to B1[1] do
begin
for j:=1 to m do write(' ',S[i,j]);writeln
end
END.
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 6