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

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

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

 
 Ответить  Открыть новую тему 
> Внешние сортировки, Помогите пожалуйста написать программу внешней сортировки
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Danil

Репутация: -  0  +


Здравствуйте!!!!
Подскажите или напишите пожалуйста программу сортировки естественным слиянием,
результат сортировки должен быть представлен после выполнения каждого шага

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.

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


Гость






В строку поиска заносишь +естест* +слия* и получаешь десяток реализаций... Берешь любую и добавляешь вывод там, где захочется... Зачем приводить еще одну программу, к тому же заведомо нерабочую?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





Группа: Пользователи
Сообщений: 2
Пол: Мужской
Реальное имя: Danil

Репутация: -  0  +


использование массивов запрещено, если ими пользоваться то программу легко написать smile.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(forex1992 @ 11.03.2011 2:02) *
использование массивов запрещено, если ими пользоваться то программу легко написать smile.gif

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

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

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


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 29.10.2020 12:53
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name