shef, я уже после увидел, что символы это цифры, поэтому сделал для всех символов.
Алгаритм такой, как описал ivashkanet, только 4) сидит внутри 3) в виде невыводимых символов.
Держи.
| Код |
//процедура удаления повторяющихся наборов символов (слов)
procedure udalenie;
var pi,pq,pl:Word;
label l1;
begin
l1:
for pi:=0 to razmer_mas-2 do //цикл для слов, с которыми будет сравниваться
for pl:=pi+1 to razmer_mas-1 do //цикл для сравниваемых слов
begin
if slova[pi]=slova[pl] then //если совпадают надо удалять
begin
for pq:=pl to razmer_mas-2 do
slova[pq]:=slova[pq+1]; //затирается повторный элемент (двигаются все левее)
slova[pq]:=''; //последний элемент очищается
dec(razmer_mas); //уменьшение размера массива
goto l1;
end;
end;
end;
//основная процедура
var s:String; //введенная строка
slova:array of string; //динамический массив строк
simvol,razmer_mas,l,k,nomer_simvla,sovpad_simvol:Word;
label l1;
begin
writeln('Введите строку не более 255 символов с пробелами');
readln(s);
l:=Length(S); //определить длину строки
simvol:=1;
razmer_mas:=0;
repeat //повтор пока не выйдет за длину строки
if s[simvol]<>' ' then //если это не пробел
begin
inc(razmer_mas);
SetLength(slova,razmer_mas); //увеличиваем на 1 размер массива
end;
while s[simvol]<>' 'do //пока не встретим пробел
begin
slova[razmer_mas-1]:=slova[razmer_mas-1]+s[simvol]; //заносим символы в массив
inc (simvol);
if simvol=l+1 then goto l1;
end;
inc(simvol);
until simvol>l;
l1:
writeln('');
writeln('Анаграммы:');
udalenie; //удаляем повторяющиеся симводы
razmer_mas:=Length(slova); //определяем размер массива после удаления повторов
for k:=0 to razmer_mas-2 do //цикл для слов, с которыми будут сравниваться
begin
if slova[k]=chr($0D)+chr($0A) then //невыводимые символы не сравниваются
continue;
for l:=k+1 to razmer_mas-1 do //цикл для перебора сравниваемых слов
begin
sovpad_simvol:=0;
for simvol:=1 to Length(slova[k]) do //цикл для символов в сравниваемых словах
begin
if l=k+1 then
s:=slova[k]; //начальное значение
nomer_simvla:=Pos(slova[k][simvol],slova[l]); //найти вхождение символа в сравниваемой строке
if nomer_simvla<>0 then //есть вхождение?
begin //да - идем дальше
sovpad_simvol:=sovpad_simvol+1; //кол-во совпадающих символов
if (sovpad_simvol=Length(slova[k]))and(sovpad_simvol=Length(slova[l]))then
begin //кол-во символов равно длине обоих слов?
s:=s+' '+slova[l]; //да - добавляем к строке
slova[l]:=chr($0D)+chr($0A); //так как внесенное слово не может быть сравниваемым,
end; //заменяем его на невыводимый символ
end;
end;
end;
if s<>slova[k] then //если результирующая строка больше начальной
writeln(s); //вывод
s:=''; //удаление символов строки
end;
end;
|
|
)
