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

⇐ ПредыдущаяСтр 13 из 17Следующая ⇒

В случае простого слияния мы ничего не выигрываем, если данные уже частично отсортированы. На К-ом проходе длина всех сливаемых серий меньше или равна 2^К без учёта того обстоятельства, что могут быть упорядочены и более длинные серии и их можно было бы сливать. Можно было бы сразу сливать какие-либо серии длиною М и Н в одну серию длиною М+Н. Метод сортировки, при котором каждый раз сливаются две самые длинные упорядоченные последовательности, называется естественным слиянием.

Следующим нашим упражнением будет разработка алгоритма естественного слияния методом структурного программирования «сверху-вниз».

Запишем программу следующим образом:

program naturalmerge;

type item=record

key: integer;

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

end;

filetype=file of item;

var a, b, c: filetype;

z: integer; {для подсчёта числа серий}

eor: boolean; {индикатор конца серии}

begin

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

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

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

repeat

distribute; z: =0;

merge;

until z=1;

end.

Здесь две фазы сортировки (разделения и слияния) реализуются отдельными процедурами: Distribute и Merge. Запишем эти процедуры.

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

procedure distribute; {из С в А и В}

begin

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

repeat

copyrun(c, a);

if not eof(c) then copyrun(c, b);

until eof(c);

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

end;

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

procedure merge;

begin

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

while (not eof(a))and(not eof(b)) do

begin

mergerun; z: =z+1;

end;

while not eof(a) do begin; copyrun(a, c); z: =z+1; end;

while not eof(b) do begin; copyrun(b, c); z: =z+1; end;

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

end;

Здесь Copyrun(x, y)-процедура копирования серий из файла Х в файл Y, а Mergerun-процедура слияния двух серий из файлов A и B в файл C. Опишем эти процедуры. Будем использовать булевскую переменную eor, значение которой показывает, достигнут ли конец серии. Введём также процедуру Copy(x, y), которая копирует очередную запись их файла X в файл Y и определяет, достигнут ли конец серии.

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

procedure copyrun(var x, y: filetype);

{переписать серии из X в Y}

begin

repeat

copy(x, y);

until eor;

end;

При реализации процедуры Copy надо находить конец серии. Для этого нужно сравнить ключ последней переписанной записи с ключом следующей. То есть мы должны видеть следующую запись. Это «заглядывание вперёд» достигается использованием буферной переменной файла X^. Однако, не все реализации языка Паскаль поддерживает буферную переменную. В частности буферные переменные отсутствуют в Турбо Паскаль. В этом случае наиболее просто задача решается, если использовать прямой доступ к файлу, который реализуется в Турбо Паскале. Так это и сделано в процедуре Copy.

{процедура копирования записи и определения конца серии}

procedure copy(var x, y: filetype);

var buf, buf1: item;

begin

read(x, buf): write(y, buf);

if eof(x) then eor: =true

else begin

{заглядываем вперёд}

read(x, buf1);

{возвращаемся на исходную запись}

seek(x, filepos(x)-1);

eor: =buf1.key< buf.key

end;

Здесь seek-процедура, которая устанавливает указатель файла на требуемую компаненту, filepos-функция, возвращающая номер текущей компоненты файла.

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

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

procedure mergerun;

{слияние серий из А и В в С}

var bufa, bufb: item;

begin

repeat

read(a, bufa); seek(a, filepos(a)-1);

read(b, bufb); seek(b, filepos(b)-1);

if bufa.key< bufb.key

then begin; copy(a, c); if eor then copyrun(b, c); end

else begin; copy(b, c); if eor then copyrun(a, c); end;

until eor

end;

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

Пример сортировки естественным слиянием

Исходный файл

С: 44 5512 42 941806 6715 1714 15 1907

Первый проход

А: 44 551815 1707

В: 12 42 9406 67 14 15 19

С: 12 42 55 9406 18 6714 15 15 17 1907

Второй проход

А: 12 42 44 55 9414 15 15 17 19

В: 06 18 6707

С: 06 12 18 42 44 55 67 9407 14 15 15 17 19

Третий проход

А: 06 12 18 42 44 55 67 94

В: 07 14 15 15 17 19

С: 06 07 12 14 15 15 17 18 19 42 44 55 67 94

В заключении заметим, что хотя и предполагается, что процедура Distribute посылает серии поровну в оба файла, действительное количество выходных серий в «а» и «b» могут различаться больше чем на 1. Например, рассмотрим также исходные данные

С: 0806 09 1109 13 1505 07 2019 27 3113 25 (6 серий)

После разделения получим

А: 08 09 13 15 19 27 31 (1 серия)

В: 06 09 1105 07 2013 25 (3 серии)

Этот пример показывает, что простое распределение серий в несколько файлов может дать в результате меньшее число выходных серий, чем входных. Это происходит потому, что первый элемент (i+1)-й серии может быть больше, чем последний элемент i-й серии, что приведёт к автоматическому слиянию двух серий в одну, что и наблюдается в примере при распределении серий в файл А. Это следует учитывать при последующем слиянии серий, а именно, после достижения конца одного из файлов копировать весь остаток другого файла, а не только одну серию. Именно та и написана процедура Merge.

Конечно, отказ от требования, чтобы серии распределились поровну на два файла может привести к неоптимальной работе программы. Однако в худшем варианте она сохраняет те же характеристики, кроме того случай существенно неравномерного распределения статистически крайне маловероятен.

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

program naturalmerge;

type item=record

key: integer;

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

end;

filetype=file of item;

var a, b, c: filetype;

z: integer; {для подсчёта числа серий}

eor: boolean; {индикатор конца серии}

procedure copy(var x, y: filetype);

var buf, buf1: item;

begin

read(x, buf): write(y, buf);

if eof(x) then eor: =true

else begin

{заглядываем вперёд}

read(x, buf1);

{возвращаемся на исходную запись}

seek(x, filepos(x)-1);

eor: =buf1.key< buf.key

end;

procedure copyrun(var x, y: filetype);

{переписать серии из X в Y}

begin

repeat

copy(x, y);

until eor;

end;

procedure mergerun;

{слияние серий из А и В в С}

var bufa, bufb: item;

begin

repeat

read(a, bufa); seek(a, filepos(a)-1);

read(b, bufb); seek(b, filepos(b)-1);

if bufa.key< bufb.key

then begin; copy(a, c); if eor then copyrun(b, c); end

else begin; copy(b, c); if eor then copyrun(a, c); end;

until eor

end;

procedure distribute; {из С в А и В}

begin

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

repeat

copyrun(c, a);

if not eof(c) then copyrun(c, b);

until eof(c);

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

end;

procedure merge;

begin

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

while (not eof(a))and(not eof(b)) do

begin

mergerun; z: =z+1;

end;

while not eof(a) do begin; copyrun(a, c); z: =z+1; end;

while not eof(b) do begin; copyrun(b, c); z: =z+1; end;

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

end;

begin {main}

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

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

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

repeat

distribute; z: =0;

merge;

until z=1;

end.

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

0 3 86 20 27 67 32 16 37 43 8 47 7 84 6 29 92 37 77 33 70 84 72 31 16 33 47 25 83 28 48 15 87 29 77 98 49 89 83 2 14 1 4 50 2 59 1 77 65 77 71 56 21 68 59 96 64 100 24 68 30 9 77 50 88 51 57 95 68 34 1 71 99 77 75 20 14 91 78 59 86 69 29 9 63 28 88 16 27 54 96 17 16 27 18 58 50 29 16 61 74 Нажмите Enter для продолжения! 0 1 1 2 2 3 6 7 8 9 9 14 14 14 15 16 16 16 16 16 17 18 20 20 21 24 25 27 27 27 28 28 29 29 29 29 30 31 32 33 33 34 37 37 43 47 47 48 49 50 50 50 51 54 56 57 58 59 59 59 61 63 64 65 67 68 68 68 69 70 71 71 72 74 75 77 77 77 77 77 77 78 83 83 84 84 86 86 87 88 88 89 91 92 95 96 96 98 99 100 Нажмите Enter для продолжения!

В том случае, когда не используются средства прямого доступа (процедура типа 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;

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;

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

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;

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.

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

⇐ Предыдущая 8 9 10 11 121314 15 16 17 Следующая ⇒