Сортировка

Помогите, найти ошибку в этом коде (Я не ленивый у меня просто не хватает времени). Ошибка заключается в следующем: сортируя массив:
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;

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

Посмотри пример :
(* 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.

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

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

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

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

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

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

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

Сообщение отредактировано: Rumata - 30.11.02, 23:52

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

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

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

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

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

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

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

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

Господа не мучайтесь вот готовый код 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]<x do i:=i+1;
           while x<a[j] do j:=j-1;
           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<j then sort(l,j);
         if i<r then sort(i,r);
       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.

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

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


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

1

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

1

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

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