Текст модуля uList
unit UList;
interface
uses UFrac, SysUtils;
type
//---------------------Исключительные ситуации----------------------------------
EListEmpty = class(Exception)
end;
//---------------------Тип элементов списка-------------------------------------
T = Frac;
//---------------------Узел списка----------------------------------------------
PNode = ^Node;
Node = record
key : T;
next : PNode;
end;
//--------------------Дескриптор списка-----------------------------------------
PList = ^List;
List = record
first: PNode;//указатель на первый элемент списка
last : PNode;//указатель на последний элемент списка
size : integer;//число элементов в списке
end;
//--Операции на списке----------------------------------------------------------
//--------------------Создать пустой список-------------------------------------
function CreateL: PList;
//--------------------Число элементов списка------------------------------------
function Size(L: PList): integer;
//--------------------Список пуст-----------------------------------------------
function IsEmpty(L: PList): Boolean;
//--------------------Взять голову списка (слева)-------------------------------
function Head(L: PList): T;
//--------------------Добавить элемент к списку (справа)------------------------
procedure AddRight(L: PList; E: T);
//--------------------Добавить элемент к списку (слева)-------------------------
procedure AddLeft(L: PList; E: T);
//--------------------Объединить два списка в один------------------------------
procedure Merge(L,T: PList);
//---------------------Освобождает выделенную под список память-----------------
procedure DelList(var L: PList);
//--------------------Выводит значения элементов списка в строку--------------
function ListToStr(L: PList): String;
//--------------------Вставляет в заданную позицию списка новый узел------------
procedure AddInPos(var L:plist; a:t; p:pnode);
implementation
//------------------------------------------------------------------------------
function ListToStr(L: PList): String;
//Распечатывает поле key всех элементов списка,
//начиная с головы списка
var p: PNode;
begin
if L <> nil
then
begin
if Size(L) = 0 then begin Result:= Result + 'no elements'; exit end;
Result:= 'Size = ' + IntToStr(Size(L)) + '| Elements: ';
p:= L^.first;
while p <> nil do
begin
Result:=Result+'('+FracToStr(p^.key)+'),';
p:= p^.next
end;
delete(result,length(result),1);
end
else
Result:= 'List not exist';
end;
//------------------------------------------------------------------------------
function PredLast(L: PList; var Pred: PNode): PNode;
//Возвращает укзатель на предпоследний и последний элементы списка
//В случае отсутствия последнего и/или предпоследнего узла - возвращается nil.
begin
Pred:= nil;
if (L <> nil) then
with L^ do
case size of
0: begin Result:= nil end;
1: begin Result:= first; Pred:= nil end;
else
Result:= first;
while Result^.next <> nil do
begin
pred:= Result;
Result:= Result^.next;
end;
end
else
Result:= nil;
end;
//------------------------------------------------------------------------------
function CreateE(key: T): PNode;
//Создаёт элемент списка
begin
try
new(Result);
Result^.key:= key;
Result^.next:= nil
except
on EOutOfMemory do begin
raise;
end;
end;
end;
//------------------------------------------------------------------------------
function CreateL: PList;
//Создаёт пустой список
begin
try
new(Result);
Result^.first:= nil;
Result^.last:= nil;
Result^.size:= 0
except
on EOutOfMemory do begin
raise;
end;
end;
end;
//------------------------------------------------------------------------------
function Size(L: PList): integer;
//Возвращет число элементов списка L
begin
if L <> nil
then
Result:= L^.size
else//Список не существует
begin
raise EListEmpty.Create('List is empty');
Result:= -1;
end;
end;
//------------------------------------------------------------------------------
function IsEmpty(L: PList): Boolean;
//Определяет пуст ли список L
begin
Result:= False;
if L <> nil
then
if L^.first = nil
then
Result:= True;
end;
//------------------------------------------------------------------------------
procedure AddRight(L: PList; E: T);
//Добавляет элемент к списку справа
begin
if (L <> nil)
then
with L^ do
case size of
0: begin
first:= CreateE(E);
last:= first;
inc(size)
end;
else
Last^.next:= CreateE(E);
Last:= Last^.next;
inc(size)
end
end;
//------------------------------------------------------------------------------
procedure AddLeft(L: PList; E: T);
//Добавляет элемент к списку слева
var p: PNode;
begin
if (L <> nil)
then
with L^ do
case size of
0: begin
first:= CreateE(E);
last:= first;
inc(size)
end;
else
p:= CreateE(E);
p^.next:= First;
First:= p;
inc(size)
end
end;
//------------------------------------------------------------------------------
function Head(L: PList): T;
//Выделяет из списка L элемент списка, который является его головой,
//и возвращает указатель на него
var p: PNode;
begin
if L = nil
then//Список не существует
exit;
with L^ do begin
if size = 0
then // Список пуст
begin raise EListEmpty.Create('Список пуст'); exit end;
Result:= first^.key;
p:= first;
first:= first^.next;
dispose(p);
dec(size);
if size = 0
then
begin last:= nil; first:= nil end
end
end;
//------------------------------------------------------------------------------
procedure EmptyList(L: PList);
//Опустошает список
begin
if L <> nil then
while L^.size <> 0 do Head(L)
end;
//------------------------------------------------------------------------------
procedure Merge(L,T: PList);
//Объединяет два списка
begin
if (T = nil) and (L = nil)
then exit;
if (IsEmpty(L) and IsEmpty(T)) or IsEmpty(T) then exit;
if IsEmpty(L) and not IsEmpty(T) then
begin
L^.first:= T^.first;
L^.size := T^.size;
L^.last := T^.last;
T^.size:= 0;
T^.first:= nil;
T^.Last:= nil;
exit;
end;
with L^ do
begin
Last^.next:= T^.First;
Last:= T^.Last;
size:= T^.size + size
end;
T^.size:= 0;
T^.first:= nil;
T^.Last:= nil;
end;
//------------------------------------------------------------------------------
procedure DelList(var L: PList);
//Удаляет список из памяти
begin
if L <> nil then begin
EmptyList(L);
Dispose(L);
L:= nil;
end;
end;
//------------------------------------------------------------------------------
procedure AddInPos(var L:plist; a:t; p:pnode);
var z:plist; k:pnode;
begin
z:=createl;
k:=l.first;
while k.next<>p do
k:=k.next;
z.first:=k.next;
z.last:=l.last;
k.next:=nil;
l.last:=k;
addright(l,a);
merge(l,z);
end;
//------------------------------------------------------------------------------
end.