LazUtils: Use LookupStringList in LazUtils package. Remove old DictionaryStringList files.

git-svn-id: trunk@49506 -
This commit is contained in:
juha 2015-07-07 12:10:35 +00:00
parent 810d20ce56
commit af6fb723af
11 changed files with 26 additions and 795 deletions

7
.gitattributes vendored
View File

@ -2858,13 +2858,7 @@ components/lazutils/Makefile.fpc svneol=native#text/plain
components/lazutils/asiancodepagefunctions.inc svneol=native#text/pascal
components/lazutils/asiancodepages.inc svneol=native#text/pascal
components/lazutils/avglvltree.pas svneol=native#text/pascal
components/lazutils/dictionarystringlist.pas svneol=native#text/plain
components/lazutils/easylazfreetype.pas svneol=native#text/pascal
components/lazutils/examples/DictionaryStringList/ReadMe.txt svneol=native#text/plain
components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi svneol=native#text/plain
components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr svneol=native#text/plain
components/lazutils/examples/DictionaryStringList/main.lfm svneol=native#text/plain
components/lazutils/examples/DictionaryStringList/main.pas svneol=native#text/plain
components/lazutils/examples/LookupStringList/ReadMe.txt svneol=native#text/plain
components/lazutils/examples/LookupStringList/TDedupeDemo.lpi svneol=native#text/plain
components/lazutils/examples/LookupStringList/TDedupeDemo.lpr svneol=native#text/pascal
@ -4531,7 +4525,6 @@ docs/xml/README.txt svneol=native#text/plain
docs/xml/StyleGuide.txt svneol=native#text/plain
docs/xml/ide/aboutfrm.xml svneol=native#text/plain
docs/xml/lazutils/avglvltree.xml svneol=native#text/plain
docs/xml/lazutils/dictionarystringlist.xml svneol=native#text/plain
docs/xml/lazutils/easylazfreetype.xml svneol=native#text/plain
docs/xml/lazutils/fileutil.xml svneol=native#text/plain
docs/xml/lazutils/fpcadds.xml svneol=LF#text/xml eol=lf

View File

@ -1,167 +0,0 @@
{
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
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 DictionaryStringList;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, AvgLvlTree;
type
{ TDictionaryStringList }
TDictionaryStringList = class(TStringList)
private
FMap: TStringMap;
protected
procedure InsertItem(Index: Integer; const S: string); override;
public
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): Boolean;
implementation
{
Removes duplicate strings (case sensitive) from AStrings.
When the AStrings owns and contains objects, the function will return false.
}
function Deduplicate(AStrings: TStrings): Boolean;
var
i: Integer;
DSL: TDictionaryStringList;
begin
Result := False;
DSL := TDictionaryStringList.Create;
try
DSL.Assign(AStrings);
AStrings.Assign(DSL);
Result := True;
finally
DSL.Free;
end;
end;
{ TDictionaryStringList }
constructor TDictionaryStringList.Create;
begin
inherited Create;
FMap := TStringMap.Create(True);
end;
destructor TDictionaryStringList.Destroy;
begin
FMap.Free;
inherited Destroy;
end;
procedure TDictionaryStringList.Assign(Source: TPersistent);
begin
inherited Assign(Source);
if Source is TDictionaryStringList then
FMap.Assign(TDictionaryStringList(Source).FMap);
end;
procedure TDictionaryStringList.Clear;
begin
inherited Clear;
FMap.Clear;
end;
procedure TDictionaryStringList.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 TDictionaryStringList.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 TDictionaryStringList.AddObject(const S: string; AObject: TObject): Integer;
begin
Result := Add(S);
if Result > -1 then
Objects[Result] := AObject;
end;
procedure TDictionaryStringList.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('TDictionaryStringList.InsertItem:'
+' Duplicates are not allowed.');
end;
inherited InsertItem(Index, S);
FMap.Add(S); // Insert string to map, too.
end;
function TDictionaryStringList.Contains(const S: string): Boolean;
begin
Result := FMap.Contains(S);
end;
function TDictionaryStringList.Find(const S: string; out Index: Integer): Boolean;
begin
Index := IndexOf(S);
Result := Index <> -1;
end;
function TDictionaryStringList.IndexOf(const S: string): Integer;
begin
if FMap.Contains(S) then
Result := inherited IndexOf(S)
else
Result := -1
end;
end.

View File

@ -1,3 +0,0 @@
Demonstrate how TDictionaryStringList can quicly remove duplicates from a list without changing the order.
Author: Antônio Galvão

View File

@ -1,83 +0,0 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="TDictionaryStringListDemo"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="2">
<Unit0>
<Filename Value="TDictionaryStringListDemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="Main"/>
</Unit1>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="TDictionaryStringListDemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -1,20 +0,0 @@
program TDictionaryStringListDemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, Main;
{$R *.res}
begin
RequireDerivedFormResource := True;
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

View File

@ -1,90 +0,0 @@
object Form1: TForm1
Left = 353
Height = 353
Top = 194
Width = 535
BorderStyle = bsSingle
Caption = 'TDictionaryStringList Demo'
ClientHeight = 353
ClientWidth = 535
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '1.4.0.4'
object btnDedupeMemo: TButton
Left = 346
Height = 25
Top = 72
Width = 183
Anchors = [akTop, akRight]
Caption = 'Dedupe Memo'
OnClick = btnDedupeMemoClick
TabOrder = 0
end
object Memo: TMemo
Left = 0
Height = 281
Top = 72
Width = 336
ScrollBars = ssAutoBoth
TabOrder = 1
end
object lblTime: TLabel
Left = 16
Height = 15
Top = 48
Width = 30
Caption = 'Time:'
ParentColor = False
end
object lblLines: TLabel
Left = 130
Height = 15
Top = 48
Width = 90
Caption = 'Duplicated Lines:'
ParentColor = False
end
object SpinEdit1: TSpinEdit
Left = 8
Height = 23
Top = 8
Width = 94
Increment = 1000
MaxValue = 1000000000
TabOrder = 2
end
object btnGenerate: TButton
Left = 112
Height = 25
Top = 8
Width = 125
Caption = 'Generate Data'
OnClick = btnGenerateClick
TabOrder = 3
end
object btnDedupeFile: TButton
AnchorSideLeft.Control = btnDedupeMemo
AnchorSideRight.Control = btnDedupeMemo
AnchorSideRight.Side = asrBottom
Left = 346
Height = 32
Top = 232
Width = 183
Anchors = [akTop, akLeft, akRight]
Caption = 'Create File and Dedupe it'
OnClick = btnDedupeFileClick
TabOrder = 4
end
object Label1: TLabel
Left = 346
Height = 64
Top = 168
Width = 182
AutoSize = False
Caption = 'Deduplicating from a file is very much faster than using a GUI control. Use the button below to see the whole process.'
ParentColor = False
WordWrap = True
end
end

View File

@ -1,154 +0,0 @@
unit Main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
Spin, DictionaryStringList, Math;
type
{ TForm1 }
TForm1 = class(TForm)
btnDedupeMemo: TButton;
btnDedupeFile: TButton;
btnGenerate: TButton;
Label1 :TLabel;
lblLines: TLabel;
lblTime: TLabel;
Memo: TMemo;
SpinEdit1: TSpinEdit;
procedure btnDedupeFileClick(Sender: TObject);
procedure btnGenerateClick(Sender: TObject);
procedure btnDedupeMemoClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
private
inList :TStringList;
procedure UpdateDuplicates(aDuplicateCount: string);
procedure UpdateTime(aTime: TDateTime);
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.UpdateDuplicates(aDuplicateCount: string);
begin
lblLines.Caption := 'Duplicated Lines: ' + aDuplicateCount;
end;
procedure TForm1.UpdateTime(aTime: TDateTime);
begin
lblTime.Caption := 'Time: ' + TimeToStr(aTime);
end;
procedure TForm1.btnGenerateClick(Sender: TObject);
var
i, j: Integer;
s :string;
begin
UpdateDuplicates('?');
UpdateTime(0);
Memo.Clear;
Application.ProcessMessages;
Screen.Cursor := crHourGlass;
try
InList.Clear;
for i := 0 to SpinEdit1.Value - 1 do
begin
s := '';
for j := 0 to 5 do
s := s + chr(randomrange(97, 123));
InList.Add(s);
end;
Memo.Lines.Assign(inList);
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.btnDedupeMemoClick(Sender: TObject);
var
DSL :TDictionaryStringList;
T :TDateTime;
begin
Screen.Cursor := crHourGlass;
try
T := Now;
DSL := TDictionaryStringList.Create;
try
DSL.Assign(Memo.Lines);
UpdateDuplicates(IntToStr(Memo.Lines.Count - DSL.Count));
Memo.Lines.Assign(DSL);
finally
DSL.Free;
end;
UpdateTime(Now - T);
finally
Screen.Cursor := crDefault;
end;
end;
procedure TForm1.btnDedupeFileClick(Sender: TObject);
var
T :TDateTime;
N :integer;
DSL :TDictionaryStringList;
begin
lblTime.Caption := 'Time:';
lblLines.Caption := 'Duplicated lines:';
Application.ProcessMessages;
if Trim(Memo.Text) = '' then
begin
ShowMessage('Generating data. Please wait.');
btnGenerateClick(nil);
end;
ShowMessage('Saving memo to a file. Please wait.');
Memo.Lines.SaveToFile('temp.txt');
ShowMessage('Dedupping the file.');
T := Now;
N := Memo.Lines.Count;
DSL := TDictionaryStringList.Create;
try
DSL.LoadFromFile('temp.txt');
lblLines.Caption := 'Duplicated Lines: ' + IntToStr(N - DSL.Count);
DSL.SaveToFile('temp.txt');
lblTime.Caption := 'Time: ' + TimeToStr(Now - T);
ShowMessage('Deleting the file.');
DeleteFile('temp.txt');
finally
DSL.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
inList := TStringList.Create;
Randomize;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
inList.Free;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
spinedit1.Value := 100000;
end;
end.

View File

@ -88,7 +88,7 @@ begin
t.Dependencies.AddUnit('lazconfigstorage');
t.Dependencies.AddUnit('utf8process');
t.Dependencies.AddUnit('laz2_xpath');
t.Dependencies.AddUnit('dictionarystringlist');
t.Dependencies.AddUnit('lookupstringlist');
t.Dependencies.AddUnit('lazloggerprofiling');
t.Dependencies.AddUnit('fpcadds');
t.Dependencies.AddUnit('lazutilities');
@ -142,7 +142,7 @@ begin
T:=P.Targets.AddUnit('lazconfigstorage.pas');
T:=P.Targets.AddUnit('utf8process.pp');
T:=P.Targets.AddUnit('laz2_xpath.pas');
T:=P.Targets.AddUnit('dictionarystringlist.pas');
T:=P.Targets.AddUnit('lookupstringlist.pas');
T:=P.Targets.AddUnit('lazloggerprofiling.pas');
T:=P.Targets.AddUnit('fpcadds.pas');
T:=P.Targets.AddUnit('lazutilities.pas');

View File

@ -295,48 +295,48 @@
<UnitName Value="laz2_xpath"/>
</Item69>
<Item70>
<Filename Value="dictionarystringlist.pas"/>
<UnitName Value="DictionaryStringList"/>
<Filename Value="unixlazutf8.inc"/>
<Type Value="Include"/>
</Item70>
<Item71>
<Filename Value="unixlazutf8.inc"/>
<Filename Value="winlazutf8.inc"/>
<Type Value="Include"/>
</Item71>
<Item72>
<Filename Value="winlazutf8.inc"/>
<Type Value="Include"/>
</Item72>
<Item73>
<Filename Value="lazloggerprofiling.pas"/>
<UnitName Value="LazLoggerProfiling"/>
</Item73>
<Item74>
</Item72>
<Item73>
<Filename Value="fpcadds.pas"/>
<UnitName Value="FPCAdds"/>
</Item74>
<Item75>
</Item73>
<Item74>
<Filename Value="lazutilities.pas"/>
<UnitName Value="LazUtilities"/>
</Item75>
<Item76>
</Item74>
<Item75>
<Filename Value="lazfglhash.pas"/>
<UnitName Value="lazfglhash"/>
</Item76>
<Item77>
</Item75>
<Item76>
<Filename Value="lcsvutils.pas"/>
<UnitName Value="lcsvutils"/>
</Item77>
<Item78>
</Item76>
<Item77>
<Filename Value="lazcollections.pas"/>
<UnitName Value="lazCollections"/>
</Item78>
<Item79>
</Item77>
<Item78>
<Filename Value="lazlistclasses.pas"/>
<UnitName Value="LazListClasses"/>
</Item79>
<Item80>
</Item78>
<Item79>
<Filename Value="lazfreetypefpimagedrawer.pas"/>
<UnitName Value="LazFreeTypeFPImageDrawer"/>
</Item79>
<Item80>
<Filename Value="lookupstringlist.pas"/>
<UnitName Value="LookupStringList"/>
</Item80>
</Files>
<LazDoc Paths="../../docs/xml/lazutils"/>

View File

@ -15,9 +15,9 @@ uses
TTDebug, TTError, TTFile, TTGLoad, TTInterp, TTLoad, TTMemory, TTObjs,
TTProfile, TTRASTER, TTTables, TTTypes, EasyLazFreeType, LazLoggerBase,
LazLoggerDummy, LazClasses, LazFreeTypeFontCollection, LazConfigStorage,
UTF8Process, laz2_xpath, DictionaryStringList, LazLoggerProfiling, FPCAdds,
LazUtilities, lazfglhash, lcsvutils, lazCollections, LazListClasses,
LazFreeTypeFPImageDrawer, LazarusPackageIntf;
UTF8Process, laz2_xpath, LazLoggerProfiling, FPCAdds, LazUtilities,
lazfglhash, lcsvutils, lazCollections, LazListClasses,
LazFreeTypeFPImageDrawer, LookupStringList, LazarusPackageIntf;
implementation

View File

@ -1,245 +0,0 @@
<?xml version="1.0" encoding="ISO-8859-1"?>
<fpdoc-descriptions>
<package name="lazutils">
<!--
====================================================================
DictionaryStringList
====================================================================
-->
<module name="DictionaryStringList">
<short></short>
<descr>
</descr>
<!-- class Visibility: default -->
<element name="TDictionaryStringList">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- variable Visibility: private -->
<element name="TDictionaryStringList.FMap">
<short></short>
<descr>
</descr>
<seealso>
</seealso>
</element>
<!-- procedure Visibility: protected -->
<element name="TDictionaryStringList.InsertItem">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.InsertItem.Index">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.InsertItem.S">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.InsertItem.O">
<short></short>
</element>
<!-- constructor Visibility: public -->
<element name="TDictionaryStringList.Create">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- destructor Visibility: public -->
<element name="TDictionaryStringList.Destroy">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- procedure Visibility: public -->
<element name="TDictionaryStringList.Assign">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.Assign.Source">
<short></short>
</element>
<!-- procedure Visibility: public -->
<element name="TDictionaryStringList.Clear">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- procedure Visibility: public -->
<element name="TDictionaryStringList.Delete">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.Delete.Index">
<short></short>
</element>
<!-- function Visibility: public -->
<element name="TDictionaryStringList.Add">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- function result Visibility: default -->
<element name="TDictionaryStringList.Add.Result">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.Add.S">
<short></short>
</element>
<!-- function Visibility: public -->
<element name="TDictionaryStringList.AddObject">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- function result Visibility: default -->
<element name="TDictionaryStringList.AddObject.Result">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.AddObject.S">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.AddObject.AObject">
<short></short>
</element>
<!-- function Visibility: public -->
<element name="TDictionaryStringList.Contains">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- function result Visibility: default -->
<element name="TDictionaryStringList.Contains.Result">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.Contains.S">
<short></short>
</element>
<!-- function Visibility: public -->
<element name="TDictionaryStringList.Find">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- function result Visibility: default -->
<element name="TDictionaryStringList.Find.Result">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.Find.S">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.Find.Index">
<short></short>
</element>
<!-- function Visibility: public -->
<element name="TDictionaryStringList.IndexOf">
<short></short>
<descr>
</descr>
<errors>
</errors>
<seealso>
</seealso>
</element>
<!-- function result Visibility: default -->
<element name="TDictionaryStringList.IndexOf.Result">
<short></short>
</element>
<!-- argument Visibility: default -->
<element name="TDictionaryStringList.IndexOf.S">
<short></short>
</element>
</module> <!-- DictionaryStringList -->
</package>
</fpdoc-descriptions>