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