Var s:string; c:char; i,j,k:integer;
begin
write('Слово: ');
readln(s);
writeln(s);
i:=1;
while i begin
k:=0; c:=s[i];
for j:=1 to length(s) do
if c=s[j] then k:=k+1;
if k=3 then
begin
while pos(c,s)>0 do delete(s,pos(c,s),1);
i:=i-1;
end;
i:=i+1;
end;
writeln(s);
end.
Пример:
Слово: pnbouipobnpongnf
pnbouipobnpongnf
nbuibnngnf