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

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

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

 
 Ответить  Открыть новую тему 
> Естественное слияние!, Естественное слияние!
DISAPP
сообщение 29.06.2006 14:08
Сообщение #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

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


Гость






Помогите мне,пожалуйста...не могу додуматься как это сделать.... wink.gif
 К началу страницы 
+ Ответить 
volvo
сообщение 29.06.2006 17:34
Сообщение #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
 К началу страницы 
+ Ответить 
Гость
сообщение 29.06.2006 19:03
Сообщение #4


Гость






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

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

 



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