Здравствуйте, помогите пожалуйста написать файловую сортировку прямым слиянием на четырех файлах(лентах)(Pascal). Заранее Спасибо.
Погуглил нашел это(как я понял это на трех файлах):
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;
http://ru.wikibooks.org/wiki/%D0%9F%D1% ... E.D0.B2.29
