R-список, Нужна помощь Опции

[Dunkel_L]

Нужно написать процедуру в R-списе(info:string) (кольцевой список), которая меняет местами слова с четными номерами и нечетными (1-е со 2-м и т.д.)

[volvo]

Твою реализацию кольцевого списка - в студию !!!

[Dunkel_L]

Код

uses crt;
type ptr=^node;
node=record
info:string;
link:ptr;
end;
var front,fin:ptr;
procedure inqueue(c:string);
var p:ptr;
begin
new(p);
p^.info:=c;
p^.link:=nil;
if fin<>nil then
begin
fin^.link:=p;
end
else
front:=p;
fin:=p;
end;
function outqueue:string;
var p:ptr;
begin
if front<>nil then
begin
outqueue:=front^.info;
p:=front^.link;
dispose(front);
front:=p;
if front=nil then
fin:=nil;
end
else
begin
TextColor(red);
writeln('   Ошибка! Список пуст');
outqueue:=' ';
TextColor(7);
writeln(' Для продолжения работы нажмите Enter '); end
end;
procedure show;
var p,q:ptr;
var inf:string;
begin
q:=front;
repeat
p:=q^.link;
inf:=q^.info;
write(inf,';   ');
q:=p;
until(q=nil);
end;
procedure out;
var p:ptr;
begin
if front<>nil then
repeat
p:=front^.link;
dispose(front);
front:=p;
until(front=nil);
end;
procedure pe(p:ptr);   Вот сама процедура
var
r:ptr;
begin
if front<>nil then
begin
new(r);
r^.info:=p^.info;
r^.link:=p^.link;
p^.link:=r;
pe(r^.link);
end;
end;
----конец----
var n,i:integer;
var k,z:string;
begin
front:=nil;
fin:=nil;
repeat
clrscr;
writeln('Выберете деиствие');
writeln('1-Ввести элемент');
writeln('2-Убрать элемент');
writeln('3-Посмотреть все');
writeln('4-Перестановка');
writeln('5-Выход');
writeln;
write('   Введите команду и нажмите ВВОД:   ');
readln(n);
if n=1 then
begin
writeln('   Введите символ');
write('   ');
readln(k);
inqueue(k);
end
else
if n=2 then
begin
write(outqueue);
readln;
end
else
if n=3 then
begin
write('   Список:   ');
show;
readln;
end
else
if n=4 then
begin
pe(front);
end
until(n=5);
out;
end.

[volvo]

Вот так:

procedure pe(p:ptr);
var
  q:ptr;
  T: string;
begin
  q := p;
  while (p <> nil) and (p^.link <> nil) do begin
    T := p^.info;
    p^.info := p^.link^.info;
    p^.link^.info := T;

    p := p^.link^.link;
  end;
end;

[Dunkel_L]

Спасибо. Все работает. Но правда это у меня не кольцевой список.


Вот правильная реализация с твоей процедурой

Код

uses CRT;
type ptr=^node;
     node=record
     info:string;
     link:ptr;
     end;
var top,w2:ptr;
     a:word;
     b:string;

procedure Push(n:string);
var w1,w2:ptr;
begin
new(w1);
w1^.info:=n;
w2^.link:=w1^.link;
w1^.link:=top;
top:=w1;
end;

procedure vid(w1:ptr);
begin
  if (w1<>w2) then
    begin;
      vid(w1^.link);
      write(w1^.info,' ')
    end;
end;
{__________инверсия списка__________}
procedure pe(p:ptr);
var
  q:ptr;
  T: string;
begin
  q := p;
  while (p <> nil) and (p^.link <> nil) do begin
    T := p^.info;
    p^.info := p^.link^.info;
    p^.link^.info := T;

    p := p^.link^.link;
  end;
end;
{__________удаления списка__________}
function Pop:string;
var
   l:ptr;
begin
   if top <> l  then

   begin
      l:=top^.link;
      Pop:=top^.info;
      dispose (top);
      top:=l;
   end
     else  begin
      Writeln('   Ошибка! Список пуст   ');
      pop:='  ';
   end;
end;
{__________конец удаления__________}
begin
repeat
clrscr;
writeln('   1-Ввод числа в список');
writeln('   2-Удаление числа из списка');
writeln('   3-Вывод списка на экран');
writeln('   4-Вывод инвертированного списка');
writeln('   5-Выход из программы');
write('   Введите команду   ');
   readln(a);
   if a=1 then
      begin
         write('   Введите слово:  ');
         readln(b);
         Push(b);
      end else
   if a=2 then
      begin
         Writeln;
         Write(Pop);
         writeln('   удалено из стека');
         readln;
      end else
    if a=3 then
    begin
     Write('   Список:');
     vid(top);
     Writeln;
     readln;
      end else
    if a=4 then
      begin
         Write('   Исходный список:');
         vid(top);
         Writeln;
         Write('   Инвертированный список:');
         pe(top);
         Writeln;
         readln;
      end else
           if a>5 then
             Begin
               Writeln('   Неправильный ввод!  ');
             end;
until(a=5)
end.

Но теперь, если в лоб ставить твою процедуру, то перевернутый список не выводиться на экран.
Помоги разобраться, в чем беда.

[volvo]

Ну, так ты же его не выводишь...

         Write('   Исходный список:');
         vid(top);
         Writeln;
         Write('   Инвертированный список:');
         pe(top);
         vid(top); { <-- Добавь вот это... }
         Writeln;

[Dunkel_L]

Да я слепой...
Теперь у меня возник другой вопрос:
если вводишь чётное количество элементов всё работает нормально,
а если нечётное ,то первый элемент остается на месте ,а все остольные меняються.

Может нужно через счётчик?

[-Dunkel_L-]

В кольцевом списке недолжно быть указателя nil на поля ввода.А должен быть указатель на хвост(q).

Код

procedure pe(p:ptr);
var
  q:ptr;
  T: string;
begin
  q := p;
  while  (p^.link <> q) do begin
    T := p^.info;
    p^.info := p^.link^.info;
    p^.link^.info := T;

    p := p^.link^.link;
  end;
end;

Вот так попробовал но при выводе на экран вылетает.
Помоги.

[volvo]

Ты меня конечно извини, но твоя программа у меня вообще не работает (даже не добавляет элементы)... И ошибки очень грубые:
1)

procedure Push(n:string);
var w1,w2:ptr;
begin
  new(w1);
  w1^.info:=n;
  w2^.link:=w1^.link; { <-- Вот это что значит??? }
  w1^.link:=top;
  top:=w1;
end;

Чему по-твоему равно W2 там где я показал, и какое право ты имеешь обращаться к полю неинициализированного указателя?

2)

procedure vid(w1:ptr);
begin
  if (w1<>w2) then { <--- Здесь !!! }
    begin;
      vid(w1^.link);
      write(w1^.info,' ')
    end;
end;

Что ты делаешь в выделенной строке? Турбо Паскаль не позволяет производить с указателями никаких действий, кроме сравнения с nil... Сравнения адресов между собой - это в 32-битных компиляторах (а так как для них есть специальный раздел, а ты создал тему здесь - то твоя программа неправильна, и в TP работать если и будет - то некорректно)...

Исправляй.

[Dunkel_L]

Код

procedure pe(p:ptr);
var
  q:ptr;
  T: string;
begin
  q := p;
  while
{(p <> nil ) недолжно быть :(}
  (p =  q) and (p^.link <> q) do begin
    T := p^.info;
    p^.info := p^.link^.info;
    p^.link^.info := T;

    p := p^.link^.link;
  end;
end;

Тогда меняются местами только последнии два эл-та.



Насчет 1) так по лекциии создается кольцевой список
2) мы сравниваем и после этого выводим на экран


Насчёт 32 битных компеляторов незнаю, мы работаем в обычном Borland Pascal 7.0
Вот так

[volvo]

Насчет 1) так по лекциии создается кольцевой список

Выброси эту лекцию... Кольцевой список создается точно так же, как обычный (first - начало, last - конец), просто последним действием идет:

last^.next := first; { Теперь это уже "кольцо" }

, а работать с неинициализированными переменными тебя никакой нормальный лектор учить не будет...

[volvo]

Вот тебе принцип работы с R-списком (меню добавишь сам):

type
  ttype = string;

  plist = ^tlist;
  tlist =  record
    info: ttype;
    next: plist;
  end;

var
  first, last: plist;

{ Печать кольцевого списка (без рекурсии) }
procedure print(p: plist); 
begin
  repeat

    write(p^.info, '':2);
    p := p^.next;

  until p = first;
  writeln;
end;

{ Добавление элемента в конец списка }
procedure append(x: ttype);
var p: plist;
begin
  new(p);
  p^.info := x;
  p^.next := nil;

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

  last := p
end;

{ Та процедура, которая тебе нужна }
procedure change(p: plist);
var
  q: plist;
  is_first: boolean;
  T: ttype;
begin
  is_first := true;
  repeat

    if (is_first or (p <> first)) and (p^.next <> first) then begin
      T := p^.info;
      p^.info := p^.next^.info;
      p^.next^.info := T;

      p := p^.next^.next;
    end;
  until (p = first) or (p^.next = first);

end;



var
  X: ttype;

begin

  first := nil; last := nil;

  repeat

    write('next element (empty string to exit): '); readln(X);
    if X <> '' then append(X);

  until X = '';
  last^.next := first; { "Зацикливаем" список }

  write('list: '); print(first);

  change(first);

  write('list after: '); print(first);

end.

[Dunkel_L]

С НОВЫМ ГОДОМ!!!
Спасибо за твою реализацию списка.
Если мы создаём два указателя(prev, link) то это Д-список, правельно?

Код

type
  PList = ^TList;
  TList = record
    info: string;
    prev, link: PList;
  end;

[volvo]

Да... Твоя же задача для D-списка тоже решена на форуме (пользуйся поиском, я точно ее выкладывал...)