посмотрите пожалуйста ошибки, удаление n-го элемента почему то не работает, а так же нужно сделать:
- объединение 2 списков по операции "ИЛИ"
- объединение 2 упорядоченных списков в 1 упорядоченный,
- Создание списка, содержащего элементы, общие для двух других
списков,
- Вставка элемента после η-го элемента списка.
- Удаление из списка каждого второго элемента,
- Перемещение элемента node(p) на η позиций вперед по списку,
- Создание копии списка.
заранее спасибо!
Код:
uses crt;
type
data = integer;
spisok = ^spisoktype;
spisoktype = record
number: data;
next: spisok;
end;
var
tek,tek1: spisok;
first,last: spisok;
vop:integer;
i,c: word;
{процедура добавления в конец списка}
procedure addlast(var tek, last: spisok; j: word);
var
point:spisok;
t:spisok;
begin
new(point);
writeln ('введите элемент: ');
readln (point^.number);
writeln;
point^.next :=nil;
if tek = nil then begin
tek := point;
first := tek;
end
else begin
t := tek;
while (t^.next <> nil) do
t := t^.next;
t^.next := point;
last := point;
end;
writeln('Элемент успешно добавлен!');
writeln;
end;
{процедура вывода списка}
procedure Print(tek:spisok);
var
d: word;
begin
d := 0;
if tek=nil then
begin
writeln('Список пуст.');
end;
while tek<>nil do
begin
inc(d);
writeln(d, ' элемент списка: ', tek^.number);
tek:=tek^.next
end;
end;
{процедура удаления последнего элемента списка}
procedure dellast(var tek: spisok; var first, last: spisok);
begin
if (tek^.next = nil) then
first := nil else
while (tek^.next^.next <> nil) do
tek := tek^.next;
dispose(tek^.next);
tek^.next := nil;
writeln('элемент удален');
writeln;
end;
{процедура удаления n-го элемента}
procedure deln(var tek, first, last: spisok);
var
key: word; prev, del: spisok;
begin
prev := nil;
tek := first;
writeln('Введите значение удаляемого элемента: ');
readln(key); // ключ для поиска элемента
writeln;
while tek <> nil do
if tek^.number = key then begin{Если обнаружен элемент, который требуется удалить}
if tek = first then {Если удаляемый элемент является первым элементом списка, то первым элементом списка назначаем следующий элемент}
first := tek^.next
{Если удаляемый элемент не является первым элементом списка, то поле
Next предыдущего элемента теперь должно указывать на элемент, который
является следующим относительно tek}
else
prev^.next := tek^.next;
{Если удаляемый элемент является последним элементом списка, то последним
элементом списка назначаем предыдущий элемент}
if tek = last then
last := prev; {Указатель на удаляемый элемент}
del := tek;{Указатель на следующий элемент}
Dispose(Del); {Освобождение памяти, занятой под элемент}
end
else {Переход к следующему элементу списка.}
begin
prev := tek;
tek := tek^.next;
end;
writeln('Элемент успешно удален!');
writeln;
end;
{сцепление двух списков}
procedure interflow(var tek, tek1, first: spisok);
var
pred1, first1: spisok;
f, o, n, g: word;
begin
writeln;
writeln('Чтобы выполнить сцепление сначала заполните второй список!');
writeln;
writeln('Сколько элементов вставляем? ');
readln(f);
writeln;
new(tek1); // заполнение второго списка
writeln;
writeln('Введите элемент: ');
writeln;
readln(tek1^.number);
tek1^.next := nil;
first1 := tek1;
pred1 := tek1;
for o := 2 to f do
begin
new(tek1);
writeln('Введите элемент: ');
writeln;
pred1^.next := tek1;
readln(tek1^.number);
tek1^.next := nil;
pred1 := tek1;
end;
writeln;
writeln('Первый список: ');
writeln;
print(tek);
writeln;
writeln('Второй список: ');
writeln;
n := 0;
tek1 := first1;
if tek1 = nil then
writeln('Список пуст. ')
else
while tek1 <> nil do
begin
inc(n);
writeln(n, ' элемент списка: ', tek1^.number);
tek1 := tek1^.next;
end;
tek := first;
while (tek^.next <> nil) do tek := tek^.next;
tek^.next := first1;
tek1 := nil;
writeln;
writeln('Сцепление: ');
writeln;
g := 0;
tek := first;
Writeln('Содержимое списка:');
if tek = nil then
writeln('Список пуст. ')
else
while tek <> nil do
begin
inc(g);
writeln(g, ' элемент списка: ', tek^.number);
tek := tek^.next;
end;
end;
{Освобождение всех элементов списка}
procedure releaseall(var tek, first: spisok);
var
temp: spisok;
begin
tek := first;
while (tek <> nil) do
begin
temp := tek^.next;
dispose(tek);
tek := temp;
end;
first := nil;
writeln;
writeln('Все элементы списка успешно освобождены!');
writeln;
end;
{инвертирование списка}
procedure invert(var tek, first, last: spisok);
var
p, t: spisok;
begin
p := nil;
last := first;
while first <> nil do
begin
t := first^.next;
first^.next := p;
p := first;
first := t;
end;
first := p;
writeln;
writeln('Список успешно инвертирован!');
writeln;
end;
begin
repeat
writeln('1: Создание списка, добавление элемента в конец списка.');
writeln('2: Вывод списка на экран.');
writeln('3: Удаление поседнего элемента списка.');
writeln('4: Удаление n-го элемента списка.');
writeln('5: Сцепление двух списков.');
writeln('6: Очижение списка.');
writeln('7: Инвертирование списка.');
writeln('0: Выход');
writeln('');
readln(vop);
writeln('');
case vop of
1:
begin
writeln('сколько элементов вставляем?');
readln(c);
for i := 1 to c do
addlast(tek, last, i);
end;
2: print(tek);
3: dellast(tek, first, last);
4: deln(tek, first, last);
5:
begin
if first = nil then begin
writeln('сначала нужно заполнить первый список!');
end else interflow(tek, tek1, first);
end;
6: releaseall(tek, first);
7:
begin
if (first = nil) or (first^.next = nil) then begin
writeln('Ошибка, список пуст или имеет один элемент!');
end else invert(tek, first, last);
end;
end;
until (vop = 0);
end.
06.05.2016, 16:23
двусвязные, двунаправленные списки
Похожие темы
