Retonar arreglo dinamico en funcion

[ecfisa]

Empezado por Al González

Eso hace de las matrices dinámicas una herramienta muy eficiente para el manejo colectivo de datos. Su uso está vigente en innumerables casos, y aunque existen clases más especializadas, no son nada obsoletas.

Totalmente de acuerdo , y realmente son una herramienta muy poderosa, también los uso a menudo.

Quizá fué mala elección usar el modo consola para representar el ejemplo dando así la impresión de que su uso es obsoleto. Pero es que me pareció mas claro de visualizar de ese modo, a ver si puedo enmendarlo un poco ...

Código Delphi [-]
{$WARNINGS OFF}
unit uDynArray;

interface

uses SysUtils, Classes;

type
  TElementType = Integer;
  TDynArray = array of TElementType;
  EDynRangeError = class(ErangeError);

  TClassDynArray = class(TObject)
  private
    FArray: TDynArray;
    FCount: Integer;
    FRandRange: Integer;
    function CheckInRange(Index: Integer): Boolean;
    function GetItem(index: Integer): TElementType;
    procedure SetItem(index: Integer; Value: TElementType);
    procedure QSortAsc(Left, Right: Integer);
    procedure QSortDes(Left, Right: Integer);
    function GetFArray: TDynArray;
  public
    constructor Create(NewLength: Integer=0);
    procedure RndFillArray;
    procedure Sort(const Ascending: Boolean=True);
    procedure Push(Value: TElementType);
    function Pop: TElementType;
    procedure Insert(Value: TElementType; Index: Integer);
    procedure InsertRange(Index: Integer; Values: array of TElementType);
    function IndexOf(Value: TElementType): Integer;
    procedure Delete(const Index: Integer);
    procedure DeleteRange(const a,b: Integer);
    procedure Swap(const a, b: Integer);
    procedure Increase(const Value: Integer);
    procedure Assign(DynArray: TDynArray);
    procedure FillZero;
    procedure Clear;
    //...
    destructor Destroy; override;
    property Count: Integer read FCount;
    property RandRange: Integer read FRandRange write FRandRange;
    property Items[index: Integer]: TElementType read GetItem write SetItem; default;
    property GetArray: TDynArray read GetFArray;
    //...
  end;

implementation

uses Windows;

// ------------------ public ------------------

constructor TClassDynArray.Create(NewLength: Integer);
begin
  Randomize;
  FRandRange:= 100;
  SetLength(FArray, NewLength);
  FCount:= NewLength;
end;

// Llena el arreglo con valores enteros de forma aleatoria
procedure TClassDynArray.RndFillArray;
var
  i: Integer;
begin
  for i:= 0 to FCount-1 do
    FArray[i]:= Random(FrandRange);
end;

// Agrega un elemento al final del arreglo
procedure TClassDynArray.Push(Value: TElementType);
begin
  SetLength(FArray, Length(FArray)+1);
  Inc(FCount);
  FArray[FCount-1]:= Value;
end;

// Extrae un elemento del final del arreglo
function TClassDynArray.Pop: TElementType;
begin
  Result:= FArray[FCount-1];
  Dec(FCount);
  SetLength(FArray, Length(FArray));
end;

// Inserta un elemento en la posición del índice
procedure TClassDynArray.Insert(Value: TElementType; Index: Integer);
var
  i: Integer;
begin
  if Index < 0 then
    raise EDynRangeError.Create('Índice fuera de rango');
  if Index > FCount then
    Push(Value)
  else
  begin
    SetLength(FArray, Length(FArray)+1);
    Inc(FCount);
    for i:= FCount-1 downto Index+1 do
      FArray[i]:= FArray[i-1];
    FArray[Index]:= Value;
  end;
end;

// Inserta un rango de valores en FArray
procedure TClassDynArray.InsertRange(Index: Integer; Values: array of TElementType);
var
  i: Integer;
begin
  for i:= Low(Values) to High(Values) do
    Insert(Values[i], i+1);
end;

// Devuelve el índice de la primera ocurrencia de Value
function TClassDynArray.IndexOf(Value: TElementType): Integer;
var
  i: Integer;
begin
  Result:= -1;
  for i:= 0 to FCount-1 do
    if FArray[i] = Value then
    begin
      Result:= i;
      Exit;
    end;
end;

// Elimina un elemento del arreglo
procedure TClassDynArray.Delete(const Index: Integer);
var
  i: Integer;
begin
  if FCount = 0 then
    raise EDynRangeError.Create('Arreglo vacío');
  if not CheckInRange(Index) then
    raise EDynRangeError.Create('Índice fuera de rango');
  for i:= Index to FCount-1 do FArray[i]:= FArray[i+1];
  Dec(FCount);
  SetLength(FArray, Length(FArray));
end;

// Elimina desde/hasta elementos del arreglo
procedure TClassDynArray.DeleteRange(const a, b: Integer);
var
  i: Integer;
begin
   if FCount = 0 then
    raise EDynRangeError.Create('Arreglo vacío');
  if not (CheckInRange(a)and(CheckInRange(b))) then
    raise EDynRangeError.Create('Índice fuera de rango');
  for i:= a to FCount-1 do
    FArray[i]:= FArray[b+i-1];
  Dec(FCount, Abs(a-b));
  SetLength(FArray, FCount)
end;

// Intercambia dos elementos del arreglo
procedure TClassDynArray.Swap(const a, b: Integer);
var
  aux: TElementType;
begin
  if not CheckInRange(a) or not CheckInRange(b) then
    EDynRangeError.Create('Indice fuera de rango');
  aux:= FArray[a];
  FArray[a]:= FArray[b];
  FArray[b]:= aux;
end;

// Llama a ordenamientos Asc o Desc acorde al valor del argumento
procedure TClassDynArray.Sort(const Ascending: Boolean=True);
begin
  if Ascending then
    QSortAsc(0, FCount-1)
  else
    QSortDes(0, FCount-1);
end;

// Aumenta el tamaño del arreglo
procedure TClassDynArray.Increase(const Value: Integer);
begin
  try
    SetLength(FArray, Length(FArray) + Value);
    Inc(FCount, Value);
  except
    raise EDynRangeError.Create('Memoria insuficiente');
  end;
end;

// Asigna un arreglo dinámico a FArray
procedure TClassDynArray.Assign(DynArray: TDynArray);
begin
  Clear;
  try
    FCount:= Length(DynArray);
    SetLength(FArray, FCount);
    move(DynArray[0], FArray[0], FCount*sizeof(TElementType));
  except
    raise EDynRangeError.Create('Memoria insuficiente');
  end;
end;

// Pone en cero los elementos del arreglo
procedure TClassDynArray.FillZero;
begin
  ZeroMemory(@FArray[0], Count*SizeOf(TElementType));
end;

// Elimina los elementos del arreglo
procedure TClassDynArray.Clear;
begin
  SetLength(FArray, 0);
end;

destructor TClassDynArray.Destroy;
begin
  Finalize(FArray);
  inherited;
end;

// ------------------ private ------------------

// Devuevelve el elemento indicado por el índice
function TClassDynArray.GetItem(index: Integer): TElementType;
begin
  if not CheckInRange(Index) then
    raise EDynRangeError.Create('Índice fuera de rango');
  Result:= FArray[index];
end;

// Asigna valor a un elemento del arreglo
procedure TClassDynArray.SetItem(index: Integer; Value: TElementType);
begin
  if not CheckInRange(Index) then
    raise EDynRangeError.Create('Índice fuera de rango');
  if FArray[index] <> Value then
    FArray[index]:= Value;
end;

// Devuelve False si el índice esta fuera del rango
function TClassDynArray.CheckInRange(Index: Integer): Boolean;
begin
  Result:= (Index >= 0) or (Index < FCount-1);
end;

// Ordena ascendente
procedure TClassDynArray.QSortAsc(Left, Right: Integer);
var
   i, j, mid: Integer;
begin
  i := Left;
  j := Right;
  mid := FArray[(Left+Right) div 2];
  repeat
    while FArray[i] < mid do Inc(i);
    while Farray[j] > mid do Dec(j);
    if i <= j then
    begin
      Swap(i, j);
      Inc(i);
      Dec(j);
    end;
  until i > j;
  if j > Left then QSortAsc(Left, j);
  if i < Right then QSortAsc(i, Right);
end;

// Ordena descendente
procedure TClassDynArray.QSortDes(Left, Right: Integer);
var
  i, j, mid : Integer;
begin
  i:= Left;
  j:= Right;
  mid := FArray[(Left+Right) div 2];
  repeat
    while FArray[i] > mid do Inc(i);
    while FArray[j] < mid do Dec(j);
    if i <= j then
    begin
      Swap(i, j);
      Inc(i);
      Dec(j);
    end;
  until i >= j;
  if j > Left then QSortDes(Left, j);
  if i < Right then QSortDes(i, Right);
end;

// Devuelve una copia del arreglo
function TClassDynArray.GetFArray: TDynArray;
begin
  try
    SetLength(Result, FCount);
    move(FArray[0], Result[0], FCount*sizeof(TElementType));
  except
    raise EDynRangeError.Create('Memoria insuficiente');
  end;
end;
end.

Y se le puede ir agregando las funcionalidades que se nos vayan ocurriendo.

Empezado por Al González

P.D. Qué difícil es redactar desde un teléfono móvil.

De echo yo no me animo

Saludos