├── .gitattributes
├── .gitignore
├── README.md
└── Source
    ├── Project37.dpr
    ├── Project37.dproj
    ├── Project37.res
    ├── Spring.Collections.Ministacks.pas
    ├── Spring.Collections.TreeImpl.pas
    ├── Spring.Collections.TreeIntf.pas
    ├── Spring.Collections.Trees.pas
    └── TreeTests.pas


/.gitattributes:
--------------------------------------------------------------------------------
 1 | # Auto detect text files and perform LF normalization
 2 | * text=auto
 3 | 
 4 | # Custom for Visual Studio
 5 | *.cs     diff=csharp
 6 | 
 7 | # Standard to msysgit
 8 | *.doc	 diff=astextplain
 9 | *.DOC	 diff=astextplain
10 | *.docx diff=astextplain
11 | *.DOCX diff=astextplain
12 | *.dot  diff=astextplain
13 | *.DOT  diff=astextplain
14 | *.pdf  diff=astextplain
15 | *.PDF	 diff=astextplain
16 | *.rtf	 diff=astextplain
17 | *.RTF	 diff=astextplain
18 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
  1 | # Uncomment these types if you want even more clean repository. But be careful.
  2 | # It can make harm to an existing project source. Read explanations below.
  3 | #
  4 | # Resource files are binaries containing manifest, project icon and version info.
  5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files.
  6 | #*.res
  7 | #
  8 | # Type library file (binary). In old Delphi versions it should be stored.
  9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored.
 10 | #*.tlb
 11 | #
 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7.
 13 | # Uncomment this if you are not using diagrams or use newer Delphi version.
 14 | #*.ddp
 15 | #
 16 | # Visual LiveBindings file. Added in Delphi XE2.
 17 | # Uncomment this if you are not using LiveBindings Designer.
 18 | #*.vlb
 19 | #
 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2.
 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature.
 22 | #*.deployproj
 23 | #
 24 | 
 25 | # Delphi compiler-generated binaries (safe to delete)
 26 | *.exe
 27 | *.dll
 28 | *.bpl
 29 | *.bpi
 30 | *.dcp
 31 | *.so
 32 | *.apk
 33 | *.drc
 34 | *.map
 35 | *.dres
 36 | *.rsm
 37 | *.tds
 38 | *.dcu
 39 | *.lib
 40 | 
 41 | # Delphi autogenerated files (duplicated info)
 42 | *.cfg
 43 | *Resource.rc
 44 | 
 45 | # Delphi local files (user-specific info)
 46 | *.local
 47 | *.identcache
 48 | *.projdata
 49 | *.tvsconfig
 50 | *.dsk
 51 | 
 52 | # Delphi history and backups
 53 | __history/
 54 | *.~*
 55 | 
 56 | # =========================
 57 | # Operating System Files
 58 | # =========================
 59 | 
 60 | # OSX
 61 | # =========================
 62 | 
 63 | .DS_Store
 64 | .AppleDouble
 65 | .LSOverride
 66 | 
 67 | # Thumbnails
 68 | ._*
 69 | 
 70 | # Files that might appear on external disk
 71 | .Spotlight-V100
 72 | .Trashes
 73 | 
 74 | # Directories potentially created on remote AFP share
 75 | .AppleDB
 76 | .AppleDesktop
 77 | Network Trash Folder
 78 | Temporary Items
 79 | .apdisk
 80 | 
 81 | # Windows
 82 | # =========================
 83 | 
 84 | # Windows image file caches
 85 | Thumbs.db
 86 | ehthumbs.db
 87 | 
 88 | # Folder config file
 89 | Desktop.ini
 90 | 
 91 | # Recycle Bin used on file shares
 92 | $RECYCLE.BIN/
 93 | 
 94 | # Windows Installer files
 95 | *.cab
 96 | *.msi
 97 | *.msm
 98 | *.msp
 99 | 
100 | # Windows shortcuts
101 | *.lnk
102 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # DelphiSpringTrees
 2 | Trees in Spring4D
 3 | 
 4 | #Trees are a much needed feature in any toolkit.  
 5 | Delphi generics.collections does not have any trees and neither does Spring4D.  
 6 | To remedy this omision here is a modest proposal for efficient generic trees.  
 7 | 
 8 | Trees contains:  
 9 | - `TRedBlackTree<K>` : Left-leaning red black tree
10 | - `TRedBlackTree<K,V>` : Left-leaning red-black tree, can serve as a replacement for TDictionary
11 | 
12 | All classes are written with the Spring framework in mind and conform to the spring conventions.  
13 | 
14 | Because the trees are based on Spring, you can only use them via the interfaces `ITree<T>` and `ITree<K,V>`.  
15 | 
16 | Minimal sample code:
17 | 
18 | ```Delphi
19 | unit Tree;
20 | 
21 | interface
22 | 
23 | uses
24 |   //for technical reasons you need to include both units  
25 |   Spring.Collections.TreeIntf,  //contains the tree interfaces.
26 |   Spring.Collections.Trees;     //contains the static tree factories.
27 |   
28 | var
29 |   TreeAsSet: ITree<integer>;
30 |   TreeAsDictionary: ITree<integer, string>;
31 |   
32 | implementation
33 | initialization
34 |   //Tree<T> factory
35 |   TreeAsSet = Tree<integer>.RedBlackTree;
36 |   //Tree<K,V> factory
37 |   TreeAsDictionary = Tree<integer, string>.RedBlackTree;
38 |   TreeAsSet.Add(1);
39 |   TreeAsDictionary.Add(1,'test');
40 | end.
41 | 
42 | ```
43 | 


--------------------------------------------------------------------------------
/Source/Project37.dpr:
--------------------------------------------------------------------------------
 1 | program Project37;
 2 | 
 3 | {$APPTYPE CONSOLE}
 4 | 
 5 | {$R *.res}
 6 | 
 7 | uses
 8 |   System.SysUtils,
 9 |   System.Generics.Defaults,
10 |   System.Generics.Collections,
11 |   Spring.Collections.Trees in 'Spring.Collections.Trees.pas',
12 |   TreeTests in 'TreeTests.pas',
13 |   DUnitX.TestFrameWork,
14 |   DUnitX.Loggers.Console,
15 |   Spring.Collections.TreeImpl in 'Spring.Collections.TreeImpl.pas',
16 |   Spring.Collections.TreeIntf in 'Spring.Collections.TreeIntf.pas',
17 |   RedBlack in 'RedBlack.pas';
18 | 
19 | var
20 |   runner : ITestRunner;
21 |   results : IRunResults;
22 |   logger : ITestLogger;
23 | begin
24 |   try
25 |     //Create the runner
26 |     runner := TDUnitX.CreateRunner;
27 |     runner.UseRTTI := True;
28 |     //tell the runner how we will log things
29 |     logger := TDUnitXConsoleLogger.Create(true);
30 |     //nunitLogger := TDUnitXXMLNUnitFileLogger.Create;
31 |     runner.AddLogger(logger);
32 |     //runner.AddLogger(nunitLogger);
33 | 
34 |     //Run tests
35 |     results := runner.Execute;
36 | 
37 |     System.Write('Done.. press <Enter> key to quit.');
38 |     System.Readln;
39 |   except
40 |     on E: Exception do
41 |       System.Writeln(E.ClassName, ': ', E.Message);
42 |   end;
43 | end.
44 | 


--------------------------------------------------------------------------------
/Source/Project37.dproj:
--------------------------------------------------------------------------------
  1 | <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
  2 |     <PropertyGroup>
  3 |         <ProjectGuid>{76535F0E-3A16-4B22-AE88-F4A4D847B216}</ProjectGuid>
  4 |         <ProjectVersion>18.2</ProjectVersion>
  5 |         <FrameworkType>None</FrameworkType>
  6 |         <MainSource>Project37.dpr</MainSource>
  7 |         <Base>True</Base>
  8 |         <Config Condition="'$(Config)'==''">Debug</Config>
  9 |         <Platform Condition="'$(Platform)'==''">Win32</Platform>
 10 |         <TargetedPlatforms>1</TargetedPlatforms>
 11 |         <AppType>Console</AppType>
 12 |     </PropertyGroup>
 13 |     <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
 14 |         <Base>true</Base>
 15 |     </PropertyGroup>
 16 |     <PropertyGroup Condition="('$(Platform)'=='Android' and '$(Base)'=='true') or '$(Base_Android)'!=''">
 17 |         <Base_Android>true</Base_Android>
 18 |         <CfgParent>Base</CfgParent>
 19 |         <Base>true</Base>
 20 |     </PropertyGroup>
 21 |     <PropertyGroup Condition="('$(Platform)'=='iOSDevice32' and '$(Base)'=='true') or '$(Base_iOSDevice32)'!=''">
 22 |         <Base_iOSDevice32>true</Base_iOSDevice32>
 23 |         <CfgParent>Base</CfgParent>
 24 |         <Base>true</Base>
 25 |     </PropertyGroup>
 26 |     <PropertyGroup Condition="('$(Platform)'=='iOSDevice64' and '$(Base)'=='true') or '$(Base_iOSDevice64)'!=''">
 27 |         <Base_iOSDevice64>true</Base_iOSDevice64>
 28 |         <CfgParent>Base</CfgParent>
 29 |         <Base>true</Base>
 30 |     </PropertyGroup>
 31 |     <PropertyGroup Condition="('$(Platform)'=='iOSSimulator' and '$(Base)'=='true') or '$(Base_iOSSimulator)'!=''">
 32 |         <Base_iOSSimulator>true</Base_iOSSimulator>
 33 |         <CfgParent>Base</CfgParent>
 34 |         <Base>true</Base>
 35 |     </PropertyGroup>
 36 |     <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Base)'=='true') or '$(Base_Win32)'!=''">
 37 |         <Base_Win32>true</Base_Win32>
 38 |         <CfgParent>Base</CfgParent>
 39 |         <Base>true</Base>
 40 |     </PropertyGroup>
 41 |     <PropertyGroup Condition="('$(Platform)'=='Win64' and '$(Base)'=='true') or '$(Base_Win64)'!=''">
 42 |         <Base_Win64>true</Base_Win64>
 43 |         <CfgParent>Base</CfgParent>
 44 |         <Base>true</Base>
 45 |     </PropertyGroup>
 46 |     <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_1)'!=''">
 47 |         <Cfg_1>true</Cfg_1>
 48 |         <CfgParent>Base</CfgParent>
 49 |         <Base>true</Base>
 50 |     </PropertyGroup>
 51 |     <PropertyGroup Condition="('$(Platform)'=='Win32' and '$(Cfg_1)'=='true') or '$(Cfg_1_Win32)'!=''">
 52 |         <Cfg_1_Win32>true</Cfg_1_Win32>
 53 |         <CfgParent>Cfg_1</CfgParent>
 54 |         <Cfg_1>true</Cfg_1>
 55 |         <Base>true</Base>
 56 |     </PropertyGroup>
 57 |     <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_2)'!=''">
 58 |         <Cfg_2>true</Cfg_2>
 59 |         <CfgParent>Base</CfgParent>
 60 |         <Base>true</Base>
 61 |     </PropertyGroup>
 62 |     <PropertyGroup Condition="'$(Base)'!=''">
 63 |         <Icon_MainIcon>$(BDS)\bin\delphi_PROJECTICON.ico</Icon_MainIcon>
 64 |         <Icns_MainIcns>$(BDS)\bin\delphi_PROJECTICNS.icns</Icns_MainIcns>
 65 |         <SanitizedProjectName>Project37</SanitizedProjectName>
 66 |         <DCC_Namespace>System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)</DCC_Namespace>
 67 |         <DCC_DcuOutput>.\$(Platform)\$(Config)</DCC_DcuOutput>
 68 |         <DCC_ExeOutput>.\$(Platform)\$(Config)</DCC_ExeOutput>
 69 |         <DCC_E>false</DCC_E>
 70 |         <DCC_N>false</DCC_N>
 71 |         <DCC_S>false</DCC_S>
 72 |         <DCC_F>false</DCC_F>
 73 |         <DCC_K>false</DCC_K>
 74 |     </PropertyGroup>
 75 |     <PropertyGroup Condition="'$(Base_Android)'!=''">
 76 |         <AUP_CAMERA>true</AUP_CAMERA>
 77 |         <Android_LauncherIcon96>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png</Android_LauncherIcon96>
 78 |         <Android_LauncherIcon144>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png</Android_LauncherIcon144>
 79 |         <AUP_READ_CALENDAR>true</AUP_READ_CALENDAR>
 80 |         <Android_SplashImage470>$(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png</Android_SplashImage470>
 81 |         <Android_SplashImage426>$(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png</Android_SplashImage426>
 82 |         <Android_LauncherIcon72>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png</Android_LauncherIcon72>
 83 |         <AUP_WRITE_CALENDAR>true</AUP_WRITE_CALENDAR>
 84 |         <AUP_READ_PHONE_STATE>true</AUP_READ_PHONE_STATE>
 85 |         <AUP_CALL_PHONE>true</AUP_CALL_PHONE>
 86 |         <AUP_READ_EXTERNAL_STORAGE>true</AUP_READ_EXTERNAL_STORAGE>
 87 |         <AUP_ACCESS_COARSE_LOCATION>true</AUP_ACCESS_COARSE_LOCATION>
 88 |         <AUP_WRITE_EXTERNAL_STORAGE>true</AUP_WRITE_EXTERNAL_STORAGE>
 89 |         <AUP_ACCESS_FINE_LOCATION>true</AUP_ACCESS_FINE_LOCATION>
 90 |         <Android_LauncherIcon36>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png</Android_LauncherIcon36>
 91 |         <Android_SplashImage960>$(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png</Android_SplashImage960>
 92 |         <Android_SplashImage640>$(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png</Android_SplashImage640>
 93 |         <Android_LauncherIcon48>$(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png</Android_LauncherIcon48>
 94 |         <AUP_INTERNET>true</AUP_INTERNET>
 95 |     </PropertyGroup>
 96 |     <PropertyGroup Condition="'$(Base_iOSDevice32)'!=''">
 97 |         <DCC_UsePackage>FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;fmx;IndySystem;tethering;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapProviderClient;DbxCommonDriver;dbxcds;fmxFireDAC;CustomIPTransport;dsnap;IndyIPServer;fmxase;IndyCore;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;dsnapxml;bindcompfmx;RESTBackendComponents;emsclientfiredac;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;FireDACCommonDriver;bindengine;bindcompdbx;soaprtl;FMXTee;emsclient;FireDAC;inet;soapmidas;RESTComponents;dbexpress;IndyIPClient;$(DCC_UsePackage);$(DCC_UsePackage)</DCC_UsePackage>
 98 |         <Base_iOSDevice>true</Base_iOSDevice>
 99 |         <Base>true</Base>
100 |         <CfgParent>Base</CfgParent>
101 |     </PropertyGroup>
102 |     <PropertyGroup Condition="'$(Base_iOSDevice64)'!=''">
103 |         <DCC_UsePackage>FireDACSqliteDriver;FireDACDSDriver;DBXSqliteDriver;fmx;IndySystem;tethering;DBXInterBaseDriver;DataSnapClient;DataSnapCommon;DataSnapProviderClient;DbxCommonDriver;dbxcds;fmxFireDAC;CustomIPTransport;dsnap;IndyIPServer;fmxase;IndyCore;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;dsnapxml;bindcompfmx;RESTBackendComponents;emsclientfiredac;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;FireDACCommonDriver;bindengine;bindcompdbx;soaprtl;FMXTee;emsclient;FireDAC;inet;soapmidas;RESTComponents;dbexpress;IndyIPClient;$(DCC_UsePackage);$(DCC_UsePackage)</DCC_UsePackage>
104 |         <Base_iOSDevice>true</Base_iOSDevice>
105 |         <Base>true</Base>
106 |         <CfgParent>Base</CfgParent>
107 |     </PropertyGroup>
108 |     <PropertyGroup Condition="'$(Base_iOSSimulator)'!=''">
109 |         <iPhone_AppIcon120>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png</iPhone_AppIcon120>
110 |         <iPhone_Spotlight40>$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png</iPhone_Spotlight40>
111 |         <iPad_Launch1536x2048>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png</iPad_Launch1536x2048>
112 |         <iPad_Launch768x1024>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png</iPad_Launch768x1024>
113 |         <iPad_SpotLight40>$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png</iPad_SpotLight40>
114 |         <iPad_SpotLight80>$(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png</iPad_SpotLight80>
115 |         <iPad_AppIcon76>$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png</iPad_AppIcon76>
116 |         <iPhone_Spotlight80>$(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png</iPhone_Spotlight80>
117 |         <iPad_Launch1024x768>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png</iPad_Launch1024x768>
118 |         <iPad_Launch2048x1536>$(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png</iPad_Launch2048x1536>
119 |         <iPhone_AppIcon60>$(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png</iPhone_AppIcon60>
120 |         <iPad_AppIcon152>$(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png</iPad_AppIcon152>
121 |     </PropertyGroup>
122 |     <PropertyGroup Condition="'$(Base_Win32)'!=''">
123 |         <VerInfo_Locale>1033</VerInfo_Locale>
124 |         <DCC_UsePackage>FireDACSqliteDriver;FireDACDSDriver;ZComponent;DBXSqliteDriver;FireDACPgDriver;fmx;TreeViewPresenter;IndySystem;frxe21;TeeDB;tethering;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;frx21;officeXPrt;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;OmniThreadLibraryRuntimeXE5;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;CodeSiteExpressPkg;DataSnapFireDAC;FireDACDBXDriver;soapserver;tmsdXE7;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;tmswizdXE7;madBasic_;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;ZDbc;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;frxTee21;ZPlain;Tee;DataBindings;DBXOdbcDriver;frxDB21;vclFireDAC;madDisAsm_;xmlrtl;DataSnapNativeClient;svnui;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindengine;vclactnband;bindcompdbx;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;madExcept_;FireDACADSDriver;vcltouch;ZCore;emsclient;VCLRESTComponents;FireDACMSSQLDriver;FireDAC;VclSmp;DBXInformixDriver;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;tmsexdXE7;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;ZParseSql;tmsxlsdXE7;svn;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;VirtualTreesR;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
125 |         <DCC_ConsoleTarget>true</DCC_ConsoleTarget>
126 |         <DCC_Namespace>Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)</DCC_Namespace>
127 |         <VerInfo_Keys>CompanyName=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(ModuleName);FileDescription=$(ModuleName);ProductName=$(ModuleName)</VerInfo_Keys>
128 |     </PropertyGroup>
129 |     <PropertyGroup Condition="'$(Base_Win64)'!=''">
130 |         <DCC_UsePackage>FireDACSqliteDriver;FireDACDSDriver;ZComponent;DBXSqliteDriver;FireDACPgDriver;fmx;TreeViewPresenter;IndySystem;TeeDB;tethering;vclib;DBXInterBaseDriver;DataSnapClient;DataSnapServer;DataSnapCommon;officeXPrt;DataSnapProviderClient;DBXSybaseASEDriver;DbxCommonDriver;vclimg;dbxcds;DatasnapConnectorsFreePascal;MetropolisUILiveTile;vcldb;vcldsnap;fmxFireDAC;DBXDb2Driver;DBXOracleDriver;CustomIPTransport;vclribbon;dsnap;IndyIPServer;fmxase;vcl;IndyCore;DBXMSSQLDriver;IndyIPCommon;CloudService;FmxTeeUI;FireDACIBDriver;DataSnapFireDAC;FireDACDBXDriver;soapserver;inetdbxpress;dsnapxml;FireDACInfxDriver;FireDACDb2Driver;adortl;FireDACASADriver;bindcompfmx;FireDACODBCDriver;RESTBackendComponents;emsclientfiredac;ZDbc;rtl;dbrtl;DbxClientDriver;FireDACCommon;bindcomp;inetdb;ZPlain;Tee;DataBindings;DBXOdbcDriver;vclFireDAC;xmlrtl;DataSnapNativeClient;ibxpress;IndyProtocols;DBXMySQLDriver;FireDACCommonDriver;bindengine;vclactnband;bindcompdbx;soaprtl;FMXTee;TeeUI;bindcompvcl;vclie;FireDACADSDriver;vcltouch;ZCore;emsclient;VCLRESTComponents;FireDACMSSQLDriver;FireDAC;VclSmp;DBXInformixDriver;DataSnapConnectors;DataSnapServerMidas;dsnapcon;DBXFirebirdDriver;inet;fmxobj;FireDACMySQLDriver;soapmidas;vclx;ZParseSql;DBXSybaseASADriver;FireDACOracleDriver;fmxdae;RESTComponents;VirtualTreesR;FireDACMSAccDriver;dbexpress;DataSnapIndy10ServerTransport;IndyIPClient;$(DCC_UsePackage)</DCC_UsePackage>
131 |         <DCC_ConsoleTarget>true</DCC_ConsoleTarget>
132 |     </PropertyGroup>
133 |     <PropertyGroup Condition="'$(Cfg_1)'!=''">
134 |         <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
135 |         <DCC_DebugDCUs>true</DCC_DebugDCUs>
136 |         <DCC_Optimize>false</DCC_Optimize>
137 |         <DCC_GenerateStackFrames>true</DCC_GenerateStackFrames>
138 |         <DCC_DebugInfoInExe>true</DCC_DebugInfoInExe>
139 |         <DCC_RemoteDebug>true</DCC_RemoteDebug>
140 |     </PropertyGroup>
141 |     <PropertyGroup Condition="'$(Cfg_1_Win32)'!=''">
142 |         <DCC_RemoteDebug>false</DCC_RemoteDebug>
143 |     </PropertyGroup>
144 |     <PropertyGroup Condition="'$(Cfg_2)'!=''">
145 |         <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
146 |         <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
147 |         <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
148 |         <DCC_DebugInformation>0</DCC_DebugInformation>
149 |     </PropertyGroup>
150 |     <ItemGroup>
151 |         <DelphiCompile Include="$(MainSource)">
152 |             <MainSource>MainSource</MainSource>
153 |         </DelphiCompile>
154 |         <DCCReference Include="Spring.Collections.Trees.pas"/>
155 |         <BuildConfiguration Include="Release">
156 |             <Key>Cfg_2</Key>
157 |             <CfgParent>Base</CfgParent>
158 |         </BuildConfiguration>
159 |         <BuildConfiguration Include="Base">
160 |             <Key>Base</Key>
161 |         </BuildConfiguration>
162 |         <BuildConfiguration Include="Debug">
163 |             <Key>Cfg_1</Key>
164 |             <CfgParent>Base</CfgParent>
165 |         </BuildConfiguration>
166 |     </ItemGroup>
167 |     <ProjectExtensions>
168 |         <Borland.Personality>Delphi.Personality.12</Borland.Personality>
169 |         <Borland.ProjectType>Application</Borland.ProjectType>
170 |         <BorlandProject>
171 |             <Delphi.Personality>
172 |                 <Source>
173 |                     <Source Name="MainSource">Project37.dpr</Source>
174 |                 </Source>
175 |             </Delphi.Personality>
176 |             <Deployment Version="3">
177 |                 <DeployFile LocalName="$(BDS)\Redist\osx32\libcgunwind.1.0.dylib" Class="DependencyModule">
178 |                     <Platform Name="OSX32">
179 |                         <Overwrite>true</Overwrite>
180 |                     </Platform>
181 |                 </DeployFile>
182 |                 <DeployFile LocalName="$(BDS)\Redist\iossimulator\libcgunwind.1.0.dylib" Class="DependencyModule">
183 |                     <Platform Name="iOSSimulator">
184 |                         <Overwrite>true</Overwrite>
185 |                     </Platform>
186 |                 </DeployFile>
187 |                 <DeployFile LocalName="$(BDS)\Redist\iossimulator\libPCRE.dylib" Class="DependencyModule">
188 |                     <Platform Name="iOSSimulator">
189 |                         <Overwrite>true</Overwrite>
190 |                     </Platform>
191 |                 </DeployFile>
192 |                 <DeployFile LocalName="$(BDS)\Redist\osx32\libcgsqlite3.dylib" Class="DependencyModule">
193 |                     <Platform Name="OSX32">
194 |                         <Overwrite>true</Overwrite>
195 |                     </Platform>
196 |                 </DeployFile>
197 |                 <DeployFile LocalName="Win32\Debug\Project37.exe" Configuration="Debug" Class="ProjectOutput">
198 |                     <Platform Name="Win32">
199 |                         <RemoteName>Project37.exe</RemoteName>
200 |                         <Overwrite>true</Overwrite>
201 |                     </Platform>
202 |                 </DeployFile>
203 |                 <DeployClass Name="ProjectiOSDeviceResourceRules">
204 |                     <Platform Name="iOSDevice64">
205 |                         <Operation>1</Operation>
206 |                     </Platform>
207 |                     <Platform Name="iOSDevice32">
208 |                         <Operation>1</Operation>
209 |                     </Platform>
210 |                 </DeployClass>
211 |                 <DeployClass Name="ProjectOSXResource">
212 |                     <Platform Name="OSX32">
213 |                         <RemoteDir>Contents\Resources</RemoteDir>
214 |                         <Operation>1</Operation>
215 |                     </Platform>
216 |                 </DeployClass>
217 |                 <DeployClass Name="AndroidClassesDexFile">
218 |                     <Platform Name="Android">
219 |                         <RemoteDir>classes</RemoteDir>
220 |                         <Operation>1</Operation>
221 |                     </Platform>
222 |                 </DeployClass>
223 |                 <DeployClass Name="Android_LauncherIcon144">
224 |                     <Platform Name="Android">
225 |                         <RemoteDir>res\drawable-xxhdpi</RemoteDir>
226 |                         <Operation>1</Operation>
227 |                     </Platform>
228 |                 </DeployClass>
229 |                 <DeployClass Name="AdditionalDebugSymbols">
230 |                     <Platform Name="Win32">
231 |                         <RemoteDir>Contents\MacOS</RemoteDir>
232 |                         <Operation>0</Operation>
233 |                     </Platform>
234 |                     <Platform Name="iOSSimulator">
235 |                         <Operation>1</Operation>
236 |                     </Platform>
237 |                     <Platform Name="OSX32">
238 |                         <RemoteDir>Contents\MacOS</RemoteDir>
239 |                         <Operation>1</Operation>
240 |                     </Platform>
241 |                 </DeployClass>
242 |                 <DeployClass Name="AndroidLibnativeMipsFile">
243 |                     <Platform Name="Android">
244 |                         <RemoteDir>library\lib\mips</RemoteDir>
245 |                         <Operation>1</Operation>
246 |                     </Platform>
247 |                 </DeployClass>
248 |                 <DeployClass Name="iPad_Launch768">
249 |                     <Platform Name="iOSSimulator">
250 |                         <Operation>1</Operation>
251 |                     </Platform>
252 |                     <Platform Name="iOSDevice64">
253 |                         <Operation>1</Operation>
254 |                     </Platform>
255 |                     <Platform Name="iOSDevice32">
256 |                         <Operation>1</Operation>
257 |                     </Platform>
258 |                 </DeployClass>
259 |                 <DeployClass Required="true" Name="ProjectOutput">
260 |                     <Platform Name="iOSDevice64">
261 |                         <Operation>1</Operation>
262 |                     </Platform>
263 |                     <Platform Name="iOSDevice32">
264 |                         <Operation>1</Operation>
265 |                     </Platform>
266 |                     <Platform Name="Win32">
267 |                         <Operation>0</Operation>
268 |                     </Platform>
269 |                     <Platform Name="Linux64">
270 |                         <Operation>1</Operation>
271 |                     </Platform>
272 |                     <Platform Name="OSX32">
273 |                         <RemoteDir>Contents\MacOS</RemoteDir>
274 |                         <Operation>1</Operation>
275 |                     </Platform>
276 |                     <Platform Name="Android">
277 |                         <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
278 |                         <Operation>1</Operation>
279 |                     </Platform>
280 |                     <Platform Name="iOSSimulator">
281 |                         <Operation>1</Operation>
282 |                     </Platform>
283 |                 </DeployClass>
284 |                 <DeployClass Name="DependencyFramework">
285 |                     <Platform Name="Win32">
286 |                         <Operation>0</Operation>
287 |                     </Platform>
288 |                     <Platform Name="OSX32">
289 |                         <RemoteDir>Contents\MacOS</RemoteDir>
290 |                         <Operation>1</Operation>
291 |                         <Extensions>.framework</Extensions>
292 |                     </Platform>
293 |                 </DeployClass>
294 |                 <DeployClass Name="ProjectUWPManifest">
295 |                     <Platform Name="Win32">
296 |                         <Operation>1</Operation>
297 |                     </Platform>
298 |                     <Platform Name="Win64">
299 |                         <Operation>1</Operation>
300 |                     </Platform>
301 |                 </DeployClass>
302 |                 <DeployClass Name="iPhone_Launch640">
303 |                     <Platform Name="iOSSimulator">
304 |                         <Operation>1</Operation>
305 |                     </Platform>
306 |                     <Platform Name="iOSDevice64">
307 |                         <Operation>1</Operation>
308 |                     </Platform>
309 |                     <Platform Name="iOSDevice32">
310 |                         <Operation>1</Operation>
311 |                     </Platform>
312 |                 </DeployClass>
313 |                 <DeployClass Name="AndroidLibnativeX86File"/>
314 |                 <DeployClass Name="ProjectiOSDeviceDebug">
315 |                     <Platform Name="iOSDevice64">
316 |                         <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
317 |                         <Operation>1</Operation>
318 |                     </Platform>
319 |                     <Platform Name="iOSDevice32">
320 |                         <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir>
321 |                         <Operation>1</Operation>
322 |                     </Platform>
323 |                 </DeployClass>
324 |                 <DeployClass Name="iPad_Launch1024">
325 |                     <Platform Name="iOSSimulator">
326 |                         <Operation>1</Operation>
327 |                     </Platform>
328 |                     <Platform Name="iOSDevice64">
329 |                         <Operation>1</Operation>
330 |                     </Platform>
331 |                     <Platform Name="iOSDevice32">
332 |                         <Operation>1</Operation>
333 |                     </Platform>
334 |                 </DeployClass>
335 |                 <DeployClass Name="iPhone_Launch320">
336 |                     <Platform Name="iOSSimulator">
337 |                         <Operation>1</Operation>
338 |                     </Platform>
339 |                     <Platform Name="iOSDevice64">
340 |                         <Operation>1</Operation>
341 |                     </Platform>
342 |                     <Platform Name="iOSDevice32">
343 |                         <Operation>1</Operation>
344 |                     </Platform>
345 |                 </DeployClass>
346 |                 <DeployClass Name="ProjectiOSInfoPList">
347 |                     <Platform Name="iOSSimulator">
348 |                         <Operation>1</Operation>
349 |                     </Platform>
350 |                     <Platform Name="iOSDevice64">
351 |                         <Operation>1</Operation>
352 |                     </Platform>
353 |                     <Platform Name="iOSDevice32">
354 |                         <Operation>1</Operation>
355 |                     </Platform>
356 |                 </DeployClass>
357 |                 <DeployClass Name="AndroidLibnativeArmeabiFile">
358 |                     <Platform Name="Android">
359 |                         <RemoteDir>library\lib\armeabi</RemoteDir>
360 |                         <Operation>1</Operation>
361 |                     </Platform>
362 |                 </DeployClass>
363 |                 <DeployClass Name="DebugSymbols">
364 |                     <Platform Name="Win32">
365 |                         <Operation>0</Operation>
366 |                     </Platform>
367 |                     <Platform Name="iOSSimulator">
368 |                         <Operation>1</Operation>
369 |                     </Platform>
370 |                     <Platform Name="OSX32">
371 |                         <RemoteDir>Contents\MacOS</RemoteDir>
372 |                         <Operation>1</Operation>
373 |                     </Platform>
374 |                 </DeployClass>
375 |                 <DeployClass Name="iPad_Launch1536">
376 |                     <Platform Name="iOSSimulator">
377 |                         <Operation>1</Operation>
378 |                     </Platform>
379 |                     <Platform Name="iOSDevice64">
380 |                         <Operation>1</Operation>
381 |                     </Platform>
382 |                     <Platform Name="iOSDevice32">
383 |                         <Operation>1</Operation>
384 |                     </Platform>
385 |                 </DeployClass>
386 |                 <DeployClass Name="Android_SplashImage470">
387 |                     <Platform Name="Android">
388 |                         <RemoteDir>res\drawable-normal</RemoteDir>
389 |                         <Operation>1</Operation>
390 |                     </Platform>
391 |                 </DeployClass>
392 |                 <DeployClass Name="Android_LauncherIcon96">
393 |                     <Platform Name="Android">
394 |                         <RemoteDir>res\drawable-xhdpi</RemoteDir>
395 |                         <Operation>1</Operation>
396 |                     </Platform>
397 |                 </DeployClass>
398 |                 <DeployClass Name="Android_SplashImage640">
399 |                     <Platform Name="Android">
400 |                         <RemoteDir>res\drawable-large</RemoteDir>
401 |                         <Operation>1</Operation>
402 |                     </Platform>
403 |                 </DeployClass>
404 |                 <DeployClass Name="iPhone_Launch640x1136">
405 |                     <Platform Name="iOSSimulator">
406 |                         <Operation>1</Operation>
407 |                     </Platform>
408 |                     <Platform Name="iOSDevice64">
409 |                         <Operation>1</Operation>
410 |                     </Platform>
411 |                     <Platform Name="iOSDevice32">
412 |                         <Operation>1</Operation>
413 |                     </Platform>
414 |                 </DeployClass>
415 |                 <DeployClass Name="UWP_DelphiLogo44">
416 |                     <Platform Name="Win32">
417 |                         <RemoteDir>Assets</RemoteDir>
418 |                         <Operation>1</Operation>
419 |                     </Platform>
420 |                     <Platform Name="Win64">
421 |                         <RemoteDir>Assets</RemoteDir>
422 |                         <Operation>1</Operation>
423 |                     </Platform>
424 |                 </DeployClass>
425 |                 <DeployClass Name="ProjectiOSEntitlements">
426 |                     <Platform Name="iOSDevice64">
427 |                         <RemoteDir>..\</RemoteDir>
428 |                         <Operation>1</Operation>
429 |                     </Platform>
430 |                     <Platform Name="iOSDevice32">
431 |                         <RemoteDir>..\</RemoteDir>
432 |                         <Operation>1</Operation>
433 |                     </Platform>
434 |                 </DeployClass>
435 |                 <DeployClass Name="AndroidGDBServer">
436 |                     <Platform Name="Android">
437 |                         <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
438 |                         <Operation>1</Operation>
439 |                     </Platform>
440 |                 </DeployClass>
441 |                 <DeployClass Name="Android_LauncherIcon72">
442 |                     <Platform Name="Android">
443 |                         <RemoteDir>res\drawable-hdpi</RemoteDir>
444 |                         <Operation>1</Operation>
445 |                     </Platform>
446 |                 </DeployClass>
447 |                 <DeployClass Name="ProjectOSXInfoPList">
448 |                     <Platform Name="OSX32">
449 |                         <RemoteDir>Contents</RemoteDir>
450 |                         <Operation>1</Operation>
451 |                     </Platform>
452 |                 </DeployClass>
453 |                 <DeployClass Name="ProjectOSXEntitlements">
454 |                     <Platform Name="OSX32">
455 |                         <RemoteDir>..\</RemoteDir>
456 |                         <Operation>1</Operation>
457 |                     </Platform>
458 |                 </DeployClass>
459 |                 <DeployClass Name="UWP_DelphiLogo150">
460 |                     <Platform Name="Win32">
461 |                         <RemoteDir>Assets</RemoteDir>
462 |                         <Operation>1</Operation>
463 |                     </Platform>
464 |                     <Platform Name="Win64">
465 |                         <RemoteDir>Assets</RemoteDir>
466 |                         <Operation>1</Operation>
467 |                     </Platform>
468 |                 </DeployClass>
469 |                 <DeployClass Name="iPad_Launch2048">
470 |                     <Platform Name="iOSSimulator">
471 |                         <Operation>1</Operation>
472 |                     </Platform>
473 |                     <Platform Name="iOSDevice64">
474 |                         <Operation>1</Operation>
475 |                     </Platform>
476 |                     <Platform Name="iOSDevice32">
477 |                         <Operation>1</Operation>
478 |                     </Platform>
479 |                 </DeployClass>
480 |                 <DeployClass Name="AndroidSplashStyles">
481 |                     <Platform Name="Android">
482 |                         <RemoteDir>res\values</RemoteDir>
483 |                         <Operation>1</Operation>
484 |                     </Platform>
485 |                 </DeployClass>
486 |                 <DeployClass Name="Android_SplashImage426">
487 |                     <Platform Name="Android">
488 |                         <RemoteDir>res\drawable-small</RemoteDir>
489 |                         <Operation>1</Operation>
490 |                     </Platform>
491 |                 </DeployClass>
492 |                 <DeployClass Name="AndroidSplashImageDef">
493 |                     <Platform Name="Android">
494 |                         <RemoteDir>res\drawable</RemoteDir>
495 |                         <Operation>1</Operation>
496 |                     </Platform>
497 |                 </DeployClass>
498 |                 <DeployClass Name="ProjectiOSResource">
499 |                     <Platform Name="iOSSimulator">
500 |                         <Operation>1</Operation>
501 |                     </Platform>
502 |                     <Platform Name="iOSDevice64">
503 |                         <Operation>1</Operation>
504 |                     </Platform>
505 |                     <Platform Name="iOSDevice32">
506 |                         <Operation>1</Operation>
507 |                     </Platform>
508 |                 </DeployClass>
509 |                 <DeployClass Name="ProjectAndroidManifest">
510 |                     <Platform Name="Android">
511 |                         <Operation>1</Operation>
512 |                     </Platform>
513 |                 </DeployClass>
514 |                 <DeployClass Name="Android_DefaultAppIcon">
515 |                     <Platform Name="Android">
516 |                         <RemoteDir>res\drawable</RemoteDir>
517 |                         <Operation>1</Operation>
518 |                     </Platform>
519 |                 </DeployClass>
520 |                 <DeployClass Name="File">
521 |                     <Platform Name="Win32">
522 |                         <Operation>0</Operation>
523 |                     </Platform>
524 |                     <Platform Name="iOSDevice64">
525 |                         <Operation>0</Operation>
526 |                     </Platform>
527 |                     <Platform Name="OSX32">
528 |                         <RemoteDir>Contents\Resources\StartUp\</RemoteDir>
529 |                         <Operation>0</Operation>
530 |                     </Platform>
531 |                     <Platform Name="iOSDevice32">
532 |                         <Operation>0</Operation>
533 |                     </Platform>
534 |                     <Platform Name="Android">
535 |                         <Operation>0</Operation>
536 |                     </Platform>
537 |                     <Platform Name="iOSSimulator">
538 |                         <Operation>0</Operation>
539 |                     </Platform>
540 |                 </DeployClass>
541 |                 <DeployClass Name="AndroidServiceOutput">
542 |                     <Platform Name="Android">
543 |                         <RemoteDir>library\lib\armeabi-v7a</RemoteDir>
544 |                         <Operation>1</Operation>
545 |                     </Platform>
546 |                 </DeployClass>
547 |                 <DeployClass Required="true" Name="DependencyPackage">
548 |                     <Platform Name="Win32">
549 |                         <Operation>0</Operation>
550 |                         <Extensions>.bpl</Extensions>
551 |                     </Platform>
552 |                     <Platform Name="iOSDevice64">
553 |                         <Operation>1</Operation>
554 |                         <Extensions>.dylib</Extensions>
555 |                     </Platform>
556 |                     <Platform Name="OSX32">
557 |                         <RemoteDir>Contents\MacOS</RemoteDir>
558 |                         <Operation>1</Operation>
559 |                         <Extensions>.dylib</Extensions>
560 |                     </Platform>
561 |                     <Platform Name="iOSDevice32">
562 |                         <Operation>1</Operation>
563 |                         <Extensions>.dylib</Extensions>
564 |                     </Platform>
565 |                     <Platform Name="iOSSimulator">
566 |                         <Operation>1</Operation>
567 |                         <Extensions>.dylib</Extensions>
568 |                     </Platform>
569 |                 </DeployClass>
570 |                 <DeployClass Name="Android_LauncherIcon48">
571 |                     <Platform Name="Android">
572 |                         <RemoteDir>res\drawable-mdpi</RemoteDir>
573 |                         <Operation>1</Operation>
574 |                     </Platform>
575 |                 </DeployClass>
576 |                 <DeployClass Name="Android_SplashImage960">
577 |                     <Platform Name="Android">
578 |                         <RemoteDir>res\drawable-xlarge</RemoteDir>
579 |                         <Operation>1</Operation>
580 |                     </Platform>
581 |                 </DeployClass>
582 |                 <DeployClass Name="Android_LauncherIcon36">
583 |                     <Platform Name="Android">
584 |                         <RemoteDir>res\drawable-ldpi</RemoteDir>
585 |                         <Operation>1</Operation>
586 |                     </Platform>
587 |                 </DeployClass>
588 |                 <DeployClass Name="DependencyModule">
589 |                     <Platform Name="Win32">
590 |                         <Operation>0</Operation>
591 |                         <Extensions>.dll;.bpl</Extensions>
592 |                     </Platform>
593 |                     <Platform Name="iOSDevice64">
594 |                         <Operation>1</Operation>
595 |                         <Extensions>.dylib</Extensions>
596 |                     </Platform>
597 |                     <Platform Name="OSX32">
598 |                         <RemoteDir>Contents\MacOS</RemoteDir>
599 |                         <Operation>1</Operation>
600 |                         <Extensions>.dylib</Extensions>
601 |                     </Platform>
602 |                     <Platform Name="iOSDevice32">
603 |                         <Operation>1</Operation>
604 |                         <Extensions>.dylib</Extensions>
605 |                     </Platform>
606 |                     <Platform Name="iOSSimulator">
607 |                         <Operation>1</Operation>
608 |                         <Extensions>.dylib</Extensions>
609 |                     </Platform>
610 |                 </DeployClass>
611 |                 <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/>
612 |                 <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/>
613 |                 <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/>
614 |                 <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/>
615 |                 <ProjectRoot Platform="Linux64" Name="$(PROJECTNAME)"/>
616 |                 <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/>
617 |                 <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/>
618 |                 <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/>
619 |             </Deployment>
620 |             <Platforms>
621 |                 <Platform value="Android">False</Platform>
622 |                 <Platform value="iOSDevice32">False</Platform>
623 |                 <Platform value="iOSDevice64">False</Platform>
624 |                 <Platform value="iOSSimulator">False</Platform>
625 |                 <Platform value="OSX32">False</Platform>
626 |                 <Platform value="Win32">True</Platform>
627 |                 <Platform value="Win64">False</Platform>
628 |             </Platforms>
629 |         </BorlandProject>
630 |         <ProjectFileVersion>12</ProjectFileVersion>
631 |     </ProjectExtensions>
632 |     <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
633 |     <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/>
634 |     <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/>
635 | </Project>
636 | 


--------------------------------------------------------------------------------
/Source/Project37.res:
--------------------------------------------------------------------------------
https://raw.githubusercontent.com/JBontes/DelphiSpringTrees/79e3d53a9775e96e171c6ce14de0a1da4cd7521d/Source/Project37.res


--------------------------------------------------------------------------------
/Source/Spring.Collections.Ministacks.pas:
--------------------------------------------------------------------------------
  1 | { *************************************************************************** }
  2 | {                                                                             }
  3 | { Proposed addition to the                                                    }
  4 | {           Spring Framework for Delphi                                       }
  5 | {                                                                             }
  6 | { Copyright (c) 2009-2014 Spring4D Team                                       }
  7 | {                                                                             }
  8 | { http://www.spring4d.org                                                     }
  9 | {                                                                             }
 10 | { *************************************************************************** }
 11 | {                                                                             }
 12 | { Licensed under the Apache License, Version 2.0 (the "License");             }
 13 | { you may not use this file except in compliance with the License.            }
 14 | { You may obtain a copy of the License at                                     }
 15 | {                                                                             }
 16 | { http://www.apache.org/licenses/LICENSE-2.0                                  }
 17 | {                                                                             }
 18 | { Unless required by applicable law or agreed to in writing, software         }
 19 | { distributed under the License is distributed on an "AS IS" BASIS,           }
 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
 21 | { See the License for the specific language governing permissions and         }
 22 | { limitations under the License.                                              }
 23 | {                                                                             }
 24 | { *************************************************************************** }
 25 | 
 26 | // Implements a fast stack for use with tree iterators.
 27 | 
 28 | 
 29 | unit Spring.Collections.Ministacks;
 30 | 
 31 | interface
 32 | 
 33 | const
 34 |   {$ifdef CPUX64}
 35 |   DefaultSize = 63;
 36 |   {$else}
 37 |   DefaultSize = 31;
 38 |   {$endif}
 39 | 
 40 | type
 41 |   /// <summary>
 42 |   /// The ministack stores DefaultSize elements on the system's stack.
 43 |   /// It is coded for raw speed.
 44 |   /// The stack is safe for holding managed types
 45 |   /// It does not do range checking, other than through Assertions at debug time
 46 |   /// </summary>
 47 |   TMiniStack<T> = record
 48 | {$IFDEF DEBUG}
 49 |   strict private
 50 |     function capacity: Integer;
 51 | {$ENDIF}
 52 |   private
 53 |     SP: Integer;
 54 | {$IFDEF CPUX64}
 55 |     Filler: integer; // Keep array aligned
 56 | {$ENDIF}
 57 | {$IFDEF DEBUG}
 58 |     HeapFlag: TGUID;
 59 |     HeapSize: Integer;
 60 | {$ENDIF}
 61 |     //Must be the last item on the list.
 62 |     Items: array[0..DefaultSize - 1] of T;
 63 |     function GetItem(index: Integer): T; inline;
 64 |   public
 65 |     procedure Free;
 66 |     /// <summary>
 67 |     /// Initializes the stack.
 68 |     /// Must be called before the stack can be used.
 69 |     /// </summary>
 70 |     procedure Init; inline;
 71 |     function Pop: T; inline;
 72 |     procedure Push(const Item: T); inline;
 73 |     /// <summary>
 74 |     /// Returns the top item on the stack, does not alter the stack pointer.
 75 |     /// </summary>
 76 |     /// <returns></returns>
 77 |     function Peek: T; inline;
 78 |     function IsEmpty: Boolean; inline;
 79 |     /// <summary>
 80 |     /// Allows the stack to be accessed as a read-only array.
 81 |     /// Note that Item[0] is the most recent item, Item[1] the item below that etc.
 82 |     /// </summary>
 83 |     property Item[index: Integer]: T read GetItem;
 84 |     property Count: integer read SP;
 85 |   end;
 86 | 
 87 |   MiniStack<T> = class
 88 |   public type
 89 |     PStack = ^Stack;
 90 |     Stack = TMiniStack<T>;
 91 |   public
 92 |     /// <summary>
 93 |     /// Creates new ministack on the heap.
 94 |     /// </summary>
 95 |     /// <param name="Size">The maximum number of elements the stack can hold</param>
 96 |     /// <returns>Pointer to the newly created stack.</returns>
 97 |     /// <remarks>
 98 |     /// Do not create and destroy a Ministack in a loop, use the stack based Ministack instead.
 99 |     /// You can increase the constant DefaultSize (must be a true constant) if you need a bigger
100 |     /// stack.
101 |     /// </remarks>
102 |     class function Create(Size: integer = DefaultSize): PStack;
103 |   end;
104 | 
105 | {$IFDEF DEBUG}
106 | const
107 |   MagicHeapFlag: TGUID = '{EF227045-27A9-4EF3-99E3-9D279D58F9A0}';
108 |   FreedAlreadyFlag: TGUID = '{A76BBA2F-09C5-44B7-81BF-3C8869FB8D80}';
109 | {$ENDIF}
110 | 
111 | implementation
112 | 
113 | uses
114 |   System.SysUtils;
115 | 
116 | { TMiniStack<T> }
117 | 
118 | procedure TMiniStack<T>.Init;
119 | var
120 |   i: Integer;
121 | begin
122 |   SP:= 0;
123 | end;
124 | 
125 | class function MiniStack<T>.Create(Size: integer = DefaultSize): PStack;
126 | begin
127 |   Result:= AllocMem(SizeOf(TMiniStack<T>) - (DefaultSize * SizeOf(T)) + (Size * SizeOf(T)));
128 | {$IFDEF DEBUG}
129 |   Result.HeapFlag:= MagicHeapFlag;
130 |   Result.HeapSize:= Size;
131 | {$ENDIF}
132 | end;
133 | 
134 | {$IFDEF DEBUG}
135 | function TMiniStack<T>.Capacity: Integer;
136 | begin
137 |   if HeapFlag = MagicHeapFlag then begin
138 |     Result:= HeapSize;
139 |   end
140 |   else Result:= DefaultSize;
141 | end;
142 | {$ENDIF}
143 | 
144 | procedure TMiniStack<T>.Free;
145 | begin
146 | {$IFDEF DEBUG}
147 |   Assert((HeapFlag = MagicHeapFlag) or (HeapFlag = FreedAlreadyFlag),
148 |     'Do not call free on stack based MiniStacks');
149 |   Assert((HeapFlag <> FreedAlreadyFlag), 'This stack has already been freed');
150 | {$ENDIF}
151 |   Finalize(Items, count);
152 |   FreeMem(@Self);
153 | end;
154 | 
155 | function TMiniStack<T>.GetItem(index: Integer): T;
156 | begin
157 |   Assert((index >= 0) and (index < Count),
158 |     Format('Trying to get item #%d, but there are only %d items on the stack',[index, count]));
159 |   Result:= Items[count - index - 1];
160 | end;
161 | 
162 | function TMiniStack<T>.IsEmpty: Boolean;
163 | begin
164 |   Result:= (SP = 0);
165 | end;
166 | 
167 | function TMiniStack<T>.Pop: T;
168 | begin
169 |   Assert(SP > 0, 'Stack underflow');
170 |   Dec(SP);
171 |   Result:= Items[SP];
172 | end;
173 | 
174 | function TMiniStack<T>.Peek: T;
175 | begin
176 |   Assert(SP > 0, 'You cannot peek at an empty stack');
177 |   Result:= Items[SP-1];
178 | end;
179 | 
180 | procedure TMiniStack<T>.Push(const Item: T);
181 | begin
182 |   Items[SP]:= Item;
183 |   Inc(SP);
184 | {$IFDEF DEBUG}
185 |   Assert(SP <= Capacity, 'Stack overflow');
186 | {$ENDIF}
187 | end;
188 | 
189 | end.
190 | 


--------------------------------------------------------------------------------
/Source/Spring.Collections.TreeImpl.pas:
--------------------------------------------------------------------------------
   1 | unit Spring.Collections.TreeImpl;
   2 | 
   3 | { *************************************************************************** }
   4 | {                                                                             }
   5 | { Proposed addition to the                                                    }
   6 | { Spring Framework for Delphi                                                 }
   7 | {                                                                             }
   8 | { Copyright (c) 2009-2017 Spring4D Team                                       }
   9 | {                                                                             }
  10 | { http://www.spring4d.org                                                     }
  11 | {                                                                             }
  12 | { *************************************************************************** }
  13 | {                                                                             }
  14 | { Licensed under the Apache License, Version 2.0 (the "License");             }
  15 | { you may not use this file except in compliance with the License.            }
  16 | { You may obtain a copy of the License at                                     }
  17 | {                                                                             }
  18 | { http://www.apache.org/licenses/LICENSE-2.0                                  }
  19 | {                                                                             }
  20 | { Unless required by applicable law or agreed to in writing, software         }
  21 | { distributed under the License is distributed on an "AS IS" BASIS,           }
  22 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
  23 | { See the License for the specific language governing permissions and         }
  24 | { limitations under the License.                                              }
  25 | {                                                                             }
  26 | { *************************************************************************** }
  27 | 
  28 | // Adds red black trees to the spring framework.
  29 | // Core Red black tree code is an adoptation of code (c) 2017 Lukas Barth,
  30 | // released under the MIT License under the following terms:
  31 | //
  32 | //Permission is hereby granted, free of charge, to any person obtaining a copy
  33 | //of this software and associated documentation files (the "Software"), to deal
  34 | //in the Software without restriction, including without limitation the rights
  35 | //to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  36 | //copies of the Software, and to permit persons to whom the Software is
  37 | //furnished to do so, subject to the following conditions:
  38 | //
  39 | //The above copyright notice and this permission notice shall be included in all
  40 | //copies or substantial portions of the Software.
  41 | // Data is stored in sized sized buckets (dynamic arrays)
  42 | // The buckets are kept in a dynamic array.
  43 | // When a element is added, it will always be added to the top free item in the
  44 | // top free bucket.
  45 | // When an element is deleted, it is first swapped with the top occupied item
  46 | // in the top bucket; after that the top item in the top bucket is freed.
  47 | // For small items this is fast, because there is no memory fragmentation.
  48 | // Also pointers to nodes do not change (except when swapping items, which only
  49 | // affects a single node).
  50 | // For large items, combined with trees with many insertions and deletions,
  51 | // it may be better to simply store the items in the heap.
  52 | 
  53 | interface
  54 | 
  55 | uses
  56 |   System.Types,
  57 |   System.SysUtils,
  58 |   System.Generics.Collections,
  59 |   System.Generics.Defaults,
  60 |   Spring,
  61 |   Spring.Collections,
  62 |   Spring.Collections.Base,
  63 |   Spring.Collections.TreeIntf;
  64 |   //Spring.Collections.MiniStacks;
  65 | 
  66 | type
  67 | {$REGION 'TTree<T>'}
  68 |   /// <summary>
  69 |   /// Abstract parent for tree, defines the tree as a set of keys
  70 |   /// </summary>
  71 |   TTree<T> = class abstract(TCollectionBase<T>, ISet<T>, ITree<T>, IEnumerable<T>)
  72 |   private
  73 |     procedure ArgumentNilError(const MethodName: string); virtual;
  74 |   protected
  75 |     fCount: Integer;
  76 |     procedure AddInternal(const Item: T); override;
  77 |     function GetCount: Integer; reintroduce;
  78 |   public
  79 | 
  80 |     /// <summary>
  81 |     /// Adds an element to the current set and returns a Value to indicate if
  82 |     /// the element was successfully added.
  83 |     /// </summary>
  84 |     /// <param name="item">
  85 |     /// The element to add to the set.
  86 |     /// </param>
  87 |     /// <returns>
  88 |     /// <b>True</b> if the element is added to the set; <b>False</b> if the
  89 |     /// element is already in the set.
  90 |     /// </returns>
  91 |     function Add(const Item: T): boolean; virtual; abstract;
  92 | 
  93 |     /// <summary>
  94 |     /// Determines whether a <see cref="Tree&lt;T&gt;" /> object contains
  95 |     /// the specified element.
  96 |     /// </summary>
  97 |     /// <param name="item">
  98 |     /// The element to locate in the <see cref="THashSet&lt;T&gt;" /> object.
  99 |     /// </param>
 100 |     /// <returns>
 101 |     /// <b>True</b> if the <see cref="THashSet&lt;T&gt;" /> object contains
 102 |     /// the specified element; otherwise, <b>False</b>.
 103 |     /// </returns>
 104 |     function Contains(const Key: T): boolean; reintroduce; virtual; abstract;
 105 | 
 106 |     /// <summary>
 107 |     /// Removes all elements in the specified Collection from the current
 108 |     /// <see cref="Tree&lt;T&gt;" /> object.
 109 |     /// </summary>
 110 |     /// <param name="Other">
 111 |     /// The Collection of items to remove from the
 112 |     /// <see cref="THashSet&lt;T&gt;" /> object.
 113 |     /// </param>
 114 |     /// <exception cref="EArgumentNullException">
 115 |     /// <i>Other</i> is <b>nil</b>.
 116 |     /// </exception>
 117 |     procedure ExceptWith(const Other: IEnumerable<T>); virtual;
 118 | 
 119 |     /// <summary>
 120 |     /// Modifies the current <see cref="Tree&lt;T&gt;" /> object to
 121 |     /// contain only elements that are present in that object and in the
 122 |     /// specified Collection.
 123 |     /// </summary>
 124 |     /// <param name="Other">
 125 |     /// The Collection to compare to the current
 126 |     /// <see cref="Tree&lt;T&gt;" /> object.
 127 |     /// </param>
 128 |     /// <exception cref="EArgumentNullException">
 129 |     /// <i>Other</i> is <b>nil</b>.
 130 |     /// </exception>
 131 |     procedure IntersectWith(const Other: IEnumerable<T>); virtual;
 132 | 
 133 |     /// <summary>
 134 |     /// Modifies the current <see cref="Tree&lt;T&gt;" /> object to
 135 |     /// contain all elements that are present in itself, the specified
 136 |     /// Collection, or both.
 137 |     /// </summary>
 138 |     /// <param name="Other">
 139 |     /// The Collection to compare to the current
 140 |     /// <see cref="Tree&lt;T&gt;" /> object.
 141 |     /// </param>
 142 |     /// <exception cref="EArgumentNullException">
 143 |     /// <i>Other</i> is <b>nil</b>.
 144 |     /// </exception>
 145 |     procedure UnionWith(const Other: IEnumerable<T>); virtual;
 146 | 
 147 |     /// <summary>
 148 |     /// Determines whether a <see cref="Tree&lt;T&gt;" /> object is a
 149 |     /// subset of the specified Collection.
 150 |     /// </summary>
 151 |     /// <param name="Other">
 152 |     /// The Collection to compare to the current
 153 |     /// <see cref="THashSet&lt;T&gt;" /> object.
 154 |     /// </param>
 155 |     /// <returns>
 156 |     /// <b>True</b> if the <see cref="Tree&lt;T&gt;" /> object is a
 157 |     /// subset of <i>Other</i>; otherwise, <b>False</b>.
 158 |     /// </returns>
 159 |     /// <exception cref="EArgumentNullException">
 160 |     /// <i>Other</i> is <b>nil</b>.
 161 |     /// </exception>
 162 |     function IsSubsetOf(const Other: IEnumerable<T>): boolean; virtual;
 163 | 
 164 |     /// <summary>
 165 |     /// Determines whether a <see cref="Tree&lt;T&gt;" /> object is a
 166 |     /// superset of the specified Collection.
 167 |     /// </summary>
 168 |     /// <param name="Other">
 169 |     /// The Collection to compare to the current
 170 |     /// <see cref="THashSet&lt;T&gt;" /> object.
 171 |     /// </param>
 172 |     /// <returns>
 173 |     /// <b>True</b> if the <see cref="Tree&lt;T&gt;" /> object is a
 174 |     /// superset of <i>Other</i>; otherwise, <b>False</b>.
 175 |     /// </returns>
 176 |     /// <exception cref="EArgumentNullException">
 177 |     /// <i>Other</i> is <b>nil</b>.
 178 |     /// </exception>
 179 |     function IsSupersetOf(const Other: IEnumerable<T>): boolean; virtual;
 180 | 
 181 |     /// <summary>
 182 |     /// Determines whether a <see cref="THashSet&lt;T&gt;" /> object and the
 183 |     /// specified Collection contain the same elements.
 184 |     /// </summary>
 185 |     /// <param name="Other">
 186 |     /// The Collection to compare to the current
 187 |     /// <see cref="THashSet&lt;T&gt;" /> object.
 188 |     /// </param>
 189 |     /// <returns>
 190 |     /// <b>True</b> if the <see cref="THashSet&lt;T&gt;" /> object is equal
 191 |     /// to <i>Other</i>; otherwise, <b>False</b>.
 192 |     /// </returns>
 193 |     /// <exception cref="EArgumentNullException">
 194 |     /// <i>Other</i> is <b>nil</b>.
 195 |     /// </exception>
 196 |     function SetEquals(const Other: IEnumerable<T>): boolean; virtual;
 197 | 
 198 |     /// <summary>
 199 |     /// Determines whether the current <see cref="Tree&lt;T&gt;" />
 200 |     /// object and a specified Collection share common elements.
 201 |     /// </summary>
 202 |     /// <param name="Other">
 203 |     /// The Collection to compare to the current
 204 |     /// <see cref="THashSet&lt;T&gt;" /> object.
 205 |     /// </param>
 206 |     /// <returns>
 207 |     /// <b>True</b> if the <see cref="Tree&lt;T&gt;" /> object and
 208 |     /// <i>Other</i> share at least one common element; otherwise,
 209 |     /// <b>False</b>.
 210 |     /// </returns>
 211 |     /// <exception cref="EArgumentNullException">
 212 |     /// <i>Other</i> is <b>nil</b>.
 213 |     /// </exception>
 214 |     function Overlaps(const Other: IEnumerable<T>): boolean; virtual;
 215 |     procedure Traverse(Order: TTraverseOrder; const Action: TTraverseAction<T>); virtual; abstract;
 216 |   end;
 217 | {$ENDREGION}
 218 | 
 219 | {$REGION 'TBinaryTreeBase<T>'}
 220 | 
 221 |   TBinaryTreeBase<T> = class(TTree<T>)
 222 |   private const
 223 | {$IFDEF debug}
 224 |     cBucketSize = 1024;
 225 | {$ELSE}
 226 |     cBucketSize = 1024;
 227 | {$ENDIF}
 228 |   protected type
 229 |     // Nodes in the tree. The nodes hold a pointer to their parent to allow
 230 |     // for swapping of nodes, which we need to support the bucket storage system.
 231 |     PNode = ^TNode;
 232 | 
 233 |     TNode = record
 234 |     strict private
 235 |       fParent: PNode; // Used for rearraging nodes in the underlying storage.
 236 |     private
 237 |       fLeft: PNode; // Left nodes hold lower values
 238 |       fRight: PNode; // Right nodes hold higher values
 239 |       fKey: T; // The payload, use a TPair<K,V> to store a Key/Value pair.
 240 |     public //Allow fIsBlack to be repurposed (e.g. as the balance field in an AVLTree).
 241 |       fIsBlack: Boolean; // Red is the default.
 242 |     private
 243 |       /// <summary>
 244 |       /// Static method to get the color. Always use this method, never read the
 245 |       /// field directly, because the Node might be nil.
 246 |       /// A nil node with a color is valid.
 247 |       /// </summary>
 248 |       /// <returns> false if self is nil; true is the Node is red, false otherwise</returns>
 249 |       function IsRed: boolean; inline;
 250 |       function Uncle: PNode;
 251 |       property NodeColor: Boolean read fIsBlack write fIsBlack;
 252 |     public
 253 |       property Left: PNode read fLeft write fLeft;
 254 |       property Right: PNode read fRight write fRight;
 255 |       property Parent: PNode read fParent write fParent;
 256 |       property Key: T read fKey; // write fKey;
 257 |     end;
 258 |   private type
 259 |     /// <summary>
 260 |     /// Enumerator for the trees, works on Nodes, not values.
 261 |     /// </summary>
 262 |     TTreeEnumerator = class(TIterator<T>)
 263 |     private
 264 |       fTree: TBinaryTreeBase<T>;
 265 |       fCurrentNode: PNode;
 266 |       // Enumerator can be reversed.
 267 |       fDirection: TDirection;
 268 |     protected
 269 |       // function GetCurrentNonGeneric: V; override;
 270 |       function Clone: TIterator<T>; override;
 271 |       constructor Create(const Tree: TBinaryTreeBase<T>; Direction: TDirection); overload;
 272 |       constructor Create(const Tree: TBinaryTreeBase<T>); overload;
 273 |     public
 274 |       procedure Reset; override;
 275 |       function MoveNext: boolean; override;
 276 |       // function GetEnumerator: IEnumerator<T>; override;
 277 |       // function GetCurrent: T;
 278 |       property Current: T read GetCurrent;
 279 |       property CurrentNode: PNode read fCurrentNode;
 280 |     end;
 281 |   private type
 282 |     TNodePredicate = TPredicate<PNode>;
 283 |   protected type
 284 |     TBucketIndex = TPair<NativeUInt, NativeUInt>;
 285 |   protected
 286 |     fStorage: TArray<TArray<TNode>>;
 287 |     function BucketIndex(Index: NativeUInt): TBucketIndex; inline;
 288 |     /// <summary>
 289 |     /// Destroys a single Node and updates the count.
 290 |     /// Fixes the root if nessecary
 291 |     /// </summary>
 292 |     /// <remarks>
 293 |     /// Only deletes a single Node; does not delete childern and does not fixup the tree.
 294 |     /// </remarks>
 295 |     procedure FreeSingleNode(const Node: PNode);
 296 |   private
 297 |     fRoot: PNode;
 298 |     procedure SetRoot(const Value: PNode); inline;
 299 |     procedure TraversePreOrder(const Node: PNode; Action: TNodePredicate);
 300 |     procedure TraversePostOrder(const Node: PNode; Action: TNodePredicate);
 301 |     procedure TraverseInOrder(const Node: PNode; Action: TNodePredicate);
 302 |     procedure TraverseReverseOrder(const Node: PNode; Action: TNodePredicate);
 303 |     /// <summary>
 304 |     ///  Convienance method to see if two keys are equal.
 305 |     /// </summary>
 306 |     function Equal(const A, B: T): boolean; inline;
 307 |     /// <summary>
 308 |     ///  Convienance method to see if (a < b).
 309 |     /// </summary>
 310 |     /// <returns>
 311 |     ///  True if A < B, False if A >= B
 312 |     /// </returns>
 313 |     function Less(const A, B: T): boolean; inline;
 314 |     /// <summary>
 315 |     /// Finds the Node containing the Key in the given subtree.
 316 |     /// </summary>
 317 |     /// <param name="Head">The head of the subtree</param>
 318 |     /// <param name="Key">The Key to look for</param>
 319 |     /// <returns>nil if the Key is not found in the subtree; the containing Node otherwise</returns>
 320 |     function FindNode(const Head: PNode; const Key: T): PNode;
 321 | 
 322 |     function NewNode(const Key: T; Parent: PNode): PNode;
 323 | 
 324 |     function InternalInsert(Head: PNode; const Key: T): PNode; virtual;
 325 |     /// <summary>
 326 |     /// Expand the storage to add another bucket.
 327 |     /// Should perhaps be more intelligent when the tree is expanding fast?
 328 |     /// </summary>
 329 |     procedure ExpandStorage(OldCount: NativeUInt);
 330 |     function NextNode(const Node: PNode): PNode;
 331 |     /// <summary>
 332 |     /// Get the leftmost (smallest Node) in the given subtree.
 333 |     /// </summary>
 334 |     /// <param name="Head">The head of the subtree, must not be nil</param>
 335 |     /// <returns>The leftmost (smallest) Node in the subtree</returns>
 336 |     function MinNode(const Head: PNode): PNode;
 337 |     /// <summary>
 338 |     /// Get the rightmost (largest Node) in the given subtree.
 339 |     /// </summary>
 340 |     /// <param name="Head">The head of the subtree, must not be nil</param>
 341 |     /// <returns>The rightmost (largest) Node in the subtree</returns>
 342 |     function MaxNode(const Head: PNode): PNode;
 343 |     function PreviousNode(const Node: PNode): PNode;
 344 | 
 345 |     property Root: PNode read fRoot write SetRoot;
 346 |   public
 347 |     destructor Destroy; override;
 348 |     function Add(const Item: T): boolean; override;
 349 |     function Contains(const Key: T): boolean; override;
 350 |     procedure Clear; override;
 351 |     property Count: Integer read fCount;
 352 |     procedure Traverse(Order: TTraverseOrder; const Action: TTraverseAction<T>); override;
 353 |   end;
 354 | {$ENDREGION}
 355 | {$REGION 'TBinaryTreeBase<K,V>'}
 356 | 
 357 |   TBinaryTreeBase<K, V> = class(TBinaryTreeBase<TPair<K, V>>)
 358 |   protected type
 359 |     TPair = TPair<K, V>;
 360 |   private type
 361 |     PNode = TBinaryTreeBase<TPair>.PNode;
 362 |   private
 363 |     class var fKeyComparer: IComparer<K>;
 364 |     class function GetKeyComparer: IComparer<K>; static;
 365 |   public type
 366 |     TTraverseAction = reference to procedure(const Key: K; const Value: V; var Abort: boolean);
 367 |   protected
 368 |     function Equal(const A, B: K): boolean; overload;
 369 |     function Less(const A, B: K): boolean; overload;
 370 |     function Pair(const Key: K; const Value: V): TPair; inline;
 371 |     class property KeyComparer: IComparer<K> read GetKeyComparer;
 372 |   public
 373 |   end;
 374 | {$ENDREGION}
 375 | {$REGION 'TNAryTree<K,V>'}
 376 | 
 377 |   TNAryTree<K, V> = class(TBinaryTreeBase<K, V>)
 378 |   private type
 379 |     PNode = ^TNode;
 380 |     TNode = TBinaryTreeBase < TPair < K, V >>.TNode;
 381 |   private
 382 |     /// <summary>
 383 |     /// Inserts a Node into the subtree anchored at Start.
 384 |     /// </summary>
 385 |     /// <param name="Start">The 'root' of the subtree</param>
 386 |     /// <param name="Key">The Key to insert into the subtree</param>
 387 |     /// <returns>The new root of the subtree.
 388 |     /// This new root needs to be Assigned in place if the old start Node
 389 |     /// in order to retain the RedBlackness of the tree</returns>
 390 |     /// <remarks>
 391 |     /// Does *not* return an exception if a duplicate Key is inserted, but simply returns
 392 |     /// the Start Node as its result; doing nothing else.
 393 |     /// Examine the Count property to see if a Node was inserted.
 394 |     ///
 395 |     /// Can lead to duplicate keys in the tree if not called with the Root as the Head</remarks>
 396 |     function InternalInsert(Head: PNode; const Key: K; const Value: V): PNode; reintroduce; overload; virtual;
 397 |   public
 398 |     function Add(const Key: TPair<K, V>): boolean; overload; override;
 399 |     procedure Add(const Key: K; const Value: V); reintroduce; overload; virtual;
 400 |     function Get(Key: K): TPair<K, V>;
 401 |     function GetDirectChildern(const ParentKey: K): TArray<TPair<K, V>>;
 402 |   end;
 403 | {$ENDREGION}
 404 | 
 405 | 
 406 | //{$REGION 'TAVLTree<T>'}
 407 | //  TAVLTree<T> = class(TBinaryTreeBase<T>)
 408 | //  private type
 409 | //    TBalance = -2..2;
 410 | //  private type
 411 | //    PNode = ^TNode;
 412 | //    TNode = TBinaryTreeBase<T>.TNode;
 413 | //    TNodePredicate = TBinaryTreeBase<T>.TNodePredicate;
 414 | //  private type
 415 | //    TAVLNodeHelper = record helper for TNode
 416 | //      function GetCount: NativeInt;
 417 | //      function TreeDepth: NativeInt;        //longest way down
 418 | //      //We repurpose the fColor as a TBalance member.
 419 | //      function GetBalance: TBalance; inline;
 420 | //      procedure SetBalance(const Value: TBalance); inline;
 421 | //      property Balance: TBalance read GetBalance write SetBalance;
 422 | //      property Count: NativeInt read GetCount;
 423 | //    end;
 424 | //  protected
 425 | //    procedure BalanceAfterInsert(Node: PNode);
 426 | //    procedure BalanceAfterDelete(Node: PNode);
 427 | //    procedure RotateLeft(Node: PNode);
 428 | //    procedure RotateRight(Node: PNode);
 429 | //    procedure SwitchPositionWithSuccessor
 430 | //  end;
 431 | //{$ENDREGION}
 432 | 
 433 |   /// <summary>
 434 |   /// Left Leaning red black tree, mainly useful for encaplating a Set.
 435 |   /// Does not allow duplicate items.
 436 |   /// </summary>
 437 | {$REGION 'TRedBlackTree<T>'}
 438 |   TRedBlackTree<T> = class(TBinaryTreeBase<T>{$ifdef debug}, ITreeDebug{$endif})
 439 |   private type
 440 |     PNode = ^TNode;
 441 |     TNode = TBinaryTreeBase<T>.TNode;
 442 |     TNodePredicate = TBinaryTreeBase<T>.TNodePredicate;
 443 |   private
 444 |     /// <summary>
 445 |     /// Deletes the rightmost child of Start Node, retaining the RedBlack property
 446 |     /// </summary>
 447 |     //function DeleteMax(Head: PNode): PNode; overload;
 448 |     /// <summary>
 449 |     /// Deletes the leftmost child of Start Node, retaining the RedBlack property
 450 |     /// </summary>
 451 |     //function DeleteMin(Head: PNode): PNode; overload;
 452 |     /// <summary>
 453 |     /// Deletes the Node with the given Key inside the subtree under Start
 454 |     /// </summary>
 455 |     /// <param name="Start">The 'root' of the subtree</param>
 456 |     /// <param name="Key">The id of the Node to be deleted</param>
 457 |     /// <returns>The new root of the subtree.
 458 |     /// This new root needs to be Assigned in place if the old start Node
 459 |     /// in order to retain the RedBlackness of the tree</returns>
 460 |     /// <remarks>
 461 |     /// Does *not* return an exception if the Key is not found, but simply returns
 462 |     /// the Start Node as its result.
 463 |     /// Examine the Count property to see if a Node was deleted.
 464 |     /// </remarks>
 465 |     //function DeleteNode(Head: PNode; Key: T): PNode; overload;
 466 | 
 467 |     /// <summary>
 468 |     /// Inserts a Node into the subtree anchored at Start.
 469 |     /// </summary>
 470 |     /// <param name="Start">The 'root' of the subtree</param>
 471 |     /// <param name="Key">The Key to insert into the subtree</param>
 472 |     /// <returns>The new root of the subtree.
 473 |     /// This new root needs to be Assigned in place if the old start Node
 474 |     /// in order to retain the RedBlackness of the tree</returns>
 475 |     /// <remarks>
 476 |     /// Does *not* return an exception if a duplicate Key is inserted, but simply returns
 477 |     /// the Start Node as its result; doing nothing else.
 478 |     /// Examine the Count property to see if a Node was inserted.
 479 |     ///
 480 |     /// Can lead to duplicate keys in the tree if not called with the Root as the Start</remarks>
 481 |     function InternalInsert(Head: PNode; const Key: T): PNode; override;
 482 | 
 483 |     /// <summary>
 484 |     /// Corrects the RedBlackness of a Node and its immediate childern after insertion or deletion.
 485 |     /// </summary>
 486 |     /// <param name="Node"></param>
 487 |     /// <returns></returns>
 488 |     //function FixUp(Node: PNode): PNode;
 489 |     /// <summary>
 490 |     /// Inverts the color of a 3-Node and its immediate childern.
 491 |     /// </summary>
 492 |     /// <param name="Head"></param>
 493 |     //procedure ColorFlip(const Node: PNode);
 494 |     /// <summary>
 495 |     /// Assuming that Node is red and both Node.left and Node.left.left
 496 |     /// are black, make Node.left or one of its children red.
 497 |     /// </summary>
 498 |     //function MoveRedLeft(Node: PNode): PNode;
 499 |     /// <summary>
 500 |     /// Assuming that Node is red and both Node.right and Node.right.left
 501 |     /// are black, make Node.right or one of its children red.
 502 |     /// </summary>
 503 |     //function MoveRedRight(Node: PNode): PNode;
 504 |     /// <summary>
 505 |     /// Make a right-leaning 3-Node lean to the left.
 506 |     /// </summary>
 507 |     //function RotateLeft(Node: PNode): PNode;
 508 |     /// <summary>
 509 |     /// Make a left-leaning 3-Node lean to the right.
 510 |     /// </summary>
 511 |     //function RotateRight(Node: PNode): PNode;
 512 |     //function DoInsert(Head: PNode; const Key: T): PNode;
 513 |     //procedure FixUpAfterInsert(NewNode: PNode);
 514 |   private
 515 |     procedure rbFixupAfterDelete(Parent: PNode; DeletedLeft: Boolean);
 516 |     procedure rbFixupAfterInsert(Node: PNode);
 517 |     //procedure rbInsert(const Key: T); overload; inline;
 518 |     //procedure rbInsert(const Key: T; Hint: PNode); overload;
 519 |     //procedure rbInsert(const Key: T; Start: PNode); overload; inline;
 520 |     function rbInsertBase(const Key: T; Start: PNode; BaisedLeft: Boolean): PNode;
 521 |     //procedure rbInsertRightBiased(const Key: T; Start: PNode); inline;
 522 |     //procedure rbRemove(Node: PNode); inline;
 523 |     procedure rbRemoveNode(Node: PNode);
 524 |     procedure rbRotateLeft(Parent: PNode);
 525 |     procedure rbRotateRight(Parent: PNode);
 526 |     procedure rbSwapNeighbors(Parent, Child: PNode);
 527 |     procedure rbSwapNodes(n1, n2: PNode; SwapColors: Boolean);
 528 |     procedure rbSwapUnrelatedNodes(n1, n2: PNode);
 529 |     //TestMethods
 530 |     function VerifyBlackPaths(const Node: PNode; var PathLength: NativeUInt): Boolean;
 531 |     function VerifyBlackRoot: Boolean; inline;
 532 |     function VerifyIntegrity: Boolean;
 533 |     function VerifyOrder: Boolean;
 534 |     function VerifyRedBlack(const Node: PNode): Boolean;
 535 |     function VerifyTree: Boolean;
 536 |     function StorageSizeOK: Boolean;
 537 |   protected
 538 |     constructor Create; reintroduce; overload;
 539 |     constructor Create(const Comparer: IComparer<T>); reintroduce; overload;
 540 |     constructor Create(const Comparer: TComparison<T>); reintroduce; overload;
 541 |     constructor Create(const Values: array of T); reintroduce; overload;
 542 |     constructor Create(const Collection: IEnumerable<T>); reintroduce; overload;
 543 |   public
 544 |     function GetEnumerator: IEnumerator<T>; override;
 545 |     function Reversed: IEnumerable<T>; override;
 546 |   public
 547 |     function Last: T; overload; override;
 548 |     function Last(const Predicate: TPredicate<T>): T; overload;
 549 |     function LastOrDefault(const DefaultValue: T): T; overload; override;
 550 |     function LastOrDefault(const Predicate: TPredicate<T>; const DefaultValue: T): T; overload;
 551 |     function First: T; override;
 552 |     function Extract(const Key: T): T; override;
 553 |     function Remove(const Key: T): boolean; override;
 554 |     function Add(const Key: T): boolean; override;
 555 |     function Get(const Key: T): T; overload;
 556 |   end;
 557 | {$ENDREGION}
 558 | {$REGION 'TRedBlackTree<K,V>'}
 559 | 
 560 |   TRedBlackTree<K, V> = class(TRedBlackTree<TPair<K, V>>, IDictionary<K, V>, ITree<K, V>)
 561 |   private type
 562 |     TPair = TPair<K, V>;
 563 |   private type
 564 |     TTreeComparer = class(TInterfacedObject, IComparer<TPair>)
 565 |     private
 566 |       fComparer: IComparer<K>;
 567 |     public
 568 |       constructor Create(const Comparer: IComparer<K>);
 569 |       function Compare(const A, B: TPair): Integer; inline;
 570 |     end;
 571 |   private
 572 |     fValueComparer: IComparer<V>;
 573 |     fKeyComparer: IComparer<TPair>;
 574 |     fOnKeyChanged: ICollectionChangedEvent<K>;
 575 |     fOnValueChanged: ICollectionChangedEvent<V>;
 576 |   protected
 577 | {$REGION 'Property Accessors'}
 578 |     function GetItem(const Key: K): V;
 579 |     function GetKeys: IReadOnlyCollection<K>;
 580 |     function GetKeyType: PTypeInfo;
 581 |     function GetOnKeyChanged: ICollectionChangedEvent<K>;
 582 |     function GetOnValueChanged: ICollectionChangedEvent<V>;
 583 |     function GetValues: IReadOnlyCollection<V>;
 584 |     function GetValueType: PTypeInfo;
 585 |     procedure SetItem(const Key: K; const Value: V);
 586 |     function GetComparer: IComparer<TPair>;
 587 |     property Comparer: IComparer<TPair> read GetComparer;
 588 |     function Pair(const Key: K; const Value: V): TPair;
 589 | {$ENDREGION}
 590 |   public type
 591 |     TTraverseAction = reference to procedure(const Key: K; const Value: V; var Abort: boolean);
 592 |   protected
 593 |     constructor Create; reintroduce; overload;
 594 |     constructor Create(const Comparer: IComparer<K>); reintroduce; overload;
 595 |     constructor Create(const Comparer: TComparison<K>); reintroduce; overload;
 596 |     constructor Create(const Collection: IEnumerable<TPair<K, V>>); reintroduce; overload;
 597 |     constructor Create(const Values: array of TPair<K, V>); reintroduce; overload;
 598 |   public
 599 | 
 600 |     /// <summary>
 601 |     /// Adds an element with the provided Key and Value to the
 602 |     /// IDictionary&lt;K, V&gt;.
 603 |     /// </summary>
 604 |     /// <param name="Key">
 605 |     /// The item to use as the Key of the element to add.
 606 |     /// </param>
 607 |     /// <param name="Value">
 608 |     /// The item to use as the Value of the element to add.
 609 |     /// </param>
 610 |     procedure Add(const Key: K; const Value: V); reintroduce;
 611 |     procedure AddOrSetValue(const Key: K; const Value: V);
 612 | 
 613 |     /// <summary>
 614 |     /// Determines whether the IDictionary&lt;K, V&gt; contains an
 615 |     /// element with the specified Key.
 616 |     /// </summary>
 617 |     /// <param name="Key">
 618 |     /// The Key to locate in the IDictionary&lt;K, V&gt;.
 619 |     /// </param>
 620 |     /// <returns>
 621 |     /// <b>True</b> if the IDictionary&lt;K, V&gt; contains an
 622 |     /// element with the Key; otherwise, <b>False</b>.
 623 |     /// </returns>
 624 |     function ContainsKey(const Key: K): boolean;
 625 |     /// <summary>
 626 |     /// Determines whether the IDictionary&lt;K, V&gt; contains an
 627 |     /// element with the specified Value.
 628 |     /// </summary>
 629 |     /// <param name="Value">
 630 |     /// The Value to locate in the IDictionary&lt;K, V&gt;.
 631 |     /// </param>
 632 |     function ContainsValue(const Value: V): boolean;
 633 | 
 634 |     /// <summary>
 635 |     /// Determines whether the IMap&lt;TKey,TValue&gt; contains the specified
 636 |     /// Key/Value pair.
 637 |     /// </summary>
 638 |     /// <param name="Key">
 639 |     /// The Key of the pair to locate in the IMap&lt;TKey, TValue&gt;.
 640 |     /// </param>
 641 |     /// <param name="Value">
 642 |     /// The Value of the pair to locate in the IMap&lt;TKey, TValue&gt;.
 643 |     /// </param>
 644 |     /// <returns>
 645 |     /// <b>True</b> if the IMap&lt;TKey, TValue&gt; contains a pair with the
 646 |     /// specified Key and Value; otherwise <b>False</b>.
 647 |     /// </returns>
 648 |     function Contains(const Key: K; const Value: V): boolean; reintroduce;
 649 | 
 650 |     /// <summary>
 651 |     /// Removes the element with the specified Key from the
 652 |     /// IDictionary&lt;K, V&gt;.
 653 |     /// </summary>
 654 |     /// <param name="Key">
 655 |     /// The Key of the element to remove.
 656 |     /// </param>
 657 |     /// <returns>
 658 |     /// <b>True</b> if the element is successfully removed; otherwise,
 659 |     /// <b>False</b>. This method also returns <b>False</b> if <i>Key</i> was
 660 |     /// not found in the original IDictionary&lt;K, V&gt;.
 661 |     /// </returns>
 662 |     function Remove(const Key: K): boolean; reintroduce; overload;
 663 |     function Remove(const Key: K; const Value: V): boolean; reintroduce; overload;
 664 | 
 665 |     function Extract(const Key: K; const Value: V): TPair; reintroduce; overload;
 666 | 
 667 |     /// <summary>
 668 |     /// Removes the Value for a specified Key without triggering lifetime
 669 |     /// management for objects.
 670 |     /// </summary>
 671 |     /// <param name="Key">
 672 |     /// The Key whose Value to remove.
 673 |     /// </param>
 674 |     /// <returns>
 675 |     /// The removed Value for the specified Key if it existed; <b>default</b>
 676 |     /// otherwise.
 677 |     /// </returns>
 678 |     function Extract(const Key: K): V; reintroduce; overload;
 679 | 
 680 |     /// <summary>
 681 |     /// Removes the Value for a specified Key without triggering lifetime
 682 |     /// management for objects.
 683 |     /// </summary>
 684 |     /// <param name="Key">
 685 |     /// The Key whose Value to remove.
 686 |     /// </param>
 687 |     /// <returns>
 688 |     /// The removed pair for the specified Key if it existed; <b>default</b>
 689 |     /// otherwise.
 690 |     /// </returns>
 691 |     function ExtractPair(const Key: K): TPair;
 692 | 
 693 |     /// <summary>
 694 |     /// Gets the Value associated with the specified Key.
 695 |     /// </summary>
 696 |     /// <param name="Key">
 697 |     /// The Key whose Value to get.
 698 |     /// </param>
 699 |     /// <param name="Value">
 700 |     /// When this method returns, the Value associated with the specified
 701 |     /// Key, if the Key is found; otherwise, the default Value for the type
 702 |     /// of the Value parameter. This parameter is passed uninitialized.
 703 |     /// </param>
 704 |     /// <returns>
 705 |     /// <b>True</b> if the object that implements IDictionary&lt;K,
 706 |     /// V&gt; contains an element with the specified Key; otherwise,
 707 |     /// <b>False</b>.
 708 |     /// </returns>
 709 |     function TryGetValue(const Key: K; out Value: V): boolean;
 710 | 
 711 |     /// <summary>
 712 |     /// Gets the Value for a given Key if a matching Key exists in the
 713 |     /// dictionary; returns the default Value otherwise.
 714 |     /// </summary>
 715 |     function GetValueOrDefault(const Key: K): V; overload;
 716 | 
 717 |     /// <summary>
 718 |     /// Gets the Value for a given Key if a matching Key exists in the
 719 |     /// dictionary; returns the given default Value otherwise.
 720 |     /// </summary>
 721 |     function GetValueOrDefault(const Key: K; const DefaultValue: V): V; overload;
 722 | 
 723 |     function AsReadOnlyDictionary: IReadOnlyDictionary<K, V>;
 724 | 
 725 |     /// <summary>
 726 |     /// Gets or sets the element with the specified Key.
 727 |     /// </summary>
 728 |     /// <param name="Key">
 729 |     /// The Key of the element to get or set.
 730 |     /// </param>
 731 |     /// <Value>
 732 |     /// The element with the specified Key.
 733 |     /// </Value>
 734 |     property Items[const Key: K]: V read GetItem write SetItem; default;
 735 | 
 736 |     /// <summary>
 737 |     /// Gets an <see cref="IReadOnlyCollection&lt;T&gt;" /> containing the
 738 |     /// keys of the IDictionary&lt;K, V&gt;.
 739 |     /// </summary>
 740 |     /// <Value>
 741 |     /// An <see cref="IReadOnlyCollection&lt;T&gt;" /> containing the keys of
 742 |     /// the object that implements IDictionary&lt;K, V&gt;.
 743 |     /// </Value>
 744 |     property Keys: IReadOnlyCollection<K> read GetKeys;
 745 | 
 746 |     /// <summary>
 747 |     /// Gets an <see cref="IReadOnlyCollection&lt;T&gt;" /> containing the
 748 |     /// values in the IDictionary&lt;K, V&gt;.
 749 |     /// </summary>
 750 |     /// <Value>
 751 |     /// An <see cref="IReadOnlyCollection&lt;T&gt;" /> containing the values
 752 |     /// in the object that implements IDictionary&lt;K, V&gt;.
 753 |     /// </Value>
 754 |     property Values: IReadOnlyCollection<V> read GetValues;
 755 | 
 756 |     property OnKeyChanged: ICollectionChangedEvent<K> read GetOnKeyChanged;
 757 |     property OnValueChanged: ICollectionChangedEvent<V> read GetOnValueChanged;
 758 |     property KeyType: PTypeInfo read GetKeyType;
 759 |     property ValueType: PTypeInfo read GetValueType;
 760 |   end;
 761 | {$ENDREGION}
 762 | 
 763 | resourcestring
 764 |   SSetDuplicateInsert = 'Cannot insert a duplicate item in a set';
 765 |   SInvalidTraverseOrder = 'Invalid traverse order';
 766 | 
 767 | implementation
 768 | 
 769 | uses
 770 |   {$if CompilerVersion < 28.0} //prior to XE7
 771 |   System.TypInfo,
 772 |   {$endif}
 773 |   Spring.ResourceStrings,
 774 |   Spring.Collections.Lists,
 775 |   Spring.Collections.Events;
 776 | 
 777 | type
 778 |   Color = record
 779 |   public const
 780 |     // Red and Black are modelled as boolean to simplify the IsRed function.
 781 |     Red = false;
 782 |     Black = true;
 783 |   end;
 784 | 
 785 | procedure TBinaryTreeBase<T>.SetRoot(const Value: PNode);
 786 | begin
 787 |   fRoot := Value;
 788 |   if (Assigned(Value)) then begin
 789 |     fRoot.Parent := nil;
 790 |     fRoot.NodeColor:= Color.Black;
 791 |   end;
 792 | end;
 793 | 
 794 | function TBinaryTreeBase<T>.BucketIndex(Index: NativeUInt): TBucketIndex;
 795 | begin
 796 |   Result.Key:= index div NativeUInt(cBucketSize);
 797 |   Result.Value:= index mod NativeUInt(cBucketSize);
 798 | end;
 799 | 
 800 | constructor TRedBlackTree<T>.Create;
 801 | begin
 802 |   inherited Create;
 803 | end;
 804 | 
 805 | constructor TRedBlackTree<T>.Create(const Comparer: TComparison<T>);
 806 | begin
 807 |   inherited Create(Comparer);
 808 | end;
 809 | 
 810 | constructor TRedBlackTree<T>.Create(const Comparer: IComparer<T>);
 811 | begin
 812 |   inherited Create(Comparer);
 813 | end;
 814 | 
 815 | constructor TRedBlackTree<T>.Create(const Collection: IEnumerable<T>);
 816 | begin
 817 |   Create;
 818 |   AddRange(Collection);
 819 | end;
 820 | 
 821 | constructor TRedBlackTree<T>.Create(const Values: array of T);
 822 | begin
 823 |   Create;
 824 |   AddRange(Values);
 825 | end;
 826 | 
 827 | function TRedBlackTree<T>.rbInsertBase(const Key: T; Start: PNode; BaisedLeft: Boolean): PNode;
 828 | const
 829 |   AllowDuplicates = false;
 830 | var
 831 |   Parent, Cur: PNode;
 832 | begin
 833 |   Parent := Start;
 834 |   Cur := Start;
 835 | 
 836 |   while (Cur <> nil) do begin
 837 |     Parent := Cur;
 838 | 
 839 | 	  if (BaisedLeft) then begin
 840 |       if (Comparer.Compare(Key, Cur.Key) > 0) then Cur := Cur.Right
 841 |       else Cur := Cur.Left;
 842 |     end else begin
 843 |       if (Comparer.Compare(Cur.Key, Key) > 0) then Cur := Cur.Left
 844 |       else Cur := Cur.Right;
 845 |     end;
 846 |   end;
 847 | 
 848 |   if (Parent = nil) then begin
 849 |     // new root!
 850 |     Root := NewNode(Key, nil);
 851 |     Result:= Root;
 852 |   end else begin
 853 |     if not(AllowDuplicates) and (Comparer.Compare(Key, Parent.Key) = 0) then begin
 854 |       raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert);
 855 |     end;
 856 | 
 857 |     Result:= NewNode(Key, Parent);
 858 | 
 859 |     if (Comparer.Compare(Parent.Key, Key) > 0) then Parent.Left := Result
 860 |     else if (Comparer.Compare(Key, Parent.Key) > 0) then Parent.Right := Result
 861 |     else begin
 862 | 	    if (BaisedLeft) then Parent.Left := Result
 863 |       else Parent.Right := Result;
 864 |     end;
 865 | 
 866 |     rbFixupAfterInsert(Result);
 867 |   end;
 868 | end;
 869 | 
 870 | procedure TRedBlackTree<T>.rbRotateLeft(Parent: PNode);
 871 | var
 872 |   RightChild: PNode;
 873 | begin
 874 |   RightChild := Parent.Right;
 875 |   Parent.Right := RightChild.Left;
 876 |   if (RightChild.Left <> nil) then begin
 877 |     RightChild.Left.Parent := Parent;
 878 |   end;
 879 | 
 880 |   RightChild.Left := Parent;
 881 |   RightChild.Parent := Parent.Parent;
 882 | 
 883 |   if (Parent <> Root) then begin
 884 |     if (Parent.Parent.Left = Parent) then Parent.Parent.Left := RightChild
 885 |     else Parent.Parent.Right := RightChild;
 886 |   end else begin
 887 |     Root := RightChild;
 888 |   end;
 889 | 
 890 |   Parent.Parent := RightChild;
 891 | end;
 892 | 
 893 | procedure TRedBlackTree<T>.rbRotateRight(Parent: PNode);
 894 | var
 895 |   LeftChild: PNode;
 896 | begin
 897 |   LeftChild := Parent.Left;
 898 |   Parent.Left := LeftChild.Right;
 899 |   if (LeftChild.Right <> nil) then LeftChild.Right.Parent := Parent;
 900 | 
 901 |   LeftChild.Right := Parent;
 902 |   LeftChild.Parent := Parent.Parent;
 903 | 
 904 |   if (Parent <> Root) then begin
 905 |     if (Parent.Parent.Left = Parent) then Parent.Parent.Left := LeftChild
 906 |     else Parent.Parent.Right := LeftChild
 907 |   end else Root := LeftChild;
 908 | 
 909 |   Parent.Parent := LeftChild;
 910 | end;
 911 | 
 912 | procedure TRedBlackTree<T>.rbFixupAfterInsert(Node: PNode);
 913 | var
 914 |   Parent: PNode;
 915 |   GrandParent: PNode;
 916 | begin
 917 |   //The root is never red. If the Parent is red, it must be below the root.
 918 |   //Also red nodes are always assigned
 919 |   while ((Node.Parent.IsRed) and (Node.Uncle.IsRed)) do begin
 920 |     Node.Parent.NodeColor := Color.Black;
 921 |     Node.Uncle.NodeColor := Color.Black;
 922 | 
 923 |     if (Node.Parent.Parent <> Root) then begin // never iterate into the root
 924 |       Node.Parent.Parent.NodeColor := Color.Red;
 925 |       Node := Node.Parent.Parent;
 926 |     end else begin
 927 |       // Don't recurse into the root.
 928 |       Exit;
 929 |     end;
 930 |   end;
 931 | 
 932 |   if (Node.Parent.NodeColor = Color.Black) then Exit;
 933 | 
 934 |   Parent := Node.Parent;
 935 |   Assert(Assigned(Parent)); //The root is never red, so the grandparent is always valid.
 936 |   GrandParent := Parent.Parent;
 937 | 
 938 |   if (GrandParent.Left = Parent) then begin
 939 |     if (Parent.Right = Node) then begin
 940 |       // 'folded in' situation
 941 |       rbRotateLeft(Parent);
 942 |       Node.NodeColor := Color.Black;
 943 |     end else begin
 944 |       // 'straight' situation
 945 |       Parent.NodeColor := Color.Black;
 946 |     end;
 947 | 	  rbRotateRight(GrandParent);
 948 |   end else begin
 949 |     //GrandParent.Right = Parent
 950 |     if (Parent.Left = Node) then begin
 951 |       // 'folded in'
 952 |       rbRotateRight(Parent);
 953 |       Node.NodeColor := Color.Black;
 954 |     end else begin
 955 |       // 'straight'
 956 |       Parent.NodeColor := Color.Black;
 957 |     end;
 958 |     rbRotateLeft(GrandParent);
 959 |   end;
 960 | 
 961 |   GrandParent.NodeColor := Color.Red;
 962 | end;
 963 | 
 964 | function TRedBlackTree<T>.VerifyBlackRoot: boolean;
 965 | begin
 966 |   //The root must be black.
 967 |   Result:= (Root = nil) or (Root.NodeColor = Color.Black);
 968 | end;
 969 | 
 970 | function TRedBlackTree<T>.VerifyBlackPaths(const Node: PNode; var PathLength: NativeUInt): boolean;
 971 | var
 972 |   LeftLength, RightLength: NativeUInt;
 973 | begin
 974 |   //All nodes must have the same number of black non-nil children.
 975 |   if (Node.Left = nil) then LeftLength := 0
 976 |   else if not(VerifyBlackPaths(Node.Left, LeftLength)) then Exit(False);
 977 | 
 978 |   if (Node.Right = nil) then RightLength := 0
 979 |   else if (not VerifyBlackPaths(Node.Right, RightLength)) then Exit(False);
 980 | 
 981 |   if (LeftLength <> RightLength) then begin
 982 |     Exit(False);
 983 |   end;
 984 | 
 985 |   if (Node.NodeColor = Color.Black) then PathLength := LeftLength + 1
 986 |   else PathLength := LeftLength;
 987 | 
 988 |   Result:= True;
 989 | end;
 990 | 
 991 | function TRedBlackTree<T>.VerifyRedBlack(const Node: PNode): boolean;
 992 | begin
 993 |   //A red node must have two black children
 994 |   if (Node = nil) then Exit(True);
 995 | 
 996 |   if (Node.IsRed) then begin
 997 |     if (Node.Right.IsRed) or (Node.Left.IsRed) then begin
 998 |       Exit(False);
 999 |     end;
1000 |   end;
1001 | 
1002 |   Result:= VerifyRedBlack(Node.Left) and VerifyRedBlack(Node.Right);
1003 | end;
1004 | 
1005 | {TODO -oJB -cVerifyOrder : Rewrite using iterator}
1006 | function TRedBlackTree<T>.VerifyOrder: boolean;
1007 | const
1008 |   AllowDuplicates = false;
1009 | var
1010 |   Key, Previous: T;
1011 |   Start: boolean;
1012 | begin
1013 |   //A binary tree must always have the nodes in sorted order.
1014 |   Start:= true;
1015 |   for Key in Self do begin
1016 |     if (Start) then begin
1017 |       Previous:= Key;
1018 |       Start:= false;
1019 |       continue;
1020 |     end else begin
1021 |       if Comparer.Compare(Key, Previous) < 0 then Exit(False);
1022 |       if not(AllowDuplicates) and (Comparer.Compare(Key, Previous) = 0) then Exit(False);
1023 |       Previous:= Key;
1024 |     end;
1025 |   end;
1026 | 
1027 |   Result:= True;
1028 | end;
1029 | 
1030 | function TRedBlackTree<T>.VerifyTree: Boolean;
1031 | var
1032 |   Cur: PNode;
1033 | begin
1034 |   //A tree cannot have loops
1035 |   if (Count = 0) then Exit(True);
1036 | 
1037 |   Cur := Self.Root;
1038 |   while (Cur.Left <> nil) do begin
1039 |     Cur := Cur.Left;
1040 |     if (Cur.Left = Cur) then begin
1041 |       Assert(false);
1042 |       Exit(false);
1043 |     end;
1044 |   end;
1045 | 
1046 |   while (Cur <> nil) do begin
1047 | 
1048 |     if (Cur.Left <> nil) then begin
1049 |       if (Cur.Left.Parent <> Cur) then begin
1050 |         assert(false);
1051 |         Exit(False);
1052 |       end;
1053 |       if (Cur.Right = Cur) then begin
1054 |          assert(false);
1055 |          Exit(False);
1056 |       end;
1057 |     end;
1058 | 
1059 |     if (Cur.Right <> nil) then begin
1060 |       if (Cur.Right.Parent <> Cur) then begin
1061 |         assert(false);
1062 |         Exit(False);
1063 |       end;
1064 |       if (Cur.Right = Cur) then begin
1065 |          assert(false);
1066 |          Exit(False);
1067 |       end;
1068 |     end;
1069 | 
1070 |     //find the next-largest vertex
1071 |     if (Cur.Right <> nil) then begin
1072 |       // go to smallest larger-or-equal Child
1073 |       Cur := Cur.Right;
1074 |       while (Cur.Left <> nil) do begin
1075 |         Cur := Cur.Left;
1076 |       end;
1077 |     end else begin
1078 |       // go up
1079 | 
1080 |       // skip over the Nodes already visited
1081 |       while ((Cur.Parent <> nil) and (Cur.Parent.Right = Cur)) do begin // these are the Nodes which are smaller and were already visited
1082 |         Cur := Cur.Parent;
1083 |       end;
1084 | 
1085 |       // go one further up
1086 |       if (Cur.Parent = nil) then begin
1087 |         // done
1088 |         Cur := nil;
1089 |       end else begin
1090 |         // go up
1091 |         Cur := Cur.Parent;
1092 |       end;
1093 |     end;
1094 |   end; {while}
1095 | 
1096 |   Exit(True);
1097 | end;
1098 | 
1099 | function TRedBlackTree<T>.VerifyIntegrity: Boolean;
1100 | var
1101 |   Dummy: NativeUInt;
1102 |   TreeOK: Boolean;
1103 |   RootOK: Boolean;
1104 |   PathsOK: Boolean;
1105 |   ChildrenOK: Boolean;
1106 |   OrderOK: Boolean;
1107 | 
1108 | begin
1109 |   TreeOK := Self.VerifyTree;
1110 | 
1111 |   RootOK := Self.VerifyBlackRoot;
1112 |   PathsOK := (Self.Root = nil) or VerifyBlackPaths(Root, dummy);
1113 |   ChildrenOK := VerifyRedBlack(Self.Root);
1114 | 
1115 |   OrderOK := Self.VerifyOrder;
1116 |   Assert(RootOK,'Root not OK');
1117 |   Assert(PathsOK, 'Paths not OK');
1118 |   Assert(ChildrenOK, 'Children not OK');
1119 |   Assert(TreeOK, 'Tree not OK');
1120 |   Assert(OrderOK, 'Order not OK');
1121 | 
1122 |   Result:= RootOK and PathsOK and ChildrenOK and TreeOK and OrderOK;
1123 | end;
1124 | 
1125 | procedure TRedBlackTree<T>.rbSwapNodes(n1, n2: PNode; SwapColors: Boolean);
1126 | var
1127 |   Temp: Boolean;
1128 | begin
1129 |   if (n1.Parent = n2) then begin
1130 |     Self.rbSwapNeighbors(n2, n1);
1131 |   end else if (n2.Parent = n1) then begin
1132 |     Self.rbSwapNeighbors(n1, n2);
1133 |   end else begin
1134 |     Self.rbSwapUnrelatedNodes(n1, n2);
1135 |   end;
1136 | 
1137 |   if not(SwapColors) then begin
1138 |     Temp:= n1.NodeColor;
1139 |     n1.NodeColor:= n2.NodeColor;
1140 |     n2.NodeColor:= Temp;
1141 |   end;
1142 | end;
1143 | 
1144 | procedure TRedBlackTree<T>.rbSwapNeighbors(Parent, Child: PNode);
1145 | var
1146 |   Temp: PNode;
1147 | begin
1148 |   Child.Parent := Parent.Parent;
1149 |   Parent.Parent := Child;
1150 |   if (Child.Parent <> nil) then begin
1151 |     if (Child.Parent.Left = Parent) then begin
1152 |       Child.Parent.Left := Child;
1153 |     end else begin
1154 |       Child.Parent.Right := Child;
1155 |     end;
1156 |   end else begin
1157 |     //This may color the root red, we will correct this later.
1158 |     //Do not force the Root Black here.
1159 |     fRoot := Child;
1160 |   end;
1161 | 
1162 |   if (Parent.Left = Child) then begin
1163 |     Parent.Left := Child.Left;
1164 |     if (Parent.Left <> nil) then begin
1165 |       Parent.Left.Parent := Parent;
1166 |     end;
1167 |     Child.Left := Parent;
1168 | 
1169 |     Temp:= Parent.Right;
1170 |     Parent.Right:= Child.Right;
1171 |     Child.Right:= Temp;
1172 | 
1173 |     if (Child.Right <> nil) then begin
1174 |       Child.Right.Parent := Child;
1175 |     end;
1176 |     if (Parent.Right <> nil) then begin
1177 |       Parent.Right.Parent := Parent;
1178 |     end;
1179 |   end else begin
1180 |     Parent.Right := Child.Right;
1181 |     if (Parent.Right <> nil) then begin
1182 |       Parent.Right.Parent := Parent;
1183 |     end;
1184 |     Child.Right := Parent;
1185 | 
1186 |     Temp:= Parent.Left;
1187 |     Parent.Left:= Child.Left;
1188 |     Child.Left:= Temp;
1189 | 
1190 |     if (Child.Left <> nil) then begin
1191 |       Child.Left.Parent := Child;
1192 |     end;
1193 |     if (Parent.Left <> nil) then begin
1194 |       Parent.Left.Parent := Parent;
1195 |     end;
1196 |   end;
1197 | end;
1198 | 
1199 | procedure TRedBlackTree<T>.rbSwapUnrelatedNodes(n1, n2: PNode);
1200 | var
1201 |   Temp: PNode;
1202 | begin
1203 |   Temp:= n1.Left;
1204 |   n1.Left:= n2.Left;
1205 |   n2.Left:= Temp;
1206 | 
1207 |   if (n1.Left <> nil) then n1.Left.Parent := n1;
1208 |   if (n2.Left <> nil) then n2.Left.Parent := n2;
1209 | 
1210 |   Temp:= n1.Right;
1211 |   n1.Right:= n2.Right;
1212 |   n2.Right:= Temp;
1213 | 
1214 |   if (n1.Right <> nil) then n1.Right.Parent := n1;
1215 |   if (n2.Right <> nil) then n2.Right.Parent := n2;
1216 | 
1217 |   Temp:= n1.Parent;
1218 |   n1.Parent:= n2.Parent;
1219 |   n2.Parent:= Temp;
1220 | 
1221 |   if (n1.Parent <> nil) then begin
1222 |     if (n1.Parent.Right = n2) then n1.Parent.Right := n1
1223 |     else n1.Parent.Left := n1;
1224 |   end else begin
1225 |     fRoot := n1; //Allow the root to be red, we will correct this later.
1226 |   end;
1227 |   if (n2.Parent <> nil) then begin
1228 |     if (n2.Parent.Right = n1) then n2.Parent.Right := n2
1229 |     else n2.Parent.Left := n2;
1230 |   end else begin
1231 |     fRoot := n2;
1232 |   end;
1233 | end;
1234 | 
1235 | procedure TRedBlackTree<T>.rbRemoveNode(Node: PNode);
1236 | var
1237 |   Cur, Child: PNode;
1238 |   RightChild: PNode;
1239 |   DeletedLeft: Boolean;
1240 |   {$ifopt C+} ColorDiff: boolean; {$endif}
1241 | label
1242 |   DeleteNode;  //Instead of a exit + try finally we use a goto(exitpoint)
1243 | begin
1244 |   Cur := Node;
1245 |   Child := Node;
1246 | 
1247 |   if ((Cur.Right <> nil) and (Cur.Left <> nil)) then begin
1248 |     // Find the minimum of the larger-or-equal Children
1249 |     Child := Cur.Right;
1250 |     while (Child.Left <> nil) do begin
1251 |       Child := Child.Left;
1252 |     end; {while}
1253 |   end else if (Cur.Left <> nil) then begin
1254 |     // Only a left Child. This must be red and cannot have further Children (otherwise, black-balance would be violated)
1255 |     Child := Child.Left;
1256 |     Assert(Child.IsRed);
1257 |     Assert((Child.Left = nil) and (Child.Right = nil));
1258 |   end;
1259 | 
1260 |   if (Child <> Node) then begin
1261 |     {$ifopt c+} ColorDiff:= Node.NodeColor <> Child.NodeColor; {$endif}
1262 |     Self.rbSwapNodes(Node, Child, false);
1263 |     Assert(ColorDiff = (Node.NodeColor <> Child.NodeColor)); //Make sure color-counts are preserved
1264 |   end;
1265 |   // Now, Node is a pseudo-leaf with the color of Child.
1266 | 
1267 |   // Node cannot have a left Child, so if it has a right Child, the child must be red,
1268 |   // thus Node must be black
1269 |   if (Node.Right <> nil) then begin
1270 |     Assert(Node.Right.IsRed);
1271 |     Assert(Node.NodeColor = Color.Black);
1272 |     // replace Node with its Child and color the Child black.
1273 |     RightChild := Node.Right;
1274 |     Self.rbSwapNodes(Node, RightChild, true);
1275 |     RightChild.NodeColor := Color.Black;
1276 |     RightChild.Right := nil; // Self stored the Node to be deleted…
1277 | 
1278 |     goto DeleteNode; // no fixup necessary
1279 |   end;
1280 | 
1281 |   // Node has no Children, so we have to just delete it, which is no problem if we are red. Otherwise, we must start a fixup at the Parent.
1282 |   if (Node.Parent <> nil) then begin
1283 |     DeletedLeft:= (Node.Parent.Left = Node);
1284 |     if (DeletedLeft) then Node.Parent.Left := nil
1285 |     else Node.Parent.Right := nil;
1286 | 
1287 |   end else begin
1288 |     Root := nil; // Tree is now empty!
1289 |     goto DeleteNode; // No fixup needed!
1290 |   end;
1291 | 
1292 |   if (Node.NodeColor = Color.Black) then begin
1293 |     rbFixupAfterDelete(Node.Parent, DeletedLeft);
1294 |   end;
1295 | DeleteNode:
1296 |   FreeSingleNode(Node);
1297 | end;
1298 | 
1299 | procedure TRedBlackTree<T>.rbFixupAfterDelete(Parent: PNode; DeletedLeft: Boolean);
1300 | var
1301 |   Sibling: PNode;
1302 |   Temp: Boolean;
1303 | begin
1304 |   Assert((DeletedLeft and (Parent.Left = nil)) or (Parent.Right = nil));
1305 | 
1306 |   while True do begin
1307 |     // We just deleted a black Node below Parent.
1308 |     if (DeletedLeft) then begin
1309 |       Sibling := Parent.Right;
1310 |     end else begin
1311 |       Sibling := Parent.Left;
1312 |     end;
1313 | 
1314 |     Assert(Assigned(Sibling));
1315 |     // Sibling must exist! If it didn't, then that branch would have had too few blacks…
1316 |     if (
1317 |         (Parent.NodeColor = Color.Black) and
1318 |         (Sibling.NodeColor = Color.Black) and
1319 |         ((Sibling.Left = nil) or (Sibling.Left.NodeColor = Color.Black)) and
1320 |         ((Sibling.Right = nil) or (Sibling.Right.NodeColor = Color.Black))
1321 |     ) then begin
1322 | 
1323 |       // We can recolor and propagate up! (Case 3)
1324 |       Sibling.NodeColor := Color.Red;
1325 |       // Now everything below Parent is ok, but the branch started in Parent lost a black!
1326 |       if (Parent = Root) then begin
1327 |         // Doesn't matter! Parent is the root, no harm done.
1328 |         Exit;
1329 |       end else begin
1330 |         // propagate up!
1331 |         DeletedLeft := (Parent.Parent.Left = Parent);
1332 |         Parent := Parent.Parent;
1333 |       end;
1334 |     end else begin // could not recolor the Sibling, do not propagate up
1335 |       Break; //Stop propagating red nodes up.
1336 |     end;
1337 |   end;
1338 | 
1339 |   if (Sibling.IsRed) then begin
1340 |     // Case 2
1341 |     Sibling.NodeColor := Color.Black;
1342 |     Parent.NodeColor := Color.Red;
1343 |     if (DeletedLeft) then begin
1344 |       rbRotateLeft(Parent);
1345 |       Sibling := Parent.Right;
1346 |     end else begin
1347 |       rbRotateRight(Parent);
1348 |       Sibling := Parent.Left;
1349 |     end;
1350 |   end;
1351 | 
1352 |   if (
1353 |       (Sibling.NodeColor = Color.Black) and
1354 |       ((Sibling.Left = nil) or (Sibling.Left.NodeColor = Color.Black)) and
1355 |       ((Sibling.Right = nil) or (Sibling.Right.NodeColor = Color.Black))
1356 |   ) then begin
1357 |     // case 4
1358 |     Parent.NodeColor := Color.Black;
1359 |     Sibling.NodeColor := Color.Red;
1360 | 
1361 |     Exit; // No further fixup necessary
1362 |   end;
1363 | 
1364 |   if (DeletedLeft) then begin
1365 |     if ((Sibling.Right = nil) or (Sibling.Right.NodeColor = Color.Black)) then begin
1366 |       // left Child of Sibling must be red! This is the folded case. (Case 5) Unfold!
1367 |       rbRotateRight(Sibling);
1368 |       Sibling.NodeColor := Color.Red;
1369 |       // The new Sibling is now the Parent of the Sibling
1370 |       Sibling := Sibling.Parent;
1371 |       Sibling.NodeColor := Color.Black;
1372 |     end;
1373 | 
1374 |     // straight situation, case 6 applies!
1375 |     rbRotateLeft(Parent);
1376 | 
1377 |     Temp:= Parent.NodeColor;
1378 |     Parent.NodeColor:= Sibling.NodeColor;
1379 |     Sibling.NodeColor:= Temp;
1380 | 
1381 |     Sibling.Right.NodeColor := Color.Black;
1382 |   end else begin
1383 |     if ((Sibling.Left = nil) or (Sibling.Left.NodeColor = Color.Black)) then begin
1384 |       // right Child of Sibling must be red! This is the folded case. (Case 5) Unfold!
1385 | 
1386 |       rbRotateLeft(Sibling);
1387 |       Sibling.NodeColor := Color.Red;
1388 |       // The new Sibling is now the Parent of the Sibling
1389 |       Sibling := Sibling.Parent;
1390 |       Sibling.NodeColor := Color.Black;
1391 |     end;
1392 | 
1393 |     // straight situation, case 6 applies!
1394 |     rbRotateRight(Parent);
1395 | 
1396 |     Temp:= Parent.NodeColor;
1397 |     Parent.NodeColor:= Sibling.NodeColor;
1398 |     Sibling.NodeColor:= Temp;
1399 | 
1400 |     Sibling.Left.NodeColor := Color.Black;
1401 |   end;
1402 | end;
1403 | 
1404 | //procedure TRedBlackTree<T>.rbRemove(Node: PNode);
1405 | //begin
1406 | //  rbRemoveNode(Node);
1407 | //end;
1408 | 
1409 | 
1410 | function TBinaryTreeBase<T>.Contains(const Key: T): boolean;
1411 | begin
1412 |   Result:= Assigned(FindNode(Root, Key));
1413 | end;
1414 | 
1415 | destructor TBinaryTreeBase<T>.Destroy;
1416 | begin
1417 |   Clear;
1418 |   inherited;
1419 | end;
1420 | 
1421 | function TRedBlackTree<T>.Get(const Key: T): T;
1422 | var
1423 |   Node: PNode;
1424 | begin
1425 |   Node:= FindNode(Root, Key);
1426 |   if Assigned(Node) then Result:= Node.Key
1427 |   else raise EInvalidOperationException.CreateRes(@SSequenceContainsNoMatchingElement);
1428 | end;
1429 | 
1430 | function TBinaryTreeBase<T>.Add(const Item: T): boolean;
1431 | var
1432 |   OldCount: Integer;
1433 | begin
1434 |   OldCount:= Count;
1435 |   Root:= Self.InternalInsert(Root, Item);
1436 |   Result:= (Count <> OldCount);
1437 | end;
1438 | 
1439 | function TRedBlackTree<T>.GetEnumerator: IEnumerator<T>;
1440 | begin
1441 |   Result:= TTreeEnumerator.Create(Self);
1442 | end;
1443 | 
1444 | function TBinaryTreeBase<T>.FindNode(const Head: PNode; const Key: T): PNode;
1445 | begin
1446 |   Result:= Head;
1447 |   while Result <> nil do begin
1448 |     if (Equal(Key, Result.Key)) then Exit;
1449 |     if (Less(Key, Result.Key)) then Result:= Result.Left
1450 |     else Result:= Result.Right;
1451 |   end;
1452 | end;
1453 | 
1454 | function TBinaryTreeBase<T>.InternalInsert(Head: PNode; const Key: T): PNode;
1455 | var
1456 |   Current, Parent: PNode;
1457 |   Compare: integer;
1458 | begin
1459 |   Parent:= nil;
1460 |   Current:= Head;
1461 |   while Current <> nil do begin
1462 |     Compare:= Comparer.Compare(Key, Current.fKey);
1463 |     Parent:= Current;
1464 |     if (Compare > 0) then Current:= Current.Right
1465 |     else if (Compare < 0) then Current:= Current.Left
1466 |     else raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert);
1467 |   end;
1468 | 
1469 |   Current:= NewNode(Key, Parent);
1470 |   if (Compare > 0) then begin
1471 |     Current.Right:= Parent.Right;
1472 |     Parent.Right:= Current;
1473 |   end else begin
1474 |     Current.Left:= Parent.Left;
1475 |     Parent.Left:= Current;
1476 |   end;
1477 |   Result:= Current;
1478 | 
1479 | //  if Head = nil then begin
1480 | //    Exit(NewNode(Key, nil));
1481 | //  end;
1482 | //
1483 | //  if Equal(Key, Head.Key) then raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert)
1484 | //  else if (Less(Key, Head.Key)) then begin
1485 | //    Head.Left:= InternalInsert(Head.Left, Key);
1486 | //  end else begin
1487 | //    Head.Right:= InternalInsert(Head.Right, Key);
1488 | //  end;
1489 | //
1490 | //  Result:= Head;
1491 | end;
1492 | 
1493 | function TRedBlackTree<T>.First: T;
1494 | begin
1495 |   if (Root = nil) then raise EInvalidOperationException.CreateRes(@SSequenceContainsNoElements);
1496 |   Result:= MinNode(Root).Key;
1497 | end;
1498 | 
1499 | function TBinaryTreeBase<T>.TNode.Uncle: PNode;
1500 | var
1501 |   GrandParent: PNode;
1502 | begin
1503 |   Assert(Assigned(Parent));
1504 |   GrandParent:= Parent.Parent;
1505 |   Assert(Assigned(GrandParent));
1506 |   if (GrandParent.Left = Parent) then Result:= GrandParent.Right
1507 |   else Result:= GrandParent.Left;
1508 | end;
1509 | 
1510 | function TBinaryTreeBase<T>.TNode.IsRed: boolean;
1511 | begin
1512 |   if @Self = nil then Exit(false);
1513 |   Result:= not(fIsBlack);
1514 | end;
1515 | 
1516 | function TRedBlackTree<T>.Add(const Key: T): boolean;
1517 | var
1518 |   OldCount: Integer;
1519 | begin
1520 |   OldCount:= Count;
1521 |   InternalInsert(Root, Key);
1522 |   //Root.NodeColor:= Color.Black;
1523 |   Result:= (Count <> OldCount);
1524 | end;
1525 | 
1526 | //function TRedBlackTree<T>.DoInsert(Head: PNode; const Key: T): PNode;
1527 | //var
1528 | //  Node, Parent, InsertedNode: PNode;
1529 | //  Diff: integer;
1530 | //begin
1531 | //  Parent:= nil;
1532 | //  Node:= Head;
1533 | //  while (Node <> nil) do begin
1534 | //    Diff:= Comparer.Compare(Key, Node.Key);
1535 | //    if (Diff = 0) then raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert);
1536 | //    Parent:= Node;
1537 | //    if (Diff < 0) then Node:= Node.Left else Node:= Node.Right;
1538 | //  end; {while}
1539 | //  InsertedNode:= NewNode(Key, Parent);
1540 | //  if Assigned(Parent) then begin
1541 | //
1542 | //    if (Diff < 0) then Parent.Left:= InsertedNode
1543 | //    else Parent.Right:= InsertedNode;
1544 | //    FixUpAfterInsert(InsertedNode);
1545 | //  end else begin
1546 | //    Root:= InsertedNode;  //SetRoot will also correct the color and parent nodes
1547 | //  end;
1548 | //
1549 | //
1550 | ////  if Head = nil then begin
1551 | ////    Exit(NewNode(Key, nil));
1552 | ////  end;
1553 | ////  if (fSpecies = TD234) then begin
1554 | ////    if (Head.Left.IsRed) and (Head.Right.IsRed) then ColorFlip(Head);
1555 | ////  end;
1556 | ////
1557 | ////  if (Less(Key, Head.Key)) then begin
1558 | ////    Head.Left:= DoInsert(Head.Left, Key);
1559 | ////  end else begin
1560 | ////    Head.Right:= DoInsert(Head.Right, Key);
1561 | ////  end;
1562 | ////
1563 | ////  if Head.Right.IsRed then Head:= RotateLeft(Head);
1564 | ////  if Head.Left.IsRed and Head.Left.Left.IsRed then Head:= RotateRight(Head);
1565 | ////
1566 | ////  if (fSpecies = BU23) then begin
1567 | ////    if (Head.Left.IsRed and Head.Right.IsRed) then ColorFlip(Head);
1568 | ////  end;
1569 | ////
1570 | ////  Result:= Head;
1571 | //end;
1572 | 
1573 | function TRedBlackTree<T>.InternalInsert(Head: PNode; const Key: T): PNode;
1574 | begin
1575 |   Result:= rbInsertBase(Key, Head, true);
1576 | end;
1577 | 
1578 | //var
1579 | //  Current, Parent: PNode;
1580 | ////  Compare: integer;
1581 | ////begin
1582 | ////  Parent:= nil;
1583 | ////  Current:= Head;
1584 | ////  while Current <> nil do begin
1585 | ////    Compare:= Comparer.Compare(Key, Current.fKey);
1586 | ////    Parent:= Current;
1587 | ////    if (Compare > 0) then Current:= Current.Right
1588 | ////    else if (Compare < 0) then Current:= Current.Left
1589 | ////    else raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert);
1590 | ////  end;
1591 | //begin
1592 | //  Parent:= Head;
1593 | //  DoInsert(Parent, Key);
1594 | //end;
1595 | 
1596 | //function TRedBlackTree<T>.DeleteMin(Head: PNode): PNode;
1597 | //begin
1598 | //  Assert(Assigned(Head));
1599 | //  if (Head.Left = nil) then begin
1600 | //    FreeSingleNode(Head);
1601 | //    Exit(nil);
1602 | //  end;
1603 | //  if not(Head.Left.IsRed) and not(Head.Left.Left.IsRed) then Head:= MoveRedLeft(Head);
1604 | //  Head.Left:= DeleteMin(Head.Left);
1605 | //  Result:= FixUp(Head);
1606 | //end;
1607 | 
1608 | //function TRedBlackTree<T>.DeleteMax(Head: PNode): PNode;
1609 | //begin
1610 | //  Assert(Assigned(Head));
1611 | //  if (Head.Left.IsRed) then Head:= RotateRight(Head);
1612 | //  if Head.Right = nil then begin
1613 | //    FreeSingleNode(Head);
1614 | //    Exit(nil);
1615 | //  end;
1616 | //  if not(Head.Right.IsRed) and not(Head.Right.Left.IsRed) then Head:= MoveRedRight(Head);
1617 | //  Head.Right:= DeleteMax(Head.Right);
1618 | //  Result:= FixUp(Head);
1619 | //end;
1620 | 
1621 | function TRedBlackTree<T>.Remove(const Key: T): boolean;
1622 | var
1623 |   Node: PNode;
1624 | begin
1625 |   Node:= FindNode(Root, Key);
1626 |   if (Node = nil) then Exit(false);
1627 |   rbRemoveNode(Node);
1628 |   Result:= True;
1629 | end;
1630 | 
1631 | //var
1632 | //  OldCount: Integer;
1633 | //begin
1634 | //  OldCount:= Count;
1635 | //  Root:= DeleteNode(Root, Key);
1636 | //  if Root <> nil then begin
1637 | //    Root.NodeColor:= Color.Black;
1638 | //  end;
1639 | //  Result:= (Count <> OldCount);
1640 | //end;
1641 | 
1642 | function TRedBlackTree<T>.Reversed: IEnumerable<T>;
1643 | begin
1644 |   Result:= TTreeEnumerator.Create(Self, FromEnd);
1645 | end;
1646 | 
1647 | 
1648 | function TRedBlackTree<T>.StorageSizeOK: Boolean;
1649 | begin
1650 |   Result:= ((Count+cBucketSize-1) div cBucketSize) = Length(fStorage);
1651 | end;
1652 | 
1653 | //function TRedBlackTree<T>.DeleteNode(Head: PNode; Key: T): PNode;
1654 | //begin
1655 | //  Assert(Assigned(Head));
1656 | //  if Less(Key, Head.Key) then begin
1657 | //    if not(Head.Left.IsRed) and not(Head.Left.Left.IsRed) then Head:= MoveRedLeft(Head);
1658 | //    Head.Left:= DeleteNode(Head.Left, Key);
1659 | //  end else begin
1660 | //    if Head.Left.IsRed then Head:= RotateRight(Head);
1661 | //    if Equal(Key, Head.Key) and (Head.Right = nil) then begin
1662 | //      FreeSingleNode(Head);
1663 | //      Exit(nil);
1664 | //    end;
1665 | //    if not(Head.Right.IsRed) and not(Head.Right.Left.IsRed) then Head:= MoveRedRight(Head);
1666 | //    if Equal(Key, Head.Key) then begin
1667 | //      Head.fKey:= MinNode(Head.Right).Key;
1668 | //      Head.Right:= DeleteMin(Head.Right);
1669 | //    end
1670 | //    else Head.Right:= DeleteNode(Head.Right, Key);
1671 | //  end;
1672 | //  Result:= FixUp(Head);
1673 | //end;
1674 | 
1675 | function TRedBlackTree<T>.Last: T;
1676 | begin
1677 |   if (Root = nil) then raise EInvalidOperationException.CreateRes(@SSequenceContainsNoElements);
1678 |   Result:= MaxNode(Root).Key;
1679 | end;
1680 | 
1681 | function TRedBlackTree<T>.Last(const Predicate: TPredicate<T>): T;
1682 | var
1683 |   Item: T;
1684 | begin
1685 |   for Item in Reversed do begin
1686 |     if Predicate(Item) then Exit(Item);
1687 |   end;
1688 |   raise EInvalidOperationException.CreateRes(@SSequenceContainsNoMatchingElement);
1689 | end;
1690 | 
1691 | function TRedBlackTree<T>.LastOrDefault(const DefaultValue: T): T;
1692 | begin
1693 |   if (Root = nil) then Exit(DefaultValue);
1694 |   Result:= MaxNode(Root).Key;
1695 | end;
1696 | 
1697 | function TRedBlackTree<T>.LastOrDefault(const Predicate: TPredicate<T>; const DefaultValue: T): T;
1698 | var
1699 |   Item: T;
1700 | begin
1701 |   for Item in Reversed do begin
1702 |     if Predicate(Item) then Exit(Item);
1703 |   end;
1704 |   Result:= DefaultValue;
1705 | end;
1706 | 
1707 | function TBinaryTreeBase<T>.MinNode(const Head: PNode): PNode;
1708 | begin
1709 |   Assert(Head <> nil);
1710 |   Result:= Head;
1711 |   while Result.Left <> nil do Result:= Result.Left;
1712 | end;
1713 | 
1714 | function TBinaryTreeBase<T>.MaxNode(const Head: PNode): PNode;
1715 | begin
1716 |   Assert(Head <> nil);
1717 |   Result:= Head;
1718 |   while Result.Right <> nil do Result:= Result.Right;
1719 | end;
1720 | 
1721 | function TBinaryTreeBase<T>.Less(const A, B: T): boolean;
1722 | begin
1723 |   Result:= Comparer.Compare(A, B) < 0;
1724 | end;
1725 | 
1726 | function TBinaryTreeBase<T>.Equal(const A, B: T): boolean;
1727 | begin
1728 |   Result:= Comparer.Compare(A, B) = 0;
1729 | end;
1730 | 
1731 | function TRedBlackTree<T>.Extract(const Key: T): T;
1732 | var
1733 |   Node: PNode;
1734 | begin
1735 |   Node:= FindNode(Root, Key);
1736 |   if (Node = nil) then raise EInvalidOperationException.CreateRes(@SSequenceContainsNoMatchingElement);
1737 |   Result:= Node.Key;
1738 |   Remove(Key);
1739 | end;
1740 | 
1741 | //procedure TRedBlackTree<T>.ColorFlip(const Node: PNode);
1742 | //begin
1743 | //  Assert(Assigned(Node));
1744 | //  Node.NodeColor:= not(Node.NodeColor);
1745 | //  if Node.Left <> nil then Node.Left.NodeColor:= not(Node.Left.NodeColor);
1746 | //  if Node.Right <> nil then Node.Right.NodeColor:= not(Node.Right.NodeColor);
1747 | //end;
1748 | 
1749 | 
1750 | //function TRedBlackTree<T>.RotateRight(Node: PNode): PNode;
1751 | //var
1752 | //  x: PNode;
1753 | //begin
1754 | //  Assert(Assigned(Node));
1755 | //  // Make a left-leaning 3-Node lean to the right.
1756 | //  x:= Node.Left;
1757 | //  Node.Left:= x.Right;
1758 | //
1759 | //  x.Right:= Node;
1760 | //
1761 | //  x.NodeColor:= x.Right.NodeColor;
1762 | //  x.Right.NodeColor:= Color.Red;
1763 | //  Result:= x;
1764 | //end;
1765 | //
1766 | //function TRedBlackTree<T>.MoveRedLeft(Node: PNode): PNode;
1767 | //begin
1768 | //  Assert(Assigned(Node));
1769 | //  // Assuming that Node is red and both Node.left and Node.left.left
1770 | //  // are black, make Node.left or one of its children red.
1771 | //  ColorFlip(Node);
1772 | //  if ((Node.Right.Left.IsRed)) then begin
1773 | //    Node.Right:= RotateRight(Node.Right);
1774 | //
1775 | //    Node:= RotateLeft(Node);
1776 | //    ColorFlip(Node);
1777 | //
1778 | //    if ((Node.Right.Right.IsRed)) then begin
1779 | //      Node.Right:= RotateLeft(Node.Right);
1780 | //    end;
1781 | //  end;
1782 | //  Result:= Node;
1783 | //end;
1784 | //
1785 | //function TRedBlackTree<T>.MoveRedRight(Node: PNode): PNode;
1786 | //begin
1787 | //  Assert(Assigned(Node));
1788 | //  // Assuming that Node is red and both Node.right and Node.right.left
1789 | //  // are black, make Node.right or one of its children red.
1790 | //  ColorFlip(Node);
1791 | //  if (Node.Left.Left.IsRed) then begin
1792 | //    Node:= RotateRight(Node);
1793 | //    ColorFlip(Node);
1794 | //  end;
1795 | //  Result:= Node;
1796 | //end;
1797 | //
1798 | //procedure TRedBlackTree<T>.FixUpAfterInsert(NewNode: PNode);
1799 | //var
1800 | //  Node: PNode;
1801 | //  P,G: PNode;
1802 | //begin
1803 | //  Assert(NewNode <> fRoot);
1804 | //  Node:= NewNode;
1805 | //  //Recolor
1806 | //  while (Node.Parent.IsRed) //The root is always black, so we are sure to have a grandparent
1807 | //        and (Node.Uncle.IsRed) do begin
1808 | //    Node.Parent.NodeColor:= Color.Black;
1809 | //    Node.Uncle.NodeColor:= Color.Black;
1810 | //
1811 | //    if (Node.Parent.Parent <> Root) then begin //do not iterate into the root
1812 | //      Node.Parent.Parent.NodeColor:= Color.Red;
1813 | //      Node:= Node.Parent.Parent;
1814 | //    end else Exit;
1815 | //  end; {while}
1816 | //
1817 | //  //Rebalance
1818 | //  if (Node.Parent.NodeColor = Color.Black) then Exit;
1819 | //  P:= Node.Parent;
1820 | //  G:= P.Parent;
1821 | //  if (G.Left = P) then begin
1822 | //    if (P.Right = Node) then begin
1823 | //      RotateLeft(P);
1824 | //      Node.NodeColor:= Color.Black;
1825 | //    end else P.NodeColor:= Color.Black;
1826 | //    RotateRight(G);
1827 | //  end else begin
1828 | //    if (P.Left = Node) then begin
1829 | //      RotateRight(P);
1830 | //      Node.NodeColor:= Color.Black;
1831 | //    end else P.NodeColor:= Color.Black;
1832 | //    RotateLeft(G);
1833 | //  end;
1834 | //  G.NodeColor:= Color.Red;
1835 | //end;
1836 | //
1837 | //function TRedBlackTree<T>.FixUp(Node: PNode): PNode;
1838 | //begin
1839 | //  Assert(Assigned(Node));
1840 | //  if ((Node.Right.IsRed)) then begin
1841 | //    if (fSpecies = TD234) and ((Node.Right.Left.IsRed)) then Node.Right:= RotateRight(Node.Right);
1842 | //    Node:= RotateLeft(Node);
1843 | //  end;
1844 | //
1845 | //  if ((Node.Left.IsRed) and (Node.Left.Left.IsRed)) then Node:= RotateRight(Node);
1846 | //
1847 | //  if (fSpecies = BU23) and (Node.Left.IsRed) and (Node.Right.IsRed) then ColorFlip(Node);
1848 | //
1849 | //  Result:= Node;
1850 | //end;
1851 | 
1852 | procedure TBinaryTreeBase<T>.FreeSingleNode(const Node: PNode);
1853 | var
1854 |   Index: TBucketIndex;
1855 |   LastNode: PNode;
1856 | begin
1857 |   {TODO -oJB -cTBinaryTreeBase<T>.FreeSingleNode : Lock in MultiThreading mode}
1858 |   Assert(Assigned(Node));
1859 |   Dec(fCount);
1860 |   if not(HasWeakRef(T)) then Finalize(Node.fKey);
1861 |   if (fCount > 0) then begin
1862 |     index:= BucketIndex(fCount);
1863 |     Assert((Index.Key + Index.Value) > 0);
1864 |     LastNode:= @fStorage[index.Key, index.Value];
1865 |     //After the move node now points to the new node
1866 |     //Fix up the anything that points to the new node.
1867 |     if (Node = LastNode) then Exit;
1868 |     if (Assigned(LastNode.Parent)) then begin
1869 |       if (LastNode.Parent.Left = LastNode) then LastNode.Parent.Left:= Node
1870 |       else LastNode.Parent.Right:= Node;
1871 |     end else begin
1872 |       fRoot:= Node;
1873 |     end;
1874 |     if Assigned(LastNode.Left) then LastNode.Left.Parent:= Node;
1875 |     if Assigned(LastNode.Right) then LastNode.Right.Parent:= Node;
1876 |     {$if CompilerVersion >= 28.0} //XE7 or higher
1877 |     if (HasWeakRef(T)) then begin
1878 |     {$else}
1879 |     if System.TypInfo.HasWeakRef(TypeInfo(T)) then begin
1880 |     {$endif}
1881 |       Node.Parent:= LastNode.Parent;
1882 |       Node.fLeft:= LastNode.fLeft;
1883 |       Node.fRight:= LastNode.fRight;
1884 |       Node.fIsBlack:= LastNode.fIsBlack;
1885 |       Node.fKey:= LastNode.fKey;  //Node.fKey is destroyed here.
1886 |       Finalize(LastNode.fKey);    //Release LastNode.fKey, otherwise the refcount will be off by one.
1887 |     end else begin
1888 |       Move(LastNode^, Node^, SizeOf(TNode));
1889 |     end;
1890 |     if (Index.Value = 0) then begin
1891 |       SetLength(fStorage[index.Key],0);
1892 |       SetLength(fStorage, Index.Key);
1893 |     end;
1894 |   end;
1895 | end;
1896 | 
1897 | function TBinaryTreeBase<T>.NextNode(const Node: PNode): PNode;
1898 | var
1899 |   Current, Parent: PNode;
1900 | begin
1901 |   if (Node = nil) then Exit(MinNode(Root))
1902 |   else if (Node.Right = nil) then begin
1903 |     Current:= Node;
1904 |     Parent:= Node.Parent;
1905 |     while (True) do begin
1906 |       if (Parent = nil) or (Current = Parent.Left) then Exit(Parent)
1907 |       else begin
1908 |         Current:= Parent;
1909 |         Parent:= Parent.Parent;
1910 |       end;
1911 |     end; {while}
1912 |   end else begin
1913 |     Result:= Node.Right;
1914 |     while Assigned(Result.Left) do begin
1915 |       Result:= Result.Left;
1916 |     end;
1917 |   end;
1918 | end;
1919 | 
1920 | function TBinaryTreeBase<T>.PreviousNode(const Node: PNode): PNode;
1921 | var
1922 |   p,q: PNode;
1923 | begin
1924 |   if (Node = nil) then Exit(MaxNode(Root))
1925 |   else if (Node.Left = nil) then begin
1926 |     p:= Node;
1927 |     q:= Node.Parent;
1928 |     while (True) do begin
1929 |       if (q = nil) or (p = q.Right) then Exit(q)
1930 |       else begin
1931 |         p:= q;
1932 |         q:= q.Parent;
1933 |       end;
1934 |     end; {while}
1935 |   end else begin
1936 |     Result:= Node.Left;
1937 |     while Assigned(Result.Right) do begin
1938 |       Result:= Result.Right;
1939 |     end;
1940 |   end;
1941 | end;
1942 | 
1943 | procedure TBinaryTreeBase<T>.TraverseInOrder(const Node: PNode; Action: TNodePredicate);
1944 | var
1945 |   Current: PNode;
1946 | begin
1947 |   Assert(Assigned(Action));
1948 |   //Assert(Assigned(Node));
1949 |   //if Assigned(Node.Left) then TraverseInOrder(Node.Left, Action);
1950 |   //if Action(Node) then Exit;
1951 |   //if Assigned(Node.Right) then TraverseInOrder(Node.Right, Action);
1952 |   Current:= Node;
1953 |   repeat
1954 |     if (Current <> nil) then if (Action(Current)) then Exit;
1955 |     Current:= NextNode(Current);
1956 |   until Current = nil;
1957 | end;
1958 | 
1959 | procedure TBinaryTreeBase<T>.TraverseReverseOrder(const Node: PNode; Action: TNodePredicate);
1960 | var
1961 |   Current: PNode;
1962 | begin
1963 |   Assert(Assigned(Action));
1964 |   //Assert(Assigned(Node));
1965 | //  if Assigned(Node.Right) then TraverseReverseOrder(Node.Right, Action);
1966 | //  if Action(Node) then Exit;
1967 | //  if Assigned(Node.Left) then TraverseReverseOrder(Node.Left, Action);
1968 |   Current:= Node;
1969 |   repeat
1970 |     if (Current <> nil) then if (Action(Current)) then Exit;
1971 |     Current:= PreviousNode(Current);
1972 |   until Current = nil;
1973 | end;
1974 | 
1975 | procedure TBinaryTreeBase<T>.TraversePostOrder(const Node: PNode; Action: TNodePredicate);
1976 | begin
1977 |   Assert(Assigned(Action));
1978 |   Assert(Assigned(Node));
1979 |   if Assigned(Node.Left) then TraversePostOrder(Node.Left, Action);
1980 |   if Assigned(Node.Right) then TraversePostOrder(Node.Right, Action);
1981 |   if Action(Node) then Exit;
1982 | end;
1983 | 
1984 | procedure TBinaryTreeBase<T>.TraversePreOrder(const Node: PNode; Action: TNodePredicate);
1985 | begin
1986 |   Assert(Assigned(Action));
1987 |   Assert(Assigned(Node));
1988 |   if Action(Node) then Exit;
1989 |   if Assigned(Node.Left) then TraversePreOrder(Node.Left, Action);
1990 |   if Assigned(Node.Right) then TraversePreOrder(Node.Right, Action);
1991 | end;
1992 | 
1993 | procedure TBinaryTreeBase<T>.Clear;
1994 | var
1995 |   Bucket: NativeUInt;
1996 |   i: NativeInt;
1997 |   j: integer;
1998 | begin
1999 |   if (fCount = 0) then Exit;
2000 |   i:= 0;
2001 |   j:= 0;
2002 |   if IsManagedType(T) then while Count > 0 do begin
2003 |     Finalize(fStorage[i][j].fKey);
2004 |     Inc(j);
2005 |     if (j = cBucketSize) then begin
2006 |       j:= 0;
2007 |       SetLength(fStorage[i],0);
2008 |       Inc(i);
2009 |     end;
2010 |     Dec(fCount);
2011 |   end else for i:= 0 to (Count div cBucketSize)-1 do begin
2012 |     //Release the bucket
2013 |     SetLength(fStorage[i],0);
2014 |   end;
2015 |   //Release the store
2016 |   SetLength(fStorage,0);
2017 |   fRoot:= nil;
2018 |   fCount:= 0;
2019 | end;
2020 | 
2021 | { TRedBlackTree<K>.TreeEnumerator }
2022 | 
2023 | constructor TBinaryTreeBase<T>.TTreeEnumerator.Create(const Tree: TBinaryTreeBase<T>; Direction: TDirection);
2024 | begin
2025 |   inherited Create;
2026 |   fTree:= Tree;
2027 |   fDirection:= Direction;
2028 | end;
2029 | 
2030 | function TBinaryTreeBase<T>.TTreeEnumerator.Clone: TIterator<T>;
2031 | begin
2032 |   Result:= TTreeEnumerator.Create(Self.fTree, Self.fDirection);
2033 | end;
2034 | 
2035 | constructor TBinaryTreeBase<T>.TTreeEnumerator.Create(const Tree: TBinaryTreeBase<T>);
2036 | begin
2037 |   Create(Tree, FromBeginning);
2038 | end;
2039 | 
2040 | function TBinaryTreeBase<T>.TTreeEnumerator.MoveNext: boolean;
2041 | begin
2042 |   if (fCurrentNode = nil) then begin
2043 |     if (fTree.Count = 0) then Exit(false);
2044 |     case fDirection of
2045 |       FromBeginning: fCurrentNode:= fTree.MinNode(fTree.Root);
2046 |       FromEnd: fCurrentNode:= fTree.MaxNode(fTree.Root);
2047 |     end;
2048 |   end else begin
2049 |     case fDirection of
2050 |       FromBeginning: fCurrentNode:= FTree.NextNode(fCurrentNode);
2051 |       FromEnd: fCurrentNode:= FTree.PreviousNode(fCurrentNode);
2052 |     end;
2053 |   end;
2054 |   if (fCurrentNode = nil) then Result:= false
2055 |   else begin
2056 |     Result:= True;
2057 |     fCurrent:= fCurrentNode.Key;
2058 |   end;
2059 | end;
2060 | 
2061 | procedure TBinaryTreeBase<T>.TTreeEnumerator.Reset;
2062 | begin
2063 |   fCurrentNode:= nil;
2064 | end;
2065 | 
2066 | { TRedBlackTree<K, V> }
2067 | 
2068 | constructor TRedBlackTree<K, V>.Create(const Comparer: IComparer<K>);
2069 | begin
2070 |   fKeyComparer:= TTreeComparer.Create(Comparer);
2071 |   inherited Create(fKeyComparer);
2072 |   fValueComparer:= TComparer<V>.Default;
2073 |   fOnKeyChanged:= TCollectionChangedEventImpl<K>.Create;
2074 |   fOnValueChanged:= TCollectionChangedEventImpl<V>.Create;
2075 | end;
2076 | 
2077 | constructor TRedBlackTree<K, V>.Create;
2078 | begin
2079 |   Create(TComparer<K>.Default);
2080 | end;
2081 | 
2082 | constructor TRedBlackTree<K, V>.Create(const Comparer: TComparison<K>);
2083 | begin
2084 |   Create(IComparer<K>(PPointer(@Comparer)^));
2085 | end;
2086 | 
2087 | constructor TRedBlackTree<K, V>.Create(const Collection: IEnumerable<TPair<K, V>>);
2088 | var
2089 |   Item: TPair;
2090 | begin
2091 |   Create;
2092 |   for Item in Collection do Self.Add(Item.Key, Item.Value);
2093 | end;
2094 | 
2095 | constructor TRedBlackTree<K, V>.Create(const Values: array of TPair<K, V>);
2096 | var
2097 |   Item: TPair;
2098 | begin
2099 |   Create;
2100 |   for Item in Values do Self.Add(Item.Key, Item.Value);
2101 | end;
2102 | 
2103 | procedure TRedBlackTree<K, V>.Add(const Key: K; const Value: V);
2104 | var
2105 |   Pair: TPair;
2106 | begin
2107 |   // Pair:= TPair.Create(Key, Value);
2108 |   Pair.Key:= Key;
2109 |   Pair.Value:= Value;
2110 |   inherited Add(Pair);
2111 | end;
2112 | 
2113 | procedure TRedBlackTree<K, V>.AddOrSetValue(const Key: K; const Value: V);
2114 | var
2115 |   Pair: TPair;
2116 |   Node: PNode;
2117 | begin
2118 |   Pair.Key:= Key;
2119 |   Pair.Value:= Value;
2120 |   Node:= FindNode(Root, Pair);
2121 |   if (Node = nil) then inherited Add(Pair)
2122 |   else Node.fKey:= Pair;
2123 | end;
2124 | 
2125 | function TRedBlackTree<K, V>.AsReadOnlyDictionary: IReadOnlyDictionary<K, V>;
2126 | begin
2127 |   Result:= Self as IReadOnlyDictionary<K, V>;
2128 | end;
2129 | 
2130 | function TRedBlackTree<K, V>.ContainsKey(const Key: K): boolean;
2131 | var
2132 |   DummyPair: TPair;
2133 | begin
2134 |   DummyPair.Key:= Key;
2135 |   DummyPair.Value:= default (V);
2136 |   Result:= Assigned(FindNode(Root, DummyPair));
2137 | end;
2138 | 
2139 | function TRedBlackTree<K, V>.ContainsValue(const Value: V): boolean;
2140 | begin
2141 |   Result:= Any(
2142 |     function(const Pair: TPair): boolean
2143 |     begin
2144 |       Result:= fValueComparer.Compare(Pair.Value, Value) = 0;
2145 |     end);
2146 | end;
2147 | 
2148 | function TRedBlackTree<K, V>.Contains(const Key: K; const Value: V): boolean;
2149 | begin
2150 |   Result:= Assigned(FindNode(Root, TPair.Create(Key, Value)));
2151 | end;
2152 | 
2153 | function TRedBlackTree<K, V>.Extract(const Key: K): V;
2154 | begin
2155 |   Result:= ExtractPair(Key).Value;
2156 | end;
2157 | 
2158 | function TRedBlackTree<K, V>.ExtractPair(const Key: K): TPair<K, V>;
2159 | var
2160 |   DummyPair: TPair;
2161 |   Node: PNode;
2162 | begin
2163 |   DummyPair.Key:= Key;
2164 |   DummyPair.Value:= default (V);
2165 |   Node:= FindNode(Root, DummyPair);
2166 |   if Assigned(Node) then Result:= Node.Key
2167 |   else raise EInvalidOperationException.CreateRes(@SSequenceContainsNoMatchingElement);
2168 | end;
2169 | 
2170 | function TRedBlackTree<K, V>.GetComparer: IComparer<TPair>;
2171 | begin
2172 |   Result:= fKeyComparer;
2173 | end;
2174 | 
2175 | function TRedBlackTree<K, V>.GetItem(const Key: K): V;
2176 | var
2177 |   Node: PNode;
2178 | begin
2179 |   Node:= FindNode(Root, Pair(Key, default (V)));
2180 |   if Assigned(Node) then Result:= Node.Key.Value
2181 |   else raise EInvalidOperationException.CreateRes(@SSequenceContainsNoMatchingElement);
2182 | end;
2183 | 
2184 | function TRedBlackTree<K, V>.GetKeys: IReadOnlyCollection<K>;
2185 | var
2186 |   Output: TList<K>;
2187 |   Item: TPair;
2188 | begin
2189 |   Output:= TList<K>.Create;
2190 |   for Item in Self do begin
2191 |     Output.Add(Item.Key);
2192 |   end;
2193 |   Result:= Output as IReadOnlyCollection<K>;
2194 | end;
2195 | 
2196 | function TRedBlackTree<K, V>.GetKeyType: PTypeInfo;
2197 | begin
2198 |   Result:= TypeInfo(K);
2199 | end;
2200 | 
2201 | function TRedBlackTree<K, V>.GetOnKeyChanged: ICollectionChangedEvent<K>;
2202 | begin
2203 |   Result:= fOnKeyChanged;
2204 | end;
2205 | 
2206 | function TRedBlackTree<K, V>.GetOnValueChanged: ICollectionChangedEvent<V>;
2207 | begin
2208 |   Result:= fOnValueChanged;
2209 | end;
2210 | 
2211 | function TRedBlackTree<K, V>.GetValues: IReadOnlyCollection<V>;
2212 | var
2213 |   Output: TList<V>;
2214 |   Item: TPair;
2215 | begin
2216 |   Output:= TList<V>.Create;
2217 |   for Item in Self do begin
2218 |     Output.Add(Item.Value);
2219 |   end;
2220 |   Result:= Output as IReadOnlyCollection<V>;
2221 | end;
2222 | 
2223 | function TRedBlackTree<K, V>.GetValueType: PTypeInfo;
2224 | begin
2225 |   Result:= TypeInfo(V);
2226 | end;
2227 | 
2228 | function TRedBlackTree<K, V>.Remove(const Key: K): boolean;
2229 | var
2230 |   Pair: TPair;
2231 | begin
2232 |   Pair.Create(Key, default (V));
2233 |   Result:= inherited Remove(Pair);
2234 | end;
2235 | 
2236 | function TRedBlackTree<K, V>.Remove(const Key: K; const Value: V): boolean;
2237 | var
2238 |   Pair: TPair;
2239 | begin
2240 |   Pair.Create(Key, Value);
2241 |   Result:= inherited Remove(Pair);
2242 | end;
2243 | 
2244 | function TRedBlackTree<K, V>.Extract(const Key: K; const Value: V): TPair<K, V>;
2245 | begin
2246 |   Result:= TPair.Create(Key, Value);
2247 |   inherited Remove(Result);
2248 | end;
2249 | 
2250 | procedure TRedBlackTree<K, V>.SetItem(const Key: K; const Value: V);
2251 | var
2252 |   Pair: TPair;
2253 |   Node: PNode;
2254 | begin
2255 |   Pair:= TPair.Create(Key, Value);
2256 |   Node:= FindNode(Root, Pair);
2257 |   if Assigned(Node) then Node.fKey:= Pair
2258 |   else raise EInvalidOperationException.CreateRes(@SSequenceContainsNoMatchingElement);
2259 | end;
2260 | 
2261 | function TRedBlackTree<K, V>.TryGetValue(const Key: K; out Value: V): boolean;
2262 | var
2263 |   Pair: TPair;
2264 |   Node: PNode;
2265 | begin
2266 |   Pair:= TPair.Create(Key, default (V));
2267 |   Node:= FindNode(Root, Pair);
2268 |   Result:= Assigned(Node);
2269 |   if Result then Value:= Node.Key.Value;
2270 | end;
2271 | 
2272 | function TRedBlackTree<K, V>.GetValueOrDefault(const Key: K): V;
2273 | begin
2274 |   if not TryGetValue(Key, Result) then Result:= default (V);
2275 | end;
2276 | 
2277 | function TRedBlackTree<K, V>.GetValueOrDefault(const Key: K; const DefaultValue: V): V;
2278 | begin
2279 |   if not TryGetValue(Key, Result) then Result:= DefaultValue;
2280 | end;
2281 | 
2282 | function TRedBlackTree<K, V>.Pair(const Key: K; const Value: V): TPair;
2283 | begin
2284 |   Result:= TPair.Create(Key, Value);
2285 | end;
2286 | 
2287 | { TRedBlackTree<K, V>.TTreeComparer }
2288 | 
2289 | constructor TRedBlackTree<K, V>.TTreeComparer.Create(const Comparer: IComparer<K>);
2290 | begin
2291 |   inherited Create;
2292 |   fComparer:= Comparer;
2293 | end;
2294 | 
2295 | function TRedBlackTree<K, V>.TTreeComparer.Compare(const A, B: TPair<K, V>): Integer;
2296 | begin
2297 |   Result:= fComparer.Compare(A.Key, B.Key);
2298 | end;
2299 | 
2300 | { TNAryTree<K, V> }
2301 | 
2302 | // Todo: implement addition code.
2303 | function TNAryTree<K, V>.Add(const Key: TPair<K, V>): boolean;
2304 | begin
2305 |   Root:= InternalInsert(Root, Key);
2306 | end;
2307 | 
2308 | procedure TNAryTree<K, V>.Add(const Key: K; const Value: V);
2309 | begin
2310 |   Root:= InternalInsert(Root, Key, Value);
2311 | end;
2312 | 
2313 | function TNAryTree<K, V>.Get(Key: K): TPair<K, V>;
2314 | var
2315 |   Node: PNode;
2316 | begin
2317 |   Node:= FindNode(Root, Pair(Key, default (V)));
2318 |   Result:= Node.Key;
2319 | end;
2320 | 
2321 | function TNAryTree<K, V>.GetDirectChildern(const ParentKey: K): TArray<TPair<K, V>>;
2322 | var
2323 |   Node, Parent: PNode;
2324 |   Count, Index: Integer;
2325 | begin
2326 |   Parent:= FindNode(Root, Pair(ParentKey, default (V)));
2327 |   Count:= 0;
2328 |   Node:= Parent.Left;
2329 |   while Node <> nil do begin
2330 |     Inc(Count);
2331 |     Node:= Node.Right;
2332 |   end; { while }
2333 |   SetLength(Result, Count);
2334 |   index:= 0;
2335 |   Node:= Parent.Left;
2336 |   while Node <> nil do begin
2337 |     Result[index]:= Node.Key;
2338 |     Inc(index);
2339 |     Node:= Node.Right;
2340 |   end; { while }
2341 | end;
2342 | 
2343 | function TNAryTree<K, V>.InternalInsert(Head: PNode; const Key: K; const Value: V): PNode;
2344 | var
2345 |   Current, Parent: PNode;
2346 |   Compare: integer;
2347 |   KVPair: TPair<K,V>;
2348 | begin
2349 |   Parent:= nil;
2350 |   Current:= Head;
2351 |   KVPair:= Pair(Key, Value);
2352 |   while Current <> nil do begin
2353 |     Compare:= Comparer.Compare(KVPair, Current.fKey);
2354 |     Parent:= Current;
2355 |     if (Compare > 0) then Current:= Current.Right
2356 |     else if (Compare < 0) then Current:= Current.Left
2357 |     else raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert);
2358 |   end;
2359 | 
2360 |   Current:= NewNode(KVPair, Parent);
2361 |   if (Compare > 0) then begin
2362 |     Current.Right:= Parent.Right;
2363 |     Parent.Right:= Current;
2364 |   end else begin
2365 |     Current.Left:= Parent.Left;
2366 |     Parent.Left:= Current;
2367 |   end;
2368 |   Result:= Current;
2369 | end;
2370 | //begin
2371 | //  if Head = nil then begin
2372 | //    Exit(NewNode(Pair(Key, Value), nil));
2373 | //  end;
2374 | //
2375 | //  if Equal(Key, Head.Key.Key) then raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert)
2376 | //  else if (Less(Key, Head.Key.Key)) then begin
2377 | //    Head.Left:= InternalInsert(Head.Left, Key, Value);
2378 | //  end else begin
2379 | //    Head.Right:= InternalInsert(Head.Right, Key, Value);
2380 | //  end;
2381 | //
2382 | //  Result:= Head;
2383 | //end;
2384 | 
2385 | { TTree<K> }
2386 | 
2387 | procedure TTree<T>.ExceptWith(const Other: IEnumerable<T>);
2388 | var
2389 |   Element: T;
2390 | begin
2391 |   if (Other = nil) then ArgumentNilError('ExceptWith');
2392 |   for Element in Other do begin
2393 |     Self.Remove(Element);
2394 |   end;
2395 | end;
2396 | 
2397 | function TTree<T>.GetCount: Integer;
2398 | begin
2399 |   Result:= fCount;
2400 | end;
2401 | 
2402 | procedure TTree<T>.IntersectWith(const Other: IEnumerable<T>);
2403 | var
2404 |   Element: T;
2405 | begin
2406 |   if (Other = nil) then ArgumentNilError('IntersectWith');
2407 |   for Element in Self do begin
2408 |     if not(Other.Contains(Element)) then Self.Remove(Element);
2409 |   end;
2410 | end;
2411 | 
2412 | procedure TTree<T>.UnionWith(const Other: IEnumerable<T>);
2413 | var
2414 |   Element: T;
2415 | begin
2416 |   if (Other = nil) then ArgumentNilError('UnionWith');
2417 |   for Element in Other do begin
2418 |     Self.Add(Element);
2419 |   end;
2420 | end;
2421 | 
2422 | function TTree<T>.IsSubsetOf(const Other: IEnumerable<T>): boolean;
2423 | var
2424 |   Element: T;
2425 | begin
2426 |   if (Other = nil) then ArgumentNilError('IsSubsetOf');
2427 |   for Element in Self do begin
2428 |     if not(Other.Contains(Element)) then Exit(false);
2429 |   end;
2430 |   Result:= true;
2431 | end;
2432 | 
2433 | function TTree<T>.IsSupersetOf(const Other: IEnumerable<T>): boolean;
2434 | var
2435 |   Element: T;
2436 | begin
2437 |   if (Other = nil) then ArgumentNilError('IsSupersetOf');
2438 |   for Element in Other do begin
2439 |     if not(Self.Contains(Element)) then Exit(false);
2440 |   end;
2441 |   Result:= true;
2442 | end;
2443 | 
2444 | function TTree<T>.SetEquals(const Other: IEnumerable<T>): boolean;
2445 | begin
2446 |   if (Other = nil) then ArgumentNilError('SetEquals');
2447 |   Result:= IsSubsetOf(Other) and IsSupersetOf(Other);
2448 | end;
2449 | 
2450 | function TTree<T>.Overlaps(const Other: IEnumerable<T>): boolean;
2451 | var
2452 |   Element: T;
2453 | begin
2454 |   if (Other = nil) then ArgumentNilError('Overlaps');
2455 |   for Element in Other do begin
2456 |     if Self.Contains(Element) then Exit(true);
2457 |   end;
2458 |   Result:= false;
2459 | end;
2460 | 
2461 | procedure TBinaryTreeBase<T>.ExpandStorage(OldCount: NativeUInt);
2462 | var
2463 |   Index: TBucketIndex;
2464 | begin
2465 |   index:= BucketIndex(OldCount);
2466 |   SetLength(fStorage, index.Key + 1);
2467 |   SetLength(fStorage[index.Key], cBucketSize);
2468 | end;
2469 | 
2470 | function TBinaryTreeBase<T>.NewNode(const Key: T; Parent: PNode): PNode;
2471 | var
2472 |   Index: TBucketIndex;
2473 | begin
2474 |   index:= BucketIndex(fCount);
2475 |   if (Index.Value = 0) then begin
2476 |     // we do not test for Out of Memory. If it occurs here that's fine.
2477 |     ExpandStorage(fCount);
2478 |   end;
2479 |   // An Index.Value = 0 means insert it at the beginning of a bucket.
2480 |   // This is fine we just added a bucket.
2481 |   // The Key is the index of the bucket, which will also will be correct
2482 |   // when we just added a bucket.
2483 |   Result:= @fStorage[index.Key, index.Value];
2484 |   Result.Parent:= Parent;
2485 |   Result.Left:= nil;
2486 |   Result.Right:= nil;
2487 |   Result.fKey:= Key;
2488 |   Result.fIsBlack:= Color.Red;
2489 |   Inc(fCount);
2490 | end;
2491 | 
2492 | procedure TBinaryTreeBase<T>.Traverse(Order: TTraverseOrder; const Action: TTraverseAction<T>);
2493 | var
2494 |   ActionWrapper: TNodePredicate;
2495 | begin
2496 |   ActionWrapper:= function(const Node: PNode): boolean
2497 |     var
2498 |       Abort: boolean;
2499 |     begin
2500 |       Abort:= false;
2501 |       Action(Node.Key, Abort);
2502 |       Result:= Abort;
2503 |     end;
2504 | 
2505 |   case Order of
2506 |     TTraverseOrder.PreOrder: TraversePreOrder(Root, ActionWrapper);
2507 |     TTraverseOrder.InOrder: TraverseInOrder(nil, ActionWrapper);
2508 |     TTraverseOrder.PostOrder: TraversePostOrder(Root, ActionWrapper);
2509 |     TTraverseOrder.ReverseOrder: TraverseReverseOrder(nil, ActionWrapper);
2510 |   else raise EInvalidOperationException.CreateRes(@SInvalidTraverseOrder);
2511 |   end;
2512 | end;
2513 | 
2514 | procedure TTree<T>.ArgumentNilError(const MethodName: string);
2515 | begin
2516 |   raise EArgumentNullException.Create(Self.ClassName + MethodName + ' does not accept a nil argument');
2517 | end;
2518 | 
2519 | procedure TTree<T>.AddInternal(const Item: T);
2520 | begin
2521 |   if not(Add(Item)) then raise EInvalidOperationException.CreateRes(@SSetDuplicateInsert);
2522 | end;
2523 | 
2524 | { TBinaryTreeBase<K, V> }
2525 | 
2526 | function TBinaryTreeBase<K, V>.Equal(const A, B: K): boolean;
2527 | begin
2528 |   Result:= KeyComparer.Compare(A, B) = 0;
2529 | end;
2530 | 
2531 | class function TBinaryTreeBase<K, V>.GetKeyComparer: IComparer<K>;
2532 | begin
2533 |   if not(Assigned(fKeyComparer)) then fKeyComparer:= TComparer<K>.Default;
2534 |   Result:= fKeyComparer;
2535 | end;
2536 | 
2537 | function TBinaryTreeBase<K, V>.Less(const A, B: K): boolean;
2538 | begin
2539 |   Result:= KeyComparer.Compare(A, B) < 0;
2540 | end;
2541 | 
2542 | function TBinaryTreeBase<K, V>.Pair(const Key: K; const Value: V): TPair;
2543 | begin
2544 |   Result:= TPair.Create(Key, Value);
2545 | end;
2546 | 
2547 | 
2548 | { TAVLTree<T>.TAVLNodeHelper }
2549 | 
2550 | //function TAVLTree<T>.TAVLNodeHelper.GetBalance: TBalance;
2551 | //begin
2552 | //  Result:= TBalance(Self.fIsBlack);
2553 | //end;
2554 | //
2555 | //function TAVLTree<T>.TAVLNodeHelper.GetCount: NativeInt;
2556 | //begin
2557 | //
2558 | //end;
2559 | //
2560 | //procedure TAVLTree<T>.TAVLNodeHelper.SetBalance(const Value: TBalance);
2561 | //begin
2562 | //  TBalance(Self.fIsBlack):= Value;
2563 | //end;
2564 | //
2565 | //function TAVLTree<T>.TAVLNodeHelper.TreeDepth: NativeInt;
2566 | //begin
2567 | //
2568 | //end;
2569 | 
2570 | end.
2571 | 


--------------------------------------------------------------------------------
/Source/Spring.Collections.TreeIntf.pas:
--------------------------------------------------------------------------------
 1 | unit Spring.Collections.TreeIntf;
 2 | 
 3 | interface
 4 | 
 5 | uses
 6 |   Spring.Collections,
 7 |   Spring.Collections.Sets;
 8 | 
 9 | type
10 |   {$SCOPEDENUMS ON}
11 |   TTraverseOrder = (PreOrder, InOrder, ReverseOrder, PostOrder);
12 |   {$SCOPEDENUMS OFF}
13 |   TTraverseAction<T> = reference to procedure(const Key: T; var Abort: boolean);
14 | 
15 |   ITree<T> = interface(ISet<T>)
16 |     ['{ABF7DBD8-C61A-4CEA-AEA6-A67C881E9F02}']
17 |     procedure Traverse(Order: TTraverseOrder; const Action: TTraverseAction<T>);
18 |   end;
19 | 
20 |   ITree<K,V> = interface(IDictionary<K,V>)
21 |     ['{9466FCD0-BEF6-4BA5-BB6D-22106669C86D}']
22 |   end;
23 | 
24 |   {$ifdef debug}
25 |   ITreeDebug = interface
26 |     ['{2E25C3A0-C381-4383-9060-7EC13C0E1C42}']
27 |     function VerifyIntegrity: Boolean;
28 |     function StorageSizeOK: Boolean;
29 |   end;
30 |   {$endif}
31 | 
32 | implementation
33 | 
34 | end.
35 | 


--------------------------------------------------------------------------------
/Source/Spring.Collections.Trees.pas:
--------------------------------------------------------------------------------
  1 | { *************************************************************************** }
  2 | {                                                                             }
  3 | { Proposed addition to the                                                    }
  4 | {           Spring Framework for Delphi                                       }
  5 | {                                                                             }
  6 | { Copyright (c) 2009-2017 Spring4D Team                                       }
  7 | {                                                                             }
  8 | { http://www.spring4d.org                                                     }
  9 | {                                                                             }
 10 | { *************************************************************************** }
 11 | {                                                                             }
 12 | { Licensed under the Apache License, Version 2.0 (the "License");             }
 13 | { you may not use this file except in compliance with the License.            }
 14 | { You may obtain a copy of the License at                                     }
 15 | {                                                                             }
 16 | { http://www.apache.org/licenses/LICENSE-2.0                                  }
 17 | {                                                                             }
 18 | { Unless required by applicable law or agreed to in writing, software         }
 19 | { distributed under the License is distributed on an "AS IS" BASIS,           }
 20 | { WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.    }
 21 | { See the License for the specific language governing permissions and         }
 22 | { limitations under the License.                                              }
 23 | {                                                                             }
 24 | { *************************************************************************** }
 25 | 
 26 | 
 27 | unit Spring.Collections.Trees;
 28 | 
 29 | interface
 30 | 
 31 | uses
 32 |   System.Types,
 33 |   System.SysUtils,
 34 |   System.Generics.Defaults,
 35 |   System.Generics.Collections,
 36 |   Spring,
 37 |   Spring.Collections,
 38 |   Spring.Collections.Queues,
 39 |   Spring.Collections.Base,
 40 |   Spring.Collections.Sets,
 41 |   Spring.Collections.MiniStacks,
 42 |   Spring.Collections.Extensions,
 43 |   Spring.Collections.TreeIntf;
 44 | 
 45 | type
 46 | 
 47 |   Tree<T> = record
 48 |   public
 49 |     class function RedBlackTree: ITree<T>; overload; static;
 50 |     class function RedBlackTree(const Comparer: IComparer<T>): ITree<T>; overload; static;
 51 |     class function RedBlackTree(const Comparer: TComparison<T>): ITree<T>; overload; static;
 52 |     class function RedBlackTree(const Values: array of T): ITree<T>; overload; static;
 53 |     class function RedBlackTree(const Collection: IEnumerable<T>): ITree<T>; overload; static;
 54 |   end;
 55 | 
 56 |   Tree<K,V> = record
 57 |   public
 58 |     class function RedBlackTree: ITree<K,V>; overload; static;
 59 |     class function RedBlackTree(const Comparer: IComparer<K>): ITree<K,V>; overload; static;
 60 |     class function RedBlackTree(const Comparer: TComparison<K>): ITree<K,V>; overload; static;
 61 |     class function RedBlackTree(const Values: array of TPair<K,V>): ITree<K,V>; overload; static;
 62 |     class function RedBlackTree(const Collection: IEnumerable<TPair<K,V>>): ITree<K,V>; overload; static;
 63 | //    class function BPlusTree: ITree<K,V>; overload; static;
 64 | //    class function BPlusTree(const Comparer: IComparer<K>): ITree<K,V>; overload; static;
 65 | //    class function BPlusTree(const Comparer: TComparison<K>): ITree<K,V>; overload; static;
 66 | //    class function BPlusTree(const Values: array of TPair<K,V>): ITree<K,V>; overload; static;
 67 | //    class function BPlusTree(const Collection: IEnumerable<TPair<K,V>>): ITree<K,V>; overload; static;
 68 |   end;
 69 | 
 70 | implementation
 71 | 
 72 | uses
 73 |   Spring.Collections.TreeImpl{,
 74 |   Spring.Collections.BPlusTrees};
 75 | 
 76 | { Tree<T> }
 77 | 
 78 | class function Tree<T>.RedBlackTree(const Comparer: IComparer<T>): ITree<T>;
 79 | begin
 80 |   Result:= TRedBlackTree<T>.Create(Comparer);
 81 | end;
 82 | 
 83 | class function Tree<T>.RedBlackTree: ITree<T>;
 84 | begin
 85 |   Result:= TRedBlackTree<T>.Create;
 86 | end;
 87 | 
 88 | class function Tree<T>.RedBlackTree(const Comparer: TComparison<T>): ITree<T>;
 89 | begin
 90 |   Result:= TRedBlackTree<T>.Create(Comparer);
 91 | end;
 92 | 
 93 | class function Tree<T>.RedBlackTree(const Collection: IEnumerable<T>): ITree<T>;
 94 | begin
 95 |   Result:= TRedBlackTree<T>.Create(Collection);
 96 | end;
 97 | 
 98 | class function Tree<T>.RedBlackTree(const Values: array of T): ITree<T>;
 99 | begin
100 |   Result:= TRedBlackTree<T>.Create(Values);
101 | end;
102 | 
103 | { Tree<K, V> }
104 | 
105 | class function Tree<K, V>.RedBlackTree(const Comparer: IComparer<K>): ITree<K, V>;
106 | begin
107 |   Result:= TRedBlackTree<K,V>.Create(Comparer);
108 | end;
109 | 
110 | class function Tree<K, V>.RedBlackTree: ITree<K, V>;
111 | begin
112 |   Result:= TRedBlackTree<K,V>.Create;
113 | end;
114 | 
115 | //class function Tree<K, V>.BPlusTree(const Comparer: IComparer<K>): ITree<K, V>;
116 | //begin
117 | //  Result:= TBPlusTree<K,V>.Create(Comparer);
118 | //end;
119 | //
120 | //class function Tree<K, V>.BPlusTree: ITree<K, V>;
121 | //begin
122 | //  Result:= TBPlusTree<K,V>.Create;
123 | //end;
124 | //
125 | //class function Tree<K, V>.BPlusTree(const Comparer: TComparison<K>): ITree<K, V>;
126 | //begin
127 | //
128 | //end;
129 | //
130 | //class function Tree<K, V>.BPlusTree(const Collection: IEnumerable < TPair < K, V >> ): ITree<K, V>;
131 | //begin
132 | //
133 | //end;
134 | //
135 | //class function Tree<K, V>.BPlusTree(const Values: array of TPair<K, V>): ITree<K, V>;
136 | //begin
137 | //
138 | //end;
139 | 
140 | class function Tree<K, V>.RedBlackTree(const Collection: IEnumerable<TPair<K, V>>): ITree<K, V>;
141 | begin
142 |   Result:= TRedBlackTree<K,V>.Create(Collection);
143 | end;
144 | 
145 | class function Tree<K, V>.RedBlackTree(const Values: array of TPair<K, V>): ITree<K, V>;
146 | begin
147 |   Result:= TRedBlackTree<K,V>.Create(Values);
148 | end;
149 | 
150 | class function Tree<K, V>.RedBlackTree(const Comparer: TComparison<K>): ITree<K, V>;
151 | begin
152 |   Result:= TRedBlackTree<K,V>.Create(Comparer);
153 | end;
154 | 
155 | end.
156 | 


--------------------------------------------------------------------------------
/Source/TreeTests.pas:
--------------------------------------------------------------------------------
  1 | unit TreeTests;
  2 | 
  3 | interface
  4 | 
  5 | uses
  6 |   DUnitX.TestFramework,
  7 |   Spring.Collections.TreeIntf,
  8 |   Spring.Collections.Trees;
  9 | 
 10 | type
 11 |   [TestFixture]
 12 |   TestTreesInteger = class(TObject)
 13 |   strict private
 14 |     FTree: ITree<integer>;
 15 |   public
 16 |     [Setup]
 17 |     procedure Setup;
 18 |     [TearDown]
 19 |     procedure TearDown;
 20 |     // Sample Methods
 21 |     // Test with TestCase Atribute to supply parameters.
 22 |     [TestCase('Add20','20')]
 23 |     [TestCase('Add100','100')]
 24 |     [TestCase('Add1000','1600')]
 25 |     procedure RandomAdd(Count: Integer);
 26 |     // Test with TestCase Atribute to supply parameters.
 27 |     [TestCase('AddDelete20','20')]
 28 |     [TestCase('AddDelete100','100')]
 29 |     [TestCase('AddDelete1000','1600')]
 30 |     procedure RandomAddDelete(Count: Integer);
 31 |     [TestCase('Enumerate20','20')]
 32 |     [TestCase('Enumerate100','100')]
 33 |     [TestCase('Enumerate1000','1024')]
 34 |     procedure Enumerate(Count: Integer);
 35 |     [TestCase('SpeedTest16000','160000')]
 36 |     procedure SpeedTest(Count: Integer);
 37 |   end;
 38 | 
 39 | 
 40 |   [TestFixture]
 41 |   TestTreesIntInt = class(TObject)
 42 |   strict private
 43 |     FTree: ITree<Integer, Integer>;
 44 | 
 45 |   public
 46 |     [Setup]
 47 |     procedure Setup;
 48 |     [TearDown]
 49 |     procedure TearDown;
 50 |     // Sample Methods
 51 |     // Test with TestCase Atribute to supply parameters.
 52 |     [TestCase('Add20','20')]
 53 |     [TestCase('Add100','100')]
 54 |     [TestCase('Add1000','1000')]
 55 |     procedure RandomAdd(Count: Integer);
 56 |     // Test with TestCase Atribute to supply parameters.
 57 |     [TestCase('AddDelete20','20')]
 58 |     [TestCase('AddDelete100','100')]
 59 |     [TestCase('AddDelete1000','1000')]
 60 |     procedure RandomAddDelete(Count: Integer);
 61 |     [TestCase('Enumerate20','20')]
 62 |     [TestCase('Enumerate100','100')]
 63 |     [TestCase('Enumerate1000','1000')]
 64 |     procedure Enumerate(Count: Integer);
 65 |   end;
 66 | 
 67 | 
 68 | implementation
 69 | 
 70 | uses
 71 |   System.Classes,
 72 |   System.SysUtils,
 73 |   System.Generics.Collections;
 74 | 
 75 | { TestTrees<T> }
 76 | var
 77 | Previous: integer;
 78 | 
 79 |   procedure ActionNext(const Key: integer; var Abort: boolean);
 80 |   begin
 81 |     Assert.IsTrue(Key > Previous);
 82 |     Previous:= Key;
 83 |   end;
 84 | 
 85 |   procedure ActionPrevious(const Key: integer; var Abort: boolean);
 86 |   begin
 87 |     Assert.IsTrue(Key < Previous);
 88 |     Previous:= Key;
 89 |   end;
 90 | 
 91 | procedure TestTreesInteger.Enumerate(Count: Integer);
 92 | var
 93 |   i,a,r,c: integer;
 94 | begin
 95 |   //Add random data
 96 |   for i:= 0 to Count - 1 do begin
 97 |     r:= Random(MaxInt);
 98 |     while FTree.Contains(r) do r:= Random(MaxInt);
 99 |     c:= FTree.Count;
100 |     FTree.Add(r);
101 |     Assert.IsTrue(FTree.Count = (c+1));
102 |   end;
103 |   //forward enumeration
104 |   a:= -1;
105 |   for i in FTree do begin
106 |     Assert.IsTrue(a < i);
107 |     a:= i;
108 |   end;
109 |   //Reverse enumeration
110 |   a:= MaxInt;
111 |   for i in FTree.Reversed do begin
112 |     Assert.IsTrue(a > i);
113 |     a:= i;
114 |   end;
115 |   Previous:= FTree.First-1;
116 |   FTree.Traverse(TTraverseOrder.InOrder, ActionNext);
117 | 
118 |   Previous:= FTree.Last+1;
119 |   FTree.Traverse(TTraverseOrder.ReverseOrder, ActionPrevious);
120 | end;
121 | 
122 | procedure TestTreesInteger.RandomAdd(Count: Integer);
123 | var
124 |   i,j: integer;
125 |   r: integer;
126 |   c: integer;
127 | begin
128 |   i:= 0;
129 |   while i < Count do begin
130 |     r:= Random(MaxInt);
131 |     c:= FTree.Count;
132 |     if not(FTree.Contains(r)) then begin
133 |       FTree.Add(r);
134 |       Assert.IsTrue((c+1) = FTree.Count);
135 |       Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
136 |       inc(i);
137 |     end else begin
138 |       Assert.IsTrue(c > 0);
139 |       FTree.Remove(r);
140 |       Assert.IsTrue((c-1) = FTree.Count);
141 |       Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
142 |       FTree.Add(r);
143 |       Assert.IsTrue((c) = FTree.Count);
144 |       Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
145 |     end;
146 |   end; {while}
147 |   j:= -1;
148 |   for i in FTree do begin
149 |     Assert.IsTrue(j < i);
150 |     j:= i;
151 |   end;
152 |   j:= MaxInt;
153 |   for i in FTree.Reversed do begin
154 |     Assert.IsTrue(j > i);
155 |     j:= i;
156 |   end;
157 |   FTree.Clear;
158 |   Assert.IsTrue(FTree.Count = 0);
159 | end;
160 | 
161 | procedure TestTreesInteger.RandomAddDelete(Count: Integer);
162 | var
163 |   i,r,a,c: integer;
164 |   Data: TArray<integer>;
165 | begin
166 |   SetLength(Data, Count);
167 |   for i:= 0 to Count - 1 do begin
168 |     Data[i]:= i;
169 |     c:= FTree.Count;
170 |     FTree.Add(Data[i]);
171 |     Assert.IsTrue(FTree.Count = (c+1));
172 |     Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
173 |   end;
174 |   //Shuffle the items
175 |   for i:= 0 to Count -1 do begin
176 |     r:= Random(Count);
177 |     a:= Data[i];
178 |     Data[i]:= Data[r];
179 |     Data[r]:= a;
180 |   end;
181 |   for i:= 0 to Count -1 do begin
182 |     c:= FTree.Count;
183 |     FTree.Remove(Data[i]);
184 |     Assert.IsTrue(FTree.Count = (c-1));
185 |     Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
186 |   end;
187 |   Assert.IsTrue(FTree.Count = 0);
188 | end;
189 | 
190 | procedure TestTreesInteger.Setup;
191 | begin
192 |   FTree:= Tree<Integer>.RedBlackTree;
193 | end;
194 | 
195 | 
196 | procedure TestTreesInteger.SpeedTest(Count: Integer);
197 | var
198 |   i,r,a: integer;
199 |   Data: TArray<integer>;
200 |   Ticks: cardinal;
201 | begin
202 |   System.Writeln;
203 |   System.Writeln('Start speedtest: add/remove '+Count.ToString+' items');
204 |   Ticks:= TThread.GetTickCount;
205 |   SetLength(Data, Count);
206 |   for i:= 0 to Count - 1 do begin
207 |     Data[i]:= i;
208 |     FTree.Add(Data[i]);
209 |   end;
210 |   System.Writeln('Adding done');
211 |   //Shuffle the items
212 |   for i:= 0 to Count -1 do begin
213 |     r:= Random(Count);
214 |     a:= Data[i];
215 |     Data[i]:= Data[r];
216 |     Data[r]:= a;
217 |   end;
218 |   System.Writeln('Shuffling done');
219 |   for i:= 0 to Count -1 do begin
220 |     FTree.Remove(Data[i]);
221 |   end;
222 |   System.WriteLn('Adding and removing '+Count.ToString + ' elements took '+(TThread.GetTickCount - Ticks).ToString+' ticks');
223 |   Assert.IsTrue(FTree.Count = 0);
224 | end;
225 | 
226 | procedure TestTreesInteger.TearDown;
227 | begin
228 |   FTree:= nil;
229 | end;
230 | 
231 | 
232 | { TestTrees<K, V> }
233 | 
234 | procedure TestTreesIntInt.Enumerate(Count: Integer);
235 | var
236 |   i,a,r,c: integer;
237 |   Pair: TPair<integer, integer>;
238 | begin
239 |   //Add random data
240 |   for i:= 0 to Count - 1 do begin
241 |     r:= Random(MaxInt);
242 |     while FTree.ContainsKey(r) do r:= Random(MaxInt);
243 |     c:= FTree.Count;
244 |     FTree.Add(r,i);
245 |     Assert.IsTrue(FTree.Count = (c+1));
246 |   end;
247 |   //forward enumeration
248 |   a:= -1;
249 |   for Pair in FTree do begin
250 |     Assert.IsTrue(a < Pair.Key);
251 |     a:= Pair.Key;
252 |   end;
253 |   //Reverse enumeration
254 |   a:= MaxInt;
255 |   for Pair in FTree.Reversed do begin
256 |     Assert.IsTrue(a > Pair.Key);
257 |     a:= Pair.Key;
258 |   end;
259 | end;
260 | 
261 | procedure TestTreesIntInt.RandomAdd(Count: Integer);
262 | var
263 |   i,j: integer;
264 |   r: integer;
265 |   c: integer;
266 |   p: TPair<Integer, Integer>;
267 | begin
268 |   i:= 0;
269 |   while i < Count do begin
270 |     r:= Random(MaxInt);
271 |     c:= FTree.Count;
272 |     if not(FTree.ContainsKey(r)) then begin
273 |       FTree.Add(r,0);
274 |       Assert.IsTrue((c+1) = FTree.Count);
275 |       Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
276 |       inc(i);
277 |     end else begin
278 |       Assert.IsTrue(c > 0);
279 |       FTree.Remove(r);
280 |       Assert.IsTrue((c-1) = FTree.Count);
281 |       Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
282 |       FTree.Add(r,0);
283 |       Assert.IsTrue((c) = FTree.Count);
284 |       Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
285 |     end;
286 |   end; {while}
287 |   j:= -1;
288 |   for p in FTree do begin
289 |     Assert.IsTrue(j < p.Key);
290 |     j:= p.Key;
291 |   end;
292 |   j:= MaxInt;
293 |   for p in FTree.Reversed do begin
294 |     Assert.IsTrue(j > p.Key);
295 |     j:= p.Key;
296 |   end;
297 |   FTree.Clear;
298 |   Assert.IsTrue(FTree.Count = 0);
299 | end;
300 | 
301 | procedure TestTreesIntInt.RandomAddDelete(Count: Integer);
302 | var
303 |   i,j,r,a,c: integer;
304 |   Data: TArray<integer>;
305 | begin
306 |   SetLength(Data, Count);
307 |   for i:= 0 to Count - 1 do begin
308 |     Data[i]:= i;
309 |     c:= FTree.Count;
310 |     FTree.Add(Data[i],i);
311 |     Assert.IsTrue(FTree.Count = (c+1));
312 |     Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
313 |   end;
314 |   //Shuffle the items
315 |   for i:= 0 to Count -1 do begin
316 |     r:= Random(Count);
317 |     a:= Data[i];
318 |     Data[i]:= Data[r];
319 |     Data[r]:= a;
320 |   end;
321 |   for i:= 0 to Count -1 do begin
322 |     c:= FTree.Count;
323 |     FTree.Remove(Data[i]);
324 |     Assert.IsTrue(FTree.Count = (c-1));
325 |     Assert.IsFalse(FTree.ContainsKey(Data[i]));
326 |     for j:= i+1 to Count -1 do begin
327 |       Assert.IsTrue(FTree.ContainsKey(Data[j]));
328 |     end;
329 |     Assert.IsTrue((fTree as ITreeDebug).VerifyIntegrity);
330 |   end;
331 |   Assert.IsTrue(FTree.Count = 0);
332 | end;
333 | 
334 | procedure TestTreesIntInt.TearDown;
335 | begin
336 |   FTree:= nil;
337 | end;
338 | 
339 | procedure TestTreesIntInt.Setup;
340 | begin
341 |   FTree:= Tree<Integer, Integer>.RedBlackTree;
342 | end;
343 | 
344 | 
345 | initialization
346 |   TDUnitX.RegisterTestFixture(TestTreesInteger);
347 |   TDUnitX.RegisterTestFixture(TestTreesIntInt);
348 | end.
349 | 


--------------------------------------------------------------------------------