Ver Mensaje Individual
  #4  
Antiguo 27-08-2013
Avatar de nlsgarcia
[nlsgarcia] nlsgarcia is offline
Miembro Premium
 
Registrado: feb 2007
Ubicación: Caracas, Venezuela
Posts: 2.206
Reputación: 21
nlsgarcia Tiene un aura espectacularnlsgarcia Tiene un aura espectacular
agustingsz,

Cita:
Empezado por agustingsz
...un método de...burbuja...búsqueda binaria...
Revisa este código:
Código Delphi [-]
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    ProgressBar1: TProgressBar;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure Edit1KeyPress(Sender: TObject; var Key: Char);
  private
    procedure LoadListBox;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  A : Array of Integer;

implementation

{$R *.dfm}

procedure BubbleSort(var A : Array of Integer);
var
   i , j : Integer;
   Aux: Integer;

begin

   for j := Low(A) to High(A) - 1 do
      for i := j + 1 to High(A) do
      begin
         if A[j] > A[i] then
         begin
            Aux := A[j];
            A[j] := A[i];
            A[i] := Aux;
         end;
      end;

end;

procedure ShellSort(var A : Array of Integer; N : Integer);
var
  i, j, Step, Aux : Integer;

begin

   Step := N div 2;

   while Step > 0 do
   begin

      for i := Step to N do
      begin

         Aux := A[i];
         j := i;

         while (j >= Step) and (A[j-Step] > Aux) do
         begin
            A[j] := A[j-Step];
            dec(j,Step);
         end;

         A[j]:= Aux;

      end;

      Step := Step div 2;

   end;

end;

procedure QuickSort(var A : Array of Integer; aLo, aHi : Integer);
var
   Lo, Hi, Mid, T : Integer;

begin

   Lo := aLo;
   Hi := aHi;
   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 > aLo then
      QuickSort(A, aLo, Hi);

   if Lo < aHi then
      QuickSort(A, Lo, aHi);

  end;

function BinarySearch(const A : Array of Integer; const Element: Integer): Integer;
var
   MinIndex, MaxIndex: Integer;
   MedianIndex, MedianValue: Integer;

begin

    MinIndex := Low(A);
    MaxIndex := High(A);

    while MinIndex <= MaxIndex do
    begin

        MedianIndex := (MinIndex + MaxIndex) div 2;
        MedianValue := A[MedianIndex];

        if Element < MedianValue then
            MaxIndex := Pred(MedianIndex);

        if Element > MedianValue then
            MinIndex := Succ(MedianIndex);

        if Element = MedianValue then
        begin
            Result := MedianIndex;
            Exit;
        end

    end;

    Result := -1;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin

   RadioGroup1.ItemIndex := 0;
   RadioGroup2.ItemIndex := 0;
   Label1.Visible := False;

end;

procedure TForm1.LoadListBox;
var
   i : Integer;
begin
   ListBox1.Clear;
   ListBox1.Items.BeginUpdate;
   for i := Low(A) to High(A) do
   begin
      Application.ProcessMessages;
      ListBox1.Items.Add(IntToStr(A[i]));
      ProgressBar1.Position := Trunc((i/Length(A))*100);
   end;
   ListBox1.Items.EndUpdate;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
   i : Integer;
   Limit : Integer;

begin

   Limit := StrToInt(RadioGroup2.Items.Strings[RadioGroup2.ItemIndex]);

   Label1.Caption := Format('Generación de %d Elementos en Progreso',[Limit]);
   Label1.Visible := True;

   Button1.Enabled := False;
   Button2.Enabled := False;
   Button3.Enabled := False;

   Randomize;

   SetLength(A,Limit);

   ProgressBar1.Min := 0;
   ProgressBar1.Max := 100;

   for i := Low(A) to High(A) do
      A[i] := Random(Limit);

   LoadListBox;

   ProgressBar1.Position := 0;

   Button1.Enabled := True;
   Button2.Enabled := True;
   Button3.Enabled := True;

   Label1.Visible := False;

end;

procedure TForm1.Button2Click(Sender: TObject);
var
   i, Limit : Integer;
   Start, Stop : TDateTime;
   Msg, TimeSort, Sort : String;

begin

   Sort := RadioGroup1.Items.Strings[RadioGroup1.ItemIndex];
   Limit := StrToInt(RadioGroup2.Items.Strings[RadioGroup2.ItemIndex]);

   Label1.Caption := Format('%s de %d Elementos En Progreso',[Sort,Limit]);
   Label1.Visible := True;

   Button1.Enabled := False;
   Button2.Enabled := False;
   Button3.Enabled := False;

   Update;

   case RadioGroup1.ItemIndex of

      0 : begin
             Start := Now;
             BubbleSort(A);
             Stop := Now;
             Msg := 'El Tiempo de BubbleSort (Solo el Ordenamiento) fue %s en %d elementos';
          end;

      1 : begin
             Start := Now;
             ShellSort(A,Length(A));
             Stop := Now;
             Msg := 'El Tiempo de ShellSort (Solo el Ordenamiento) fue %s en %d elementos';
          end;

      2 : begin
             Start := Now;
             QuickSort(A,Low(A),High(A));
             Stop := Now;
             Msg := 'El Tiempo de QuickSort (Solo el Ordenamiento) fue %s en %d elementos';
          end;

   end;

   LoadListBox;

   TimeSort := FormatDateTime('hh:nn:ss:zzz',Stop-Start);

   Button1.Enabled := True;
   Button2.Enabled := True;
   Button3.Enabled := True;

   Label1.Visible := False;

   MessageDlg(Format(Msg,[TimeSort,Length(A)]),mtinformation,[mbok],0);

end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   if BinarySearch(A,StrToInt(Edit1.Text)) <> -1 then
      MessageDlg((Format('Encontrado el Elemento %s en el Arreglo',[Edit1.Text])),mtInformation,[mbOk],0)
   else
      MessageDlg((Format('El Elemento %s No Fue Encontrado en el Arreglo' ,[Edit1.Text])),mtError,[mbOk],0);
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
   Edit1.Text := ListBox1.Items.Strings[ListBox1.ItemIndex];
end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
   if not (Key in ['0'..'9',#8]) then
      Key := #0;
end;

end.
El código anterior implementa los métodos de ordenamiento BubbleSort, ShellSort, QuickSort y el método de búsqueda BinarySearch en un arreglo de enteros como ejemplo de su uso y contraste de rendimiento en diferentes conjuntos de datos creados de forma aleatoria.

El ejemplo esta disponible en el link: http://terawiki.clubdelphi.com/Delph...rch%26Sort.rar

Espero sea útil

Nelson.

Última edición por nlsgarcia fecha: 27-08-2013 a las 07:23:52.
Responder Con Cita