Помощь - Поиск - Пользователи - Календарь
Полная версия: Внешние сортировки
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
forex1992
Здравствуйте!!!!
Подскажите или напишите пожалуйста программу сортировки естественным слиянием,
результат сортировки должен быть представлен после выполнения каждого шага

var f1,f2,f3:Text;
kol_otr:Byte;
r2:integer;

procedure MyWrite(number:Byte; a:integer);
begin
CASE number of
1: writeln(f1,a);
2: writeln(f2,a);
3: writeln(f3,a);
end;
end;

procedure Myread(number:Byte; var a:integer);
begin
CASE number of
1: read(f1,a);
2: read(f2,a);
3: read(f3,a)
end;
end;

function MyEof(number:Byte):Boolean;
begin
CASE number of
1: MyEof:=Eof(f1);
2: MyEof:=Eof(f2);
3: MyEof:=Eof(f3)
end;
end;

procedure razd(VAR f1,f2,f3:Text);
var a,b:Integer;
tek_file:BYTE;
begin
reset(f1);
rewrite(f2);
rewrite(f3);
tek_file:=2;
if not eof(f1) then begin
read(f1,a);
Mywrite(tek_file,a);
end;
while not eof(f1) do begin
read(f1,b);
if b<a then
if tek_file=2 then tek_file:=3
else tek_file:=2;
a:=b;
MyWrite(tek_file,a);
end;
close(f1);
close(f2);
close(f3);
end;

procedure sliyan(var k_o:Byte);
var a,b,x:integer;
tek_file:integer;
procedure kon_otr(tek_file:Byte; buf:integer);
var r1: integer;
begin
writeln(f1,buf);
r1:=buf;
myread(tek_file,r2);
if r1<=r2 then
repeat
writeln(f1,r2);
r1:=r2;
myread(tek_file,r2);
until r1>=r2;
end;
begin
k_o:=0;
reset(f2);
reset(f3);
rewrite(f1);
if not eof(f2) then Myread(2,a);
if not eof(f3) then Myread(3,b);
while not eof(f2) and not eof(f3) do begin
if a<b then begin
Mywrite(1,a);
tek_file:=2
end
else begin
Mywrite(1,b);
tek_file:=3
end;
Myread(tek_file,x);
if tek_file=2 then begin
//if x<a then kon_otr(2,b);
a:=x;
end;
if tek_file=3 then begin
//if x<b then kon_otr(3,a);
b:=x;
end;
end;
close(f1);
close(f2);
close(f3);
end;

begin
assign(f1,'a.txt');
assign(f2,'b.txt');
assign(f3,'c.txt');
repeat
razd(f1,f2,f3);
sliyan(kol_otr);
until kol_otr=1;
close(f1);
close(f2);
close(f3);
end.

volvo
В строку поиска заносишь +естест* +слия* и получаешь десяток реализаций... Берешь любую и добавляешь вывод там, где захочется... Зачем приводить еще одну программу, к тому же заведомо нерабочую?
Lapp
Цитата(volvo @ 10.03.2011 22:03) *
Зачем приводить еще одну программу, к тому же заведомо нерабочую?

Могу высказать предположение, зачем smile.gif. Чтобы явно продемонстрировать, насколько трудно бывает людям понять, что можно делать массив из файловых переменных )). И ведь на какие ухищрения идут, а?.. lol.gif
procedure MyWrite(number:Byte; a:integer); 
begin
CASE number of
1: writeln(f1,a);
2: writeln(f2,a);
3: writeln(f3,a);
end;
end;

procedure Myread(number:Byte; var a:integer);
begin
CASE number of
1: read(f1,a);
2: read(f2,a);
3: read(f3,a)
end;
end;

function MyEof(number:Byte):Boolean;
begin
CASE number of
1: MyEof:=Eof(f1);
2: MyEof:=Eof(f2);
3: MyEof:=Eof(f3)
end;
end;

Ну, не шедевр, а?? И все вместо того, чтоб просто написать: write(f[i]), read(f[i]), eof(f[i])..
mega_chok.gif
forex1992
использование массивов запрещено, если ими пользоваться то программу легко написать smile.gif
Lapp
Цитата(forex1992 @ 11.03.2011 2:02) *
использование массивов запрещено, если ими пользоваться то программу легко написать smile.gif

А что, надо обязательно, чтоб трудно было? Просто так вырезать гланды нельзя, нужно обязательно через з@дницу?

Вот интересно все же люди мыслят. Оказывается, что программу легко написать! Но сам человек не пишет, а идет на форум и пишет условие, где НИ СЛОВА про то, что массивы использовать нельзя. Вот, чего он ждет, спрашивается? Что, когда ему напишут решение с массивом, он гордо заявит, что все вокруг - дураки? Я не понимаю, честно.

Уважаемый forex1992,
я полагаю, ты несколько ошибаешься относительно использования массивов. Их нельзя использовать вместо списков или для временного хранения содержимого списков. А то, что я написал в предыдущем посте про массив файлов, к этому не имеет ни малейшего отношения..
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.