Текст модуля uOrderedList
unit UOrderedList;
interface
uses UFrac,UList, SysUtils;
type
OrdList=PList;
OrdIntType=file of T;
//----------------Вызов главного меню-------------------------------------------
procedure MainMenu(o:ordlist;var f:OrdIntType);
//----------------Проверка на пустоту списка------------------------------------
function OrdIsEmpty(o:ordlist): Boolean;
//----------------Преобразование типизированного файла в список-----------------
function DatInOrd(var f:OrdIntType):OrdList;
//----------------Преобразование списка в файл----------------------------------
procedure OrdInDat(o:ordlist;var f:OrdIntType);
//----------------Ссылка на место вставки---------------------------------------
function InsPos(o:ordlist;a:t):pnode;
//----------------Вывод списка в строку-----------------------------------------
function OrdInStr(o:ordlist):string;
//----------------Нахождение размера списка-------------------------------------
function OrdSize(o:ordlist):integer;
//----------------Вывод элемента по индексу-------------------------------------
function OrdFind(o:ordlist; j:integer):t;
//----------------Очищение списка-----------------------------------------------
procedure OrdEmptyList(o: ordList);
//----------------Вывод индекса нужного элемента--------------------------------
function OrdFindElm(o:ordlist; j:t):integer;
//----------------Удаляет нужный элемент----------------------------------------
procedure OrdDelElmnt(o: ordlist;a:t);
//----------------Вставить значение---------------------------------------------
procedure Inserto(var o:ordlist; a:t);
implementation
//------------------------------------------------------------------------------
procedure OrdInDat(o:ordlist;var f:OrdIntType);
var i:integer; p:pnode;
begin
i:=1;
rewrite(f);
p:=o.first;
while i<>size(o)+1 do
begin
write(f,p.key);
p:=p.next;
i:=i+1;
end;
closefile(f);
end;
//------------------------------------------------------------------------------
function DatInOrd(var f:OrdIntType):OrdList;
var i:T;
begin
i.num:=0;i.denom:=0;
reset(f);
result:=createl;
while not eof(f) do
begin
read(f,i);
inserto(result,i);
end;
closefile(f);
end;
//------------------------------------------------------------------------------
procedure MainMenu(o:ordlist;var f:OrdIntType);
var i,k:integer;z:T;
begin
o:=DatInOrd(f);
i:=0; reset(f);
while i<>8 do
begin
writeln('//----------------------------------------------------------------');
writeln('1-Ввод элемента');
writeln('2-Вывод списка');
writeln('3-Подсчет количества элементов');
writeln('4-Вывод элемента по номеру его индекса');
writeln('5-Опустошить список');
writeln('6-Проверить наличие элемента');
writeln('7-Удалить элемент из списка');
writeln('8-Выход');
writeln('//----------------------------------------------------------------');
Write('Введите номер операции: ');
read(i);
if (ordisempty(o))then
begin
if i=1 then
begin
writeln('Введите элемент списка - простая дробь: ');
InputF(z);
inserto(o,z);
end
else writeln('Эту операцию нельзя выполнить на пустом списке');
end
else
case i of
1:begin
writeln('Введите элемент списка - простая дробь: ');
InputF(z);
inserto(o,z);
end;
2:writeln(OrdInStr(o));
3:writeln('Размер: ',OrdSize(o));
4:begin
write('Введите индекс элемента: ');
readln(k);
if OrdSize(o)>=k
then begin
z:=OrdFind(o,k);
writeln('Элемент с индексом ', k, ': ',FracToStr(z));
end else writeln('Такой простой дроби нет');
end;
5:begin
OrdEmptyList(o);
writeln('Список опустошен');
end;
6: begin
writeln('Введите элемент - простая дробь: ');
InputF(z);
if OrdFindElm(o,z)<>-1
then writeln('Элемент ',FracToStr(z),' с индексом: ',OrdFindElm(o,z))
else writeln('Такой простой дроби нет');
end;
7:begin
Writeln('Введите элемент для удаления - простая дробь: ');
InputF(z);
if ordFindElm(o,z)<>-1
then OrdDelElmnt(o,z)
else writeln('Такой простой дроби нет');
end;
else begin
OrdInDat(o,f);
DelList(o);
exit;
end;
end;
end;
OrdInDat(o,f);
DelList(o);
end;
//------------------------------------------------------------------------------
function OrdIsEmpty(o:ordlist): Boolean;
begin
Result:= False;
if o <> nil
then if o^.first = nil
then Result:= True;
end;
//------------------------------------------------------------------------------
function InsPos(o:ordlist;a:t):pnode;
var p:pnode;
begin
result:=o.first;
p:=o.first;
while FindIfSmaller(a,p.key) do
p:=p.next;
result:=p;
end;
//------------------------------------------------------------------------------
function OrdInStr(o:ordlist):string;
var p: PNode;
begin
if o <> nil
then
begin
Result:= 'Размер = ' + IntToStr(OrdSize(o)) + '| Элементы: ';
p:= o^.first;
while p <> nil do
begin
Result:=Result+FracToStr(p^.key)+', ';
p:= p^.next
end;
delete(result,length(result)-1,2);
end
else
Result:= 'List not exist';
end;
//------------------------------------------------------------------------------
function OrdSize(o:ordlist):integer;
begin
begin
if o <> nil
then
Result:= o^.size
else//Список не существует
raise EListEmpty.Create('List is empty');//Result:= -1
end
end;
//------------------------------------------------------------------------------
function OrdFind(o:ordlist; j:integer):t;
var i:integer; k:pnode;
begin
i:=1;
k:=o.first;
if j<Ordsize(o) then
begin
while i<>j+1 do
begin i:=i+1; k:=k.next; end;
result:=k.key;
end;
end;
//------------------------------------------------------------------------------
procedure OrdEmptyList(o: ordList);
begin
if o <> nil then
while o^.size <> 0 do Head(o)
end;
//------------------------------------------------------------------------------
function OrdFindElm(o:ordlist; j:t):integer;
var p:pnode; i:integer;
begin
result:=-1;
p:=o.first;
i:=0;
while (not EqualF(j,p^.key)) and (p^.next<>nil) do begin
p:=p.next;
i:=i+1;
end;
if EqualF(j,p^.key) then result:=i;
end;
//------------------------------------------------------------------------------
procedure OrdDelElmnt(o: ordlist;a:t);
var p,l,z:pnode;
begin
p:=o.first;
while not EqualF(a,p^.key) do begin l:=p; p:=p.next; end;
while EqualF(a,p^.key) do begin
p^.key.num:=0;
p^.key.denom:=1;
z:=p.next;
p.next:=nil;
p:=z;
o.size:=o.size-1;
end;
l.next:=p;
end;
//------------------------------------------------------------------------------
function MinEl(o:ordlist):Frac;
begin
result:=o.last.key;
end;
//------------------------------------------------------------------------------
procedure Inserto(var o:ordlist; a:t);
begin
if o.first=nil then
addleft(o,a)
else
if EqualF(o.first.key,a)then
addleft (o,a)
else
if FindIfSmaller(a,o^.first.key) then
if (OrdSize(o)<2) or (FindIfSmaller(a,MinEl(o)))then
addright(o,a)
else AddinPos(o,a,inspos(o,a))
else addleft(o,a)
end;
//------------------------------------------------------------------------------
end.