Внешняя сортировка с использованием однофазного естественного слияния Опции

[ARMAGEDON]

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

[ARMAGEDON]

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

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.


Сообщение отредактировано: ARMAGEDON - 13.05.2011 21:39