Delphi. HashMap

Из проекта

uses
  System.SysUtils, System.Classes, System.Generics.Collections, Rtti, xsuperjson, xsuperobject, System.TypInfo, System.Generics.Defaults;

{hash map for objects on TDictionary and TList<>}
  THashMap<K, V> = class
  private
    FDictionary: TDictionary<K, TList<TPair<K, V>>>;
    FKeyComparer: IComparer<K>;
    FOwnsObjects: Boolean;
    function GetItems(aKey: K): V;
    procedure SetItems(aKey: K; const aValue: V);
  public
    constructor Create(aKeyComparer: IComparer<K>; aOwnsObjects: Boolean = true);
    destructor Destroy; override;
    procedure Clear();
    procedure Add(aKey: K; aValue: V);
    procedure Remove(aKey: K);
    function ContainsKey(aKey: K): Boolean;
    property Items[aKey: K]: V read GetItems write SetItems; default;
  end;

{ THashMap }

procedure THashMap<K, V>.Add(aKey: K; aValue: V);
begin
  if not FDictionary.ContainsKey(aKey) then
    FDictionary.Add(aKey, TList<TPair<K, V>>.Create());

  FDictionary[aKey].Add(TPair<K, V>.Create(aKey, aValue));
end;

procedure THashMap<K, V>.Clear;
var
  key: K;
begin
  for key in FDictionary.Keys do
    Remove(key);
end;

function THashMap<K, V>.ContainsKey(aKey: K): Boolean;
begin
  Result := FDictionary.ContainsKey(aKey)
end;

constructor THashMap<K, V>.Create(aKeyComparer: IComparer<K>; aOwnsObjects: Boolean = true);
begin
  FDictionary := TDictionary<K, TList<TPair<K, V>>>.Create();
  EnsureNotNull(aKeyComparer, 'aKeyComparer');
  FKeyComparer := aKeyComparer;
  FOwnsObjects := aOwnsObjects;
end;

destructor THashMap<K, V>.Destroy;
begin
  Clear();
  FDictionary.Free();
  inherited;
end;

function THashMap<K, V>.GetItems(aKey: K): V;
var
  p: TPair<K, V>;
  i: integer;
begin
  if FDictionary[aKey].Count = 1 then
  begin
    p := FDictionary[aKey].Items[0];
    Result := p.Value;
    Exit;
  end
  else if FDictionary[aKey].Count > 1 then
  begin
    // compare keys in list
    for i := 0 to FDictionary[aKey].Count - 1 do
    begin
      p := FDictionary[aKey][i];
      if FKeyComparer.Compare(p.Key, aKey) = 0 then
      begin
        Result := p.Value;
        Exit;
      end;
    end;
  end;
end;

procedure THashMap<K, V>.Remove(aKey: K);
var
  i: integer;
  list: TList<TPair<K, V>>;
begin
  if not FDictionary.ContainsKey(aKey) then
    raise Exception.Create('cannnot remove, item not found');

  list := FDictionary[aKey];
  for i := list.Count - 1 downto 0 do
  begin
    if (FOwnsObjects) and (TValueTypeChecker<V>.IsValueAnObject(list[i].Value)) then
      PObject(@list[i].Value)^.Free();
  end;

  FreeAndNil(list);

  FDictionary.Remove(aKey);
end;

procedure THashMap<K, V>.SetItems(aKey: K; const aValue: V);
var
  p: TPair<K, V>;
  i: integer;
begin
  if FDictionary[aKey].Count = 1 then
  begin
    p := FDictionary[aKey].Items[0];
    FDictionary[aKey].Remove(p);
    FDictionary[aKey].Add(TPair<K, V>.Create(aKey, aValue));
    Exit;
  end
  else if FDictionary[aKey].Count > 1 then
  begin
    // compare keys in list
    for i := 0 to FDictionary[aKey].Count - 1 do
    begin
      p := FDictionary[aKey][i];
      if FKeyComparer.Compare(p.Key, aKey) = 0 then
      begin
        FDictionary[aKey].Remove(p);
        FDictionary[aKey].Add(TPair<K, V>.Create(aKey, aValue));
        Exit;
      end;
    end;
  end;
end;