Кольцевые Двусвязные Списки Опции

[ikorstenxl]

ПОМОГИТЕ ПОЖАЛУЙСТА ДОДЕЛАТЬ ПРОГРАММУ.
Вот собственно код :

Program Kursach;
uses
  crt;
type
  Tinf=integer;
  List=^TList;
  TList=record
    data:TInf;
    next : list;
    prev : list;
  end;

{=====================================Creation of Spisok====================================}
procedure AddElem(var first:List;znach1:TInf);
var
  tmp,tmp1:List;
begin
  if first=nil then
  begin
    Getmem(first,SizeOf(TList));
    first^.next:=first;
    tmp:=first;
  end
  else
  begin
    tmp:=first;
    while tmp^.next<>first do
      tmp:=tmp^.next;
    GetMem(tmp1,SizeOf(Tlist));
    tmp1^.next:=first;
    tmp^.next:=tmp1;
    tmp:=tmp1;
  end;
  tmp^.data:=znach1;
end;

{====================================Printing of Spisok=====================================}
procedure Print(spis1:List);
var
  first:List;
begin
  if spis1=nil then
  begin
    writeln('Please add a new element');
    exit;
  end;
  first:=spis1;
  Write(spis1^.data, ' ');
  spis1:=spis1^.next;
  while spis1<>first do
  begin
    Write(spis1^.data, ' ');
    spis1:=spis1^.next;
  end;
end;
{==================================Clearing all Spisok======================================}
Procedure FreeStek(spis1:List);
var
  tmp,first:List;
begin
  if spis1=nil then
    exit;
  first:=spis1;
  tmp:=spis1;
  spis1:=spis1^.next;
  dispose(tmp);
  while spis1<>first do
  begin
    tmp:=spis1;
    spis1:=spis1^.next;
    FreeMem(tmp,SizeOf(Tlist));
  end;
end;
  {===============================================================================
===========}
Procedure DelElem(var spis1:List;tmp:List);
var
  tmpi:List;
begin
  if tmp=spis1 then
  begin
    tmpi:=tmp;
    while tmpi^.next<>spis1 do
      tmpi:=tmpi^.next;
    if tmpi=spis1 then
    begin
      spis1^.next:=nil;
      dispose(spis1);
      spis1:=nil
    end
    else
    begin
      tmpi^.next:=tmp^.next;
      spis1:=spis1^.next;
      dispose(tmp)
    end;
  end
  else
  begin
    tmpi:=spis1;
    while tmpi^.next<>tmp do
      tmpi:=tmpi^.next;
    tmpi^.next:=tmp^.next;
    dispose(tmp);
  end;
end;
 {=============================Deleting the element of Spisok===============================}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
var
  tmp:List;
begin
  tmp:=spis1;

  
    if tmp^.data < 0 then                                                                    {!!!}
        if tmp^.next^.data = tmp^.prev^.data then 
  begin
    DelElem(spis1,tmp);
    exit;
  end;
  tmp:=tmp^.next;
  while tmp<>spis1 do
  begin


       if tmp^.data < 0 then                                                                  {!!!}
      if tmp^.prev^.data = tmp^.next^.data then 
    begin
      DelElem(spis1,tmp);
      exit
    end;
    tmp:=tmp^.next;
  end;
end;
{=================================Menu of Program========================================================}
var
  SpisNach,
  tmpl:List;
  znach,a,b:integer;
  ch:char;
begin
  SpisNach:=nil;
  repeat
    clrscr;
    textcolor(1);
    writeln('                     ======================================');
    writeln('                     ===                                ===');
    writeln('                     ===                                ===');
      write('                     ===');
    TextColor(4);
      Write('             WELCOME!!!');
    textcolor(1);
    writeln('         ===');
    writeln('                     ===                                ===');
    writeln('                     ===                                ===');
      write('                     ===');
    TextColor(5);
      Write('            "Circle List"');
    textcolor(1);
    writeln('       ===');
    writeln('                     ===                                ===');
    writeln('                     ===                                ===');
    writeln('                     ======================================');
    TextColor(6);
    writeln;
    writeln;
    writeln;
    writeln;
    Writeln('                           Choose the right action :');
    TextColor(7);
    writeln;
    writeln;
    Writeln('                            1) Add a new Element .');
    writeln;
    Writeln('                            2) Show the List .');
    writeln;
    Writeln('                            3) Delete the Element .');
    writeln;
    Writeln('                            4) Exit .');
    writeln;
    ch:=readkey;
    case ch of
      '1':begin
            write('Enter value of new Element  : ');
            readln(znach);
            AddElem(SpisNach,znach);
          end;
      '2':begin
            clrscr;
            Print(SpisNach);
            readkey;
          end;
      '3':begin
       DelElemZnach(SpisNach);
          end;

    end;
    until ch='4';
    freestek(spisnach);
end.

Как вы могли понять программа добавляет новый элемент в кольцевой двусвязный список, выводит на экран список,и чистит его при выходе из программы. еще есть процедура которая удаляет элементы по условию :
1) if tmp^.data < 0 then - то бишь отрицательный элемент списка,
а должно быть два условия :
1)...
2) if tmp^.prev^.data = tmp^.next^.data then - отрицательный элемент который находить между двумя одинаковыми (1 -2 1 - удалить -2).

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

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

[volvo]

Только вот дело-то в том, что когда отработает первое условие, второе уже НИКОГДА не выполнится. Согласись, сложно найти отрицательный элемент, окруженный двумя одинаковыми, после того, как удалил все отрицательные... Что-то не то с условиями. Пока не внесешь ясность - даже программу смотреть не хочется, потому как не знаешь, что в результате-то требуется.

На данный момент совет один - убрать вообще второе условие. Оно лишнее.

[ikorstenxl]

суть в том что бы удалить за раз все отрицательные элементы которые находяться между одинаковыми :
1 , 2 , -3 , 2 , 4 , 5 , 4 , 6 , -7 , 6 --------- 1 , 2 , 2 , 4 , 5 , 4 , 6 , 6

[volvo]

Так вот ты для начала список правильно создай (у тебя ж заполняются только указатели next, а prev-ы остаются нетронутыми, потом, при попытке обращения к ним, будут проблемы в виде неправильной работы на старых компиляторах и вылета программы на новых).

Когда исправишь создание списка (как - можно посмотреть на этом форуме, здесь была Everveit, которая задавала несколько вопросов по двухсвязным кольцевым спискам, и получила на них ответы; можно - начертить список на бумаге, и разобраться, как меняются все указатели при добавлении нового элемента. Это - предпочтительный вариант), тогда вот такая процедура будет работать:

function RemoveItem(var first: List; p: List): List;
begin
  if first^.next = first then
  begin
    FreeMem(first, SizeOf(Tlist));
    first := nil; RemoveItem := nil; exit;
  end;

  RemoveItem := p^.next;

  p^.prev^.next := p^.next;
  p^.next^.prev := p^.prev;
  if p = first then first := p^.next;
  FreeMem(p, SizeOf(Tlist));
  p := nil;
end;


procedure Process(var first: List);
var p: List;
begin
  if first = nil then Writeln('<empty>')
  else begin
    p := first;
    repeat
      if (p^.data < 0) and (p^.next^.data = p^.prev^.data) then
      begin
        p := RemoveItem(first, p);
      end
      else p := p^.next;
    until p = first;
  end;
end;

Кстати, печать списка можно сделать гораздо красивее:

procedure Print(first: List);
var p: List;
begin
  if first = nil then Writeln('<empty>')
  else begin
    p := first;
    repeat
      write(p^.data:4); p := p^.next;
    until p = first;
  end;
  writeln;
end;

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

[ikorstenxl]

уважаемый volvo, спасибо большое за совет, я разобрался и в итоге написал новую процедуру для создания списка и теперь функция для удаления элемента ,которую написали вы, и она работает - УРА!
но я все же что то напутал в создании списка, почему то постоянно первый элемент списка всегда присваевает ноль и я чет не могу сообразить почему, вот так выглядит процедура :

procedure AddElem(var first:List; znach1 : tinf);
var
    tmp,tmp1:List;
begin
if first=nil then
    begin
        Getmem(first,SizeOf(TList));
        first^.next:=first;
        tmp:=first;
    end
else
    begin
        tmp:=first;
        while tmp^.next<>first do
            tmp:=tmp^.next;
            GetMem(tmp1,SizeOf(Tlist));
            tmp1^.next:=tmp^.next;
            tmp1^.prev:=tmp;
            tmp1^.next^.prev := tmp1;
            tmp^.next:= tmp1;
            tmp1^.data:=znach1;
    end;
end;

не могли бы вы глянуть что я не так написал?
спасибо

Добавлено через 4 мин.
я на всякий пожарный еще прикрепил всю программу

Сообщение отредактировано: ikorstenxl - 26.05.2010 12:07

[volvo]

Вот именно потому, что ты не работаешь с полем Prev (ну объясни мне, зачем бежать по всему списку от First вперед, если можно одним движением назад получить тот же указатель?), оно и заполняется некорректно. Смотри:

procedure AddElem(var first: List; value: TInf);
var p: List;
begin
  Getmem(p, SizeOf(TList)); { <--- Это делается ВСЕГДА, вот и делаем это снаружи от If }
  p^.data := value;

  if first = nil then begin 
    {
      Первый элемент списка? Указываем "вперед" и "назад" на самого себя и
      запоминаем только что созданный элемент как первый
    }
    p^.next := p;
    p^.prev := p;
    first := p;
  end
  else begin
    {
      Ах, уже не первый? Тогда действовать надо по-другому:
      1) поскольку добавляем в "конец" списка (перед элементом first), то
      новый элемент next-ом указывает на "голову" списка, а prev-ом - туда,
      куда раньше указывал prev "головы"

      2) не забываем и про "бывший последний" элемент. (first^.prev который).
      Его поле next должно указывать куда? Правильно, на добавляемый элемент,
      иначе связи порушатся и при обходе списка будет бред.

      3) ну, и про то, что "голова" списка должна теперь указывать prev-ом на новый
      элемент, он ведь находится в списке ПЕРЕД "головой" - тоже не забываем...
    }
    p^.next := first;
    p^.prev := first^.prev;
    first^.prev^.next := p;
    first^.prev := p;
  end;

end;

Еще раз: берешь несколько листов бумаги и карандаш, чертишь на них списки и меняешь связи, пока не поймешь и не будет от зубов отлетать, что и как и почему именно в этом порядке (сменишь порядок пунктов 1, 2, 3 - будут проблемы)... Иначе так и будешь путаться в кольцевых списках.

[ikorstenxl]

большое спасибо, сижу разбираюсь.