Строки

[rokss]

Задан текст в котором нет вхождений символов '('и')'. Заменить всякую максимальную подпоследовательность, составленную более чем из 3 вхождений одного и того же символа, на (k)s, где s- повторяемый символ, а k>3- количество его повторений.

Программа есть, но выводит только повторяемые символы

program UL;
uses crt;
var s:string;
n,i,g,r:integer;
begin
readln(s);
n:=length(s);
for i:=1 to n-1 do
if s[i]=s[i+1] then begin
 g:=i;
 r:=1;
 while s[g]=s[g+1] do begin
 g:=g+1;
 r:=r+1;
 end;
 if r>3 then write(r,'(',s[i],')','  ');
 i:=i+r-1;
 end;
 end.

program UL;
uses crt;
var s:string;
n,i,g,r:integer;
begin
readln(s);
n:=length(s);
for i:=1 to n-1 do
if s[i]=s[i+1] then begin
g:=i;
r:=1;
while s[g]=s[g+1] do begin
g:=g+1;
r:=r+1;
end;
if r>3 then write(r,'(',s[i],')',' ');
i:=i+r-1;
end;
end.

[TinMan]

Ты делаешь ОЧЕНЬ УЖАСНУЮ ошибку - ты изменяешь параметр цикла в теле цикла. Видимо, ты используешь TP, так как никакой современный компилятор ее бы не пропустил. Так делать нельзя. Если тебе нужно манипулировать параметром цикла - используй while или repeat.
Вот, я навскидку сделал как-то так..

var
  s,t,q: string;
  i: integer;
begin
  //readln(s);
  s:= 'aaaaasdffff     gggggggAAhhhhh';
  i:= 2;
  t:= '';
  while i<=Length(s) do begin
    if s[i-1]=s[i] then t:= t+s[i];
    if (s[i-1]<>s[i]) or (i=Length(s)) then begin
      if Length(t)>2 then begin
        Str(Length(t)+1,q);
        Insert('('+q+')',s,Pos(t,s));
        Delete(s,Pos(t,s),Length(t));
        i:= i-Length(t)
      end;
      t:= ''
    end;
    inc(i)
  end;
  writeln(s);
  readln
end.

Наверняка можно сделать эффективнее..
(исправил замеченную ошибку)