IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Естественное слияние!, Естественное слияние!
сообщение
Сообщение #1


Гость






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

Вот листинг проги:
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

 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Помогите мне,пожалуйста...не могу додуматься как это сделать.... wink.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Цитата(Гость @ 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
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 26.09.2017 23:35
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"