Каждую подстроку длиной n > 1, состоящую из одинаковых символов, заменить на подстроку из тех же символов в количестве 2

var s:string;
      i:byte;
begin
writeln('kjhhsdaaa');
read(s);
for i:=length(s) downto 1 do
if (s[i]<>s[i-1])
then insert(s[i],s,i+1);
write(s)
end.

var
  s: string;
  i, j, k: integer;
begin
  readln(s);
  k := 1;
  for i := length(s) - 1 downto 1 do
    begin
      if s[i] = s[i+1] then inc(k);
      if ((s[i] <> s[i+1]) or (i = 1)) and (k > 1) then
        begin
          for j := 1 to k do insert(s[i+1], s, i+1);
          k := 1
        end
    end;
  writeln(s);
  readln
end.

var
  s: String; last: Char;
  i: Integer;
begin
  ReadLn(s); last:=#0;
  for i:=Length(s) downto 2 do begin
    if s[i]=s[i-1] then
      if s[i]<>last then Insert(s[i]+s[i],s,i)
      else Insert(s[i],s,i);
    last:=s[i];
  end;
  WriteLn(s);
end.

var
  s: String[255];
  i: Integer;
begin
  ReadLn(s); s[Length(s)+1]:=#0;
  for i:=Length(s) downto 2 do
    if s[i]=s[i-1] then begin
      if s[i]<>s[i+1] then Insert(s[i],s,i);
      Insert(s[i],s,i);
    end;
  WriteLn(s);
end.

var
  s: String;
  i: Integer;
begin
  ReadLn(s); s:=s+#0;
  for i:=Length(s)-1 downto 2 do
    if s[i]=s[i-1] then begin
      if s[i]<>s[i+1] then Insert(s[i],s,i);
      Insert(s[i],s,i);
    end;
  Delete(s,Length(s),1); WriteLn(s);
end.