Dynamic List of Doubles in Delphi

[CamR23]

Hi All

I'm a bit of a newbie at Delphi programming and I was wondering is there anyway of creating a list of doubles that I can add to and remove from at run time? I guess something similar to a TList but for doubles instead of pointers. Or is there a way to do it with pointers? Any advice would be greatly appreciated!

Cheers
Cameron

 

[Glenn9999]

is there anyway of creating a list of doubles that I can add to and remove from at run time?

Sure.

I guess something similar to a TList but for doubles instead of pointers.

If you were to do it in VCL, you would do it with TList. TList "does it with pointers".

Any advice would be greatly appreciated!

You may not realize this, but doubles are 6 bytes and pointers are 4 bytes and with any dynamic structure like you describe, you are adding the overhead of having 4 bytes for every double, as well as a decent amount of processing overhead.

You might do well to describe to us why you want this dynamically created and destroyable list of doubles, so we could possibly suggest something better.

Measurement is not management.

 

[fajac]

Here is the code for a Double-list I made some years ago. Used it only once and did not test all methods, so I cannot guarantee it works 100% correctly.

unit DoubleList;

interface

uses
  Classes;

type
  { Types for the Sort-methods }
  TDoubleSortMethod = function (ADouble1, ADouble2 : Double) : Integer of object;
  TDoubleSortFunc   = function (ADouble1, ADouble2 : Double) : Integer;

  TDoubleList = class (TList)
  private
    FCompareMethod : TDoubleSortMethod;
    FCompareFunc   : TDoubleSortFunc;
    function   GetItem (AIndex: Integer): Double;
    procedure  SetItem (AIndex: Integer; const AValue: Double);
    procedure  QuickSort (ASortList: PPointerList; ALeft, ARight: Integer);
  public
    constructor Create;
    destructor Destroy; override;
    procedure  Sort    (SortMethod : TDoubleSortMethod); reintroduce; overload;
    procedure  Sort    (SortFunc : TDoubleSortFunc); reintroduce; overload;
    function   Add     (AItem : Double) : Integer; reintroduce;
    procedure  Delete  (AIndex : Integer); reintroduce;
    procedure  Clear; reintroduce;
    function   First : Double; reintroduce;
    function   Last  : Double; reintroduce;
    function   IndexOf (AItem  : Double): Integer; reintroduce;
    function   Extract (AItem  : Double): Double; reintroduce;
    procedure  Insert  (AIndex : Integer; AItem: Double); reintroduce;
    function   Remove  (AItem  : Double): Integer; reintroduce;
    procedure  Assign  (ListA: TDoubleList; AOperator: TListAssignOp = laCopy; ListB: TDoubleList = nil); reintroduce;
    property   Items [AIndex : Integer] : Double read GetItem write SetItem; default;
  end;

implementation

type
  TDouble = class (TObject)
  public
    Value : Double;
    constructor Create (const AValue : Double);
  end;

{ TDoubleList }

{----------------------------------------------------------------------------------------
 Method       : TDoubleList.QuickSort
 Description  : Sorts the list; taken from unit "Classes" and adapted
 Remarks    :
-----------------------------------------------------------------------------------------}
procedure TDoubleList.QuickSort (ASortList: PPointerList; ALeft, ARight : Integer);
var
  left,
  right    : Integer;
  pivot,
  buffer   : TDouble;
begin
  repeat
    left  := ALeft;
    right := ARight;
    pivot := ASortList^ [(ALeft + ARight) shr 1];
    repeat
      if Assigned (FCompareMethod) then
        begin
          while FCompareMethod (TDouble (ASortList^ [left]).Value, pivot.Value) < 0 do
            Inc (left);
          while FCompareMethod (TDouble (ASortList^ [right]).Value, pivot.Value) > 0 do
            Dec (right);
        end
      else
        begin
          while FCompareFunc (TDouble (ASortList^ [left]).Value, pivot.Value) < 0 do
            Inc (left);
          while FCompareFunc (TDouble (ASortList^ [right]).Value, pivot.Value) > 0 do
            Dec (right);
        end;
      if left <= right then
      begin
        buffer := TDouble (ASortList^ [left]);
        ASortList^ [left] := ASortList^ [right];
        ASortList^ [right] := Pointer (buffer);
        Inc (left);
        Dec (right);
      end;
    until left > right;
    if ALeft < right then
      QuickSort (ASortList, ALeft, right);
    ALeft := left;
  until left >= ARight;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Add
-----------------------------------------------------------------------------------------}
function TDoubleList.Add (AItem: Double): Integer;
begin
  result := inherited Add (TDouble.Create (AItem));
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Assign
 Remarks     : Since the items have to be cloned, the method is completely rewritten,
               based on Classes.TList.Assign
-----------------------------------------------------------------------------------------}
procedure TDoubleList.Assign (ListA: TDoubleList; AOperator: TListAssignOp; ListB: TDoubleList);
var
  loop    : Integer;
  temp    : TDoubleList;
  source  : TDoubleList;
begin
  { ListB given? }
  if (ListB <> nil) then
    begin
      source := ListB;
      Assign (ListA);
    end
  else
    begin
      source := ListA;
    end;

  { on with the show }
  case AOperator of
    { 12345, 346 = 346 : only those in the new list }
    laCopy:
      begin
        Clear;
        Capacity := source.Capacity;
        for loop := 0 to source.Count - 1 do
          Add (source [loop]);
      end;

    { 12345, 346 = 34 : intersection of the two lists }
    laAnd:
      for loop := Count - 1 downto 0 do
        if (source.IndexOf (Items [loop]) = -1) then
          Delete(loop);

    { 12345, 346 = 123456 : union of the two lists }
    laOr:
      for loop := 0 to source.Count - 1 do
        if (IndexOf (source [loop]) = -1) then
          Add (source [loop]);

    { 12345, 346 = 1256 : only those not in both lists }
    laXor:
      begin
        temp := TDoubleList.Create; { Temp holder of 4 byte values }
        try
          temp.Capacity := source.Count;
          for loop := 0 to source.Count - 1 do
            if (IndexOf (source [loop]) = -1) then
              temp.Add (source [loop]);
          for loop := Count - 1 downto 0 do
            if (source.IndexOf (Items[loop]) <> -1) then
              Delete (loop);
          loop := Count + temp.Count;
          if Capacity < loop then
            Capacity := loop;
          for loop := 0 to temp.Count - 1 do
            Add (temp [loop]);
        finally
          temp.Free;
        end;
      end;

    { 12345, 346 = 125 : only those unique to source }
    laSrcUnique:
      for loop := Count - 1 downto 0 do
        if (source.IndexOf( Items [loop]) <> -1) then
          Delete (loop);

    { 12345, 346 = 6 : only those unique to dest }
    laDestUnique:
      begin
        temp := TDoubleList.Create;
        try
          temp.Capacity := source.Count;
          for loop := source.Count - 1 downto 0 do
            if (IndexOf (source [loop]) = -1) then
              temp.Add (source [loop]);
          Assign (temp);
        finally
          temp.Free;
        end;
      end;
  end;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Clear
-----------------------------------------------------------------------------------------}
procedure TDoubleList.Clear;
var
  loop : Integer;
begin
  for loop := 0 to Pred (Count) do
    TDouble (inherited Items [loop]).Free;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Create
-----------------------------------------------------------------------------------------}
constructor TDoubleList.Create;
begin
  inherited Create;
  { ... }
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Delete;
-----------------------------------------------------------------------------------------}
procedure TDoubleList.Delete (AIndex: Integer);
begin
  TDouble (inherited Items [AIndex]).Free;
  inherited Delete (AIndex);
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Destroy;
-----------------------------------------------------------------------------------------}
destructor TDoubleList.Destroy;
begin
  try
    Clear;
  finally
    inherited Destroy;
  end;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Extract
-----------------------------------------------------------------------------------------}
function TDoubleList.Extract (AItem: Double): Double;
var
  loop : Integer;
  item : TDouble;
begin
  for loop := 0 to Pred (Count) do
  begin
    item := TDouble (inherited Items [loop]);
    if (item.Value = AItem) then
    begin
      result := TDouble (inherited Extract (item)).Value;
      item.Free;
      Break;
    end;
  end;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.First
-----------------------------------------------------------------------------------------}
function TDoubleList.First: Double;
begin
  result := TDouble (inherited First).Value;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.GetItem
-----------------------------------------------------------------------------------------}
function TDoubleList.GetItem (AIndex: Integer): Double;
begin
  result := TDouble (inherited Items [AIndex]).Value;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.IndexOf
-----------------------------------------------------------------------------------------}
function TDoubleList.IndexOf (AItem: Double): Integer;
var
  loop : Integer;
begin
  Result := -1;
  for loop := 0 to Pred (Count) do
    if Items [loop] = AItem then
    begin
      result := loop;
      Break;
    end;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Insert
-----------------------------------------------------------------------------------------}
procedure TDoubleList.Insert (AIndex: Integer; AItem: Double);
begin
  inherited Insert (AIndex, TDouble.Create (AItem));
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Last
-----------------------------------------------------------------------------------------}
function TDoubleList.Last: Double;
begin
  result := TDouble (inherited Last).Value;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.Remove
-----------------------------------------------------------------------------------------}
function TDoubleList.Remove (AItem: Double): Integer;
var
  index : Integer;
  item  : TDouble;
begin
  index := IndexOf (AItem);

  if (index >= 0) then
  begin
    item  := TDouble (inherited Items [index]);
    result := inherited Remove (item);
    item.Free;
  end;
end;

{----------------------------------------------------------------------------------------
 Method      : TDoubleList.SetItem
-----------------------------------------------------------------------------------------}
procedure TDoubleList.SetItem (AIndex: Integer; const AValue: Double);
begin
  TDouble (inherited Items [AIndex]).Value := AValue;
end;

{----------------------------------------------------------------------------------------
 Method       : TDoubleList.Sort
 Description  : Substitutes the Sort-method of TList; two overloaded variations
 Remarks      : Since the inherited Sort-method cannot be used it is reintroduced 
-----------------------------------------------------------------------------------------}
procedure TDoubleList.Sort (SortFunc: TDoubleSortFunc);
var
  FList : PPointerList;
begin
  FCompareMethod := nil;
  FCompareFunc := SortFunc;
  FList := List;
  if Assigned (FList) and (Count > 0) then
    QuickSort (FList, 0, Pred (Count));
end;

{----------------------------------------------------------------------------------------}
procedure TDoubleList.Sort (SortMethod: TDoubleSortMethod);
var
  FList : PPointerList;
begin
  FCompareMethod := SortMethod;
  FCompareFunc := nil;
  FList := List;
  if Assigned (FList) and (Count > 0) then
    QuickSort (FList, 0, Pred (Count));
end;

{ TDouble }

{ --------------------------------
Method  :       TDouble.Create
-------------------------------- }
constructor TDouble.Create (const AValue: Double);
begin
  Value := AValue;
end;



end.