|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Помогите с программой
Может кто шарит..... а может и нет.... но все равно спрошу.....
У меня курсач на тему: Внешняя многофазная сортировка слиянием. Можешь язык поломать(((( Не знаю как сделать..... как эту гребанную сортировку слить???? Как на зло в нете не нашел алгоритма на Delphi. Как я понимаю тут 2 массива и необходимо отсортировать слиянием. Помогите кто знает как.... Заранее благодарен))) |
#2
|
|||
|
|||
Голову долго ломал и в итоге сам что-то написал
|
#3
|
|||
|
|||
Код:
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; end. |
#4
|
||||
|
||||
ТЕГИ ГДЕ???
//Может, зделать меня модером... АДМ, в личку плз требования к модеру, скорее всего подойду... Оставайтесь хорошими людьми... VK id2634397, ds [at] phoenix [dot] dj |
#5
|
||||
|
||||
Просвятите неуча. Какова дальнейшая практическая цель в этой портянке?
Жизнь такова какова она есть и больше никакова. Помогаю за спасибо. |