Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
Скачиваний:
57
Добавлен:
10.05.2014
Размер:
2.62 Кб
Скачать
{$R+}
program qsort;
(*
(c) 2005 Dima Zolotukhin aka 'Zlogic' <zlogic@gmail.com>
Redistributable under GNU GPL license
*)

const
MAX_PATH = 79;
type
str_path = string[MAX_PATH];
str_message = string[70];
type_element = longint;
type_file = file of type_element;
type_index = longint;

function get_string(m:str_message):str_path;
var
temp_str:str_path;
begin
write(m,'> ');
readln(temp_str);
get_string:=temp_str;
end;

function open_file(var f:type_file):boolean;
begin
{$I-}
reset(f);
{$I+}
open_file:=ioresult=0;
end;

function get_data(var mfile:type_file;i:type_index):type_element;
var
tmp:type_element;
begin
seek(mfile,i);
read(mfile,tmp);
get_data:=tmp;
end;

procedure swap(var mfile:type_file;x,y:type_index);
var
xv,yv:type_element;
begin
xv:=get_data(mfile,x);
yv:=get_data(mfile,y);
seek(mfile,x);
write(mfile,yv);
seek(mfile,y);
write(mfile,xv);
end;

procedure scroll_left(var mfile:type_file;var i:type_index;mvalue:type_element);
var
tmp:type_element;
begin
while get_data(mfile,i)<mvalue do
i:=i+1;
end;
procedure scroll_right(var mfile:type_file;var i:type_index;mvalue:type_element);
var
tmp:type_element;
begin
while get_data(mfile,i)>mvalue do
i:=i-1;
end;

procedure sort_file(var mfile:type_file;leftbound,rightbound:type_index);
var
middle,i,j:type_index;
mvalue:type_element;
lvalue,rvalue:type_element;
begin
if(rightbound>leftbound)then{Ґб«Ё Ў®«миҐ ®¤­®Ј® зЁб« }
begin
middle:=(leftbound+rightbound) div 2;{ЁйҐ¬ бҐаҐ¤Ё­г}
mvalue:=get_data(mfile,middle);{зЁв Ґ¬ бҐаҐ¤Ё­г}

i:=leftbound;
j:=rightbound;
repeat{¤ўЁЈ Ґ¬бп б 2е Є®­ж®ў}
scroll_left(mfile,i,mvalue);{бЄа®««Ё¬ б«Ґў }
scroll_right(mfile,j,mvalue);{бЄа®««Ё¬ бЇа ў }

if(i<=j)then{Ґб«Ё ­Ґ ЇҐаҐў «Ё«Ё §  бҐаҐ¤Ё­г}
begin
swap(mfile,i,j);{¬Ґ­пҐ¬ ¬Ґбв ¬Ё}
i:=i+1;
j:=j-1;
end;
until i>j;
if(j<rightbound)then
sort_file(mfile,leftbound,j);{б®авЁа㥬 Їа ўго Ї®«®ўЁ­г}
if(i>leftbound)then
sort_file(mfile,i,rightbound);{б®авЁа㥬 «Ґўго Ї®«®ўЁ­г}
end;
end;

var
mfile:type_file;
begin
writeln('‚Ќ€ЊЂЌ€…: ‘®авЁа®ўЄ  Їа®Ёб室Ёв Їаאַ ў д ©«Ґ!');
assign(mfile,get_string('‚ўҐ¤ЁвҐ Ё¬п д ©«  ¤«п б®авЁа®ўЄЁ'));{®вЄалў Ґ¬ д ©«}
f(open_file(mfile))then
begin
sort_file(mfile,0,filesize(mfile)-1);{б®авЁа㥬 д ©«}
close(mfile);
end
else
writeln('<< Ћ€ЃЉЂ: д ©« ­Ґ ­ ©¤Ґ­ >>');
writeln('Ќ ¦¬ЁвҐ ENTER ¤«п ўл室 ');
readln;
end.
Соседние файлы в папке 10