двунаправленные списки Паскаль

[mishammm]

Здраствуйте. Помогите плиз переделать программку под двунаправленные списки. В программе нужно было создать телефонный справочник и сделать процедуру удаления по фамилии.
Собственно вот сама программа:

uses 
    crt;

type
student = record
surname:String[30];
nomer:integer;
end;
ptr=^item;
item=record
data:student;
next:ptr;
end;
var sp:array[1..4] of student;
head,newptr,current,previous:ptr;
i,num_i:integer;
ch,key:char;
n:integer;
st:student;
flag:boolean;
procedure createfirstitem;
begin
head:=newptr;
head^.next:=nil;
end;


procedure insertInBeginning;
begin
newptr^.next:=head;
head:=newptr;
end;



procedure searchPlaceInsert(value:student);
begin
current:=head;
repeat
previous:=current;
current:=current^.next;
if current=nil then
flag:=true
else
begin
if current^.data.surname >= value.surname then
flag:=true
else flag:=false;
end;
until flag;
end;



procedure insertintomiddle;
begin
previous^.next:=newptr;
newptr^.next:=current;
end;




procedure insert(value:student);
begin
new(newptr);
newptr^.data:=value;
if head=nil then
createfirstitem
else
if value.surname<=head^.data.surname then
insertinbeginning
else 
begin
searchplaceinsert(value);
insertintomiddle;
end;
end;



procedure delfirst;
begin
head:=current^.next;
dispose(current);
end;
function searchplacedelete(value:string):boolean;
begin
repeat
previous:=current;
current:=current^.next;
until (current^.data.surname=value) or (current^.next=nil);
if current^.data.surname=value then
searchplacedelete:=true
else
searchplacedelete:=false;
end;



procedure delmiddle;
begin
previous^.next:=current^.next;
dispose(current);
end;



procedure delete;
var str:string;
begin
if head=nil then
begin
writeln('List empty');
end
else
begin
write('Enter surname to delete: ');
readln(str);
current:=head;
if current^.data.surname=str then delfirst
else if (searchplacedelete(str)=true) then
delmiddle
else
begin
writeln('Isnt found');
end;
end;
end;




procedure outlist;
begin
current:=head;
if current=nil then
writeln('list is empty')
else
begin
writeln('output list');
repeat
write(current^.data.surname,' ');
current:=current^.next;
until current=nil;
end;
writeln;
end;

procedure Line(m:integer);
var i:integer;
begin
for i:=1 to m do
write('-');
writeln;
end;




Begin
n:=0;

repeat

writeln('1. Add element');
writeln('2. Output');
writeln('3. Delete element');
writeln('4. Exit');
ch:=readkey;
clrscr;
case ch of
'1':
begin
write('Prizvishe: ');
readln(st.surname);
write('nomer');
readln(st.nomer);
insert(st);
n:=n+1;
end;




'2':begin

Line(69);
  writeln('|   | Призвіще | Nomer |');
  
  Line(69);

current:=head;
for i := 1 to n do
  begin
  st:=current^.data;
    write(st.surname:15,'|',st.nomer: 15, '|');
    writeln;
    current:=current^.next;
    end;
    end;
   
  
  
  '3' :begin
delete;
n:=n-1;
end;
end
until ch='4';
end.

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

[mishammm]

ну хоть процедуры какие будут меняться? я понимаю лень копаться в коде моём. пожалуйста

[reflexx]

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

ну хоть процедуры какие будут меняться? я понимаю лень копаться в коде моём. пожалуйста

В структуре нужно добавить указатель на предыдущий элемент:

ptr = ^item;
item = record
  data: student;
  back: ptr:
  next: ptr;
end;

При добавлении элемента нужно указать на предыдущий элемент:
1. Прокрутить список до предпоследнего элемента
2. Создать новый элемент
3. Присвоить указатель предпоследнего элемента указателю "назад" нового элемента

Должна "облегчится" процедура удаления из середины:
1. Прокрутить список до элемента, который нужно удалить (удаляемый элемент)
2. Указатель "назад" удаляемого элемента указывает на элемент ниже (элемент ниже удаляемого) и указателю "вперёд" элемента ниже удаляемого присваиваем
указатель "вперёд" удаляемого элемента.
3. Не забываем разрушить удаляемый элемент.

P.S Если бы код был читаемым, то глянул бы, а так извини - без обид. Используй табуляцию и не используй глобальные переменные в подпрограммах и может тебе начнут помогать.

[Serge_Bliznykov]

позволил себе отформатировать код TC (в коде ничего не правил!)

uses
  crt;

type
  student = record
    surname: string[30];
    nomer: integer;
  end;
  ptr = ^item;
  item = record
    data: student;
    next: ptr;
  end;
var sp: array[1..4] of student;
  head, newptr, current, previous: ptr;
  i, num_i: integer;
  ch, key: char;
  n: integer;
  st: student;
  flag: boolean;

procedure createfirstitem;
begin
  head := newptr;
  head^.next := nil;
end;

procedure insertInBeginning;
begin
  newptr^.next := head;
  head := newptr;
end;

procedure searchPlaceInsert(value: student);
begin
  current := head;
  repeat
    previous := current;
    current := current^.next;
    if current = nil then
      flag := true
    else
    begin
      if current^.data.surname >= value.surname then
        flag := true
      else flag := false;
    end;
  until flag;
end;

procedure insertintomiddle;
begin
  previous^.next := newptr;
  newptr^.next := current;
end;

procedure insert(value: student);
begin
  new(newptr);
  newptr^.data := value;
  if head = nil then
    createfirstitem
  else
    if value.surname <= head^.data.surname then
      insertinbeginning
    else
    begin
      searchplaceinsert(value);
      insertintomiddle;
    end;
end;

procedure delfirst;
begin
  head := current^.next;
  dispose(current);
end;

function searchplacedelete(value: string): boolean;
begin
  repeat
    previous := current;
    current := current^.next;
  until (current^.data.surname = value) or (current^.next = nil);
  if current^.data.surname = value then
    searchplacedelete := true
  else
    searchplacedelete := false;
end;

procedure delmiddle;
begin
  previous^.next := current^.next;
  dispose(current);
end;

procedure delete;
var str: string;
begin
  if head = nil then
  begin
    writeln('List empty');
  end
  else
  begin
    write('Enter surname to delete: ');
    readln(str);
    current := head;
    if current^.data.surname = str then delfirst
    else if (searchplacedelete(str) = true) then
      delmiddle
    else
    begin
      writeln('Isnt found');
    end;
  end;
end;

procedure outlist;
begin
  current := head;
  if current = nil then
    writeln('list is empty')
  else
  begin
    writeln('output list');
    repeat
      write(current^.data.surname, ' ');
      current := current^.next;
    until current = nil;
  end;
  writeln;
end;

procedure Line(m: integer);
var i: integer;
begin
  for i := 1 to m do
    write('-');
  writeln;
end;

begin
  n := 0;

  repeat

    writeln('1. Add element');
    writeln('2. Output');
    writeln('3. Delete element');
    writeln('4. Exit');
    ch := readkey;
    clrscr;
    case ch of
      '1':
        begin
          write('Prizvishe: ');
          readln(st.surname);
          write('nomer');
          readln(st.nomer);
          insert(st);
          n := n + 1;
        end;

      '2': begin

          Line(69);
          writeln('|   | Призвіще | Nomer |');
          Line(69);
          current := head;
          for i := 1 to n do
          begin
            st := current^.data;
            write(st.surname: 15, '|', st.nomer: 15, '|');
            writeln;
            current := current^.next;
          end;
        end;

      '3': begin
          delete;
          n := n - 1;
        end;
    end
  until ch = '4';
end.

[mishammm]

благодарю за форматирование,

[Serge_Bliznykov]

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

благодарю за форматирование,

всегда пожалуйста!

вы по сути то разобрались, куда Вам дальше идти и что делать,чтобы списки стали двухнаправленными?