Wydaje mi się że tutaj nadaje się sortowanie przez scalanie
Po każdej iteracji ciągi długości 2^{k} są posortowane , gdzie k to numer iteracji
Można też wczytać do pamięci fragment pliku , posortować ulubionym algorytmem
a następnie scalać posortowane fragmenty
Jak napisać procedurę scalającą pliki
uses crt;
const maxA=1 shl 7;
type TArray=array[1..maxA]of string;
procedure heapify(var A:TArray;i,heapsize:integer);
var left,right,largest:integer;
isHeap:boolean;
temp:string;
begin
isHeap:=false;
while((i<=heapsize)and not isHeap) do
begin
left:=2*i;
right:=2*i+1;
if((left<=heapsize)and(A[left]>A[i])) then
largest:=left
else
largest:=i;
if((right<=heapsize)and(A[right]>A[largest])) then
largest:=right;
if(largest<>i) then
begin
temp:=A[i];
A[i]:=A[largest];
A[largest]:=temp;
i:=largest;
end
else
isHeap:=true;
end;
end;
procedure buildHeap(var A:TArray;len:integer);
var i:integer;
begin
for i:=len shr 1 downto 1 do
heapify(A,i,len);
end;
procedure heapSort(var A:TArray;len:integer);
var i,heapsize:integer;
temp:string;
begin
buildHeap(A,len);
heapsize:=len-1;
for i:=len downto 2 do
begin
temp:=A[1];
A[1]:=A[i];
A[i]:=temp;
heapify(A,1,heapsize);
heapsize:=heapsize-1;
end;
end;
var f1,f2:text;
i,j:integer;
A:TArray;
path1,path2:string;
begin
writeln('Podaj sciezke do pliku zrodlowego');
readln(path1);
writeln('Podaj sciezke do pliku wynikowego');
readln(path2);
assign(f1,path1);
assign(f2,path2);
reset(f1);
rewrite(f2);
j:=0;
while not eof(f1) do
begin
readln(f1,A[j+1]);
j:=j+1;
if((j=maxA)or eof(f1)) then
begin
heapSort(A,j);
for i:=1 to j do
writeln(f2,A[i]);
j:=0;
end;
end;
close(f1);
close(f2);
end.
(Procedura sortująca jest napisana na podstawie algorytmu przedstawionego u Cormena więc może nie być optymalna)
Jak napisać procedurę scalającą posortowane fragmenty pliku tzw serie
Czytałem trochę tego co napisał Wirth w książce "Algorytmy+struktury danych=programy"
a także jakiś trzyczęściowy wykład w sieci http://zofia.kruczkiewicz.staff.iiar.pwr.wroc.pl/wyklady/ALG/Algusm5_1.pdf
ale mimo tego jakoś nie bardzo wiem jak napisać taką procedurę
procedure SimpleMergeSort (name:string);
var
k, i, j, kol, tmp:longint;
a1, a2:string;
f, f1, f2:text;
begin
kol := 0;
assign(f,name);
assign(f1,'f01.txt');
assign(f2,'f02.txt');
{I-}
reset(f);
{I+}
if ioresult<>0 then
writeln('Blad otwarcia pliku')
else
begin
reset(f);
while ( not eof(f) ) do
begin
readln(f,a1);
kol:=kol+1;
end;
close(f);
end;
k := 1;
while ( k < kol ) do
begin
reset(f);
rewrite(f1);
rewrite(f2);
if ( not eof(f) ) then readln(f,a1);
while ( not eof(f) ) do
begin
i:=0;
while((i < k) and not eof(f)) do
begin
writeln(f1,a1);
readln(f,a1);
i:=i+1;
end;
j:=0;
while ((j < k) and not eof(f)) do
begin
writeln(f2,a1);
readln(f,a1);
j:=j+1;
end;
end;
close(f2);
close(f1);
close(f);
rewrite(f);
reset(f1);
reset(f2);
if ( not eof(f1) ) then readln(f1,a1);
if ( not eof(f2) ) then readln(f2,a2);
while ( (not eof(f1)) and (not eof(f2))) do
begin
i := 0;
j := 0;
while ( (i < k) and (j < k) and (not eof(f1)) and (not eof(f2))) do
begin
if ( a1 < a2 ) then
begin
writeln(f,a1);
readln(f1,a1);
i:=i+1;
end
else
begin
writeln(f,a2);
readln(f2,a2);
j:=j+1;
end;
end;
while ( (i < k) and not eof(f1) ) do
begin
writeln(f,a1);
readln(f1,a1);
i:=i+1;
end;
while ( (j < k) and not eof(f2) ) do
begin
writeln(f,a2);
readln(f2,a2);
j:=j+1;
end;
end;
while ( not eof(f1) ) do
begin
writeln(f,a1);
readln(f1,a1);
end;
while ( not eof(f2) ) do
begin
writeln(f,a2);
readln(f2,a2);
end;
close(f2);
close(f1);
close(f);
k :=k*2;
end;
erase(f1);
erase(f2);
end;
Ta procedura nie scala jednak dobrze plików
Wygląda na to że podczas scalania nie kopiuje całego pliku
Jak tę procedurę poprawić