Помощь - Поиск - Пользователи - Календарь
Полная версия: Задача про строки и повторяющиеся символы.
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Гость_Роман
16.12.2004 16:54
Текст задачи:
Задан текст,в котором нет вхождения символов "(" и ")".Выполниеть его сжатие то есть заменить всякую максимальную подпоследовательность,составленную из более чем трех вхождений одного и того же символа,на (k)s,где s-повторяемый символ,а k>3 - количество его повторений.
Заранее благодарен.Я искал но вроде не нашел такую задачку. :p2:
volvo
16.12.2004 23:44
Гость_Роман
Эта программа производит сжатие строки по описанному алгоритму.
Код

const
 s: string =
    'assssssssssssssssssssssrrrfigngnnnnnnn ytytytyyyyy fffff ijjjjjj';

function change_more(s: string;
        var i: byte): string;
 var
   j, count: byte;
   st: string;
 begin
   j := succ(i);
   while (s[j] = s[i]) and
         (j <= length(s)) do inc(j);
   count := j - i;
   if count > 3 then
     begin
       str(count, st);
       s := copy(s, 1, i) + '(' + st + ')' + copy(s, j, 255);
       inc(i, succ(2 + length(st)))
     end
   else i := j;
   change_more := s
 end;

var
 i: byte;
 test: string;
begin
 test := s; i := 1;
 while i <= length(test) do
   test := change_more(test, i);
 writeln(test)
end.
Guest
19.12.2004 15:27
Большое спасибо.
А можно ли изменить ее так чтобы эту строчку вводить с клавиатуры,а то я пытался и у меня не получалось???? Напишите пожалуйста эту же программу но строчку с клавиатуры вводить!
volvo
19.12.2004 16:08
Начинайте думать хотя-бы немножко...
Код

(*
const
s: string =
   'assssssssssssssssssssssrrrfigngnnnnnnn ytytytyyyyy fffff ijjjjjj';
*)
function change_more(s: string;
       var i: byte): string;
var
  j, count: byte;
  st: string;
begin
  j := succ(i);
  while (s[j] = s[i]) and
        (j <= length(s)) do inc(j);
  count := j - i;
  if count > 3 then
    begin
      str(count, st);
      s := copy(s, 1, i) + '(' + st + ')' + copy(s, j, 255);
      inc(i, succ(2 + length(st)))
    end
  else i := j;
  change_more := s
end;

var
i: byte;
test: string;
begin
write('s = '); readln(s);
test := s; i := 1;
while i <= length(test) do
  test := change_more(test, i);
writeln(test)
end.
Guest
19.12.2004 23:21
Премного благодарен! :molitva:
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.