| Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате |
| Форум программистов > Центр помощи > [Pascal&Delphi] Лаба по многофазной сортировке |
| Автор: zarogon 15.1.2007, 17:10 |
| Всем доброго времени суток. Задали лабу реализовать алгоритм многофазной сортировки слиянием в файлах на Делфи или Паскале. Вот суть Многоканальную (m-канальную) сортировку слиянием можно выполнить с помо- помощью лишь т + 1 файлов (в отличие от описанной выше 2/п-файловой стратегии). При этом выполняется ряд проходов с объединением серий из т файлов в более длинные серии в (т + 1)-м файле. Вот последовательные шаги такой процедуры. 1. В течение одного прохода, когда серии от каждого из т файлов объединяются в серии (т + 1)-го файла, нет нужды использовать все серии от каждого из т входных файлов. Когда какой-либо из файлов становится выходным, он запол- заполняется сериями определенной длины, причем количество этих серий равно ми- минимальному количеству серий, находящихся в сливаемых файлах. 2. В результате каждого прохода получаются файлы разной длины. Поскольку ка- каждый из файлов, загруженных сериями в результате предшествующих т прохо- проходов, вносит свой вклад в серии текущего прохода, длина всех серий на опреде- определенном проходе представляет собой сумму длин серий, созданных за предшест- предшествующие т проходов. (Если выполнено менее т проходов, можно считать, что гипотетические проходы, выполненные до первого прохода, создавали серии длины 1.). Подобный процесс сортировки слиянием называется многофазной сортировкой. Кто знает помогите пожалуйста Заранее благодарен |
| Автор: shamm 4.5.2009, 22:03 |
| Я не программист, но что-то получилось. unit sort; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ExtCtrls, Grids, ComCtrls; type TForm1 = class(TForm) Panel1: TPanel; Label1: TLabel; Edit1: TEdit; GroupBox1: TGroupBox; Button1: TButton; Button2: TButton; StringGrid1: TStringGrid; StringGrid2: TStringGrid; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label6: TLabel; T1: TStringGrid; T2: TStringGrid; T3: TStringGrid; Label7: TLabel; Label8: TLabel; Label9: TLabel; StringGrid4: TStringGrid; Label10: TLabel; Edit2: TEdit; Label5: TLabel; Label11: TLabel; Button3: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Edit2Change(Sender: TObject); procedure Button3Click(Sender: TObject); private { Private declarations } public { Public declarations } end; const max = 10000; // максимальное значение элементов массива var Form1: TForm1; elm : integer; // число элементов массива i,j,k,contr : integer; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); // создать и заполнить массив произвольными элементами var i : integer; // параметр цикла begin elm:=StrToInt(Edit1.Text); // кол-во элементов массива Randomize; // инициализация генератора псевдослучайных чисел if (elm < 1) then begin ShowMessage('Oшибка. Массив не создан!'); elm:=0; end else begin StringGrid1.colcount:=elm; // ввод размерности массива StringGrid2.colcount:=elm; StringGrid4.colcount:=elm; end; for i:=1 to elm do StringGrid1.Cells[i-1,0]:= IntToStr(Random(max)+1); // заполнение массива элементами Button2.Visible:=true; // кнопка сортировки видима end; procedure TForm1.Button2Click(Sender: TObject); //сортировка const bf = 6; //размер буфера var buf :array [1..bf] of integer; // задаем буфер serBeg,ser,sera,serb,seraBeg,serbBeg : integer; //начало серии в массиве pust,pustf :integer; // число пустых элементов, серий в промежуточном массиве f,f1,f2: integer; // числа Фибоначчи p1,p2,p3: integer; // число элементов в отрезках m : array [1..3,1..2] of integer; // хранение длины и числа серий a,b,c :integer; h, min, s, ms:word; procedure BubbleSort; // подпрограмма сортировки пузырьком var i,j,x : integer; begin for i :=1 to bf-1 do for j := i+1 to bf do if buf[i]>buf[j] then begin x := buf[i]; buf[i] := buf[j]; buf[j] := x end; end; begin serBeg:=0; // начало отсчета серии pust:=0; // обнуление количества пустых элементов ser:=0; // количество серий sera:=0; // число серий в массиве a serb:=0; // число серий в массиве b seraBeg:=1; // начало первой серии в массиве а serbBeg:=1; // начало первой серии в массиве b T2.ColCount:=0; T3.ColCount:=0; T1.ColCount:=0; Label6.Caption:= FloatToStr(Time); while (serbeg<elm) do begin for i:=1 to bf do // перенос первой серии в буфер begin if (serBeg+i)<= elm then begin buf[i]:= StrToInt(StringGrid1.Cells [serBeg-1+i,0]); //считываем серию и заносим в буфер end else begin buf[i]:= 0; // заполнение недостающих элементов нулями pust:=pust+1; // счетчик лишних нулей end; end; BubbleSort; // сортировка буфера пузырьком ser:=ser+1; // счетчик общих серий // перенос из буфера в вспомогательный массив T1.ColCount:=serBeg+bf; //размер вспомог массива for i:=1 to bf do //запись серии из буфера в a T1.Cells[serBeg-1+i,0]:=IntToStr(buf[i]); // вывод буфера на 2 serBeg := serBeg+bf; //конец след серии end; // вычисление чисел Фибоначчи f1:=0;f2:=1; // первые числа Фибоначчи f:=f1+f2; //след число while(f<ser) do begin f1:=f2; f2:=f; f:=f1+f2; end; pustf:=f-ser; // добавляем фиктивные серии for j:=1 to pustf do begin ser:=ser+1; // счетчик общих серий T1.ColCount:=serBeg+bf; //размер вспомог массива for i:=1 to bf do //запись серии из буфера в a begin T1.Cells[serBeg-1+i,0]:=IntToStr(0); // вывод буфера на 2 pust:= pust+1; end; serBeg := serBeg+bf; //конец след серии end; //распределение серий по массивам в второй запишемменьшее число Фибоначчи p1:=bf*f1; //кол -во элементов во втором массиве p2:=bf*f2; //кол -во элементов в третьем массиве p3:=p1+p2; //общее число элементов T2.ColCount:=p1; T3.ColCount:=p2; for i:=1 to p1 do // Перенесем в 4 массив p1 элементов T2.Cells[i-1,0]:=T1.Cells[i-1,0]; p1:=p1; for i:=1 to p2 do // Перенесем в 5 массив остальные элементы T3.Cells[i-1,0]:=T1.Cells[i-1+p1,0]; // создадим массив для размера 3х3 столбцы - ленты, 1 строка - длина серии, // 2 строка элементов в серии, 3 строка -элементов в массиве // заполним его элементами m[1,1]:=0; // серий в 1 массиве m[2,1]:=f1; // серий в 2 массиве m[3,1]:=f2; // серий в 3 массиве m[1,2]:=0; // длина серий в 1 массиве m[2,2]:=bf; // длина серий в 2 массиве m[3,2]:=bf; // длина серий в 3 массиве // перематываем все ленты на начало i:=1; j:=1; k:=1; while m[1,1]+m[2,1]+m[3,1]<>1 do //выполняем, пока на лентах не останется только одна серия begin if m[1,1]=0 then //сливаем 2и3 ленты на 1 begin k:=1; //начало ленты m[1,2]:=m[2,2]+m[3,2]; //новая длина серии в 1 ленте if m[2,1]<m[3,1] then T1.ColCount:=m[2,1]*m[1,2] else T1.ColCount:=m[3,1]*m[1,2]; //новая длина 1 ленты while m[2,1]*m[3,1]<>0 do //пока число серий во 2 или 3 ленте не станет равным нулю begin b:=m[2,2]; //длина выбраной серии во 2-й ленте c:=m[3,2]; //длина выбраной серии в 3-й ленте while (b*c)<>0 do begin if StrToInt(T2.Cells[i-1,0]) < StrToInt(T3.Cells[j-1,0])then //сравниваем элементы begin T1.Cells[k-1,0]:= T2.Cells[i-1,0]; i:=i+1; b:=b-1; end else begin T1.Cells[k-1,0]:= T3.Cells[j-1,0]; j:=j+1; c:=c-1; end; k:=k+1; end; if b=0 then begin while c<>0 do begin T1.Cells[k-1,0]:= T3.Cells[j-1,0]; j:=j+1; c:=c-1; k:=k+1; end; end else begin while b<>0 do begin T1.Cells[k-1,0]:= T2.Cells[i-1,0]; i:=i+1; b:=b-1; k:=k+1; end; end; m[1,1]:=m[1,1]+1; m[2,1]:=m[2,1]-1; m[3,1]:=m[3,1]-1; end; k:=1; //перемотка ленты на начало end else if m[2,1]=0 then //сливаем 1и3 ленты на 2 begin i:=1; //начало ленты m[2,2]:=m[1,2]+m[3,2]; //новая длина серии для 2 ленты if m[1,1]<m[3,1] then T2.ColCount:=m[1,1]*m[2,2] else T2.ColCount:=m[3,1]*m[2,2]; //новая длина 2 ленты while m[1,1]*m[3,1]<>0 do //пока число серий в 1 или 3 ленте не станет равным нулю begin a:=m[1,2]; //длина выбраной серии во 2-й ленте c:=m[3,2]; //длина выбраной серии в 3-й ленте while (a*c)<>0 do begin if StrToInt(T1.Cells[k-1,0]) < StrToInt(T3.Cells[j-1,0])then //сравниваем элементы begin T2.Cells[i-1,0]:= T1.Cells[k-1,0]; k:=k+1; a:=a-1; end else begin T2.Cells[i-1,0]:= T3.Cells[j-1,0]; j:=j+1; c:=c-1; end; i:=i+1; end; if a=0 then begin while c<>0 do begin T2.Cells[i-1,0]:= T3.Cells[j-1,0]; j:=j+1; c:=c-1; i:=i+1; end; end else begin while a<>0 do begin T2.Cells[i-1,0]:= T1.Cells[k-1,0]; k:=k+1; a:=a-1; i:=i+1; end; end; m[2,1]:=m[2,1]+1; m[1,1]:=m[1,1]-1; m[3,1]:=m[3,1]-1; end; i:=1; // перемотка ленты 2 на начало end else if m[3,1]=0 then //сливаем 1и 2 ленты на 3 begin j:=1; //начало ленты m[3,2]:=m[1,2]+m[2,2]; //новая длина серии 3 if m[1,1]<m[2,1] then T3.ColCount:=m[1,1]*m[3,2] else T3.ColCount:=m[2,1]*m[3,2]; //новая длина 3 ленты while m[1,1]*m[2,1]<>0 do //пока число серий в 1 или 2 ленте не станет равным нулю begin a:=m[1,2]; //длина выбраной серии во 2-й ленте b:=m[2,2]; //длина выбраной серии в 3-й ленте while (a*b)<>0 do begin if StrToInt(T1.Cells[k-1,0]) < StrToInt(T2.Cells[i-1,0])then //сравниваем элементы begin T3.Cells[j-1,0]:= T1.Cells[k-1,0]; k:=k+1; a:=a-1; end else begin T3.Cells[j-1,0]:= T2.Cells[i-1,0]; i:=i+1; b:=b-1; end; j:=j+1; end; if a=0 then begin while b<>0 do begin T3.Cells[j-1,0]:= T2.Cells[i-1,0]; i:=i+1; b:=b-1; j:=j+1; end; end else begin while a<>0 do begin T3.Cells[j-1,0]:= T1.Cells[k-1,0]; k:=k+1; a:=a-1; j:=j+1; end; end; m[3,1]:=m[3,1]+1; m[1,1]:=m[1,1]-1; m[2,1]:=m[2,1]-1; end; j:=1; // перемотка ленты 2 на начало end; end; // отбрасываем пустые элементы, выводим результаты if m[1,1]=1 then for i:=1 to elm do begin StringGrid2.Cells[i-1,0]:=T1.Cells[i-1+pust,0]; StringGrid4.Cells[elm-i,0]:=T1.Cells[i-1+pust,0]; end; if m[2,1]=1 then for i:=1 to elm do begin StringGrid2.Cells[i-1,0]:=T2.Cells[i-1+pust,0]; StringGrid4.Cells[elm-i,0]:=T2.Cells[i-1+pust,0]; end; if m[3,1]=1 then for i:=1 to elm do begin StringGrid2.Cells[i-1,0]:=T3.Cells[i-1+pust,0]; StringGrid4.Cells[elm-i,0]:=T3.Cells[i-1+pust,0]; end; DecodeTime(Time-StrToFloat(Label6.Caption), h, min, s, ms); Label6.Caption:= IntToStr(s)+'s '+ IntToStr(ms)+'ms'; Edit2.Visible:=true; end; procedure TForm1.Edit2Change(Sender: TObject); //поиск элемента begin Button3.Visible:= False; if (StrToInt(Edit2.Text) <= max) and (StrToInt(Edit2.Text) <> 0) then Button3.Visible:=True ; StringGrid2.Col:=0; StringGrid4.Col:=0; end; procedure TForm1.Button3Click(Sender: TObject); (*реализация быстрого последовательного поиска. Алгоритм Q*) var h, min, s, ms:word; begin Label11.Caption:=FloatToStr(Time); StringGrid2.colcount:=elm+1; i:=1; //Q1 инициализация StringGrid2.Cells[elm,0]:= Edit2.Text; while StrToInt(Edit2.Text)<> StrToInt (StringGrid2.Cells[i-1,0])do // Q2 сравнение i:=i+1; //Q3 продвижение if i<=elm then //Q4 конец файла? begin DecodeTime(Time-StrToFloat(Label11.Caption), h, min, s, ms); //расчет времени поиска Label11.Caption:= IntToStr(s)+'s '+ IntToStr(ms)+'ms'; StringGrid2.Col:=i-1; // показать результат поиска StringGrid4.Col:=elm-i; end else Label11.Caption:='Такого элемента нет!'; end; end. |