Внешняя сортировка с использованием однофазного естественного слияния |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Внешняя сортировка с использованием однофазного естественного слияния |
ARMAGEDON |
Сообщение
#1
|
Новичок Группа: Пользователи Сообщений: 12 Пол: Мужской Репутация: 0 |
Срочно нужна программа внешней сортировки с использованием однофазного естественного слияния на языке Pascal, желательно с комментариями, пояснениями, а то курсач на носу!!! People,помогите кто чем может)))
|
ARMAGEDON |
Сообщение
#2
|
Новичок Группа: Пользователи Сообщений: 12 Пол: Мужской Репутация: 0 |
Кто то там пищал что такая сортировка невозможна, ну вот например я вот так реализовал ее, переделав двухфазную.
ВНЕШНЯЯ СОРТИРОВКА С ИСПОЛЬЗОВАНИЕМ ОДНОФАЗНОГО ЕСТЕСТВЕННОГО СЛИЯНИЯ program naturalmerge; uses CRT; type item = record key:integer; end; filetype = file of item; var a,b,c,d,e:filetype; z:integer; eor:boolean; procedure create; var i: byte; buf: item; begin rewrite©; randomize; for i:=1 to 20 do begin buf.key:=random(100); write(c,buf); end; close©; end; procedure view(var x:filetype); var buf: item; begin reset(x); if filesize(x)<>0 then begin repeat read(x,buf); write(buf.key,' '); until eof(x); writeln; readkey; end; 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 distribute; begin reset©;rewrite(a);rewrite(b); repeat copyrun(c,a); if not eof© then copyrun(c,b); until eof©; write('A= '); view(a); write('B= '); view(b); close(a);close(b);close©; end; procedure mergerun (var w,y,x:filetype); var bufa,bufb:item; begin repeat read(w,bufa); seek(w,filepos(w)-1); read(y,bufb); seek(y,filepos(y)-1); if bufa.key<bufb.key then begin copy(w,x); if eor then copyrun(y,x); end else begin copy(y,x); if eor then copyrun(w,x); end; until eor end; procedure merge; label m1,m2; begin m1: z:=1; reset(a);reset(b); rewrite(d); rewrite(e) ; while (not eof(a)) and (not eof(b)) do begin if odd(z) then mergerun(a,b,d) else mergerun(a,b,e); z:=z+1; end; while not eof(a) do begin copyrun(a,d); z:=z+1; end; while not eof(b) do begin copyrun(b,e);z:=z+1; end; if filesize(d)<>0 then write('D= '); view(d); if filesize(e)<>0 then write('E= '); view(e) ; writeln; If (filesize(e)=0) or (filesize(d)=0) then begin writeln('OTSORTIROVAN'); exit; end; if (eof(a)) and (eof(b)) then goto m2; m2: Z:=1; reset(d); reset(e); rewrite(a); rewrite(b); while (not eof(d)) and (not eof(e)) do begin if odd(z) then mergerun(d,e,a) else mergerun(d,e,b); z:=z+1; end; while not eof(d) do begin copyrun(d,b); z:=z+1; end; while not eof(e) do begin copyrun(e,a); z:=z+1; end; if filesize(a)<>0 then write('A= '); view(a); if filesize(b)<>0 then write('B= '); view(b) ; If (filesize(a)=0) or (filesize(b)=0) then begin writeln('OTSORTIROVAN'); readkey;exit; end; if (eof(d)) and (eof(e)) then goto m1; close(a);close(b); close(d); close(e); end; begin {main} clrscr; assign(a,'a.txt'); assign(b,'b.txt'); assign(c,'c.txt'); assign(d,'d.txt'); assign(e,'e.txt'); create; writeln('Ishodniy massiv '); view©; distribute; z:=0; merge; writeln('++++++++++++++++++++++++++++++++++++++++++++++++++++') ; end. Сообщение отредактировано: ARMAGEDON - |
Текстовая версия | 20.05.2024 5:42 |