SparseArray
This is a simple class that provides a sparse array for Delphi. All you have to do is create the object and then set the array entries as needed. If you try to access an array entry that is not defined as something it will return 0. Here is an example...
Foo := TSparseArray.Create;
Foo[2] := 24;
Foo[1034] := 1;
Joe := Foo[2]; { Joe now equals 24 }
Joe := Foo[500]; { Joe now equals 0 }
Joe := Foo.Count; { Joe now equals 2 }
Foo[2] := 0;
Joe := Foo.Count; { Joe now equals 1 }
There are still a couple of procedures/functions to finish but it's still a rather useful class. There are some limits as well. Since this is based on a TList you cannot have more than a total of 16k entries. Also this array only stores LongInts. But these can be cast as a pointer if needed.
---------------------------------------
unit Sparsear;
interface
uses Classes;
type
TSparseArrayCompare = (sacBefore, sacExact, sacAfter);
TSparseArray = class
private
FList: TList;
FLastExact: integer;
function Get(Key: LongInt): LongInt;
procedure Put(Key: LongInt; Item: LongInt);
function ClosestNdx(Key: LongInt; var Status: TSparseArrayCompare): LongInt;
public
constructor Create; virtual;
destructor Destroy; virtual;
function Count: integer;
procedure Clear;
property Data[Key: LongInt]: LongInt read Get write Put; default;
function First: LongInt;
function Last: LongInt;
function Previous(Key: LongInt): LongInt;
function Next(Key: LongInt): LongInt;
property Items: TList read FList;
end;
implementation
type
TSparseArrayEntry = class
Key: LongInt;
Data: LongInt;
end;
{ create ourself }
constructor TSparseArray.Create;
begin
inherited Create;
FList := TList.Create;
FLastExact := -1;
end;
destructor TSparseArray.Destroy;
begin
Clear;
FList.Free;
inherited Destroy;
end;
{ clear the list and the accumlators }
procedure TSparseArray.Clear;
begin
with FList do while Count > 0 do begin
TSparseArrayEntry(Items[Count-1]).Free;
Delete(Count-1);
end;
FLastExact := -1;
end;
{ simple array management }
function TSparseArray.Count: integer;
begin
Result := FList.Count;
end;
function TSparseArray.First: LongInt;
begin
if FList.Count > 0 then Result := TSparseArrayEntry(FList[0]).Key
else Result := Low(LongInt);
end;
function TSparseArray.Last: LongInt;
begin
if FList.Count > 0 then Result := TSparseArrayEntry(FList[FList.Count-1]).Key
else Result := High(LongInt);
end;
function TSparseArray.Previous(Key: LongInt): LongInt;
begin
Result := -1;
end;
function TSparseArray.Next(Key: LongInt): LongInt;
begin
Result := -1;
end;
{ get an array entry }
function TSparseArray.Get(Key: LongInt): LongInt;
var
Status: TSparseArrayCompare;
Ndx: integer;
begin
{ assume we are going to fail }
Result := 0;
{ are you here? }
Ndx := ClosestNdx(Key, Status);
{ if we found it then return its data }
if Status = sacExact then
Result := TSparseArrayEntry(FList[Ndx]).Data;
end;
{ set an array entry }
procedure TSparseArray.Put(Key: LongInt; Item: LongInt);
var
Status: TSparseArrayCompare;
Ndx: integer;
AEntry: TSparseArrayEntry;
begin
{ were do we add? }
Ndx := ClosestNdx(Key, Status);
{ did we find a match? }
if Status = sacExact then begin
{ is the new data actually nil? }
if Item = 0 then begin
FList.Delete(Ndx);
FLastExact := -1;
end
{ otherwise just assign its data then }
else
TSparseArrayEntry(FList[Ndx]).Data := Item;
end
{ otherwise we need to create a new array entry }
else begin
AEntry := TSparseArrayEntry.Create;
if AEntry <> nil then begin
{ fill it in }
AEntry.Key := Key;
AEntry.Data := Item;
{ ok so where do we put it? }
case Status of
sacBefore:
FList.Insert(Ndx,AEntry);
sacAfter:
Ndx := FList.Add(AEntry);
end;
end;
end;
end;
{ find closest index, depending on the resulting status this may
return a matching index or something relative to an existing index }
function TSparseArray.ClosestNdx(Key: LongInt; var Status: TSparseArrayCompare): LongInt;
var
NowAt, StartAt, EndAt: integer;
Found: boolean;
{ compare two keys, -1 = Key1 is less, 0 = Key1 is Key2, 1 = Key1 is greater }
function Compare(Key1, Key2: LongInt): TSparseArrayCompare;
begin
if Key1 < Key2 then Result := sacBefore
else if Key1 > Key2 then Result := sacAfter
else Result := sacExact;
end;
begin
{ if FLastExact pointing at something valid? }
if FLastExact > -1 then begin
{ yep its still the same }
if Key = TSparseArrayEntry(FList[FLastExact]).Key then begin
Status := sacExact;
Result := FLastExact;
Exit;
end
{ otherwise reset data }
else FLastExact := -1;
end;
{ is there nothing to search thru? }
if FList.Count = 0 then begin
Status := sacAfter;
Result := 0;
end
{ lets set up some variables and search }
else begin
Found := False;
StartAt := 0; { start at the beginning }
EndAt := FList.Count-1; { go till the end }
{ loopin dude }
repeat
{ now were are we? }
NowAt := (StartAt+EndAt) div 2;
{ see if its somewhere around here? }
Status := Compare(Key, TSparseArrayEntry(FList[NowAt]).Key);
{ calculate the new relative bounds and check for an exact match }
case Status of
sacBefore:
EndAt := NowAt - 1;
sacExact:
Found := True;
sacAfter:
StartAt := NowAt + 1;
end;
{ game over man }
until Found or (StartAt > EndAt);
{ did we find it? }
if Found then begin
Result := NowAt;
Status := sacExact;
FLastExact := NowAt;
end
else begin
{ leave it where we left off }
Result := StartAt;
{ are we inserting or adding? }
if Result > FList.Count-1 then
Status := sacAfter
else
Status := sacBefore;
end;
end;
end;
end.