Здравствуйте, помогите, пожалуйста, с такой задачкой:
Отсортируйте массив размера 50 000 методом слияния отрезков. Используйте 5 файлов для хранения отрезков. 20 - максимальное количество элементов в оперативной памяти. Используйте метод внутренней сортировки - Пузырек.
ЗЫ: нашел код, но не могу с ним до конца разобраться + он не работает с указанными выше значениями(где именно возникает проблема нашел, а исправить не могу). если не трудно помогите исправить и написать комментарии к процедурам
Код:
const
FileName='file.txt';
FileNew='File2.txt';
AdditionalFilesNumber=12; //файлов для хранения
ElementsInMemory=24; //элементов в памяти
zero=ord('0');
type
mas=array [0..49999] of integer;
TFileArray=array [0..AdditionalFilesNumber-1] of text;
bool=array [0..Additionalfilesnumber-1] of boolean;
var fa:TfileArray; f,f2:Text; fb:bool;
procedure CreateAdditionalFiles;
var i: integer;
begin
for i:=low(TFileArray) to high(TFileArray) do
begin
if i>9 then
assign(fa[i],'tmp1'+chr(i+38)+'.txt')
else
assign(FA[i],'tmp'+chr(i mod AdditionalFilesNumber+zero)+'.txt');
rewrite(FA[i]);
end;
end;
procedure ResetAdditionalFiles;
var i: integer;
begin
for i:=low(TFileArray) to high(TFileArray) do
begin
if i>9 then
assign(fa[i],'tmp1'+chr(i+38)+'.txt')
else
assign(FA[i],'tmp'+chr(i mod AdditionalFilesNumber+zero)+'.txt');
reset(FA[i]);
end;
end;
procedure CloseAdditionalFiles;
var i: integer;
begin
for i:=low(TFileArray) to high(TFileArray) do
close(FA[i]);
end;
procedure DeleteAdditionalFiles;
var i: integer;
begin
for i:=low(TFileArray) to high(TFileArray) do
begin
if i>9 then
assign(fa[i],'tmp1'+chr(i+38)+'.txt')
else
assign(FA[i],'tmp'+chr(i mod AdditionalFilesNumber+zero)+'.txt');
erase(FA[i]);
end;
erase(f2);
end;
procedure AddaArrayFile2(a:mas;n:longint);
var i:integer;
begin
Append(f2);
for i:=0 to n do
Write(f2,' ',a[i]);
end;
procedure AddaArrayFilename(a:mas;n:longint);
var i:integer;
begin
Append(f);
for i:=0 to n do
Write(f,' ',a[i]);
end;
procedure AddArrayToOpenFile(fileID:integer; a:integer);
begin
write(FA[fileID],' ',a);
end;
procedure sort(var a:mas;n:longint);
var i,j: longint; tmp:longint;
begin
for i:=0 to n-1 do
for j:=0 to n-1 do
if a[j]>a[j+1] then begin
tmp:=a[j+1];
a[j+1]:=a[j];
a[j]:=tmp;
end;
end;
procedure Input;
var i:longint; a:mas;
begin
Assign(f,'File.txt');
rewrite(f);
randomize;
for i:=0 to 5000 do
begin
a[i]:=random(9);
write(f,' ',a[i]);
end;
close(f);
end;
procedure SortFile;
var i:integer; a:mas;
begin
Assign(f,Filename);
Reset(f);
Assign(f2,Filenew);
Rewrite(f2);
while not eof(f) do
begin
for i:=0 to ElementsInMemory-1 do
if eof(f) then
break
else
read(f,a[i]);
sort(a,i-1);
AddaArrayFile2(a,i-1);
end;
close(f);
close(f2);
end;
procedure Partition(k:longint);
var i,z:longint; a:integer;
begin
assign(f2,FileNew);
Reset(f2);
CreateAdditionalFiles;
z:=0;
while not eof(f2) do
begin
for i:=0 to k do
if eof(f2) then
break
else begin
read(f2,a);
AddArrayToOpenFile(z,a);
end;
inc(z);
if z=12 then z:=0;
end;
close(f2);
CloseAdditionalFiles;
end;
function GetSeriesNumber: longint;
var f: text; previous,next,res:integer;
begin
res:=1;
assign(f,Filename);
reset(f);
read(f,next);
while not eof(f) do
begin
previous:=next;
read(f,next);
if (next<previous) then inc(res);
end;
close(f);
writeln(res);
result:=res;
end;
function flag:boolean;
var i:integer;
begin
Result:=false;
for i:=low(fb) to high(fb) do
if not fb[i] then begin
Result:=true;
break;
end;
end;
procedure Merge(k:longint);
var i,j,z:longint; a:mas;
begin
assign(f,filename);
rewrite(f);
ResetAdditionalFiles;
while flag do begin
z:=0;
for i:=low(fa) to high(fa) do
for j:=1 to k do
if eof(fa[i]) then begin
fb[i]:=true;
break;
end
else begin
read(fa[i],a[z]);
inc(z);
end;
sort(a,z-1);
AddaArrayFilename(a,z-1);
end;
CloseAdditionalFiles;
Close(f);
end;
procedure flag2;
var i:integer;
begin
for i:=low(fb) to high(fb) do
fb[i]:=false;
end;
var k:longint;
begin
input;
k:=1;
while getseriesnumber>1 do begin
Sortfile;
partition(k);
Merge(k);
flag2;
K:=k*2;
end;
DeleteAdditionalFiles;
end.