Ayuda programa basico

[agustingsz]

Buenas noches, tengo el siguiente programa

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

Const
 NumEstudiante = 4;
 NumAsignatura = 4;

Type
 IndiceEstudiantes = 1 .. NumEstudiante;
 IndiceAsignaturas = 1 .. NumAsignatura;
 TablaNotas        = Array [IndiceEstudiantes,IndiceAsignaturas] of real;
 MediaAlumnos      = Array [IndiceEstudiantes] of real;
 MediaAsignaturas  = Array [IndiceAsignaturas] of real;
var
 Notas        : TablaNotas;
 M_Alumnos    : MediaAlumnos;
 M_Asignatura : MediaAsignatura;

Procedure LeerNotas (Var N: TablaNotas);
Var
 E: 1 .. NumEstudiantes;
 A: 1 .. NumAsignaturas;

Begin
for E := 1 to NumEstudiantes do
 Begin
 Writeln ('Introduzca las ', NumAsignaturas,'calificaciones del alumno ',E,' en una sola linea');
 for A := 1 to NumAlumno do
  read (N [E,A]);
  readln;
 end;
End;

Procedure MediaProAsignatura (Var N : TablaNotas; Var Medias : MediaAsignatura);
Var
 E    : 1 .. NumEstudiantes;
 A    : 1 .. NumAsignaturas;
 Suma : Real;

Begin
 for E := 1 to NumAsignaturas do
 Begin
   Suma := 0 ;
   for A := 1 to NumEstudiantes do
     Suma := Suma + N [E,A];
   Medias [A] := Suma / NumEstudiantes ;
 end;
End;

Procedure MediaProEstudiante (Var N : TablaNotas; Var Medias : MediaAsignatura);
Var
 E    : 1 .. NumEstudiantes;
 A    : 1 .. NumAsignaturas;
 Suma : Real;

Begin
 for E := 1 to NumEstudiantess do
 Begin
   Suma := 0 ;
   for A := 1 to NumAsignaturas do
     Suma := Suma + N [E,A];
   Medias [A] := Suma / NumEstudiantes;
 end;
End;

Procedure Resultados (var M : TablaNotas , Var Media_A : MediaAsignatura , Var Media_E : MediaEstudiante);
Var
 E    : 1 .. NumEstudiantes;
 A    : 1 .. NumAsignaturas;

Begin
 Writeln ('Estudiante' : 10 , 'Media' : 10 , ' ' : 25 , 'Asignaturas');
 Writeln ('..........' : 10 , '.....' : 10 , ' ' : 25 , '...........');
 for E := 1 to NumEstudiantes do
 Begin
   Writeln (E : 5 , Media_E [E] : 15 :2);
   for A := 1 to NumAsignaturas do
     Writeln (Notas [E,A] :14 :2 );
     writeln;
    end;
   writeln;
   write ('Medias de las asignaturas', ' ' :3 );
   for A := 1 to NumAsignaturas do  do
     Writeln (Media_A [A] :3 :2 , ' ' : 10);
   writeln
 End;

End;

Begin
  try
    { TODO -oUser -cConsole Main : Insert code here }
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

Como habría que hacer para agregarle un metodo de busqueda, ya sea burbuja, busqueda binaria, etc?

Gracias !

[ecfisa]

Hola agustingsz, bienvenido a Club Delphi


Como a todos los que se inician te invitamos a que leas nuestra guía de estilo.

Por si precisaras incluir ambas acciones (buscar/ordenar), en estos enlaces tenes diferentes algorítmos de ordenamiento y búsqueda:

• Algorítmos de ordenamiento
• Algorítmos de búsqueda

Como habría que hacer para agregarle un metodo de busqueda, ya sea burbuja, busqueda binaria, etc?

Como un procedimiento más al que se le pasa como argumento el arreglo a ordenar; o sobre el cuál se realizará la búsqueda según sea la acción que desempeñará.

Una observación final, el método de la burbuja (bubble sort) no es de búsqueda sino de ordenamiento.

Saludos.

[[nlsgarcia]]

agustingsz,

Empezado por agustingsz

...Como habría que hacer para agregarle un método de...burbuja...busqueda binaria...

Revisa estos links:

Bubble Sort Delphi : https://gist.github.com/fabriciocolombo/2495415

Binary Search Delphi : http://en.wikibooks.org/wiki/Algorit..._search#Delphi

Algoritmos en Pascal : http://antares.sip.ucm.es/cpareja/li...o-completo.pdf

Function : http://www.delphibasics.co.uk/RTL.asp?Name=Function

Procedure : http://www.delphibasics.co.uk/RTL.asp?Name=Procedure

Espero sea útil

Nelson.

[[nlsgarcia]]

agustingsz,

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.