uses crt; var s:string; kl,c,i,j,max,maxi:integer; function sort (s:string):string; var c:char; i,j:integer; begin for i:=1 to length(s)-1 do for j:=i+1 to length(s) do if s[i]>s[j] then begin c:=s[i]; s[i]:=s[j]; s[j]:=c; end; sort:=s; end; function words(s:string;n:integer):string; const lim =[' ',',','!']; var ss:string; k,c,i:integer; begin ss:=''; c:=1; k:=1; while k<=length(s) do begin while not(s[k] in lim) and (k<=length(s)) do begin if c=n then ss:=ss+s[k]; inc (k); end; inc (c); while (s[k] in lim) and (k<=length(s)) do inc (k); end; words:=ss; end; begin clrscr; s:='abc bca dert bac tred rdet tdre'; c:=1; while words(s,c)<>'' do inc (c); max:=1; maxi:=1; for i:=1 to c-1 do begin kl:=1; for j:=i+1 to c do if sort(words(s,i))=sort(words(s,j)) then inc(kl); if kl>max then begin max:=kl; maxi:=i; end; end; writeln ('max=',max); for i:=1 to c do if sort(words(s,maxi))=sort(words(s,i)) then write (words(s,i),' '); end.