Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Естественное слияние!

Автор: DISAPP 29.06.2006 18:08

Задание: написать программу, реализующую сортировку файлов методом естественного слияния....

Вот листинг проги:

Uses CRT;

Type
item = record
key : integer;
end;

filetype = file of item;

Var
a,b,c : filetype;
z : integer;
eor : boolean;

Procedure Create;
Var
i : byte;
buf : item;
begin
rewrite( c );
randomize;
for i:=1 to 20 do
begin
buf.key:=random(100);
Write(c,buf);
end;
close( c );
end;

Procedure View;
Var
buf : item;
begin
reset( c );
repeat
Read(c,buf);
Write(buf.key,' ');
until eof( c );
readkey;
end;

Procedure Copy(var x,y:filetype);
Var
buf,buf1 : item;
begin
Read(x,buf);
Write(y,buf);
if eof(x) then eor:=true
else
begin
Read(x,buf1);
seek(x,filepos(x)-1);
eor:=buf1.key<buf.key
end;
end;

Procedure Copyrun(var x,y:filetype);
begin
repeat
Copy(x,y);
until eor;
end;

Procedure Mergerun;
Var
bufa,bufb : item;
begin
repeat
Read(a,bufa);
seek(a,filepos(a)-1);
Read(b,bufb);
seek(b,filepos(b)-1);
if bufa.key<bufb.key then
begin;
copy(a,c);
if eor then Copyrun(b,c);
end
else
begin;
Copy(b,c);
if eor then Copyrun(a,c);
end;
until eor
end;

Procedure Distribute;
begin
reset( c );
rewrite(a);
rewrite(b);
repeat
Copyrun(c,a);
if not eof( c ) then Copyrun(c,b);
until eof( c );
close(a);
close(b);
close( c );
end;

Procedure Merge;
begin
reset(a);
reset(b);
rewrite( c );
while (not eof(a)) and (not eof(b)) do
begin
Mergerun;
z:=z+1;
end;
while not eof(a) do
begin;
Copyrun(a,c);
z:=z+1;
end;
while not eof(b) do
begin;
Copyrun(b,c);
z:=z+1;
end;
close(a);
close(b);
close( c );
end;


Begin
clrscr;
textcolor(white);
assign(a,'c:a');
assign(b,'c:b');
assign(c,'c:c');
Create;
View;
repeat
Distribute;
z:=0;
Merge;
until z=1;
WriteLn;
View;
end.

Выводит: например,
2 4 7 6 9 6 1 5 8 8 7
1 2 4 5 6 6 7 7 8 8 9

Что нужно написать, чтобы выводила еще и этапы сортировки?
например:
17 31' 5 59' 13 41 43 67' 11 23 29 47' 3 7 71' 2 19 57' 37 61
5 17 31' 59' 11 13 23 29 41 43 47 67' 2 3 7 19 57 71' 37 61
5 11 13 17 23 29 31 41 43 47 59 67' 2 3 7 19 37 57 61 71
2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 57 59 61 67 71

ПОМОГИТЕ ПОЖАЛУЙСТА!!!!!!!!ОЧЕНЬ СРОЧНО!!!!
p.s. Если кто-нить увидит какие-нить минусы в проге, напишите о них...

М
Не дублируй темы.
Прочитай правила форума, особенно внимательно пункты 4 и 5


Автор: Гость 29.06.2006 20:37

Помогите мне,пожалуйста...не могу додуматься как это сделать.... wink.gif

Автор: volvo 29.06.2006 21:34

Цитата(Гость @ 29.06.2006 16:37)
Помогите мне,пожалуйста...не могу додуматься как это сделать.... wink.gif

Основную программу переписать вот так:
Begin
clrscr; textcolor(white);
assign(a,'c:\a');
assign(b,'c:\b');
assign(c,'c:\c');
Create;
View;
repeat
Distribute;
z:=0;
Merge;
writeln; View; writeln;
until z=1;
end.
и тебе опять будет счастье smile.gif

Автор: Гость 29.06.2006 23:03

Спасибо!!!
Ты призван делать людей счастливыми!!!