- Код: Выделить всё
program lab3;
uses Crt;
const
chis=['1'..'2'];{Массив для работы меню}
type
PInf = ^TInf;
TInf = record {Запись для элемента очереди}
num:Integer; {Число }
next:PInf; {Указатель на следующий элемент очереди}
end;
var
c,m:Longint; {Количество операций сравнения и пересылок}
key:char; {Переменная для работы меню}
keys,kn:integer;
ftext:text; {Переменная для работы с текстовым файлом}
txt_filename:string[9]; {Переменная для определения имени файла}
function IsQueueEmpty(qHead, qTail:PInf):Boolean;{Функция проверки очереди на пустоту}
begin
IsQueueEmpty:=qHead=nil;
end;
procedure SetQueueNext(var qHead, qTail:PInf; next:PInf);{Процедура устанавливает следующий элемент очереди}
begin
if IsQueueEmpty(qHead, qTail) then begin
qHead:=next
end
else begin
qTail^.next:=next;
end;
qTail:=next;
end;
procedure AddQueueNext(var qHead, qTail:PInf; num:Integer);{Процедура добавления нового элемента в очередь}
var
p:PInf;
begin
New(p);
p^.num:=num;
p^.next:=nil;
SetQueueNext(qHead, qTail, p);
end;
procedure EmptyQueue(var qHead, qTail:PInf);{Процедура очистки очереди}
begin
qHead:=nil;
qTail:=nil;
end;
procedure RandomQueue(var qHead, qTail:PInf);{Процедура заполнения очереди случайными числами от 0 до 99}
var
i:Integer;
begin
Randomize;
for i:=1 to kn do
AddQueueNext(qHead, qTail, Random(100));
end;
procedure pr_DirectFusion(var qHead, qTail:PInf); {Процедура сортировки очереди методом прямого слияния}
var
aHead:array[0..1] of PInf; {Указатели на начала рабочих очередей }
aTail:array[0..1] of PInf; {Указатели на концы рабочих очередей }
cHead:array[0..1] of PInf; {Указатели на начала очередей для слияния }
cTail:array[0..1] of PInf; {Указатели на концы очередей для слияния }
qr:array[0..1] of Integer; {Размеры серий для рабочих очередей }
i,k,n,p:Integer;
p1:PInf;
begin
c:=0;
m:=0;
for i:=0 to 1 do
EmptyQueue(aHead[i], aTail[i]);
n:=0;
k:=0;
p1:=qHead;
while p1<>nil do begin {Делаем расщепление очереди на 2 очереди}
SetQueueNext(aHead[k], aTail[k], p1);
Inc(m);
Inc(n);
k:=1-k; {Меняем очередь на другую }
p1:=p1^.next;
end;
for k:=0 to 1 do
aTail[k]^.next:= nil;
p:=1; {Начинаем основной алгоритм сортировки }
while p<n do begin
for k:=0 to 1 do
EmptyQueue(cHead[k], cTail[k]);
i:=0;
{Пока в рабочих очередях есть элементы }
while (aHead[0]<>nil) or (aHead[1]<>nil) do begin
for k:=0 to 1 do begin
qr[k]:=0;
if aHead[k] <> nil then
qr[k]:=p;
end;
{Реализовываем алгоритм слияния }
while (qr[0] > 0) and (qr[1] > 0) do begin
case aHead[0]^.num < aHead[1]^.num of
True:k:=0;
False:k:=1;
end;
Inc(c);
SetQueueNext(cHead[i], cTail[i], aHead[k]);
Inc(m);
{Перемещаем указатель начала рабочей очереди вперед }
aHead[k]:=aHead[k]^.next;
if aHead[k] <> nil then
Dec(qr[k])
else
qr[k]:=0;
end;
k:=-1;
if qr[0] > 0 then {Если в рабочей очереди 0 еще остались элементы }
k:=0
else if qr[1] > 0 then {Если в рабочей очереди 0 еще остались элементы }
k:=1;
if k in [0,1] then
while (qr[k]>0) and (aHead[k]<>nil) do begin
SetQueueNext(cHead[i],cTail[i],aHead[k]);
Inc(m);
aHead[k]:=aHead[k]^.next;
Dec(qr[k]);
end;
i:=1-i;
end;
for k:=0 to 1 do begin
cTail[k]^.next:=nil;
end;
for k:=0 to 1 do begin
aHead[k]:=cHead[k]; {Получаем новые рабочие очереди }
end;
p:=2*p; {Увеличиваем размер серии }
end;
qHead:=cHead[0];
qTail:=cTail[0];
end;
{ Возвращает из числа num цифру с номером digitNo, при условии, что
в числе всего digitsNumber цифр }
function Digit(num, digitsNumber, digitNo: Integer): Integer;
var
i:Integer;
s:String;
begin
Str(num,s);
while Length(s) < digitsNumber do
s:='0'+s;
Digit:= Ord(s[digitNo]) - Ord('0');
end;
procedure ConcatQueues(var q1Head, q1Tail: PInf; q2Head, q2Tail: PInf);{Процедура Объединения двух очередей}
begin
if IsQueueEmpty(q2Head, q2Tail) then
Exit;
if IsQueueEmpty(q1Head, q1Tail) then begin
q1Head := q2Head;
q1Tail := q2Tail;
end
else begin
q1Tail^.next := q2Head;
q1Tail := q2Tail;
end;
end;
procedure pr_DigitalSorting(var qHead, qTail:PInf);{Процедура цифровой сортировки очереди}
const
l= 2; {Количество байт для сравнения}
mm= 10; {Количество очередей}
var
qmHead: array[0..mm - 1] of PInf; {Головы очередей}
qmTail: array[0..mm - 1] of PInf; {Хвосты очередей}
i,d,j:Integer;
p,pTmp:PInf;
begin
c:=0;
m:=0;
for j:=l downto 1 do begin
for i:=0 to mm-1 do {Делаем очереди пустыми}
EmptyQueue(qmHead[i], qmTail[i]);
p:=qHead;
while p<>nil do begin {Заполняем очереди}
d:=Digit(p^.num, l, j);
pTmp:=p;
p:=p^.next;
SetQueueNext(qmHead[d], qmTail[d], pTmp);
qmTail[d]^.next:=nil;
Inc(m);
end;
EmptyQueue(qHead, qTail);
for i:=0 to mm-1 do begin { Объединяем все очереди в одну }
ConcatQueues(qHead, qTail, qmHead[i], qmTail[i]);
Inc(m);
end;
end;
end;
procedure PrintQueue(qHead, qTail:PInf);{Процедура вывода очереди на экран и в файл}
var
p:PInf;
begin
p:=qHead;
while p<>nil do begin
Write(p^.num,' ');
write(ftext, p^.num,' ');
p:=p^.next;
end;
Writeln;
writeln(ftext);
end;
procedure PrintInf;{Процедура вывода на экран количества операций сравнения и пересылок}
begin
Writeln('C = ', c, ', M = ', m);
writeln(ftext, 'C = ', c, ', M = ', m);
end;
procedure Print(var qHead, qTail:PInf; s:String; keys:integer);{Процедура вывода на экран информации об очереди}
begin
Writeln(s,':');
writeln(ftext, s,':');
PrintQueue(qHead, qTail);
Writeln;
writeln(ftext);
case keys of {Запуск процедуры сортировки масива взависимости от выбора в меню}
1:pr_DirectFusion(qHead, qTail);
2:pr_DigitalSorting(qHead, qTail);
end;
Writeln('Последовательность после сортировки:');
writeln(ftext,'Последовательность после сортировки:');
PrintQueue(qHead, qTail);
Writeln;
writeln(ftext);
PrintInf;
Writeln('Для продолжения нажмите любую клавишу...');
ReadKey;
end;
var
qHead,qTail:PInf; {Указатели на начало и конец очереди }
begin
ClrScr;
Writeln('Меню выбора метода сортировки последовательности целых чисел:');
Writeln('1. Метод прямого слияния');
Writeln('2. Методом цифровой сортировки');
Write('Нажмите клавишу 1, 2');
repeat
key:=readkey;
until (key in chis);
keys:=integer(key)-48;
str(keys:1,txt_filename);
txt_filename:='lab3' + txt_filename + '.txt';
assign(ftext, txt_filename); {Создаем текстовый файл lab1+метод.txt}
{$I-}Reset(ftext);{$I+} {Ловим ошибку при отсутствии файла}
if IOResult = 2 then begin
Rewrite(ftext);{Если нет файла, создаем}
end
else begin
Append(ftext);
end;
case keys of
1:writeln(ftext, 'Метод прямого слияния');
2:writeln(ftext, 'Методом цифровой сортировки');
end;
ClrScr;
Write('Введите количество элементов в последовательности:');
Readln(kn);
writeln(ftext, 'количество элементов в последовательности - ',kn);
Writeln;
RandomQueue(qHead, qTail);{Генерация элементов}
Print(qHead, qTail, 'Случайная последовательность',keys);
Writeln;
writeln(ftext);
Print(qHead, qTail, 'Упорядоченная последовательность',keys);
close(ftext);
Writeln('Для выхода из программы нажмите любую клавишу...');
ReadKey;
end.
