1 {
2 *****************************************************************************
3 This file is part of LazUtils.
4
5 See the file COPYING.modifiedLGPL.txt, included in this distribution,
6 for details about the license.
7 *****************************************************************************
8
9 Author: Juha Manninen / Antônio Galvão
10
11 Abstract:
12 This is an unsorted StringList with a fast lookup feature.
13 Internally it uses a map container to store the strings again
14 which is then used for Contains, IndexOf and Find methods.
15
16 The extra container does not reserve too much memory because the strings are
17 reference counted and not really copied.
18
19 All Duplicates property values are fully supported,
20 including dupIgnore and dupError, unlike in unsorted StringList.
21
22 This class is useful only when you must preserve the order in list, but
23 also need to do fast lookups to see if a string exists, or must prevent duplicates.
24 }
25 unit LookupStringList;
26
27 {$mode objfpc}{$H+}
28
29 interface
30
31 uses
32 Classes, SysUtils, AvgLvlTree;
33
34 type
35
36 { TLookupStringList }
37
38 TLookupStringList = class(TStringList)
39 private
40 FMap: TStringMap;
41 protected
42 procedure InsertItem(Index: Integer; const S: string); override;
43 public
44 constructor Create(aCaseSensitive: Boolean);
45 constructor Create;
46 destructor Destroy; override;
47 procedure Assign(Source: TPersistent); override;
48 procedure Clear; override;
49 procedure Delete(Index: Integer); override;
Addnull50 function Add(const S: string): Integer; override;
AddObjectnull51 function AddObject(const S: string; AObject: TObject): Integer; override;
Containsnull52 function Contains(const S: string): Boolean; // A new function
functionnull53 function Find(const S: string; out Index: Integer): Boolean; override;
IndexOfnull54 function IndexOf(const S: string): Integer; override;
55 end;
56
Deduplicatenull57 function Deduplicate(AStrings: TStrings): Integer;
58
59
60 implementation
61
Deduplicatenull62 function Deduplicate(AStrings: TStrings): Integer;
63 // Removes duplicate strings (case sensitive) from AStrings.
64 // Returns the number of duplicates removed.
65 var
66 DSL: TLookupStringList;
67 InCnt: Integer;
68 begin
69 InCnt := AStrings.Count;
70 DSL := TLookupStringList.Create(True);
71 try
72 DSL.Assign(AStrings);
73 AStrings.Assign(DSL);
74 Result := InCnt - AStrings.Count;
75 finally
76 DSL.Free;
77 end;
78 end;
79
80 { TLookupStringList }
81
82 constructor TLookupStringList.Create(aCaseSensitive: Boolean);
83 begin
84 inherited Create;
85 CaseSensitive := aCaseSensitive;
86 FMap := TStringMap.Create(aCaseSensitive);
87 end;
88
89 constructor TLookupStringList.Create;
90 begin
91 Create(False); // Case-insensitive by default
92 end;
93
94 destructor TLookupStringList.Destroy;
95 begin
96 FMap.Free;
97 inherited Destroy;
98 end;
99
100 procedure TLookupStringList.Assign(Source: TPersistent);
101 begin
102 inherited Assign(Source);
103 if Source is TLookupStringList then
104 FMap.Assign(TLookupStringList(Source).FMap);
105 end;
106
107 procedure TLookupStringList.Clear;
108 begin
109 inherited Clear;
110 FMap.Clear;
111 end;
112
113 procedure TLookupStringList.Delete(Index: Integer);
114 var
115 s: String;
116 begin
117 s := Strings[Index];
118 inherited Delete(Index);
119 // The string must not be deleted from map if there are duplicates.
120 // Calling IndexOf is slow but it is needed.
121 if (Duplicates <> dupAccept) or (inherited IndexOf(s) = -1) then
122 FMap.Remove(s);
123 end;
124
Addnull125 function TLookupStringList.Add(const S: string): Integer;
126 begin
127 if not Sorted and (Duplicates = dupIgnore) and FMap.Contains(S) then
128 Result := -1
129 else
130 Result := inherited Add(S);
131 end;
132
TLookupStringList.AddObjectnull133 function TLookupStringList.AddObject(const S: string; AObject: TObject): Integer;
134 begin
135 Result := Add(S);
136 if Result > -1 then
137 Objects[Result] := AObject;
138 end;
139
140 procedure TLookupStringList.InsertItem(Index: Integer; const S: string);
141 begin
142 if not Sorted and (Duplicates <> dupAccept) then
143 if FMap.Contains(S) then
144 case Duplicates of
145 DupIgnore : Exit;
146 DupError : raise Exception.Create('TLookupStringList.InsertItem:'
147 +' Duplicates are not allowed.');
148 end;
149 inherited InsertItem(Index, S);
150 FMap.Add(S); // Insert string to map, too.
151 end;
152
Containsnull153 function TLookupStringList.Contains(const S: string): Boolean;
154 begin
155 Result := FMap.Contains(S);
156 end;
157
Findnull158 function TLookupStringList.Find(const S: string; out Index: Integer): Boolean;
159 begin
160 Index := IndexOf(S);
161 Result := Index <> -1;
162 end;
163
IndexOfnull164 function TLookupStringList.IndexOf(const S: string): Integer;
165 begin
166 if FMap.Contains(S) then
167 Result := inherited IndexOf(S)
168 else
169 Result := -1
170 end;
171
172 end.
173
174