Задача на строки, помогите разобраться Опции

[DIasT]

В общем задача состоит в следующим: Дана последовательность символов. Заменить все восклицательные знаки на точки, все точки на многоточие, ряды тоящих рядом точек одной точкой.
Например a!!.bc....d..e.! => a.....bc.d.e....

в общем вот что у меня получилось:

var
  s: string;
  p: integer;

begin
  s := 'a!!bc....d..e.!';
  repeat
    p := pos('!', s);
    if p > 0 then begin
      delete(s, p, length('!'));
      insert('.', s, p);
    end;
  until p = 0;
  writeln(s);
end.

восклицательные знаки заменяются нормально. Но при добавлении такого же цикла для точек он уходит в себя. Как сделать правильно?

Еще вопрос как превратить последовательность рядом стоящих точек в одну. Я нашел только как превращать последовательность ЛЮБЫХ символов в один.

var s:string;
var i:integer;
begin
s:='a!!bc....d..e.!';
for i:=1 to ord(s[0]) do
while (s[i]=s[i+1]) and (I<length(s)) do
delete (s,i,1);
writeln(s);
end.

Помогите решить задачку. Или дайте ссылку на подобную (то что я нашел - написал выше)
Заранее благодарен.

Сообщение отредактировано: DIasT - 9.05.2007 18:39

[Айра]

Но при добавлении такого же цикла для точек он уходит в себя.

Правильно. Ведь ты точку, не удаляешь, а заменяешь на много точек, а выход из цикла у тебя тогда, когда точек уже не найдено. Поэтому он крутится бесконечно)))

Чтобы нормально заменялись группа точек и одна, предлагаю сделать так: сначала мы все отдельностоящие точки заменяем на '?', потом издеваемся над остальными знаками (сначала над группами точек, потом над '!'), а затем ?-ы меняем на '...'.
выглядит это приблизительно воть так:

uses wincrt;
var
  s: string;
  p,i,t,z: integer;

begin
  s := 'a!!.bc....d..e.!';
  writeln(s);
  t := 1;                           {меняем одну точку на '?'}
  while t <= length(s) do begin
    while (s[t] = '.') and (s[t]<>s[t+1]) and (s[t]<>s[t-1]) and (t<length(s)) do
    begin
      delete (s,t,1);
      insert('?',s,t);
    end;
    inc(t);
  end;

  i := 1;
  while i <= length(s) do begin          { группу точек на одну}
    while (s[i] = '.') and (s[i]=s[i+1]) and (I<length(s)) do delete (s,i,1);
    inc(i);
  end;

  repeat
    p := pos('!', s);             { '!' на '.' }
    if p > 0 then begin
      delete(s, p, length('!'));
      insert('.', s, p);
    end;
  until p = 0;

  repeat
    z := pos('?', s);             {и конечно '?' на '.'}
    if z > 0 then begin
      delete(s,z,1);
      insert('...', s, z);
    end;
  until p = z;

  writeln(s);         {довольствуемся результатом   }
end.

Сообщение отредактировано: Айра - 9.05.2007 23:45

[Malice]

Вроде все красиво, но результата такого же не получается..

uses crt;
function rep (s,s1,s2:string):string;
begin
if pos (s1,s)>0 then begin
rep:=copy (s,1,pos (s1,s)-1)+s2
+rep ( copy(s,pos (s1,s)+length (s1),255),s1,s2);
End
 else
rep:=s;
end;
var S:string;
begin
clrscr;
S:='a!!.bc....d..e.!';
while pos ('..',S)>0 do s:=rep (s,'..','.');
S:=REP (S,'.','...');
S:=REP (S,'!','.');
writeln (S);
end.