Delphi dicas

Unidade de busca

// Unidade de Ordenação

// Desenvolvida por FABIO ANDRIOLI SILVA

// Email:  fabio.andrioli@terra.com.br

// Reune os principais metonos de ordenação

// A ordenação e feita por ordem de caracteres, assim serve tanto para ordenaão numerica como de strings







unit MetodosOrd;



interface



type



        TVetorCar = array [1..1000] of string;



        TOrdem = (Crescente, Decrescente);



        TMetodoOrd = class

        private

        procedure Troca(var Valor1, Valor2:String; troc1,troc2:Integer);

        public

        procedure InsercaoDireta (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure ShellSort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure HeapSort       (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure SelectionSort  (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure BubbleSort     (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure ShakeSort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure CombSort       (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

        procedure Quicksort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

end;



implementation



uses UMain;





//======================           INSERÇÃO DIRETA            ==================

procedure TMetodoOrd.InsercaoDireta (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

i,j,k : integer;

ch: string;                                         {ch: chave a ser inserida}

begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;

        for i:= 2 to nPt do begin              {i: posição do elemento a ser inserido}

                k:= 1;

                j:= i-1;

                ch:= VetorCar[i];

                While (j >= 1) and (k = 1) do begin      {k, j: início do primeiro segmento}



                        case Ordem of

                        Crescente: begin

                                inc(MainForm.nComp);

                                If (ch < VetorCar[j]) then begin

                                        inc(MainForm.nTroc);

                                        VetorCar[j+1] := VetorCar[j];

                                        j:= j-1;

                                        MainForm.AtualizaTab(0,j+1);

                                end else

                                k:= j+1

                        end;



                        Decrescente: begin

                                inc(MainForm.nComp);

                                If (ch > VetorCar[j]) then begin

                                        inc(MainForm.nTroc);

                                        VetorCar[j+1] := VetorCar[j];

                                        j:= j-1;

                                        MainForm.AtualizaTab(0,j+1);

                                end else

                                k:= j+1

                        end;



                end;

        end;



        VetorCar[k] := ch;

        MainForm.AtualizaTab(0,k);

end;

end;





//======================           SHELL SORT                 ==================

procedure TMetodoOrd.ShellSort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

gap, i, j, k : integer;

begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;



        gap := nPt div 2;

        while (gap > 0) do begin

                for i := (gap + 1) to nPt do begin

                        j:= i - gap;

                        while (j > 0) do begin

                                k:= j+ gap;

                                inc(MainForm.nComp);



                                case Ordem of

                                Crescente:   begin                                //Ordem Crescente

                                        if (VetorCar[j] > VetorCar[k]) then begin

                                                Troca(VetorCar[j],VetorCar[k],j,k);

                                        end else

                                        j:=0;

                                end;

                                Decrescente: begin                                //Ordem Decrescente

                                        if (VetorCar[j] < VetorCar[k]) then begin

                                                Troca(VetorCar[j],VetorCar[k],j,k);

                                        end else

                                        j:=0;

                                end;

                        end;



                        j:= j - gap;

                end;

        end;



        gap := gap div 2;

end;

end;





//======================           HEAP SORT                  ==================

procedure TMetodoOrd.HeapSort       (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

i, left, right : integer;



//------------------------------------------------------------------------------

procedure Heapfy(L, R : LongInt);

var

i, j : LongInt;

x : String;

begin

        i := L;

        j := 2 * L;

        x := VetorCar[i];





        case Ordem of

        Crescente: begin                                //Ordem Crescente



                if (j < R) and (VetorCar[j + 1] > VetorCar[j]) then

                Inc(j);



                while (j <= R) and (VetorCar[j] > x) do begin

                        VetorCar[i] := VetorCar[j];

                        MainForm.AtualizaTab(i,j);

                        inc(MainForm.nTroc);

                        i := j;

                        j := j * 2;

                        if (j < R) and (VetorCar[j + 1] > VetorCar[j]) then

                        Inc(j);

                end;

        end;

        Decrescente: begin                              //Ordem Decrescente



                if (j < R) and (VetorCar[j + 1] < VetorCar[j]) then

                Inc(j);



                while (j <= R) and (VetorCar[j] < x) do begin

                        VetorCar[i] := VetorCar[j];

                        MainForm.AtualizaTab(i,j);

                        inc(MainForm.nTroc);

                        i := j;

                        j := j * 2;

                        inc(MainForm.nComp,2);                //soma a comparação do "while" + "if"

                        if (j < R) and (VetorCar[j + 1] < VetorCar[j]) then

                        Inc(j);

                end;



        end;

end;



inc(MainForm.nComp);                          //soma ultima comparação do "while"

VetorCar[i] := x;

end;

//------------------------------------------------------------------------------

begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;



        left  := (nPt div 2) + 1;

        right :=  nPt;

        while (left > 1) do begin

                dec(left);

                Heapfy(left,right);

        end;



        for i := right downto 1 do begin

                Troca(VetorCar[1],VetorCar[i],1,i);

                Heapfy(1,i - 1);

        end;

end;





//======================           SELECTION SORT             ==================

procedure TMetodoOrd.SelectionSort  (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

i,j,min : integer;



begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;



        for i:=1 to nPt do begin

                min:=i;

                for j:=i+1 to nPt do begin

                        inc(MainForm.nComp);

                        case Ordem of

                        Crescente:   if VetorCar[j]<VetorCar[min] then

                        Troca(VetorCar[j],VetorCar[min],j,min);

                        Decrescente: if VetorCar[j]>VetorCar[min] then

                        Troca(VetorCar[j],VetorCar[min],j,min)

                end;

        end;

end;

end;





//======================           BUBLE SORT                 ==================

procedure TMetodoOrd.BubbleSort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

i, j : integer;



begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;



        for i := 1 to nPt do begin

                for j := i+1 to nPt do begin

                        inc(MainForm.nComp);

                        case Ordem of

                        Crescente:    if VetorCar[i] > VetorCar[j] then

                        Troca(VetorCar[i],VetorCar[j],i,j);



                        Decrescente:  if VetorCar[i] < VetorCar[j] then

                        Troca(VetorCar[i],VetorCar[j],i,j);

                end;

        end;

end;

end;





//======================           SHAKE SORT                 ==================

procedure TMetodoOrd.ShakeSort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

i : integer;

Mudou  : boolean;

begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;



        repeat

                Mudou:= false;



                for i:= 1 to nPt-1 do begin

                        inc(MainForm.nComp);



                        case Ordem of

                        Crescente:   if (VetorCar[i] > VetorCar[i+1]) then begin

                                Troca(VetorCar[i],VetorCar[i+1],i,i+1);

                                Mudou:= true;

                        end;



                        Decrescente: if (VetorCar[i] < VetorCar[i+1]) then begin

                                Troca(VetorCar[i],VetorCar[i+1],i,i+1);

                                Mudou:= true;

                        end;

                end;



        end;



        if Mudou then begin

                Mudou:= false;



                for i:= nPt downto 2 do  begin

                        inc(MainForm.nComp);



                        case Ordem of

                        Crescente:   if (VetorCar[i] < VetorCar[i-1]) then begin

                                Troca(VetorCar[i],VetorCar[i-1],i,i-1);

                                Mudou:= true;

                        end;



                        Decrescente: if(VetorCar[i] > VetorCar[i-1]) then begin

                                Troca(VetorCar[i],VetorCar[i-1],i,i-1);

                                Mudou:= true;

                        end;



                end;

        end;

end;



until not Mudou;        //até não mudou

end;





//======================           COMB SORT                  ==================

procedure TMetodoOrd.CombSort      (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

var

gap, i,j : integer;



begin

        gap:= trunc(nPt/1.33);



        While not (gap < 1) do begin

                for i := 1 to (nPt - gap) do begin

                        j := i + gap;

                        inc(MainForm.nComp);



                        case Ordem of

                        Crescente:    if VetorCar[i] > VetorCar[j] then

                        Troca(VetorCar[i],VetorCar[j],i,j);



                        Decrescente:  if VetorCar[i] < VetorCar[j] then

                        Troca(VetorCar[i],VetorCar[j],i,j);

                end;

        end;



        gap:= trunc(gap/1.33);

end;

end;





//======================           QUICK SORT                 ==================

procedure TMetodoOrd.Quicksort (var VetorCar: TVetorCar ; nPt: integer ; Ordem: TOrdem);

//------------------------------------------------------------------------------

procedure PartialSortC(left, right : integer; var VetorCar: TVetorCar);

var

l,r : integer;

mid : string;

begin

        l:= left;

        r:= right;

        mid:= VetorCar[(l+r) div 2];



        repeat



                case Ordem of



                Crescente:

                begin

                        while (VetorCar[l] < mid) do begin

                                inc(l);

                                inc(MainForm.nComp);

                        end;

                        while (mid < VetorCar[r]) do begin

                                dec(r);

                                inc(MainForm.nComp);

                        end;

                end;



                Decrescente:

                begin

                        while (VetorCar[l] > mid) do begin

                                inc(l);

                                inc(MainForm.nComp);

                        end;

                        while (mid > VetorCar[r]) do begin

                                dec(r);

                                inc(MainForm.nComp);

                        end;

                end;

        end;



        inc(MainForm.nComp,2);                            //Comparaçoes dos "While"



        if (l <= r) then begin

                if (l<>r) then

                Troca(VetorCar[l],VetorCar[r],l,r);

                inc(l);

                dec(r);

        end;

until (l > r);





if (left < r)then

PartialSortC(left,r,VetorCar);



if (l < right)then

PartialSortC(l,right,VetorCar);

end;

//------------------------------------------------------------------------------



begin

        MainForm.nComp :=0;

        MainForm.nTroc :=0;

        PartialSortC(1,nPt,VetorCar);

end;





procedure TMetodoOrd.Troca(var Valor1, Valor2:String; troc1,troc2:Integer);

var aux: string;

begin

        aux   := Valor1;

        Valor1:= Valor2;

        Valor2:= aux;

        inc(MainForm.nTroc);

        MainForm.AtualizaTab(troc1,troc2);

end;



end.