2015-10-22
225Лабораторная работа №2 «Односвязные списки».
Код программы:
Program Spisok;
Uses
crt; {Для использования readkey и clrscr}
Type
Tinf=integer; {тип данных, который будет храниться в элементе списка}
List=^TList; {Указатель на элемент типа TList}
TList= record {А это наименование нашего типа "запись" обычно динамические структуры описываются через запись}
data:TInf; {данные, хранимые в элементе}
next:List; {указатель на следующий элемент списка}
end;
{Процедура добавления нового элемента в односвязный список}
procedure AddElem(var spis1:List;znach1:TInf);
Var
tmp:List;
Begin
if spis1=nil then {Проверяем не пуст ли список, если пуст, то }
Begin
GetMem(spis1, sizeof (TList)); {создаём его первый элемент}
tmp:=spis1;
End
else {в случае если список не пуст}
Begin
tmp:=spis1;
while tmp^.next<>nil do
tmp:=tmp^.next; {ставим tmp на последний элемент списка}
GetMem(tmp^.next, sizeof (TList)); {создаём следующий элемент}
tmp:=tmp^.next; {переносим tmp на новый элемент}
end;
tmp^.next:=nil; {зануляем указатель}
tmp^.data:=znach1; {заносим значение}
end;
{процедура печати списка
полностью расписана при работе со стеком}
|
|
|
procedure Print(spis1:List);
Begin
if spis1=nil then
Begin
writeln('Список пуст.');
exit;
end;
while spis1<>nil do
Begin
Write(spis1^.data, ' ');
spis1:=spis1^.next
end;
end;
{процедура удаления списка
полностью расписана при работе со стеком}
Procedure FreeStek(spis1:List);
Var
tmp:List;
Begin
while spis1<>nil do
Begin
tmp:=spis1;
spis1:=spis1^.next;
FreeMem(tmp, SizeOf (Tlist));
end;
end;
{процедура поиска в списке
полностью расписана при работе со стеком}
Function SearchElemZnach(spis1:List;znach1:TInf):List;
Begin
if spis1<>nil then
while (Spis1<>nil) and (znach1<>spis1^.data) do
spis1:=spis1^.next;
SearchElemZnach:=spis1;
end;
{процедура удаления элемента
полностью расписана при работе со стеком}
Procedure DelElem(var spis1:List;tmp:List);
Var
tmpi:List;
Begin
if (spis1=nil) or (tmp=nil) then
exit;
if tmp=spis1 then
Begin
spis1:=tmp^.next;
FreeMem(tmp, SizeOf (TList));
End
Else
Begin
tmpi:=spis1;
while tmpi^.next<>tmp do
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next;
FreeMem(tmp, sizeof (TList));
end;
end;
{процедура удаления элемента по значению
полностью расписана при работе со стеком}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
Var
tmp:List;
Begin
if Spis1=nil then
Begin
Writeln('Список пуст');
exit;
end;
tmp:=SearchElemZnach(spis1,znach1);
if tmp=nil then
Begin
writeln('Элемент с искомым значением ',znach1, ' отсутствует в списке');
exit;
end;
DelElem(spis1,tmp);
Writeln('Элемент удалён');
end;
{процедура удаления элемента по позиции
полностью расписана при работе со стеком}
Procedure DelElemPos(var spis1:List;posi:integer);
Var
i:integer;
tmp:List;
Begin
if posi<1 then
exit;
if spis1=nil then
Begin
Write('Список пуст');
Exit
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
Begin
tmp:=tmp^.next;
inc(i)
end;
if tmp=nil then
Begin
Writeln('Элемента с порядковым номером ',posi, ' Нет в списке.');
writeln('В списке всего ',i-1, ' элементов');
Exit
end;
DelElem(spis1,tmp);
|
|
|
Writeln('Элемент удалён');
end;
{Процедура сортировки "пузырьком" с изменением только данных
полностью расписана при работе со стеком}
procedure SortBublInf(nach:list);
Var
tmp,rab:List;
tmps:Tinf;
Begin
GetMem(tmp, SizeOf (Tlist));
rab:=nach;
while rab<>nil do
Begin
tmp:=rab^.next;
while tmp<>nil do
Begin
if tmp^.data<rab^.data then
Begin
tmps:=tmp^.data;
tmp^.data:=rab^.data;
rab^.data:=tmps
end;
tmp:=tmp^.next
end;
rab:=rab^.next
End
end;
{Процедура сортировки "пузырьком" с изменением только адресов
полностью расписана при работе со стеком}
procedure SortBublLink(nach:List);
Var
tmp,pered,pered1,pocle,rab:List;
Begin
rab:=nach;
while rab<>nil do
Begin
tmp:=rab^.next;
while tmp<>nil do
Begin
if tmp^.data<rab^.data then
Begin
pered:=nach;
pered1:=nach;
if rab<>nach then
while pered^.next<>rab do pered:=pered^.next;
while pered1^.next<>tmp do pered1:=pered1^.next;
pocle:=tmp^.next;
if rab^.next=tmp then
Begin
tmp^.next:=rab;
rab^.next:=pocle
End
Else
Begin
tmp^.next:=rab^.next;
rab^.next:=pocle;
end;
if pered1<>rab then
pered1^.next:=rab;
if rab<>nach then
pered^.next:=tmp
Else
nach:=tmp;
pered1:=tmp;
tmp:=rab;
rab:=pered1;
end;
tmp:=tmp^.next;
end;
rab:=rab^.next;
end;
end;
Var
Spis,tmpl:List;
znach:integer;
ch:char;
Begin
Spis:=nil;
Repeat
clrscr;
Write('Программа для работы со ');
TextColor(4);
Writeln('списком.');
TextColor(7);
Writeln('Выберите желаемое действие:');
Writeln('1) Добавить элемент.');
Writeln('2) Вывод списка.');
Writeln('3) Удаление элемента по значению.');
Writeln('4) Удаление элемента по порядковому номеру.');
Writeln('5) Поиск элемента по значению.');
Writeln('8) Выход.');
writeln;
ch:=readkey;
case ch of
'1': begin
write('Введите значение добавляемого элемента ');
readln(znach);
AddElem(Spis,znach);
end;
'2': begin
clrscr;
Print(Spis);
readkey;
end;
'3': begin
Write('Введите значение удаляемого элемента ');
readln(znach);
DelElemZnach(Spis,znach);
readkey;
end;
'4': begin
Write('Введите порядковый номер удаляемого элемента ');
readln(znach);
DelElemPos(Spis,znach);
readkey;
end;
'5': begin
write('Введите значение искомого элемента ');
readln(znach);
tmpl:=SearchElemZnach(Spis,znach);
if tmpl=nil then
write('Искомый элемент отсутствует в списке')
Else
write('Элемент ',tmpl^.data,' найден');
readkey;
end;
end;
until ch='8';
FreeStek(Spis);
end.
Отладка:
 |
Выполнил: Гриненко А.А. ФАУ2-1
