Срочно нужна программа внешней сортировки с использованием однофазного естественного слияния на языке Pascal, желательно с комментариями, пояснениями, а то курсач на носу!!! People,помогите кто чем может)))

Можешь считать, что твой Армагеддон уже начался:
Однофазная сортировка естественным слиянием

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

В случае прямого слияния мы не получаем никакого преимущества, если данные уже
являются частично упорядоченными. Размер сливаемых при каждом проходе
последовательностей не зависит от существования более длинных уже упорядоченных
последовательностей, которые можно было бы просто объединить.
Сортировка, при которой всегда сливаются две самые длинные из возможных
последовательностей, назвается естественным слиянием.
Эта сортировка является двухфазной сортировкой слиянием с тремя
лентами(файлами).
Максимальную упорядоченную последовательность будем называть серией.
Пусть имеется начальный файл А. Каждый проход состоит из фазы распределения
серий из фалйа А поровну в файлы В и С и фазы слияния, объединяющей серии из
файлов В и С в файл А.
Процесс сортировки заканчивается, как только в файле А останется только одна
серия.
Рассмотрим сортировку естественным слиянием на примере (серии подчеркнуты).
Пусть задан файл А:

А - 17 31 05 59 13 41 43 76 11 23 29 47 03 07 71 02 19 57 37
61

B - 17 31 13 41 43 76 03 07 71 37 61

C - 05 59 11 23 29 47 02 19 57

A - 05 17 31 59 11 13 23 29 41 43 47 76 02 03 07 19 57 71 37 61

B - 05 17 31 59 02 03 07 19 57 71

C - 11 13 23 29 41 43 47 76 37 61

A - 05 11 13 17 23 29 31 41 43 47 59 76 02 03 07 19 37 57 61 71

B - 05 11 13 17 23 29 31 41 43 47 59 76

C - 02 03 07 19 37 57 61 71

A - 02 03 05 07 11 13 17 19 23 29 31 37 41 43 47 57 59 61 71 76
Hа основе рассмотренного выше алгоритма легко получить алгоритм однофазной
сортировки естественным слиянием с четырьмя файлами. "

Добавлено через 6 мин.
http://www.dore.ru/perl/nntp.pl?f=1&gid=17&mid=62765

Легко? Что ж никто не получил-то до сих пор? Ну, вот, давай, ты и будешь первым. Получи и покажи. А не копируй заявления о том, что это легко. Ты сделай сначала...

Н. Вирт по крайней мере, когда писал о сортировке естественным слиянием ("Алгоритмы и структуры данных", 2.4.2 Естественное слияние, стр 135), говорил: "Каждый проход состоит из фазы распределения серий из C поровну в А и B, и фазы слияния, объединяющей серии A и B вновь в C" (С) То есть, сортировка-то двухфазная. И ничего из того, что у тебя написано дальше, у Вирта в книге не было. Это отсебятина. Изобретай однофазную естественную сортировку дальше...

так я ж вообще не понимаю , так написано там что легко получить

....

вот тут кое что написано как из двухфазной сделать однофазную

Тогда удочните,что подразумевается под однофазной?Потому что,как писал volvo

Извините,я все равно в вашем рисунке про однофазную вижу 2 фазы,как минимум на первом этапе когда формировались 2 первых массива.Более того разве поочередное записывание серий из 2 файлов в 2 это будет не распределением?Здесь уже идет вопрос,как воспринимать понятия.

вот нашел алгоритм в книге Н.Вирта "АЛГОРИТМЫ + СТРУКТУРЫ ДАННЫХ = ПРОГРАММЫ" подробнее об однофазном слиянии на 108-114 страницах этой книги. Кто может напишите по алгоритму программу а то я не волоку по этой теме про слияния Нажмите для просмотра прикрепленного файла

Добавлено через 5 мин.
а вот тут книжка Вирта http://reslib.com/book/Algoritmi_strukturi_dannih_programmi

НАРОД, это однофазная сортировка????

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

Procedure MergeSort(name: string; var f: text);
          Var s1,s2,a1,a2,where,tmp: integer;
              f1,f2: text;
          Begin
             s1:=5; s2:=5; {Можно задать любые числа, которые запустят цикл while}
             Assign(f,name);
             Assign(f1,'{имя 1-го вспомогательного файла}');
             Assign(f2,'{имя 2-го вспомогательного файла}');
             While (s1>1) and (s2>=1) do
               begin
                 where:=1;
                 s1:=0; s2:=0;
                 Reset(f); Rewrite(f1); Rewrite(f2);
                 Read(f,a1);
                 Write(f1,a1,' ');
                 While not EOF(f) do
                   begin
                     read(f,a2);
                     If (a2<a1) then
                       begin
                         Case where of
                            1: begin
                                 where:=2;
                                 inc(s1);
                               End;
                            2: begin
                                 where:=1;
                                 inc(s2);
                               End;
                         End;
                       End;
                     Case where of
                        1: write(f1,a2,' ');
                        2: write(f2,a2,' ');
                     End;
                     a1:=a2;
                   End;
                 If where=2 then
                   inc(s2)
                 else
                   inc(s1);
                 Close(f); Close(f1); Close(f2);
 
 
                 Rewrite(f); Reset(f1); Reset(f2);
                 Read(f1,a1);
                 Read(f2,a2);
                 While (not EOF(f1)) and (not EOF(f2)) do
                   begin
                     If (a1<=a2) then
                       begin
                         Write(f,a1,' ');
                         Read(f1,a1);
                       End
                     else
                       begin
                         Write(f,a2,' ');
                         Read(f2,a2);
                       End;
                   End;
                 While not EOF(f1) do
                   begin
                     tmp:=a1;
                     Read(f1,a1);
                     If not EOF(f1) then
                        Write(f,tmp,' ')
                     else
                        Write(f,tmp);
                   End;
                 While not EOF(f2) do
                   begin
                     tmp:=a2;
                     Read(f2,a2);
                     If not EOF(f2) then
                        Write(f,tmp,' ')
                     else
                        Write(f,tmp);
                   End;
                 Close(f); Close(f1); Close(f2);
               End; 
             Erase(f1);
             Erase(f2);
          End;

Добавлено через 6 мин.
или может быть вот эта сортировка однофазная????

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

Procedure MergeSort(name: string; var f: text);
          Var a1,a2,s,i,j,kol,tmp: integer;
              f1,f2: text;
              b: boolean;
          Begin
             kol:=0;
 
             Assign(f,name);
             Reset(f);
             While not EOF(f) do
               begin
                 read(f,a1);
                 inc(kol);
               End;
             Close(f);
 
             Assign(f1,'{имя 1-го вспомогательного файла}');
             Assign(f2,'{имя 2-го вспомогательного файла}');
 
             s:=1;
             While (s<kol) do
               begin
 
                 Reset(f); Rewrite(f1); Rewrite(f2);
                 For i:=1 to kol div 2 do
                   begin
                     Read(f,a1);
                     Write(f1,a1,' ');
                   End;
                 If (kol div 2) mod s<>0 then
                   begin
                     tmp:=kol div 2;
                     While tmp mod s<>0 do
                       begin
                         Read(f,a1);
                         Write(f1,a1,' ');
                         inc(tmp);
                       End;
                   End;
                 While not EOF(f) do
                   begin
                     Read(f,a2);
                     Write(f2,a2,' ');
                   End;
                 Close(f); Close(f1); Close(f2);
 
 
                 Rewrite(f); Reset(f1); Reset(f2);
                 Read(f1,a1); 
                 Read(f2,a2);
                 While (not EOF(f1)) and (not EOF(f2)) do
                   begin
                     i:=0; j:=0;
                     b:=true;
                     While (b) and (not EOF(f1)) and (not EOF(f2)) do
                       begin
                         If (a1<a2) then
                           begin
                             Write(f,a1,' ');
                             Read(f1,a1);
                             inc(i);
                           End
                         else
                           begin
                             Write(f,a2,' ');
                             Read(f2,a2);
                             inc(j);
                           End;
                         If (i=s) or (j=s) then b:=false;
                       End;
                     If not b then
                       begin
                         While (i<s) and (not EOF(f1)) do
                           begin
                             Write(f,a1,' ');
                             Read(f1,a1);
                             inc(i);
                           End;
                         While (j<s) and (not EOF(f2)) do
                           begin
                             Write(f,a2,' ');
                             Read(f2,a2);
                             inc(j);
                           End;
                       End;
                   End;
                 While not EOF(f1) do
                   begin
                     tmp:=a1;
                     Read(f1,a1);
                     If not EOF(f1) then
                       Write(f,tmp,' ')
                     else
                       Write(f,tmp);
                   End;
                 While not EOF(f2) do
                   begin
                     tmp:=a2;
                     Read(f2,a2);
                     If not EOF(f2) then
                       Write(f,tmp,' ')
                     else
                       Write(f,tmp);
                   End;
                 Close(f); Close(f1); Close(f2);
 
                 s:=s*2;
               End;
             Erase(f1);
             Erase(f2);
          End;

Однофазная сортировка простым слиянием

Фаза разделения файла А на два файла В и С не относится к сортировке. Она
непродуктивна, хотя и заниммает половину всех операций по переписи.
Очевидным улучшением (по быстродействию, но не по занимаемой памяти)
рассмотренного выше алгоритма является объединение фазы разделения с фазой
слияния.
Вместо слияния в один файл результаты слияния необходимо сразу распределять по
двум файлам, которые станут исходными для последующего прохода.
Такая сортировка называется однофазовой сортировкой простым слиянием. очевидно,
что для такой сортировки требуется уже не три, а четыре дополнительных файла.
Рассмотрим выполнение однофазной сортировки на примере.
Пусть задан файл А: 55 12 87 76 98 24 84 27
Разбиваем его на два файла:
С - 55 12 87 76 D - 55 98 84 87 С - 12 24 55 98

B - 98 24 84 27 E - 12 24 27 76 B - 27 76 84 87

A - 12 24 27 55 76 84 87 98


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

В случае прямого слияния мы не получаем никакого преимущества, если данные уже
являются частично упорядоченными. Размер сливаемых при каждом проходе
последовательностей не зависит от существования более длинных уже упорядоченных
последовательностей, которые можно было бы просто объединить.
Сортировка, при которой всегда сливаются две самые длинные из возможных
последовательностей, назвается естественным слиянием.
Эта сортировка является двухфазной сортировкой слиянием с тремя
лентами(файлами).
Максимальную упорядоченную последовательность будем называть серией.
Пусть имеется начальный файл А. Каждый проход состоит из фазы распределения
серий из фалйа А поровну в файлы В и С и фазы слияния, объединяющей серии из
файлов В и С в файл А.
Процесс сортировки заканчивается, как только в файле А останется только одна
серия.
Рассмотрим сортировку естественным слиянием на примере (серии подчеркнуты).
Пусть задан файл А:

А - 17 31 05 59 13 41 43 76 11 23 29 47 03 07 71 02 19 57 37
61

B - 17 31 13 41 43 76 03 07 71 37 61

C - 05 59 11 23 29 47 02 19 57

A - 05 17 31 59 11 13 23 29 41 43 47 76 02 03 07 19 57 71 37 61

B - 05 17 31 59 02 03 07 19 57 71

C - 11 13 23 29 41 43 47 76 37 61

A - 05 11 13 17 23 29 31 41 43 47 59 76 02 03 07 19 37 57 61 71

B - 05 11 13 17 23 29 31 41 43 47 59 76

C - 02 03 07 19 37 57 61 71

A - 02 03 05 07 11 13 17 19 23 29 31 37 41 43 47 57 59 61 71 76
Hа основе рассмотренного выше алгоритма легко получить алгоритм однофазной
сортировки естественным слиянием с четырьмя файлами.

исходя из [b]"Однофазная сортировка простым слиянием" может быть можно получить алгоритм однофазной сортировки естественным слиянием с четырьмя файлами???[/b]

Как же ты меня своим копи-пастом достал. Я тебе сказал: СДЕЛАЙ И ПОКАЖИ реализацию, а не приводи заявления о том, что это возможно. Чувствуешь разницу?

А теперь внимательно посмотри в самый низ той страницы, которую ты выложил. "Программа 2.13 Сортировка простым слиянием". Ты простое от естественного отличаешь вообще? Я тебе в первом же ответе дал ссылку на тему, где рекомендуется для однофазного слияния использовать простое, ты начал выёживаться, а теперь сам мне приводишь этот пример? Этот номер с мной не проходит, если что... Думай дальше...

Нет, фаза распределения и фаза слияния разделены => двухфазная...

Аналогично...

так если бы я сделал, я вообще не поднимал бы данный вопрос!

Добавлено через 4 мин.
Ну хорошо, а для 4-х путевого однофазного простого слияния есть у кого программа???

про однофазную сортировку

Кто то там пищал что такая сортировка невозможна, ну вот например я вот так реализовал ее, переделав двухфазную.
ВНЕШНЯЯ СОРТИРОВКА С ИСПОЛЬЗОВАНИЕМ ОДНОФАЗНОГО ЕСТЕСТВЕННОГО СЛИЯНИЯ

program naturalmerge;

uses CRT;
type
item = record
key:integer;
end;
filetype = file of item;

var
a,b,c,d,e:filetype;
z:integer;
eor:boolean;

procedure create;
var
i: byte;
buf: item;
begin
rewrite©;
randomize;
for i:=1 to 20 do begin
buf.key:=random(100);
write(c,buf);
end;
close©;
end;

procedure view(var x:filetype);
var buf: item;
begin
reset(x);
if filesize(x)<>0 then begin
repeat
read(x,buf);
write(buf.key,' ');
until eof(x); writeln;
readkey; end;
end;

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;
end;

procedure copyrun(var x,y:filetype);
begin
repeat
copy(x,y);
until eor;
end;

procedure distribute;
begin
reset©;rewrite(a);rewrite(b);
repeat
copyrun(c,a);
if not eof© then copyrun(c,b);
until eof©;
write('A= '); view(a);
write('B= '); view(b);
close(a);close(b);close©;
end;

procedure mergerun (var w,y,x:filetype);
var bufa,bufb:item;
begin
repeat
read(w,bufa); seek(w,filepos(w)-1);
read(y,bufb); seek(y,filepos(y)-1);
if bufa.key<bufb.key then begin
copy(w,x);
if eor then copyrun(y,x);
end
else begin
copy(y,x);
if eor then copyrun(w,x);
end;

until eor
end;


procedure merge;
label m1,m2;
begin

m1: z:=1; reset(a);reset(b); rewrite(d); rewrite(e) ;
while (not eof(a)) and (not eof(b)) do
begin
if odd(z) then mergerun(a,b,d) else mergerun(a,b,e);
z:=z+1;
end;
while not eof(a) do begin
copyrun(a,d); z:=z+1; end;
while not eof(b) do begin
copyrun(b,e);z:=z+1; end;

if filesize(d)<>0 then write('D= '); view(d);
if filesize(e)<>0 then write('E= '); view(e) ;
writeln;
If (filesize(e)=0) or (filesize(d)=0)
then begin writeln('OTSORTIROVAN'); exit; end;

if (eof(a)) and (eof(b)) then goto m2;

m2: Z:=1;
reset(d); reset(e); rewrite(a); rewrite(b);

while (not eof(d)) and (not eof(e)) do begin
if odd(z) then mergerun(d,e,a) else mergerun(d,e,b);
z:=z+1; end;
while not eof(d) do begin
copyrun(d,b); z:=z+1; end;
while not eof(e) do begin
copyrun(e,a); z:=z+1; end;

if filesize(a)<>0 then write('A= '); view(a);
if filesize(b)<>0 then write('B= '); view(b) ;
If (filesize(a)=0) or (filesize(b)=0)
then begin writeln('OTSORTIROVAN'); readkey;exit; end;

if (eof(d)) and (eof(e)) then goto m1;

close(a);close(b);
close(d); close(e);
end;

begin {main} clrscr;
assign(a,'a.txt');
assign(b,'b.txt');
assign(c,'c.txt');
assign(d,'d.txt');
assign(e,'e.txt');
create;
writeln('Ishodniy massiv ');
view©;

distribute; z:=0;
merge;

writeln('++++++++++++++++++++++++++++++++++++++++++++++++++++') ;
end.

cialis 5mg online uk