Cita:
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
![Mano Arriba](images/smilies/DeAcuerdo.gif)
, 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;
constructor TClassDynArray.Create(NewLength: Integer);
begin
Randomize;
FRandRange:= 100;
SetLength(FArray, NewLength);
FCount:= NewLength;
end;
procedure TClassDynArray.RndFillArray;
var
i: Integer;
begin
for i:= 0 to FCount-1 do
FArray[i]:= Random(FrandRange);
end;
procedure TClassDynArray.Push(Value: TElementType);
begin
SetLength(FArray, Length(FArray)+1);
Inc(FCount);
FArray[FCount-1]:= Value;
end;
function TClassDynArray.Pop: TElementType;
begin
Result:= FArray[FCount-1];
Dec(FCount);
SetLength(FArray, Length(FArray));
end;
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;
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;
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;
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;
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;
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;
procedure TClassDynArray.Sort(const Ascending: Boolean=True);
begin
if Ascending then
QSortAsc(0, FCount-1)
else
QSortDes(0, FCount-1);
end;
procedure TClassDynArray.Increase(const Value: Integer);
begin
try
SetLength(FArray, Length(FArray) + Value);
Inc(FCount, Value);
except
raise EDynRangeError.Create('Memoria insuficiente');
end;
end;
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;
procedure TClassDynArray.FillZero;
begin
ZeroMemory(@FArray[0], Count*SizeOf(TElementType));
end;
procedure TClassDynArray.Clear;
begin
SetLength(FArray, 0);
end;
destructor TClassDynArray.Destroy;
begin
Finalize(FArray);
inherited;
end;
function TClassDynArray.GetItem(index: Integer): TElementType;
begin
if not CheckInRange(Index) then
raise EDynRangeError.Create('Índice fuera de rango');
Result:= FArray[index];
end;
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;
function TClassDynArray.CheckInRange(Index: Integer): Boolean;
begin
Result:= (Index >= 0) or (Index < FCount-1);
end;
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;
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;
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.
Cita:
Empezado por Al González
P.D. Qué difícil es redactar desde un teléfono móvil. ![Embarrassment](http://www.clubdelphi.com/foros/images/smilies/redface.gif)
|
De echo yo no me animo
Saludos
![Smilie](http://www.clubdelphi.com/foros/images/smilies/smile.gif)