В общем задача состоит в следующим: Дана последовательность символов. Заменить все восклицательные знаки на точки, все точки на многоточие, ряды тоящих рядом точек одной точкой.
Например 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.

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

Такого же - это как понять? Ты точку на точку менять собрался? Или на что?


Вот так, например:

  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;

Точку надо на 3 точки заменить (...)

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

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

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.

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

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.

Malice, а у меня твой код вообще ошибкой 202 ругается..

ВСЕМ БОЛЬШОЕ СПАСИБО! ОЧЕНЬ ВЫРУЧИЛИ!

потому что ты сначала заменяешь все ряды стоящих рядом точек точками, а потом эти же точки (которые получились из рядов рядом стоящих точек) заменяешь на многоточие. А в условии задачи, немного по-другому:

uses crt;
var S:string;
begin
clrscr;
S:='a!!.bc....d..e.!';
while pos ('..',S)>0 do s:=rep (s,'..','.'); { <-вот сдесь замена всех рядов рядом стоящих точек на одну точку, 
                                                            после чего получаем строчку 'a!!.bc.d.e.!'}

S:=REP (S,'.','...');   {сдесь заменяем все точки (по заданию, нужно менять только те точки, которые были 
                               по одной в исходной строке) на многоточие
                               в этой программе получится строка 'a!!...bc...d...e...!', а надо бы 'a!!...bc.d.e...!'}
S:=REP (S,'!','.');
writeln (S);
end.

Так что код предложенный Айра более правильный.

если не затруднит помогите еще вот что решить: дана последовательность символов раздененная двоеточиями. Выписать то, что стоит между 1-м и 2-м, 3-м и 4-м двоеточиями: as:sdf:gh:jkl:qwe => sdfjkl

В следующий раз создавай отдельную тему.

function _pos(s: String; count, curr: Byte): Byte;
begin
  if (count = curr) then _pos := 0 else begin
    inc(curr);
    _pos := Pos(':', s) + _pos(Copy(s, Pos(':', s) + 1, 255), count, curr);
  end;
end;

var
  s: String;
begin
  s := '12345:XXX:YYY:RRR:GGGF:8888';
  writeln(
   Copy(s, _pos(s, 1, 0) + 1, _pos(s, 2, 0) - _pos(s, 1, 0) - 1) +
   Copy(s, _pos(s, 3, 0) + 1, _pos(s, 4, 0) - _pos(s, 3, 0) - 1)
  );
end.

Ок, учту.

Спасибо большое, очень выручил.