Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Списки и удаление повторяющихся символов

Автор: NTL 14.12.2006 4:01

Используя однонаправленные списки, помогите, пожалуйста, написать процедуру. В слове, состоящем из букв и цифр и заканчивающемся точкой, перед каждой группой одинаковых букв вставить цифру, изображающую число букв в этой группе, а саму группу заменить одной буквой. Other words, например, собббака, то выводим со3бака и т.д. Ввод-вывод списка есть

Код

Type
  point = ^MyWord;
  MyWord = record
    ch: char;
    next: point
  end;
var
   slovo:point;
{---------------------------------------------------------------------------}
procedure Print (first: point);
Var r: point;
begin
  R:= first;
  write('C/\OBO = ');
  While r<>nil do
    begin
      Write (r^.ch);
      R:=r^.Next;
  end;
  writeln;
end;
{---------------------------------------------------------------------------}
procedure Vvod(var first:point);
var r, last:point;
begin
  first:= nil; last := nil;

   writeln('HABEPuTE C/\OBO C "." HA KOHCE ');
  repeat
      new(r);
      r^.next := nil;
      read(r^.ch);

      if first = nil then first := r
      else last^.next := r;

      last := r;
  until r^.ch = '.';

end;

ЗЫ: Спасибо, volvo, за редактирование ввода

Автор: NTL 15.12.2006 20:29

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

Код

Procedure insert_before (Var q: point; x: char);
Var r: point;
Begin
  New(r);
  r^.Next:=q^.Next;
  q^.Next:=r;
  r^.ch:=q^.ch;
  q^.ch:=x
end;
{---------------------------------------------------------------------------}
Procedure Delete(Var q: point);
Var r: point;
Begin
  r:=q^.next;
  q^:=r^;
  r^.Next:=nil;
End;
{----------------------------------------------------------------------------}
Procedure MyProc(first:point);
var r,temp:point;
       k:integer;
begin
new(r);
r:=first;
repeat
     k:=0;
     temp:=r;
     if temp = temp^.next then
       begin
          r:=temp;
           while (temp = r^.next) do
              begin
                  inc(k);
                  r:=r^.next;
                  delete(r);
              end;
           insert_before(temp,chr(ord(k)));
       end;
     r:=r^.next;
  write(r^.ch);
until r = nil;
end;

Автор: volvo 15.12.2006 21:11

Что именно не компилируется? Номер строки и сообщение об ошибке компилятора - в студию... У меня проходит компиляцию безошибочно. Может, вызываешь как-нибудь не так?

Автор: Гость 17.12.2006 16:39

Цитата(volvo @ 15.12.2006 17:11)

Что именно не компилируется?

Я хотел сказать, что не получаю должного рез-та. Хотя по коду вроде все правильно

Автор: NTL 20.12.2006 17:50

Ну, неужели никто не может помочь мне Пожалуйста...

Автор: мисс_граффити 21.12.2006 0:37

покажи, как вызываешь...

Автор: NTL 21.12.2006 7:21

Никак не могу додуматься...Помогите плзззз

Код

begin
clrscr;
  vvod(slovo);
  print(slovo);
  MyProc(slovo);
  readkey;
  end.

Автор: volvo 21.12.2006 15:42

procedure myproc(first: point);
var
  r, temp: point;
  k: integer;

begin
  r := first;
  repeat
    k:=1;
    temp := r;
    while (r^.next <> nil) and (temp^.ch = r^.next^.ch) do begin
      inc(k);
      delete®;
    end;

    if k > 1 then
      insert_before(temp, chr(ord('0') + k));

    r:=r^.next;
  until r = nil;
end;

Вызывать - вот так:

  clrscr;
  vvod(slovo);
  print(slovo);
  MyProc(slovo);
  print(slovo);
  readkey;

, потому, что тебе надо не заменить "на лету", оставив сам список неизменным, в заменить символы именно в списке, следовательно в myproc не печатается ничего, печать вызывается ПОСЛЕ...

Автор: NTL 22.12.2006 20:46

volvo, спасибо огромное!Опять ВЫ меня выручаете Все работает!