Двунаправленный список(Delphi), задание сделал, но двунаправленостью не пахнет Опции

[krox]

Задание следующее...

Элементы двунаправленного списка имеют следующую структуру:
Шифр детали
Наименование
Цена
Вес
Указатель предыдущего
Указатель последующего
Удалить элемент с заданным номером К от начала списка.

задание выполнил используя пример однонаправленого списка...
помогите/объясните как сделать задание с двунаправлеными списками...

вот код

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    GroupBox2: TGroupBox;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Label4: TLabel;
    Edit3: TEdit;
    Edit4: TEdit;
    GroupBox3: TGroupBox;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    GroupBox4: TGroupBox;
    Label13: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

type PElem=^TElem;  //Описание указателя на элемент
 TElem= record           //Описание элемента
   shifr: string[5];
   naim: string[10];
   cena:string[2];
   ves:string[3];
   st:integer;
   sled: PElem;
   pred: PElem;
 end;

var
  Form1: TForm1;
     p, head,zad, last, nex: PElem;
     t,i:integer;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin

 head:=Nil;
 last:=Nil;
 nex:=Nil;
 t:=0;
end;
//добавление
procedure TForm1.Button1Click(Sender: TObject);
begin
 New(p);
 p^.shifr:=Edit1.Text;
 p^.naim:=Edit2.text;
 p^.cena:=Edit3.Text;
 p^.ves:=Edit4.Text;
 t:=t+1;
 Edit6.Clear;
 Edit6.Text:=inttostr(t);
 P^.st:=strtoint(Edit6.Text);
 If head=Nil Then   head:=p
 Else
  last^.sled:=p;
 P^.sled:=Nil;
 Last:=p;
end;
//просмотр
procedure TForm1.Button3Click(Sender: TObject);
begin
 P:=Head;
 Label9.Caption:='';   Label10.Caption:='';
 Label11.Caption:='';   Label12.Caption:='';
 While P <> Nil Do
 Begin
  Label9.Caption:=Label9.Caption+chr(13)+P^.shifr;
  Label10.Caption:=Label10.Caption+chr(13)+P^.naim;
  Label11.Caption:=Label11.Caption+chr(13)+P^.cena;
  Label12.Caption:=Label12.Caption+chr(13)+P^.ves;
  P:=P^.sled;
 End;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
Close;
end;
//удаление элемента с заданным номером
procedure TForm1.Button2Click(Sender: TObject);
begin
i:=0;
 P:=Head;
 While P<>Nil Do
 Begin
  If StrToInt(Edit5.Text)-1=i Then
  Begin
    If P=Head Then
    Begin
      Head:=P^.sled;
      Dispose(P);
      P:=Head;
    End
    Else
    Begin
     If P^.sled=Nil Then
     begin
       Last^.sled:=Nil;
     end
     Else
      Begin
         Last^.sled:=P^.sled;
      End;
      dispose(P);
      P:=Last;
    End;
  End;
  Last:=P;
  P:=P^.sled;
  inc(i);
 End;
end;

end.

в этом коде однонаправленый список... нужен двунаправленый по заданию...

в прикреплёном архиве все файлы проекта...

[volvo]

Во-первых, у тебя Дельфи, а для Дельфи есть соответствующий раздел...

Во вторых, то, что ты делаешь - не выдерживает никакой критики: описал бы список как класс, было бы гораздо лучше, зачем усложнять себе жизнь работой с глобальными переменными? Зачем объединять указатели sled/pred и данные? Не надо этого делать... как только тебе понадобится сохранить содержимое списка в файл, ты поймешь, о чем я... Все проще гораздо:

type
  ptitem = ^titem;
  titem = class
    data: myRec; // твои данные
    prev, next: ptitem;

  public
    constructor create(const value: myRec);
  end;

  tlist = class
  private
    head, tail: ptitem;
  public
    constructor create;
    procedure append(const value: myRec);
    procedure removeByIndex(i: integer);
  end;

//...

Для удаления элемента из двухсвязного списка пользуемся

procedure tlist.remove_item(p: ptitem); // <--- сюда передается адрес элемента, который надо удалить
var r: ptitem;
begin
  r := p^.prev;
  if r <> nil then r^.next := p^.next
  else head := p^.next;

  r := p^.next;
  if r <> nil then r^.prev := p^.prev
  else tail := p^.prev;

  dispose(p);
  p := nil
end;

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

P.S. Если пользуешься Дельфи 2009, то можно сделать еще красивее...

[krox]

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

где в этот код воткнуть указатель на предыдущий элемент....

procedure TForm1.Button1Click(Sender: TObject);
begin
 New(p);
 p^.shifr:=Edit1.Text;
 p^.naim:=Edit2.text;
 p^.cena:=Edit3.Text;
 p^.ves:=Edit4.Text;
 t:=t+1;
 Edit6.Clear;
 Edit6.Text:=inttostr(t);
 P^.st:=strtoint(Edit6.Text);
 If head=Nil Then   head:=p
 Else
  last^.sled:=p;
 P^.sled:=Nil;
 Last:=p;
end;

менять тип рекорд не буду... записи(списки) сохранять в файл не надо...

и как изменить

procedure tlist.remove_item(p: ptitem); // <--- сюда передается адрес элемента, который надо удалить
var r: ptitem;
begin
  r := p^.prev;
  if r <> nil then r^.next := p^.next
  else head := p^.next;

  r := p^.next;
  if r <> nil then r^.prev := p^.prev
  else tail := p^.prev;

  dispose(p);
  p := nil
end;

не пользуясь классами а массивом записей TElem= record

[volvo]

менять тип рекорд не буду... записи(списки) сохранять в файл не надо...

Ну, как знаешь... А я подсказывать тебе, как некорректно написать программу, не буду... Пишешь на Дельфи - так и используй Дельфи (а вместе с ним - классы, свойства, и все преимущества ООП), а не загоняй себя искусственными ограничениями в возможности Турбо Паскаля версии 4.0 в красивой оболочке...

не пользуясь классами а массивом записей TElem= record

Ну-ну... Ты еще опиши:

var myList: array[1 .. 10000] of TElem

, и считай, что создал список... Где ты массив записей-то нашел?

[krox]

вся проблема в том, что ООП ещё не проходили.... иначе бы конечно его использовал... а так даже н знаю как классы использовать(((

[volvo]

Записи и процедуры/функции знаешь, как использовать? Вот так я бы делал это задание (при запрете использования классов):
 Unit1.pas ( 3.51 килобайт ) Кол-во скачиваний: 733


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

Хотя очень интересно получается... ООП еще не проходили, а то что и TForm и TEdit и TButton - это все классы - на это что, наплевать?

[krox]

спасибо тебе, volvo... сёдня был на паре... показал то что вчера сделал... преподша помогла добавление двунаправленого списка сделать и заодно объяснила что к чему... ей главное чтобы научились в данном случае использовать двунаправленые/однонаправленые списки...
но к сожалению, при всём моём желании я не смогу использовать твой код, т.к. преподша поймёт что делал не сам... да и за сегоднешнюю пару уже получил объяснения как и что сделать)

ещё раз спасибо за затраченное на меня время)

[мисс_граффити]

Хотя очень интересно получается... ООП еще не проходили, а то что и TForm и TEdit и TButton - это все классы - на это что, наплевать?

Нас так же учили...
Программирование на языках высокого уровня (конкретно - на Делфи) - 1 семестр. ООП - четвертый.
Типа воспринимайте кнопки и формы как данность ))

[krox]

Препод сказал ещё сортировку по любому ключу прилепить и просмотр в обратную стророну сделать....

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

procedure TForm1.Button7Click(Sender: TObject);
var tmp:PElem;
begin
if last <> nil then
 begin{1}
  m:= true;
  p:= last;
  while p^.sled <> nil do
  begin{2}
   if(p^.shifr > p^.sled^.shifr) or (p^.shifr = p^.sled^.shifr) then
   begin{3}
    m:=true;
    if p=last then
     last:=p^.sled
     else p^.pred^.sled:=p^.sled;
    if p^.sled=head then//начало условия
     begin
      head:=p;
      tmp:=nil;
     end
     else
      begin
       p^.sled^.sled^.pred:=p;
       tmp:= p^.sled^.sled;
      end;  //КОНЕЦ УСЛОВИЯ
    p^.sled^.sled:=p;
    p^.sled^.pred:=p^.pred;
    p^.pred:=p.sled;
    p^.sled:=tmp;
    end{3}
   else p:=p^.sled;
   end;{2}

   m:=false;
   p:=head;
  while p^.pred<>nil do
   begin {3.1}
     if(p^.shifr < p^.sled^.shifr) or (p^.shifr = p^.sled^.shifr) then
      begin {3.2}
       m:=true;
       if p=head then head:=p^.pred
        else p^.sled^.pred:=p^.pred;
       if p^.pred=last then
        begin
         last:=p;
         tmp:=nil;
        end
        else
         begin{3.3}
          p^.pred^.pred^.sled:=p;
          tmp:=p^.pred^.pred;
         end;{3.3}
        p^.pred^.pred:=p;
        p^.pred^.sled:=p^.sled;
        p^.sled:=p^.pred;
        p^.pred:=tmp;
      end {3.2}
      else
       p:=p^.pred;
   end;{3.1}
  end{2}

  else begin
  ShowMessage('Нечего сортировать');
  end;{1}
end;

на втором WHILE происходит ошибка....

 ____2.rar ( 8.84 килобайт ) Кол-во скачиваний: 484
- файл с проектом на делфи7
только не надо отдельные функции и процедуры дописывать) весь код должен быть на одной кнопке
нид хелп с сортировкой)

Сообщение отредактировано: krox - 25.10.2008 18:43

[volvo]

только не надо отдельные функции и процедуры дописывать) весь код должен быть на одной кнопке

По-моему, ты недооцениваешь преимущества Паскаля/Дельфи... Условия соблюдены (весь код - на одной кнопке) :

procedure TForm1.Button7Click(Sender: TObject);

  function insert_sort(l: pelem): pelem;

    function insert(a: pelem; l: pelem): pelem;
    begin
      a^.sled := nil;
      if l = nil then insert := a
      else
        if a^.shifr < l^.shifr then begin
          a^.sled := l; insert := a;
        end
        else begin
          l^.sled := insert(a, l^.sled);
          insert := l;
        end;
    end;

  begin
    if l = nil then insert_sort := nil
    else insert_sort := insert(l, insert_sort(l^.sled));
  end;

begin
  if head <> nil then begin
    head := insert_sort(head);
  end
  else begin
    ShowMessage('Нечего сортировать');
  end;

end;

Об алгоритме (а именно - это сортировка списка вставками) можно прочитать у Роберта Сэджвика (Robert Sedgewick)

[krox]

спасибо) работает) очень грамотный и тонкий наёп с твоей стороны) очень долго ржал)

ООП будет в следющем семестре... на языке Java
вот там и научусь использовать классы, методы и т.д)

сколько читаю про программирование, везде пишут, что функции и процедуры лучше и эффективнее использовать, но в данный момент нам препод ставит задачу по написанию проги так как она нас учила)

кста, очень глЮпый вопрос, а где тут двунаправленость?)

и ещё возник вопрос

else insert_sort := insert(l, insert_sort(l^.sled)); это рекурсия?

Сообщение отредактировано: krox - 25.10.2008 21:12

[volvo]

очень глЮпый вопрос, а где тут двунаправленость?)

Точно там же, где и предложенное мной выше разделение на данные/указатели... Ты ж этого не сделал?

Если б ты все-таки отделил данные от указателей pred/sled, то можно было бы элементарно отсортировать список без рекурсии, например так:

procedure TForm1.Button7Click(Sender: TObject);
var
  i, j: pelem;
  T: myRecord;
begin
  i := head;
  while i <> nil do begin
    T := i^.data.shifr;
    j := i^.pred;
    while (j <> nil) and (T < j^.data.shifr) do begin
      j^.sled^.data := j^.data;
      j := j^.pred;
    end;

    if j = nil then first^.data := T
    else j^.sled^.data := T;

    i := i^.sled;
  end;

, но поскольку ты пошел "другим путем" (С) - этот номер не пройдет...

Кстати, проверь работу сортировки как следует... По-моему для двунаправленного списка она отрабатывает не совсем корректно: если ты захочешь после сортировки пробежать по списку в обратном направлении, тебя может ждать сюрприз...

[krox]

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

procedure TForm1.Button7Click(Sender: TObject);
  function insert_sort(l: pelem): pelem;

    function insert(p: pelem; l: pelem): pelem;
    begin
      p^.sled := nil;
      if l = nil then insert := p
      else
        if p^.shifr < l^.shifr then begin
          p^.sled := l; insert := p;
        end
        else begin
          l^.sled := insert(p, l^.sled);
          insert := l;
        end;
    end;

  begin
    if l = nil then insert_sort := nil
    else insert_sort := insert(l, insert_sort(l^.sled));
  end;

begin
  if head <> nil then begin
    head := insert_sort(head);
  end
  else begin
    ShowMessage('Нечего сортировать');
  end;

у нас не спрашива.т разделение на данные и указатели, точнее, так не надо делать... препод ничего насчёт этого не говорил...

в коде выше как двунаправленость засунуть?)

[volvo]

в коде выше как двунаправленость засунуть?)

Как хочешь так и засовывай... Заодно засунь трехнаправленность... Можешь и четырех, от этого ничего не изменится. Это - алгоритм сортировки ОДНОсвязного списка. Точка. Понимаешь, в чем дело, или нет? НЕ ЗНАЕТ этот код о том, что есть ссылка на предыдущий элемент. Не знает, и знать не хочет... "Меньше знаешь - лучше спишь" (С) помнишь? Вот и функция insert_sort() так же себя ведет. Зачем ей лишняя информация о том, что еще там ты намутил в списке? Она знает, что есть элемент списка, и одно из его полей - это указатель на следующий элемент. Все. Больше - ничего. Используя только эти данные функция прекрасно сортирует список. Только после сортировки проходить по списку придется от head к last, а не наоборот...

точнее, так не надо делать... препод ничего насчёт этого не говорил...

Мне как-то все равно, что там говорит твой "препод". Понимаешь? Задание дано тебе, вот и решай его сам с извращениями, если не хочешь слушать, как решить БЕЗ них...

[krox]

попытаюсь объяснить преподу эту точку зрения...

хочу слушать тебя и слушаю, а так же хочу разобраться в этой теме...
фигово её объяснили да и то на примере однонаправленного списка(
сделаю как ты посоветуешь)

[krox]

можешь ещё с выводом элементов в обратном порядке помочь?
а то я написал

procedure TForm1.Button6Click(Sender: TObject);
var c:integer;
begin
p:=last;
 Label9.Caption:='';   Label10.Caption:='';
 Label11.Caption:='';   Label12.Caption:='';
if p = nil then ShowMessage('Список пуст') else
begin
p^.pred := last^.pred;
 While P <> Nil Do
 Begin
  Label9.Caption:=Label9.Caption+chr(13)+P^.shifr;
  Label10.Caption:=Label10.Caption+chr(13)+P^.naim;
  Label11.Caption:=Label11.Caption+chr(13)+P^.cena;
  Label12.Caption:=Label12.Caption+chr(13)+P^.ves;
P:=last^.pred;
 end;
 End;
end;

и нифига не работает((((

[krox]

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

объясните плз, что добавить/убрать, чтобы удалял элемент по номеру?

procedure TForm1.Button2Click(Sender: TObject);
var d:Boolean;
begin
d:=false;
i:=0;   //счётчик
// P:=Head;
// Last:=nil;
 While (not d) {and (P<>Nil)} Do
 Begin
   if (head=nil) then begin
   ShowMessage('Нечего удалять');
   d:=true
   end
   else begin
 If StrToInt(Edit5.Text)-1=i Then
  Begin
  If StrToInt(Edit5.Text)-1=i Then
  Begin
    head:=head^.sled;
     if head=nil then last:=nil
     else head^.pred:=nil;
  end
      else
      if p=last then
       begin
        last:=last^.pred;
        if last=nil then
        head:=nil
        else
        last^.sled:=nil;
        end
        else
         begin
         p^.pred^.sled:=p^.sled;
         p^.sled^.pred:=p^.pred;
       end;
       end;
       d:=true;
  dispose(p);


   end;
   end;
  inc(i);
 End; //закрытие цикла
end;