На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! правила раздела Алгоритмы
1. Помните, что название темы должно хоть как-то отражать ее содержимое (не создавайте темы с заголовком ПОМОГИТЕ, HELP и т.д.). Злоупотребление заглавными буквами в заголовках тем ЗАПРЕЩЕНО.
2. При создании темы постарайтесь, как можно более точно описать проблему, а не ограничиваться общими понятиями и определениями.
3. Приводимые фрагменты исходного кода старайтесь выделять тегами code.../code
4. Помните, чем подробнее Вы опишете свою проблему, тем быстрее получите вразумительный совет
5. Запрещено поднимать неактуальные темы (ПРИМЕР: запрещено отвечать на вопрос из серии "срочно надо", заданный в 2003 году)
6. И не забывайте о кнопочках TRANSLIT и РУССКАЯ КЛАВИАТУРА, если не можете писать в русской раскладке :)
Модераторы: Akina, shadeofgray
Страницы: (2) [1] 2  все  ( Перейти к последнему сообщению )  
> Сортировка
    Помогите, найти ошибку в этом коде (Я не ленивый у меня просто не хватает времени). Ошибка заключается в следующем: сортируя массив:
    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.
        :D

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

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

          Помогите найти ошибку, или хотя бы намекните где она может быть.
            у тебя траббл заключается в следующем....

            надо вызывать свою процу именно так
            ExpandedWrap disabled
              <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 -
              мне кажется, что ты вызывал ее с единичкой вместо нуля
                А как-же самый быстрый метод сортировки - 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


                              Очень остроумно. >:(
                                Можно к Вам обратиться за помощью?
                                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                0 пользователей:


                                Рейтинг@Mail.ru
                                [ Script execution time: 0,0731 ]   [ 15 queries used ]   [ Generated: 21.05.24, 06:51 GMT ]