Двусвязный список

[Work Group]

Ребят,можете помочь пожалуйста!!программа заключается в создании двусвязного списка и работа с ним(перемещение вправо и влево,удаление,вставка всправа и слева,перемещение в начало и конец)...так как тут надо вставлять и передвигаться,я так понял,что надо делать через char..и вот первая проблема,это создание самого списка..запоминает только один элемент...да и со вставкой с обеих сторон у меня проблемы...можете помочь пожалуйста!!

unit Unit1;
interface
 type
   Znch= Char;
   List= ^TList;
   TList= record
     data : Znch;
     next : List;
     prev : List;
   end;
 var
  trmB,trmE,ptrTop: List;

procedure FreeSteck(stek: List);
Procedure Creat(var nach: List; Znach1: Znch);
Procedure Print(spis: List);
Procedure MoveRight(old_cell, new_cell: List);
Procedure MoveLeft(old_cell, New_cell: List);
Procedure Delete (target: List);
Procedure InsertAft (var pref,nex: List; Znach1: Znch);
Procedure InsertBef (var pref,nex: List; Znach1: Znch);
//Procedure Head ();
//Procedure Tail ();

implementation

procedure FreeSteck (stek: List);
 var
  tmp: List;
   begin
    while stek<>nil do
     begin
      tmp:= stek;
      stek:= stek^.next;
      FreeMem(tmp,SizeOf(TList));
     end;
   end;

procedure Print (spis: List);

 begin
  if spis=nil then
   begin
     writeln('list is empty');
     exit;
   end;
 while spis<>nil do
   begin
     write(spis^.data);
     spis:= Spis^.next;
   end;
 end;

procedure Creat (var nach: List; Znach1: Znch);
 begin
   GetMem (nach, SizeOf(TList));
   nach^.next:= nil;
   nach^.prev:= nil;
   nach^.data:= Znach1;
 end;

procedure MoveRight(old_cell,new_cell: List);
 begin
  if new_cell^.next=nil then
    writeln ('You are in the tail')
  else
    old_cell^.prev:= new_cell^.next;
 end;

procedure MoveLeft(old_cell,new_cell: List);
 begin
   if new_cell^.prev=nil then
     writeln ('You are in the head')
   else
     old_cell^.next:=new_cell^.prev;
 end;

procedure Delete (target: List);
 var
  aftert, beforet: List;
 begin
   aftert:= target^.next;
   beforet:= target^.prev;
   beforet^.next:= aftert;
   aftert^.prev:= beforet;
 end;

Procedure InsertAft (var pref,nex: List; Znach1: Znch);
 var cur: List;
 begin
  New (cur);
  cur^.data:= znach1;
  if nex <> nil then begin
   cur^.prev:=pref;
   cur^.next:=nex;
   pref^.next:=cur;
   nex^.prev:=cur;
  end
 else
  begin
   cur^.next:=nil;
   cur^.prev:=pref;
   pref^.next:=cur;
  end;
end;

Procedure InsertBef (var pref,nex: List; Znach1: Znch);
 var cur: List;
  begin
   new (cur);
   cur^.data:= znach1;
   if nex <> nil then begin
   cur^.next:= pref;
   cur^.prev:= nex;
   pref^.prev:= cur;
   nex^.next:= cur;
  end
 else begin
   cur^.prev:=nil;
   cur^.next:= pref;
   pref^.prev:= cur;
 end;
end;

end.


uses
  crt,Unit1;
var
  SpisNach,
  SpisEnd,
  tmpl:List;
  ch:char;
  znach:Znch;

begin
 SpisNach:=nil;
 SpisEnd:=nil;
 begin
  writeln('Input the elements');
  readln(znach);
  Creat(SpisNach, znach);
 end;
 repeat
  clrscr;
  Writeln('Choose the action');
  Writeln('1) Move right');
  Writeln('2) Move left');
  Writeln('3) Delet the element');
  Writeln('4) Insert before');
  Writeln('5) Insert after');
  Writeln('6) Move to the head');
  Writeln('7) Move to the tail');
  Writeln('8) output the list');
  Writeln('9) Exit');
  writeln;
  ch:=readkey;
  case ch of
     {'1'
     '2'
     '3'}
     '4' : begin
            write('Input  ');
            readln(znach);
            InsertBef(Spisnach,SpisEnd,znach);
           end;
     '5' : begin
             write('Input  ');
             readln(znach);
             InsertAft(SpisNach,SpisEnd,znach);
           end;
     '6' : begin
            readln (znach);
            end;
     //'7'
     '8' : Begin
            clrscr;
            Print(SpisNach);
            readkey;
           end;
         end;
     until ch = '9';
    FreeSteck(SpisNach);
    readln;
end.

[VektorAB]

Не стал разбираться в коде, ответ на вашу первую проблемму.
Создание двунаправленного списка.
Вот я сделал пример где двунаправленный список заполнен данными из типизированного файла. Список закольцован.

     
type
    adresOb=^zvenoOb;
    ZvenoOb=record
                  shifr:integer;{шифр объекта}
                  name:string[40];{наименование объекта}
                  stoimost:longint;{стоимость объекта}
                  prevOb,nextOb:adresOb
{prevOb-указатель на предыдущее звено}
{nextOb-указатель на следующее звено}
            end;
Obj=record
               shifr:integer;
               name:string[40];
               stoimost:longint;
         end;


var
Mnojestvo:set of 0..100;
pbOb,peOb,pvsOb:adresOb;
mas:obj;
fObj:file of obj;


procedure CreateSpisok;
          begin
                         Assign(fobj,'file.prm');
                         Reset(fobj);
                         new(pbOb);
                         Read(fobj,mas);
                         pbOb^.shifr:=mas.shifr;
                         pbOb^.name:=mas.name;
                         Mnojestvo:=[mas.shifr];
                         pbOb^.stoimost:=mas.stoimost;
                         pvsOb:=pbOb;
                         while not(eof(fobj)) do
                                  begin
                                       Read(fobj,mas);
                                       new(peOb);
                                       Mnojestvo:=Mnojestvo+[mas.shifr];
                                       peOb^.shifr:=mas.shifr;
                                       peOb^.name:=mas.name;
                                       peOb^.stoimost:=mas.stoimost;
                                       pvsOb^.nextOb:=peOb;
                                       peOb^.prevOb:=pvsOb;
                                       pvsOb:=peOb
                                  end;
                          pbob^.prevOb:=peOb;
                          peOb^.nextOb:=pbOb;
                          Close(fobj)
                             end
          end;

Вот так будет создан двунаправленный список заполненный объектами из типизированного файла,
переделайте немного под свою версию, практика не помещает. Может и поймете где ошиблись.

Если что то непонятно справшивайте.

2) Для перемещения в начало и конец в моем примере созданы указатели pbOb(начало),peOb(конец). Думаю тут не должно быть проблем.

И что за вставка с обеих сторон?? Объясните поподробнеей.

[Work Group]

спасибо,сейчас буду разбираться.

у меня есть ещё задача,перемещение по списку вправо и влево.и значит где-нибудь,когда указатель у нас находится не на крайнем элементе,мы можем вставить новый элемент или справа от него..вроде так.

[eoln]

Поправил исходник из поста #1

Procedure MoveRight(var new_cell: List);
Procedure MoveLeft(var New_cell: List);
...
Procedure InsertAft (var  nex, SpisEnd: List; Znach1: Znch);
Procedure InsertBef (var pref, SpisNach: List; Znach1: Znch);
...
procedure MoveRight(var new_cell: List);
 begin
  if new_cell^.next=nil then
    writeln ('You are in the tail')
  else
    new_cell := new_cell^.next;
 end;

procedure MoveLeft(var new_cell: List);
 begin
   if new_cell^.prev=nil then
     writeln ('You are in the head')
   else
     new_cell := new_cell^.prev;
 end;

Procedure InsertAft (var nex, SpisEnd: List; Znach1: Znch);
//раздвигаем список для нового элемента - связываем его с соседями
 var cur: List;
 begin
  New (cur);
  cur^.data:= znach1;
  cur^.next:=nex^.next;
  if nex^.next = nil then//если справо пусто
     SpisEnd := cur//то вставляемое будет концом
   else
     nex^.next^.prev := cur;
  cur^.prev:=nex;
  nex^.next:=cur
end;

Procedure InsertBef (var pref, SpisNach: List; Znach1: Znch);
//аналогично InsertAft'у
var cur: List;
begin
   new (cur);
   cur^.data:= znach1;
   cur^.prev:=pref^.prev;
   if pref^.prev = nil then
     SpisNach := cur
   else
     pref^.prev^.next := cur;
   cur^.next:= pref;
   pref^.prev:= cur
end;

Ну и соответственно в главном листинге

uses
  Unit1;
var
  SpisNach, SpisEnd, SpisCur, tmpl:List;
  ch:char;
  znach:Znch;

begin
  writeln('Input the elements');
  readln(znach);
  Creat(SpisNach, znach);
  SpisEnd := SpisNach;//в начале конец и начало совпадают
  SpisCur := SpisNach;//это указатель на текущий элемент списка
 repeat
  //clrscr;
  Writeln('Choose the action');
  Writeln('1) Move right');
  Writeln('2) Move left');
  Writeln('3) Delet the element');
  Writeln('4) Insert before');
  Writeln('5) Insert after');
  Writeln('6) Move to the head');
  Writeln('7) Move to the tail');
  Writeln('8) output the list');
  Writeln('9) Exit');
  writeln;
  readln(ch);//ch:=readkey;
  case ch of
     '1' : MoveRight(SpisCur);
     '2' : MoveLeft(SpisCur);
     //'3'
     '4' : begin
            write('Input  ');
            readln(znach);
            InsertBef(SpisCur, SpisNach, znach);
           end;
     '5' : begin
             write('Input  ');
             readln(znach);
             InsertAft(SpisCur,SpisEnd, znach);
           end;
     '6' : SpisCur := SpisNach;
     '7' : SpisCur := SpisEnd;
     '8' : Begin
            //clrscr;
            Print(SpisNach);
            //readkey;
           end;
         end;
     until ch = '9';
    FreeSteck(SpisNach);
    readln;
end.

Удаление похоже на вставку - просто меняем соседей

target^.prev^.next := target^.next;
target^.next^.prev := target^.prev;
dispose(target)

При этом смотрим чтобы корректно концы обрабатывались

[VektorAB]

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

Я сейчас код набрасаю как вставить эллемент сразу с двух сторон, а там сами разберетесь что Вам надо.

[eoln]

VektorAB, у топик-стартера задание нечёткое, мне оно кажется как программа прогуливающаяся по списку и вставляющая элементы относительно текущей позиции(Великий Могучий Русский язык, понимаешь ли ). У меня, например, перемещение означает не обмен соседних элементов, а переход текущего указателя вправо/влево, а вставка справа/слева - это раздвижение списка относительно текущей позиции и добавление элемента, а не добавление к концу/началу. Так вот код

   if nex <> nil then begin
   cur^.next:= pref;
   cur^.prev:= nex;
   pref^.prev:= cur;
   nex^.next:= cur;

напоминает неудачную попытку создания кольцевого списка, а процедура Print является выводом линейного списка. Так что чёрт его знает что имел ввиду ТС.

[VektorAB]

)) Всё ясно что написали.
Но я и вовсе не имел ввижу добавление в конец списка и в начало.
Я спросил почему нельзя добавить в крайнию позицию ТОбишь первую и последнюю. Мне кажется если добавлять то нужно добавлять везде))

Я вот щас делаю добавление и справа и слева одновременно.
Тоесть указал номер эллемента и программа добавляет 2 идентичных компоненты пососедству. Добавление слева сделал, но что справа пока не сходиться. Но я кажись допираю до сути

{вставляем ПОДСКАЖИТЕ ЧТО НЕ ТАК)}
new(ptHelp);
ptHelp^.shift:=mas.shift;
ptHelp^.name:=mas.name;
ptHelp^.stoimost:=mas.stoimost;
ptHelp^.nextOb:=pvsOb;
ptHelp^.prevOb:=pvsOb^.prevOb;
pvsOb^.prevOb^.nextOb:=ptHelp;
pvsOb^.prevOb:=ptHelp;{Left Complete.}

ptHelp^.prevOb:=pvsOb;{Right Error}
ptHelp^.nextOb:=pvsOb^.nextOb;
pvsOb^.nextOb^.prevOb:=ptHelp;
pvsOb^.nextOb:=ptHelp;

[VektorAB]

Почему то пришлось заводить 2 вспомогательных указателя, подскажите пожалуйста если можно сделать по другому.

uses crt;
type
    Obj=record
               shift:integer;
               name:string[40];
               stoimost:longint;
         end;
    adresOb=^zvenoOb;
    ZvenoOb=record
                  shift:integer;
                  name:string[40];
                  stoimost:longint;
                  prevOb,nextOb:adresOb
            end;
var
Mnojestvo:set of 0..100;
ptHelp2,ptHelp,pbOb,peOb,pvsOb:adresOb;
mas:obj;
Inser,i,j:integer;
fObj:file of obj;
procedure CreateSpisok;
          begin
                         Reset(fobj);
                         new(pbOb);
                         Read(fobj,mas);
                         pbOb^.shift:=mas.shift;
                         pbOb^.name:=mas.name;
                         Mnojestvo:=[mas.shift];
                         pbOb^.stoimost:=mas.stoimost;
                         pvsOb:=pbOb;
                         while not(eof(fobj)) do
                                  begin
                                       Read(fobj,mas);
                                       new(peOb);
                                       Mnojestvo:=Mnojestvo+[mas.shift];
                                       peOb^.shift:=mas.shift;
                                       peOb^.name:=mas.name;
                                       peOb^.stoimost:=mas.stoimost;
                                       pvsOb^.nextOb:=peOb;
                                       peOb^.prevOb:=pvsOb;
                                       pvsOb:=peOb
                                  end;
                                  pbob^.prevOb:=peOb;
                                  peOb^.nextOb:=pbOb;
                         close(fobj)
          end;
begin
clrscr;
Assign(fobj,'Objects.vek');
CreateSpisok;

{Выводим список}
pvsOb:=pbOb;
for i:=1 to 7 do
    begin
         Writeln(i,' ',pvsOb^.name);
         pvsOb:=pvsOb^.nextOb;
    end;

{Ввод данных новой компоненты}
Write('Введите позицию вставки.');
Read(InSer);
pvsOb:=peOb;
For i:=1 to InSer do
    pvsOb:=pvsOb^.nextOb;
Write('‚Введи шифр:');
Readln(mas.shift);
Write('Введи Имя:');
Readln(mas.name);
Write('Введи стоимость:');
Read(mas.stoimost);

{Вставка компоненты.}
{Слева}
new(ptHelp);
ptHelp^.shift:=mas.shift;
ptHelp^.name:=mas.name;
ptHelp^.stoimost:=mas.stoimost;
ptHelp^.nextOb:=pvsOb;
ptHelp^.prevOb:=pvsOb^.prevOb;
pvsOb^.prevOb^.nextOb:=ptHelp;
pvsOb^.prevOb:=ptHelp;
{Справа}
new(ptHelp2);
ptHelp2^.shift:=mas.shift;
ptHelp2^.name:=mas.name;
ptHelp2^.stoimost:=mas.stoimost;
ptHelp2^.prevOb:=pvsOb;
ptHelp2^.nextOb:=pvsOb^.nextOb;
pvsOb^.nextOb^.prevOb:=ptHelp2;
pvsOb^.nextOb:=ptHelp2;

{Выводим}
pvsOb:=pbOb;
for i:=1 to 7 do
    begin
         Writeln(i,' ',pvsOb^.name);
         pvsOb:=pvsOb^.nextOb;
    end;
readkey
end.

[VektorAB]

А что же я на код ТС-а не обратил внимания там все стало понятным просле прочтения 4 и 5 пунктов меню, Вставка лиюо справа либо слева.

Ну это то же самое что и написаное выше.

Только добавить необходимо условный оператор , в случае если выбирается 1 эллемент при вставке слева, и последный при вставке справа.

[eoln]

Сообщение от VektorAB

Почему то пришлось заводить 2 вспомогательных указателя, подскажите пожалуйста если можно сделать по другому.

Только так и никак по-другому. Добавляем мы 2 элемента, следовательно память выделить мы должны именно под 2 элемента. Правда тут можно упростить, использовав одну переменную для указателей (указатель ведь это всего лишь 2-х байтовое число, которое после установки связи с соседними элементами нам даром не нужно) и применив "наследование" типа Obj для ZvenoOb (это чтобы несколько строк убрать), но вызывать new в любом случае надо дважды.