Форум на Исходниках.RU

Сортировка

Swindler — Mon, 15 May 2006 08:08:08 +0000

Swindler: haa, обращайся, на то ж и форуи :). Только б ты новую тему завела, а то подняла какую-то доисторическую :yes: .

Сортировка

haa — Mon, 15 May 2006 08:04:27 +0000

haa: Можно к Вам обратиться за помощью?

Сортировка

alexgrus — Mon, 09 Dec 2002 21:37:49 +0000

alexgrus:

Цитата new, 09.12.02, 11:48:42

Очень остроумно. >:(

Сортировка

new — Mon, 09 Dec 2002 08:48:42 +0000

new: 1

Сортировка

GrAnd — Mon, 09 Dec 2002 06:47:19 +0000

GrAnd: А всегда пользуюсь некоторой своей модификацией сортировки Шелла.
Более оптимального не видел, и память экономит и время мизерное

rgValue - массив значений
iNextOffset - размер элемента массива
iCount - количество элементов
gIndex - результирующий массив индексов

void inline XSort(const float* rgValue, const int iNextOffset, const int iCount, int* rgIndex)
{
for(int i=0; i int iInd;
for (int h = iCount>>1; h; h>>=1)
for (int i=h; i for (int j=i-h; j>=0 && (rgValue[rgIndex[j+h]*iNextOffset] {
iInd = rgIndex[j];
rgIndex[j] = rgIndex[j+h];
rgIndex[j+h] = iInd;
}
}
;D ;D ;D

Сортировка

ADIDAS — Sat, 07 Dec 2002 23:51:54 +0000

ADIDAS: Господа не мучайтесь вот готовый код QSort всё работает.
private
{ Private declarations }
public
{ Public declarations }
end;
SetArray = array of integer;
var
Form1: TForm1;
data:SetArray;
{ ******** }
oneProcent:integer;
implementation
{$R *.DFM}
procedure quicksort(var a: SetArray; Lo,Hi: integer);
procedure sort(l,r: integer);
var
i,j,x,y: integer;
begin
i:=l; j:=r; x:=a[(l+r) DIV 2];

repeat

while a[i] while x if i<=j then
begin
y:=a[i]; a[i]:=a[j]; a[j]:=y;
i:=i+1; j:=j-1;
end;
until i>j;
Form1.Gauge1.Progress:=(j-(StrToInt(form1.Edit1.Text) div 2)) div OneProcent;
if l if i end;

begin {quicksort};
sort(Lo,Hi);
end;

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
begin
SetLength(Data,StrToInt(Edit1.Text)+1);
Randomize;
for i:=1 to StrToInt(Edit1.Text) do data[i]:=Random(StrToInt(Edit1.Text)*2);

oneProcent:=((StrToInt(Edit1.Text)-1) div 100) div 2;
quicksort(data,1,StrToInt(Edit1.Text));

for i:=1 to StrToInt(Edit1.Text) do
begin
Table.Cells[0,i]:='# '+IntToStr(i);
Table.Cells[1,i]:=IntToStr(data[i]);
Gauge2.Progress:=i div (StrToInt(Edit1.Text) div 100);

end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Table.Cells[1,0]:='QuickSort';
end;

procedure TForm1.Edit1Change(Sender: TObject);
begin
Table.RowCount:=StrToInt(Edit1.Text)+1;
end;

end.

Сортировка

DNick — Thu, 05 Dec 2002 10:11:53 +0000

DNick: Вообще-то для целых чисел самая быстрая сортировка - подсчетом (но гадина, самая расточительная в плане памяти)

Сортировка

Shiru_Otaku — Wed, 04 Dec 2002 00:08:01 +0000

Shiru_Otaku: Я-же сказал - самый быстрый метод сортировки;) В основном для целых чисел... Поищи в инете алгоритм (bit sort, битовая сортировка), он очень простой (и единственно подходящий для задач типа сортировки полигонов итп - когда массивы очень большие, т.к. он делает всего-лишь разрядность*количество прогонов)...

Сортировка

alexgrus — Sun, 01 Dec 2002 21:10:16 +0000

alexgrus:

Цитата Shiru_Otaku, 01.12.02, 03:05:47

А как-же самый быстрый метод сортировки - bitsort?

А что это за метод такой.

Спасибо всем за участие, я наконец-то разобрался с QSort.

Сортировка

Shiru_Otaku — Sun, 01 Dec 2002 00:05:47 +0000

Shiru_Otaku: А как-же самый быстрый метод сортировки - bitsort?

Сортировка

Rumata — Sat, 30 Nov 2002 23:51:53 +0000

Rumata: мне кажется, что ты вызывал ее с единичкой вместо нуля

Сортировка

Rumata — Sat, 30 Nov 2002 23:49:51 +0000

Rumata: у тебя траббл заключается в следующем....

надо вызывать свою процу именно так

const N = 20; var A: array[1..N] of Integer; I: Integer; begin A[ 1] := 38; A[ 2] := 8; A[ 3] := 3; A[ 4] := 45; A[ 5] := 12; A[ 6] := 89; A[ 7] := 15; A[ 8] := 21; A[ 9] := 8; A[10] := 89; A[11] := 7; A[12] := 34; A[13] := 3; A[14] := 38; A[15] := 40; A[16] := 18; A[17] := 19; A[18] := 5; A[19] := 1; A[20] := 56; for I := 1 to N do Write(A[I]:3); Writeln; QuickSort(A, 0, N); // не забудь!!! именно [b]НОЛЬ[/b] for I := 1 to N do Write(A[I]:3); Writeln; Writeln; end.

Сортировка

alexgrus — Thu, 28 Nov 2002 01:40:44 +0000

alexgrus: По-моему я немного поторопился. :o
Изучив и протестировав алгоритм сортировки QuickS я пришел к выводу – а ошибочка то осталась. :-[

Это ошибка заключается в том, что первый элемент массива НЕ СОРТИРУЕТСЯ а каким то образом остается постоянно первым.

Помогите найти ошибку, или хотя бы намекните где она может быть.

Сортировка

alexgrus — Sun, 24 Nov 2002 01:10:37 +0000

alexgrus: :D

Большое спасибо AleXXKSyS !!!
Я посмотрел код вроде разобрался, но чесно говоря я не ожидал что так быстро ответят.

Сортировка

AleXXKSyS — Sat, 23 Nov 2002 08:00:18 +0000

AleXXKSyS: Посмотри пример :
(* Sortirovca metodami vstavki, puzirka, viborki i bistroi sortirovki.
Puzirek: Prosmotr lineinogo massiva n! raz, v rezulitate cego
sravnivaiutsa 2 sosednih elementa i v sluacae neobhodimosti
meniaiutsa mestami(vozrastanie ili ubivanie).
Biborka: Viborka maximalnogo elementa i ustanovca ego na 1 pozitiu,
dalee nahodim maximalnii v (n-1) ostavshihsea i ustanovca ego
na 2 pozitiu, i t.d(zavisimosti ot vozrastanie ili ubivanie).
Vstavca: Poisk 2-h elementov, kotorie otsortirovani, i vstavleaem mejdu
nimi ostalinoi massiv, dalee sravnivaem sosednie elementi s
otsortirovannimi i meneaem mestami pri neobhodimosti i t.d.
do togo poka ne poluchim polnoistiu otsortirovanni massiv.
QuickSort: Samii optimalnii metod, v kotorom pri sortirovke sravnivaiutsea
naibolee dalinie kliuchi. Massiv recursivno delitsa popolam
i v poluchennih polovinkah proishodit sortirovca. *)
Program LabMPI2;
Uses Crt, Dos;
Const Max = 1500; { Max=8000 }
Type MaxArray = array[1..Max] of Integer;
var i, j, T : Integer;
A, BubbleSortArray,
SelectionSortArray,
QuickSortArray,
InsertSortArray : MaxArray;
hour0, hour1, min0, min1,
sec0, sec1, hund0, hund1 : Word;
SelectionTime, InsertTime,
BubbleTime, QuickTime : LongInt;
F : text;
Procedure BubbleSort(var _A: array of Integer);
begin
for I := High(_A) downto Low(_A) do
for J := Low(_A) to High(_A) - 1 do
if _A[J] > _A[J + 1] then
begin
T := _A[J];
_A[J] := _A[J + 1];
_A[J + 1] := T;
end;
end;
Procedure SelectionSort(var _A: array of Integer);
begin
for I := Low(_A) to High(_A) - 1 do
for J := High(_A) downto I + 1 do
if _A[I] > _A[J] then
begin
T := _A[I];
_A[I] := _A[J];
_A[J] := T;
end;
end;
Procedure QuickSort(var _A: array of Integer);

procedure QuickS(var _A: array of Integer; iLo, iHi: Integer);
var
Lo, Hi, Mid: Integer;
begin
Lo := iLo;
Hi := iHi;
Mid := _A[(Lo + Hi) div 2];
repeat
while _A[Lo] < Mid do Inc(Lo);
while _A[Hi] > Mid do Dec(Hi);
if Lo <= Hi then
begin
T := _A[Lo];
_A[Lo] := _A[Hi];
_A[Hi] := T;
Inc(Lo);
Dec(Hi);
end;
until Lo > Hi;
if Hi > iLo then QuickS(_A, iLo, Hi);
if Lo < iHi then QuickS(_A, Lo, iHi);
end;

begin
QuickS(_A, Low(_A), High(_A));
end;

Procedure InsertSort(Var _A: array of Integer);
begin
for i:=1 to Max do
begin
T := _A[i];
j := i-1;
while( (j>=0)and(_A[j]>T) )do
begin
_A[j+1] := _A[j];
j := j-1;
end;
_A[j+1] := T;
end;
end;

begin
ClrScr;
Randomize;
for i := 1 to Max do A[i] := random(Max);
for i := 1 to Max do
begin
QuickSortArray[i] := A[i];
InsertSortArray[i] := A[i];
BubbleSortArray[i] := A[i];
SelectionSortArray[i] := A[i];
end;

Assign(F, 'Sorting.txt');
ReWrite(F);
WriteLn('Press any key to begin sorting');
ReadKey;

GetTime(hour0,min0,sec0,hund0);
QuickSort(QuickSortArray);
GetTime(hour1,min1,sec1,hund1);
QuickTime := (sec1-sec0)*100 + hund1-hund0;

GetTime(hour0,min0,sec0,hund0);
SelectionSort(SelectionSortArray);
GetTime(hour1,min1,sec1,hund1);
SelectionTime := (sec1-sec0)*100 + hund1-hund0 ;

GetTime(hour0,min0,sec0,hund0);
BubbleSort(BubbleSortArray);
GetTime(hour1,min1,sec1,hund1);
BubbleTime := (sec1-sec0)*100 + hund1-hund0;

GetTime(hour0,min0,sec0,hund0);
InsertSort(InsertSortArray);
GetTime(hour1,min1,sec1,hund1);
InsertTime := (sec1-sec0)*100 + hund1-hund0;

WriteLn(F, ' Quick Select Bubble Insert UnSorted');
for i := 1 to Max do
WriteLn(F, QuickSortArray[i]:6, ' ',
SelectionSortArray[i]:6,' ',
BubbleSortArray[i]:6, ' ',
InsertSortArray[i]:6, ' ', A[i]:6);
Close(F);
WriteLn('QuickTime = ', QuickTime,' msec');
WriteLn('InsertTime = ', InsertTime,' msec');
WriteLn('SelectionTime = ', SelectionTime,' msec');
WriteLn('BubbleTime = ', BubbleTime,' msec');
ReadKey;
end.

Сортировка

alexgrus — Sat, 23 Nov 2002 04:22:41 +0000

alexgrus: Помогите, найти ошибку в этом коде (Я не ленивый у меня просто не хватает времени). Ошибка заключается в следующем: сортируя массив:
A[1] := 38; A[2] := 8; A[3] := 3; A[4] := 45; A[5] := 12;
A[6] := 89; A[7] := 15; A[8] := 21; A[9] := 8; A[10] := 89;
A[11] := 7; A[12] := 34; A[13] := 3; A[14] := 38; A[15] := 40;
A[16] := 18; A[17] := 19; A[18] := 5; A[19] := 1; A[20] := 56;
при помощи этого кода у меня получается: 38, 1, 3, 5, 7, 3, 8, 8, 12, 15, 18, 19, 21, 34, 38, 40, 56, 89, 45, 89.

И если возможно, подскажите, может быть есть более эффективный способ сортировки массива (желательно оптимизируя этот код).

procedure TForm1.InsertSort(var A: array of integer; ABeg, AEnd: integer);
var CountBeg, CountEnd, Temp: integer;
begin
CountBeg := ABeg + 1;
while CountBeg <= AEnd do
begin
Temp := A[CountBeg];
CountEnd := CountBeg - 1;
while (CountEnd >= ABeg) and (A[CountEnd] > Temp) do
begin
A[CountEnd + 1] := A[CountEnd];
CountEnd := CountEnd - 1;
end;
A[CountEnd + 1] := Temp;
CountBeg := CountBeg + 1;
end;
end;

function TForm1.Partition(var A: array of integer; ABeg, AEnd: integer): integer;
var
CountBeg, CountEnd,
Pivot,
Center,
Temp: integer;
begin
Center := ABeg + ((AEnd - ABeg) div 2);
Pivot := A[Center];
A[Center] := A[ABeg];
CountBeg := ABeg + 1;
CountEnd := AEnd;
while CountBeg < CountEnd do
begin
while (CountBeg < CountEnd) and (Pivot > a[CountBeg]) do
CountBeg := CountBeg + 1;
while (CountBeg <= CountEnd) and (Pivot < a[CountEnd]) do
CountEnd := CountEnd - 1;
//Переставляем элементы местами
Temp := A[CountBeg];
A[CountBeg] := A[CountEnd];
A[CountEnd] := Temp;
CountEnd := CountEnd - 1;
CountBeg := CountBeg + 1;
end;
A[ABeg] := A[CountEnd];
A[CountEnd] := Pivot;
Partition := CountEnd;
end;

procedure TForm1.QuickSort(var A: array of integer; ABeg, AEnd: integer);
var Center: integer;
begin
while ABeg < AEnd do
begin
if (AEnd - ABeg) <= 12 then begin
InsertSort(A, ABeg, AEnd);
break;
end
else begin
Center := Partition(A, ABeg, AEnd);
if (Center - ABeg) <= (AEnd - Center) then begin
QuickSort(A, ABeg, Center - 1);
ABeg := Center + 1;
end
else begin
QuickSort(A, Center + 1, AEnd);
AEnd := Center - 1;
end;
end;

end;
end;

В принципе код не сложный, поэтому я не стал его комментировать.