Файл: 2. Лекции Паскаль (Часть 2).doc

В том случае, когда не используются средства прямого доступа (процедура типа Seek) алгоритм усложняется.

При слиянии серии основная сложность связана с правильной обработкой конца серии. Признаком конца серии может быть либо прочитанная следующая запись с ключом меньше, чем ключ предыдущей записи, либо конец соответствующего файла. При этом если в первом случае для правильного слияния серий необходимо сравнивать ключи записей в bufa и в bufb, то во втором-достаточно переписать в выходной файл С остаток серии другого файла.

Здесь также необходимо учитывать, что когда достигнут конец файла, в буфере остаётся его последняя запись, которую надо правильно переписать в выходной файл С.

При распределении серий в файла А и В необходимо правильно определять конец серии. Здесь для определения конца серии сравниваем ключ записи, находящийся в буфере (переменная buf) с ключом предыдущей записи (хранится в переменной Х). Если buf.key<x, то в буфере находится запись уже другой серии, которую надо переписать в другой файл.

Ниже приведены тексты процедур разделения и слияния серий, а также основной части программы с подробными комментариями, которые помогут Вам лучше понять предложенный здесь алгоритм.

{сформировать признак конца сортировки}

procedure ended;

begin

reset(a);reset(b);

if eof(a) or eof(b) then {получили одну серию} z:=1;

close(a);close(b);

end;

{разделение файла С на файлы А и В}

procedure distribute;

var buf:item;

x:integer;

pt:boolean;{переключатель выходных файлов}

{если pt=true, то запись в файл А, иначе в файл В}

ok:boolean;{признак нахождения в буфере последней записи серии}

begin

reset(c);rewrite(a);rewrite(b);

pt:=true;

ok:=false;

if not eof(c) then {переписываем в А первую запись из С, её ключ запоминаем в X}

begin

read(c,buf);write(a,buf);x:=buf.key;

end;

if not eof(c) then

begin

read(c,buf);{читаем в буфер вторую запись из С}

repeat {повторять пока не закончится файл С}

while not eof(c) and ((buf.key>=x) or ok) do

{пока не конец С и либо не конец серии, либо в буфере находится запись другой серии}

begin

ok:=false;

if pt then write(a,buf) else write(b,buf);

x:=buf.key;read(c,buf);

end;

if buf.key<x then

{в буфере находится запись уже другой серии и её надо переписать в другой файл}

begin;pt:=not pt;ok:=true;end;

if eof(c) then

{записать в выходной файл последнюю запись файла С, уже прочитанную в буфер}

if pt then write(a,buf) else write(b,buf);

until eof(c);

end;

close(a);close(b);close(c);

end;

{процедура слияния серий}

procedure merge;

var bufa,bufb:item;

xa,xb:integer;

ok,pr1,pr2:boolean;

k1,k2:boolean;

{pr1-признак того, что было прочитано не меньше двух записей файла А}

{pr2-признак того, что было прочитано не меньше двух записей файла В}

{k1-признак того, что в буфере есть запись файла А}

{k2-признак того, что в буфере есть запись файла В}

begin

reset(a);reset(b);rewrite(c);

pr1:=false;pr2:=false;k1:=false;k2:=false;

if not eof(a) then begin;read(a,bufa);k1:=true;end;

if not eof(b) then begin;read(b,bufb);k2:=true;end;

repeat {повторять пока не закончится либо файл А, либо файл В}

ok:=eof(a) or eof(b);

while not ok do

{повторять пока не закончится либо один из файлов, либо серия}

begin

if bufa.key<bufb.key

then begin

write(c,bufa);xa:=bufa.key;read(a,bufa);pr1:=true;

ok:=eof(a) or (xa>bufa.key);

end

else begin

write(c,bufb);xb:=bufb.key;read(b,bufb);pr2:=true;

ok:=eof(b) or (xb>bufb.key);

end;

end;

if (xa>bufa.key)and pr1 {конец текущей серии файла А}

then while (xb<bufb.key)and not eof(b) do

{переписать в файл С остаток текущей серии файла В}

begin

write(c,bufb);xb:=bufb.key;read(b,bufb)

end;

if (xb>bufb.key)and pr2 {конец текущей серии файла В}

then while (xa<bufa.key)and not eof(a) do

{переписать в файл С остаток текущей серии файла A}

begin

write(c,bufa);xa:=bufa.key;read(a,bufa)

end;

until eof(a) or eof(b);

if not eof(a) and k2

{в bufb есть запись и файл А не закончился}

{переписать в файл С записи из файла А с ключами меньше, чем ключ записи в bufb}

then while(bufa.key<bufb.key)and not eof(a) do

begin;write(c,bufa);read(a,bufa);end;

else if not eof(b) and k1

{в bufа есть запись и файл В не закончился}

{переписать в файл С записи из файла В с ключами меньше, чем ключ записи в bufа}

then while(bufb.key<bufa.key) and not eof(b) do

begin;write(c,bufb);read(b,bufb);end;

if k1 and k2{переписать в С записи из буферов bufa и bufb}

then if bufa.key<bufb.key

then begin;write(c,bufa);write(c,bufb);end;

else begin;write(c,bufb);write(c,bufa);end;

else if k1 then write(c,bufa)

else if k2 then write(c,bufb);

{переписать в С остаток файла А}

while not eof(a) do begin;read(a,bufa);write(c,bufa);end;

{переписать в С остаток файла В}

while not eof(b) do begin;read(b,bufb);write(c,bufb);end;

close(a);close(b);close(c);

end;

Внешняя сортировка файлов естественным слиянием (используется только последовательный доступ к файлам).

Программа использует уже готовый файл содержащий не отсортированные данные и не распечатывает отсортированный файл (программа только сортирует файл file1).

program natmeg;

type item=record

key:integer;

{описание других полей}

end;

tfile=file of item;

var a,b,c:tfile;

procedure ended;

begin

reset(a);reset(b);

if eof(a) or eof(b) then {получили одну серию} z:=1;

close(a);close(b);

end;

procedure distribute;

var buf:item;

x:integer;

pt:boolean;{переключатель выходных файлов}

{если pt=true, то запись в файл А, иначе в файл В}

ok:boolean;{признак нахождения в буфере последней записи серии}

begin

reset(c);rewrite(a);rewrite(b);

pt:=true;

ok:=false;

if not eof(c) then {переписываем в А первую запись из С, её ключ запоминаем в X}

begin

read(c,buf);write(a,buf);x:=buf.key;

end;

if not eof(c) then

begin

read(c,buf);{читаем в буфер вторую запись из С}

repeat {повторять пока не закончится файл С}

while not eof(c) and ((buf.key>=x) or ok) do

{пока не конец С и либо не конец серии, либо в буфере находится запись другой серии}

begin

ok:=false;

if pt then write(a,buf) else write(b,buf);

x:=buf.key;read(c,buf);

end;

if buf.key<x then

{в буфере находится запись уже другой серии и её надо переписать в другой файл}

begin;pt:=not pt;ok:=true;end;

if eof(c) then

{записать в выходной файл последнюю запись файла С, уже прочитанную в буфер}

if pt then write(a,buf) else write(b,buf);

until eof(c);

end;

close(a);close(b);close(c);

end;

procedure merge;

var bufa,bufb:item;

xa,xb:integer;

ok,pr1,pr2:boolean;

k1,k2:boolean;

{pr1-признак того, что было прочитано не меньше двух записей файла А}

{pr2-признак того, что было прочитано не меньше двух записей файла В}

{k1-признак того, что в буфере есть запись файла А}

{k2-признак того, что в буфере есть запись файла В}

begin

reset(a);reset(b);rewrite(c);

pr1:=false;pr2:=false;k1:=false;k2:=false;

if not eof(a) then begin;read(a,bufa);k1:=true;end;

if not eof(b) then begin;read(b,bufb);k2:=true;end;

repeat {повторять пока не закончится либо файл А, либо В}

ok:=eof(a) or eof(b);

while not ok do

{повторять пока не закончится либо один из из файлов, либо серия}

begin

if bufa.key<bufb.key

then begin

write(c,bufa);xa:=bufa.key;read(a,bufa);pr1:=true;

ok:=eof(a) or (xa>bufa.key);

end

else begin

write(c,bufb);xb:=bufb.key;read(b,bufb);pr2:=true;

ok:=eof(b) or (xb>bufb.key);

end;

end;

if (xa>bufa.key)and pr1 {конец текущей серии файла А}

then while (xb<bufb.key)and not eof(b) do

{переписать в файл С остаток текущей серии файла В}

begin

write(c,bufb);xb:=bufb.key;read(b,bufb)

end;

if (xb>bufb.key)and pr2 {конец текущей серии файла В}

then while (xa<bufa.key)and not eof(a) do

{переписать в файл С остаток текущей серии файла А}

begin

write(c,bufa);xa:=bufa.key;read(a,bufa)

end;

until eof(a) or eof(b);

if not eof(a) and k2

{в bufb есть запись и файл А не закончился}

{переписать в файл С записи из файла А с ключами меньшими, чем ключ записи в bufb}

then while(bufa.key<bufb.key)and not eof(a) do

begin;write(c,bufa);read(a,bufa);end;

else if not eof(b) and k1

{в bufа есть запись и файл В не закончился}

{переписать в файл С записи из файла В с ключами меньшими, чем ключ записи в bufа}

then while(bufb.key<bufa.key) and not eof(b) do

begin;write(c,bufb);read(b,bufb);end;

if k1 and k2{переписать в С записи из буферов bufa и bufb}

then if bufa.key<bufb.key

then begin;write(c,bufa);write(c,bufb);end;

else begin;write(c,bufb);write(c,bufa);end;

else if k1 then write(c,bufa)

else if k2 then write(c,bufb);

{переписать в С остаток файла А}

while not eof(a) do begin;read(a,bufa);write(c,bufa);end;

{переписать в С остаток файла В}

while not eof(b) do begin;read(b,bufb);write(c,bufb);end;

close(a);close(b);close(c);

end;

begin {main}

assign(a,'{имя внешнего файла}');

assign(b,'{имя внешнего файла}');

assign(c,'{имя внешнего файла}');

repeat

z:=0;

distribute;

merge;

ended;

until z=1;

end.

Результат работы:

9.3.5. Сортировка многофазным слиянием.

Р
ассмотренные выше методы сортировки простым и естественным слиянием достаточно просты, однако не эффективны, так как сортировка выполняется за значительное число проходов. Например, при сортировке М записей простым слиянием требуется:

К -проходов.

Е
стественный путь повышения эффективности сортировки заключается в предварительной внутренней сортировке записей, формирование из них серий возможно большей длинны и распределение этих серий по нескольким файлам. При Р-путевом сбалансированным слияний число проходов

Г
де R-начальное число серий. Поскольку на каждом проходе обрабатывается N записей, то эффективность всего процесса сортировки будет пропорциональна

А
с учётом внутренней сортировки

Из этой формулы виден второй путь повышения эффективности сортировки, а именно увеличивать число файлов P. Однако при сбалансированном многофазном слиянии одновременно используются лишь чуть больше половины имеющихся файлов, а остальные простаивают. Возникает вопрос, можно ли ещё лучше использовать имеющиеся файлы? Да, это возможно, если распределить начальные серии не поровну между всеми файлами, а более хитрым способом, так чтобы на каждой фазе слияния, кроме самой последней, только один файл оказывался пустым. Такой метод называется многофазным слиянием.

Вернёмся к предыдущему примеру сортировки 1700 записей, предварительно отсортированных в серии по 100 записей. Однако на первом этапе распределим эти серии на 3 файла следующим образом: в файл 1-7 серий, в файл 2-6 серий, в файл 3-4 серии.

Далее будем сливать эти серии в файл 4. В результате в файле 4 мы получим 4 серии длиною 300 записей, в файле 1 останется 3 серии, в файле 2 будет 2 серии, а файл 3 станет пустой. Далее сливаем серии в файл 3 и так далее, пока не получим отсортированный файл, состоящий из одной серии длиною 1700 записей. Процесс сортировки показан на рисунке.

1

F4

Внутренняя сортировка и распределение

F2

7(100) 6(100) 4(100)

Слияние 1

F1

3(100) 2(100) 4(300)

Слияние 1

F1

1(100) 2(500) 2(300)

Слияние 1

F1

1(900) 1(500) 1(300)

Слияние 1

F1

1(1700)

Рисунок. Сортировка 1700 записей с использованием 4 файлов методом многофазного слияния.

Например, для 4 файлов имели следующую последовательность Фибоначчи 2-го порядка

0 , 0 , 1 , 1 , 2 , 4 , 7 , 13 , 24 , 44 , 81.

Возможные начальные распределения серий показаны в таблице.

Таблица.

Начальное распределение серий для 4 лент.

Из сказанного выше следует, что алгоритм многофазного слияния применим только к таким входным данным, в которых число начальных серий имеет волне определённое значение. А что же делать, если число начальных серий отличается от требуемого? В этом случае поступают следующим образом: вводится соответствующее число фиктивных пустых серий, так, чтобы сумма реальных и фиктивных серий давала нужное значение. Однако возникает сразу следующий вопрос: как распределить фиктивные серии между файлами? Давайте посмотрим, как сливаются реальные и фиктивные серии. Понятно, что выбор фиктивной серии с i-ый файла означает, что i-ый файл не участвует в слиянии; в результате слияние происходит с менее чем N-1 файлами. Слияние фиктивных серий со всех N-1 входных файлов не предполагает никакой действительной операции слияния, а означает просто запись фиктивных серий на входной файл. Из этого можно сделать вывод, что фиктивные серии нужно распределить на N-1 файлов как можно более равномерно, так как мы заинтересованы в слиянии с возможно большего числа файлов. Можно также показать, что фиктивные серии лучше располагать в начале файлов.

Пример программы Сортировка многофазным слиянием:

Программа использует уже готовый файл содержащий не отсортированные данные и не распечатывает отсортированный файл (программа только сортирует файл file0).

program Многофазное слияние;

uses crt;

const n=10;

type item=record

key:integer;

{описания других полей}

end;

filetype=file of item;

var f0,f1,f2,f3,a,b,c,d:filetype;

ser0,ser1,ser2,ser3,kolser,disk0,disk1,disk2,disk3,z,l,all,zero0,zero1,zero2,zero3:integer;

eora,eorb,eorc,per,eor:boolean;

mas:array[1..n]of integer;

data:item;

procedure fibonachi;

procedure fib;

begin

disk0:=disk1+disk2+disk3;

while disk0<kolser do

begin

disk3:=disk2;disk2:=disk1;disk1:=disk0;disk0:=disk1+disk2+disk3;

end;

end;

begin

disk1:=1;disk2:=1;disk3:=1;fib;kolser:=disk0;

disk1:=0;disk2:=0;disk3:=1;fib;disk1:=disk2;disk2:=kolser-(disk1+disk3);

end;

procedure readfile;

begin

l:=0;

while not eof(f0)and not(l=n) do

begin l:=l+1;read(f0,data);mas[l]:=data.key;end;

all:=l;

end;

procedure massort;

var buf,units:integer;

m:boolean;

begin

units:=all;

repeat

m:=true;;

units:=units-1;

for l:=1 to units do

begin

if mas[l]>mas[l+1]

then begin buf:=mas[l];mas[l]:=mas[l+1];mas[l+1]:=buf;m:=false;end;

end;

until m or (units=1);

end;

procedure sort(var x:filetype);

begin

readfile;massort;

for l:=1 to all do begin data.key:=mas[l];write(x,data);end;

end;

procedure sortrun;

begin

reset(f0);rewrite(f1);rewrite(f2);rewrite(f3);

kolser:=1;zero0:=0;zero1:=0;zero2:=0;zero3:=0;ser0:=0;ser1:=0;ser2:=0;ser3:=0;

repeat

fibonachi;

if disk1<>ser1 then begin

if not eof(f0) then sort(f1)

else zero1:=zero1+1;

ser1:=ser1+1;

end;

if disk2<>ser2 then begin

if not eof(f0) then sort(f2)

else zero2:=zero2+1;

ser2:=ser2+1;

end;

if disk3<>ser3 then begin

if not eof(f0) then sort(f3)

else zero3:=zero3+1;

ser3:=ser3+1;

end;

if (not eof(f0))and(kolser=(ser1+ser2+ser3)) then kolser:=kolser+1;