DZone Snippets: structure code

Basic Trie data structure in Ruby

ntk () — Sat, 07 Jun 2008 20:54:39 GMT



# Inspired by http://www.rubyquiz.com/quiz103.html

# cf. also http://en.wikipedia.org/wiki/Trie



#!/usr/local/bin/ruby -w



require 'pp'



class Hash



   def deep_merge!(second)

      # cf. http://snippets.dzone.com/posts/show/4146

      merger = proc { |key,v1,v2| Hash === v1 && Hash === v2 ? v1.merge(v2, &merger) : v2 }

      self.merge!(second, &merger)

   end



   def nested_hash(array)

      node = self

      array.each do |i|

         node[i]=Hash.new if node[i].nil?

         node = node[i]

      end 

      self

   end



   def merge_nested_hash!(nested_hash)

      deep_merge!(nested_hash)

   end



   # code basis taken from: "Find every path and it's value in a Hash" by Florian Aßmann,

   # http://snippets.dzone.com/posts/show/3565



   def each_trie_path

      raise ArgumentError unless block_given?

      self.class.each_trie_path(self) { |path, object| yield(path, object) }

   end



   protected

   def self.each_trie_path(object, path = [], &block)  



      if object.is_a?(Hash)

         object.each do |key, value|



            if key == true && value == {}

               if path == [:root]  # special case for empty string: [[:root], {true=>{}}]

                  yield(path, {true=>{}})

                  next

               end

               yield(path, object)

            end



            self.each_trie_path(value, [path , key].flatten, &block)

         end

      else 

         yield(path, object)

      end

   end 



end





class Trie



   @hash = Hash.new.merge_nested_hash!(Hash.new)

   #@hash = Hash.new.merge_nested_hash!({:root=>{}})

   #@hash = Hash.new.merge_nested_hash!(Hash.new.nested_hash([:root]))

   class << self; attr_accessor :hash; end    # Trie.hash



   def initialize

      Trie.hash.merge_nested_hash!({:root=>{}})

   end





   def add_int(int)   # for int >= 0

      ia = int.to_s.scan(/[[:digit:]]/).map { |i| i.to_i }  # integer array; ex: [4,6,2]

      ia.unshift(:root).push(true)

      Trie.hash.merge_nested_hash!(Hash.new.nested_hash(ia))

   end



   def matchi(int)  # match integer

      ia = int.to_s.scan(/[[:digit:]]/).map { |i| i.to_i }  

      node = Trie.hash.fetch(:root,nil)

      ia.each do |digit|

         node = node[digit]

         #node = node.fetch(digit,nil)

         return false unless node

      end

      node.fetch(true,nil) ? true : false

   end



   def mfpi(int)   # match first part of integer

      ia = int.to_s.scan(/[[:digit:]]/).map { |i| i.to_i }

      node = Trie.hash.fetch(:root,nil)

      ia.each do |digit|

         node = node[digit]

         return false unless node

      end

      return true

   end





   def add_word(word)

      ca = word.split(//u)    # UTF-8 aware character array

      ca.unshift(:root).push(true)

      Trie.hash.merge_nested_hash!(Hash.new.nested_hash(ca))

   end



   def match(word)   # match entire word

      ca = word.split(//u)    

      node = Trie.hash.fetch(:root,nil)

      ca.each do |char|

         node = node[char]

         #node = node.fetch(char,nil)

         return false unless node

      end

      node.fetch(true,nil) ? true : false

   end



   def mfpw(word)   # match first part of word

      ca = word.split(//u)    

      node = Trie.hash.fetch(:root,nil)

      ca.each do |char|

         node = node[char]

         return false unless node

      end

      return true

   end



end





trie = Trie.new

p Trie.hash



trie.add_word("word")

pp Trie.hash            

p trie.match("word")      

p trie.match("word2")   

trie.add_word("word2")

p trie.match("word2")   

pp Trie.hash            # {:root=>{"w"=>{"o"=>{"r"=>{"d"=>{true=>{}, "2"=>{true=>{}}}}}}}}



trie.add_word("")

p trie.match("")

pp Trie.hash



puts



p trie.match("word")      

p trie.mfpw("wor")     # match first part of word



puts



trie.add_int(12345)

p Trie.hash



trie.add_int(12980345)

pp Trie.hash



trie.add_int(8512)

pp Trie.hash

p trie.matchi(8512)

p trie.matchi(85)

p trie.mfpi(85)     # match first part of integer

p trie.matchi(51)



puts



puts

pp Trie.hash

paths = []

Trie.hash.each_trie_path { |path, value| paths.push([ path ]) }

#Trie.hash.each_trie_path { |path, value| paths.push([ path, value ]) }

#pp paths

puts

paths.each { |x| p x }

puts





#------------------------------------------------------





require 'pp'



class Hash

   def Hash.new_nested_hash

     Hash.new{|h,k| h[k]=Hash.new(&h.default_proc) }

   end

end





class Trie



   @hash = Hash.new_nested_hash

   #@hash = Hash.new_nested_hash.update(true=>{})  # add empty string by default

   class << self; attr_accessor :hash; end    # Trie.hash



   def <<(word)

      ca = word.split(//u)    # UTF-8 aware character array

      wl = ca.size            # word length

      str = ""

      wl.times { |x| str << "[ca.at(#{x})]" }

      str = "Trie.hash" << str << "[true]"

      #p str     # example: "Trie.hash[ca.at(0)][ca.at(1)][ca.at(2)][ca.at(3)][true]"

      eval(str)

   end





   def match(word)

      ca = word.split(//u)    # UTF-8 aware character array

      wl = ca.size            # word length

      str = ""



      wl.times { |x| str << ".fetch(ca.at(#{x}),nil)" }

      str = "Trie.hash" << str << ".fetch(true,nil)"

      #p str   # example: "Trie.hash.fetch(ca.at(0),nil).fetch(ca.at(1),nil).fetch(ca.at(2),nil).fetch(true,nil)"

      ret = eval(str) rescue nil



=begin

      # alternative

      wl.times { |x| str << ".fetch(ca.at(#{x}),{})" }

      str = "Trie.hash" << str << ".fetch(true,nil)"

      #p str   # example: "Trie.hash.fetch(ca.at(0),{}).fetch(ca.at(1),{}).fetch(ca.at(2),{}).fetch(true,nil)"

      ret = eval(str)

=end



      ret == {} ? true : false   # {} is the default value created by Trie.hash or Hash.new_nested_hash respectively

   end



end





trie = Trie.new

trie << "word"

pp Trie.hash            

p trie.match("word")      

p trie.match("word2")   

trie << "word2"

p trie.match("word2")   

pp Trie.hash            # {"w"=>{"o"=>{"r"=>{"d"=>{true=>{}, "2"=>{true=>{}}}}}}}



trie << ""

p trie.match("")

pp Trie.hash





#------------------------------------------





# alternative with default :root element



require 'pp'



class Hash

   def Hash.new_nested_hash

     Hash.new{|h,k| h[k]=Hash.new(&h.default_proc) }

   end

end





class Hash



   # code basis taken from: "Find every path and it's value in a Hash" by Florian Aßmann,

   # http://snippets.dzone.com/posts/show/3565



   def each_trie_path

      raise ArgumentError unless block_given?

      self.class.each_trie_path(self) { |path, object| yield(path, object) }

   end



   protected

   def self.each_trie_path(object, path = [], &block)  



      if object.is_a?(Hash)

         object.each do |key, value|



            if key == true && value == {}

               if path == [:root]  # special case for empty string: [[:root], {true=>{}}]

                  yield(path, {true=>{}})

                  next

               end

               yield(path, object)

            end



            self.each_trie_path(value, [path , key].flatten, &block)

         end

      else 

         yield(path, object)

      end

   end 



end





class Trie



   @hash = Hash.new_nested_hash

   class << self; attr_accessor :hash; end    # Trie.hash



   def initialize

      Trie.hash[:root]

   end





   def add_int(int)   # for int >= 0

      ia = int.to_s.scan(/[[:digit:]]/).map { |i| i.to_i }  # integer array; ex: [4,6,2]

      ia.unshift(:root)

      str = ""

      ia.size.times { |x| str << "[ia.at(#{x})]" }

      str = "Trie.hash" << str << "[true]"

      eval(str)

   end



   def matchi(int)  # match integer

      ia = int.to_s.scan(/[[:digit:]]/).map { |i| i.to_i }  

      node = Trie.hash.fetch(:root,nil)

      ia.each do |digit|

         node = node.fetch(digit,nil)

         return false unless node

      end

      node.fetch(true,nil) ? true : false

   end



   def mfpi(int)   # match first part of integer

      ia = int.to_s.scan(/[[:digit:]]/).map { |i| i.to_i }

      node = Trie.hash.fetch(:root,nil)

      ia.each do |digit|

         node = node.fetch(digit,nil)

         return false unless node

      end

      return true

   end





   def <<(word)

      ca = word.split(//u)    # UTF-8 aware character array

      ca.unshift(:root)

      #ca = [:root, *word.split(//u)]

      #ca = [:root].concat(word.split(//u))

      str = ""

      ca.size.times { |x| str << "[ca.at(#{x})]" }

      str = "Trie.hash" << str << "[true]"

      #p str     # example: "Trie.hash[ca.at(0)][ca.at(1)][ca.at(2)][ca.at(3)][true]"

      eval(str)

   end



   def match(word)

      ca = word.split(//u)    

      ca.unshift(:root)

      #ca = [:root, *word.split(//u)]

      #ca = [:root].concat(word.split(//u))

      str = ""

      ca.size.times { |x| str << ".fetch(ca.at(#{x}),nil)" }

      str = "Trie.hash" << str << ".fetch(true,nil)"

      #p str   # example: "Trie.hash.fetch(ca.at(0),nil).fetch(ca.at(1),nil).fetch(ca.at(2),nil).fetch(true,nil)"

      ret = eval(str) rescue nil



=begin

      # alternative

      ca.size.times { |x| str << ".fetch(ca.at(#{x}),{})" }

      str = "Trie.hash" << str << ".fetch(true,nil)"

      #p str   # example: "Trie.hash.fetch(ca.at(0),{}).fetch(ca.at(1),{}).fetch(ca.at(2),{}).fetch(true,nil)"

      ret = eval(str)

=end



      ret == {} ? true : false   # {} is the default value created by Trie.hash or Hash.new_nested_hash respectively

   end



   def match2(word)   # match entire word

      ca = word.split(//u)    

      node = Trie.hash.fetch(:root,nil)

      ca.each do |char|

         node = node.fetch(char,nil)

         return false unless node

      end

      node.fetch(true,nil) ? true : false

   end



   def mfpw(word)   # match first part of word

      ca = word.split(//u)    

      node = Trie.hash.fetch(:root,nil)

      ca.each do |char|

         node = node.fetch(char,nil)

         return false unless node

      end

      return true

   end



end





trie = Trie.new

trie << "word"

pp Trie.hash            

p trie.match("word")      

p trie.match("word2")   

trie << "word2"

p trie.match("word2")   

pp Trie.hash            # {:root=>{"w"=>{"o"=>{"r"=>{"d"=>{true=>{}, "2"=>{true=>{}}}}}}}}



trie << ""

p trie.match("")

pp Trie.hash



puts



p trie.match2("word")      

p trie.mfpw("wor")     # match first part of word



puts



trie.add_int(8512)

pp Trie.hash

p trie.matchi(8512)

p trie.matchi(85)

p trie.mfpi(85)     # match first part of integer

p trie.matchi(51)



puts



puts

pp Trie.hash

paths = []

Trie.hash.each_trie_path { |path, value| paths.push([ path ]) }

#Trie.hash.each_trie_path { |path, value| paths.push([ path, value ]) }

#pp paths

puts

paths.each { |x| p x }

puts

Automating Zend MVC Structure

fernyb (Fernando) — Mon, 17 Mar 2008 15:13:29 GMT

Automating Zend MVC Structure
This is what I use... It's very useful.



#

# Automate the creation of the Zend MVC Framework

# Script Written by: Fernando Barajas

# Usage: php ./zendcreate.php

#



# Create the Zend MVC Framework.

define('ZEND_FILE_TYPE', '.tar.gz');

define('ZEND_FILE_NAME', 'ZendFramework-1.5.0'. ZEND_FILE_TYPE);

define('ZEND_FRAMEWORK_URL', 'http://framework.zend.com/releases/ZendFramework-1.5.0/'. ZEND_FILE_NAME);

define('APPLICATION_NAME', 'zend_'. time());





passthru("wget ". ZEND_FRAMEWORK_URL);





if(file_exists(ZEND_FILE_NAME)) {

	# unzip the file -- tar zxvf ./ZEND_FILE_NAME

	passthru("tar zxvf ". ZEND_FILE_NAME);

	

	# Make the Applications Directories

	passthru("mkdir ". APPLICATION_NAME);

	

	# Move the Library directory into the application directory

	passthru("mv ./". basename(ZEND_FILE_NAME, ZEND_FILE_TYPE) ."/library ./". APPLICATION_NAME ."/library");

	

	# Make the App Directory 

	passthru("mkdir ". APPLICATION_NAME ."/app");

	

		passthru("mkdir ". APPLICATION_NAME ."/app/controllers");

		passthru("mkdir ". APPLICATION_NAME ."/app/models");

		passthru("mkdir ". APPLICATION_NAME ."/app/views");

			

			passthru("mkdir ". APPLICATION_NAME ."/app/views/scripts");

			

	

	# Make the public Directory

	passthru("mkdir ". APPLICATION_NAME ."/public");

	

	# Make the Front Controller / Bootstrap file

$zend_bootstrap_code = '

# Set Error Reporting

error_reporting(E_ALL|E_STRICT);

ini_set(\'display_errors\', \'on\');



# Set include path the DOCUMENT_ROOT / library for Zend Library

ini_set(\'include_path\', $_SERVER[\'DOCUMENT_ROOT\']."/../library");



# Zend Framework Includes

require_once \'Zend/Loader.php\';



Zend_Loader::loadClass(\'Zend_Controller_Front\');



# Un-Comment the two lines below if you will be using Routes

# Most likely you will be. I recommend that you do. 

# They are very useful

#

# Zend_Loader::loadClass(\'Zend_Controller_Router_Rewrite\');

# Zend_Loader::loadClass(\'Zend_Controller_Router_Route_Regex\');

#



# Get the front controller instance

$front = Zend_Controller_Front::getInstance();

$front->setControllerDirectory("../app/controllers");



$front->throwExceptions(true);



#

# Get an Instance For Routing

# $route = $front->getRouter(); // Returns a rewrite router by default

# $route->addRoute(\'user\',

#	new Zend_Controller_Router_Route(\'user/:username\', array(\'controller\' => \'index\', \'action\' => \'test\'))

# );

#

# $route->addRoute(\'product\',

#	new Zend_Controller_Router_Route_Regex(\'product/(\d+)\', array(\'controller\' => \'index\', \'action\' => \'test\'))

# );

#

# $route->addRoute(\'login\',

#	new Zend_Controller_Router_Route_Regex(\'login\', array(\'controller\' => \'index\', \'action\' => \'test\'))

# );

#



# Start the dispatch

$front->dispatch();



?>

';

	# Write the Bootstrap file

	file_put_contents("./". APPLICATION_NAME ."/public/index.php", trim($zend_bootstrap_code));

	

# Write The Index Controller

$zend_index_controller_code = '



class IndexController extends Zend_Controller_Action {



	public function indexAction() {

		# => Logic code here...

		$this->view->random_number = rand(0,10);

		$this->view->status = "It works!";

		$this->render("index");

	}

}



?>

';

	# Write the First Index Controller

	file_put_contents("./". APPLICATION_NAME ."/app/controllers/IndexController.php", trim($zend_index_controller_code));





# Write the index view file

$zend_index_view_code = '







  

  Zend Framework





Status: status ?>



	Random Number: random_number ?>







';

	# Write the First Index View File

	passthru("mkdir ./". APPLICATION_NAME ."/app/views/scripts/index");

	file_put_contents("./". APPLICATION_NAME ."/app/views/scripts/index/index.phtml", $zend_index_view_code);

	

	

# Create the .htaccess file

$zend_htaccess_code = '

RewriteEngine On

RewriteRule !\.(js|ico|gif|jpg|png|css)$ index.php

';

	# Write the .htaccess code to disk

	file_put_contents("./". APPLICATION_NAME ."/public/.htaccess", trim($zend_htaccess_code));

	

	

	# Delete the Downloaded Framework Directory and tar file

	passthru("rm -f ./". ZEND_FILE_NAME);

	passthru("rm -rf ./". basename(ZEND_FILE_NAME, ZEND_FILE_TYPE));

	

	passthru("clear");

	

	echo "\nZend Framework has been created... Done!\n\n";

}



?>

reverse linked list

nevadalife (nevada) — Sat, 23 Sep 2006 17:46:59 GMT

Reverse Linked list by reversing links for each node or swapping the nodes at each end.

a binary tree structure "PersistentTree"

jonasraoni (Jonas Raoni Soares Silva) — Sat, 02 Jul 2005 03:50:02 GMT

unit StreamAdapter.pas



//+ Jonas Raoni Soares Silva

//@ http://jsfromhell.com



unit StreamAdapter;



interface



uses

  Classes;



type

  IStream = interface( IInterface )

    ['{FBEF199A-09BC-4B61-89EA-1EF8B22C93A5}']

    function Read(var Buffer; const Count: Longint): Longint;

    function Write(const Buffer; const Count: Longint): Longint;

    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;

    procedure ReadBuffer(var Buffer; const Count: Longint);

    procedure WriteBuffer(const Buffer; const Count: Longint);

    function CopyFrom(Source: TStream; const Count: Int64): Int64;

    function WriteTo(Dest: TStream; const Count: Int64): Int64;



    procedure SetPosition( const Value: Int64 );

    procedure SetSize( const Value: Int64 );

    function GetPosition: Int64;

    function GetSize: Int64;



    property Position: Int64 read GetPosition write SetPosition;

    property Size: Int64 read GetSize write SetSize;

  end;



  TStreamAdapter = class( TInterfacedObject, IStream )

  private

    FStream: TStream;

    procedure SetPosition( const Value: Int64 );

    procedure SetSize( const Value: Int64 );

    function GetPosition: Int64;

    function GetSize: Int64;



  public

    constructor Create( Stream: TStream );

    destructor Destroy; override;



    function Read(var Buffer; const Count: Longint): Longint;

    function Write(const Buffer; const Count: Longint): Longint;



    procedure ReadBuffer(var Buffer; const Count: Longint);

    procedure WriteBuffer(const Buffer; const Count: Longint);



    function CopyFrom(Source: TStream; const Count: Int64): Int64;

    function WriteTo(Dest: TStream; const Count: Int64): Int64;



    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64;



    property Position: Int64 read GetPosition write SetPosition;

    property Size: Int64 read GetSize write SetSize;

  end;



implementation



{ TStreamAdapter }



function TStreamAdapter.CopyFrom(Source: TStream; const Count: Int64): Int64;

begin

  Result := FStream.CopyFrom( Source, Count );

end;



constructor TStreamAdapter.Create(Stream: TStream);

begin

  FStream := Stream;

end;



destructor TStreamAdapter.Destroy;

begin

  FStream.Free;

  inherited;

end;



function TStreamAdapter.GetPosition: Int64;

begin

  Result := FStream.Position;

end;



function TStreamAdapter.GetSize: Int64;

begin

  Result := FStream.Size;

end;



function TStreamAdapter.Read(var Buffer; const Count: Integer): Longint;

begin

  Result := FStream.Read( Buffer, Count );

end;



procedure TStreamAdapter.ReadBuffer(var Buffer; const Count: Integer);

begin

  FStream.ReadBuffer( Buffer, Count );

end;



function TStreamAdapter.Seek(const Offset: Int64;

  Origin: TSeekOrigin): Int64;

begin

  Result := FStream.Seek( Offset, Origin );

end;



procedure TStreamAdapter.SetPosition(const Value: Int64);

begin

  FStream.Position := Value;

end;



procedure TStreamAdapter.SetSize(const Value: Int64);

begin

  FStream.Size := Value;

end;



function TStreamAdapter.Write(const Buffer; const Count: Integer): Longint;

begin

  Result := FStream.Write( Buffer, Count );

end;



procedure TStreamAdapter.WriteBuffer(const Buffer; const Count: Integer);

begin

  FStream.WriteBuffer( Buffer, Count );

end;



function TStreamAdapter.WriteTo(Dest: TStream; const Count: Int64): Int64;

begin

  Result := Dest.CopyFrom( FStream, Count );

end;



end.

unit PersistentTree.pas



//+ Jonas Raoni Soares Silva

//@ http://jsfromhell.com



unit PersistentTree;



interface



uses

  Windows, Classes, SysUtils, StreamAdapter;



type

  EPersistentTree = class( Exception );



  TPersistentTree = class;



  TPersistentTreeClass = class of TPersistentTree;



  TPersistentTree = class( TStream )

  private

    FStream: IStream;

    FList: TList;

    FBaseClass: TPersistentTreeClass;

    FOwner, FParent: TPersistentTree;

    FOwnStream: Boolean;

    FDataFilename, FFilename: string;

    FLastPosition, FDataBegin, FDataLength: Int64;



    function GetItem(const Index: Integer): TPersistentTree;

    function GetCount: Integer;

    function GetStream: TStream;

    function Import( Item: TPersistentTree ): Boolean;

    procedure ClearData;

    procedure RecreateStream( const Pos: Int64; const Deep: Boolean = False );

    procedure Synchronize;



  protected

    //override to provide writing/reading notifications

    procedure Loaded; virtual;

    procedure Saving; virtual;



    //derived from TStream

    function GetSize: Int64; override;

    procedure SetSize(NewSize: Longint); override;

    procedure SetSize(const NewSize: Int64); override;



  public

    constructor Create; virtual;

    destructor Destroy; override;



    //derived from TStream

    function Read( var Buffer; Count: Longint ): Longint; override;

    function Write( const Buffer; Count: Longint ): Longint; override;

    function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; override;



    function Truncate: Int64;

    function ReadString: string;

    procedure WriteString( const Data: string );



    procedure Save( const AFilename: string ); overload;

    procedure Save( Stream: TStream ); overload;

    procedure Load( const AFilename: string ); overload;

    procedure Load( Stream: IStream ); overload;

    procedure Load( Stream: TStream ); overload;



    function Add: TPersistentTree; overload;

    function Add( Item: TPersistentTree ): Integer; overload;

    procedure Insert( const Index: Integer; Item: TPersistentTree);

    function IndexOf( Item: TPersistentTree ): Integer;

    function Remove( Item: TPersistentTree ): Integer;

    procedure Delete( const Index: Integer);

    function Extract( Item: TPersistentTree ): TPersistentTree;

    procedure Exchange( const IndexA, IndexB: Integer );

    procedure Move(const CurIndex, NewIndex: Integer);

    procedure Clear;



    property Items[ const Index: Integer ]: TPersistentTree read GetItem; default;

    property Count: Integer read GetCount;

    property Owner: TPersistentTree read FOwner;

    property Parent: TPersistentTree read FParent;

    property Filename: string read FFilename;

    property BaseClass: TPersistentTreeClass read FBaseClass write FBaseClass;

  end;



  TPersistentTreeHeader = packed record

    Sig: array[0..4] of Char;

    Ver: Word;

  end;



const

  PERSISTENT_TREE_HEADER: TPersistentTreeHeader = ( Sig: 'PTREE'; Ver: 1 );



function GetTempFile: string;





implementation



function GetTempFile: string;

var

  Path: array[0..MAX_PATH-1] of Char;

begin

  GetTempPath( MAX_PATH, Path );

  GetTempFileName( Path, 'BUF', 0, Path );

  Result := Path;

end;



{ TPersistentTree }



procedure TPersistentTree.Clear;

var

  I: Integer;

begin

  for I := FList.Count - 1 downto 0 do

  begin

    TPersistentTree( FList[I] ).Free;

    FList.Delete( I );

  end;

end;



constructor TPersistentTree.Create;

begin

  FBaseClass := TPersistentTreeClass( Self.ClassType );

  FList := TList.Create;

  FStream := TStreamAdapter.Create( GetStream );

  FOwnStream := True;

end;



destructor TPersistentTree.Destroy;

begin

  ClearData;

  FList.Free;

  inherited;

end;



procedure TPersistentTree.Exchange(const IndexA, IndexB: Integer);

begin

  FList.Exchange( IndexA, IndexB );

end;



function TPersistentTree.GetCount: Integer;

begin

  Result := FList.Count;

end;



function TPersistentTree.GetItem(const Index: Integer): TPersistentTree;

begin

  Result := FList[ Index ];

end;



function TPersistentTree.IndexOf(

  Item: TPersistentTree): Integer;

begin

  Result := FList.IndexOf( Item );

end;



procedure TPersistentTree.Load(const AFilename: string);

var

  FS: TFileStream;

  //Header: TPersistentTreeHeader;

begin

  FS := TFileStream.Create( AFilename, fmOpenRead or fmShareDenyWrite );

  try

    //FS.Read( Header, SizeOf( TPersistentTreeHeader ) );

    //if not CompareMem( @Header, @PERSISTENT_TREE_HEADER, SizeOf( TPersistentTreeHeader ) ) then

    //  raise EPersistentTree.CreateFmt( '%s.LoadFromFile :: "%s" Not Recognized', [ClassName, AFilename] );

    Load( FS );

    FFilename := AFilename;

  except

    FS.Free;

    raise;

  end;

end;



procedure TPersistentTree.Load(Stream: TStream);

begin

  Load( TStreamAdapter.Create( Stream ) );

end;



function TPersistentTree.Remove(Item: TPersistentTree): Integer;

begin

  Result := FList.Remove( Item );

  if Result >= 0 then

    Item.Free;

end;



procedure TPersistentTree.Save( const AFilename: string );

var

  FS: TFileStream;

begin

  FS := TFileStream.Create( AFilename, fmCreate or fmShareDenyWrite );

  try

    //FS.Write( PERSISTENT_TREE_HEADER, SizeOf( TPersistentTreeHeader ) );

    Save( FS );

  finally

    FS.Free;

  end;

end;



procedure TPersistentTree.Save(Stream: TStream);

var

  I: LongInt;

begin

  Seek( 0, soBeginning );

  Saving;



  FDataLength := Size;

  Stream.Write( FDataLength, SizeOf( FDataLength ) );

  Stream.CopyFrom( Self, 0 );



  I := FList.Count;

  Stream.Write( I, SizeOf( I ) );

  for I := 0 to FList.Count-1 do

    Self[I].Save( Stream );

end;



function TPersistentTree.Write( const Buffer; Count: Longint ): Longint;

begin

  if FOwnStream then

    Result := FStream.Write( Buffer, Count )

  else

  begin

    Synchronize;

    if Position + Count > Size then

      RecreateStream( Position );

    Result := FStream.Write( Buffer, Count );

    FLastPosition := FStream.Position;          

  end;



end;



function TPersistentTree.Read( var Buffer; Count: Longint): Longint;

begin

  if FOwnStream then

    Result := FStream.Read( Buffer, Count )

  else

  begin

    Synchronize;

    if Count < 0 then

      Count := 0

    else if Count > Size - Position then

      Count := Size - Position;

    Result := FStream.Read( Buffer, Count );

    FLastPosition := FStream.Position;

  end

end;



function TPersistentTree.Seek(const Offset: Int64;

  Origin: TSeekOrigin): Int64;

begin

  if FOwnStream then

    Result := FStream.Seek( Offset, Origin )

  else

  begin

    Synchronize;

    case Origin of

      soBeginning: Result := FDataBegin + Offset;

      soCurrent: Result := FStream.Position + Offset;

      soEnd: Result := FDataBegin + Size - Offset;

    else

      Result := 0;

    end;

    if Result > -1 then

      if Result <= FDataBegin + Size then

        Result := FStream.Seek( Result, soBeginning ) - FDataBegin

      else

      begin

        RecreateStream( Size );

        Result := FStream.Seek( Result, soBeginning );

      end;

    FLastPosition := FStream.Position;

  end;

end;



procedure TPersistentTree.SetSize(const NewSize: Int64);

begin

  if FOwnStream then

    FStream.Size := NewSize

  else begin

    if NewSize <= 0 then

      RecreateStream( 0 )

    else if NewSize > Size then

      RecreateStream( Size )

    else

    begin

      FDataLength := NewSize;

      Seek( 0, soEnd );

    end;

    FLastPosition := FStream.Position;

  end;

end;



procedure TPersistentTree.Synchronize;

begin

  if not FOwnStream and ( ( FStream.Position < FDataBegin ) or ( FStream.Position - FDataBegin > FDataLength ) ) then

    FStream.Seek( FLastPosition, soBeginning );

end;



procedure TPersistentTree.Load( Stream: IStream);

var

  I: LongInt;

begin

  ClearData;



  FStream := Stream;

  FOwnStream := False;



  Stream.Read( FDataLength, SizeOf( FDataLength ) );

  FDataBegin := FStream.Position;

  FLastPosition := FDataBegin;



  Stream.Seek( FDataLength, soCurrent );



  Stream.Read( I, SizeOf( I ) );

  for I := I - 1 downto 0 do

    Add.Load( FStream );



  //Seek( 0, soBeginning ); it isnt needed since synchonize will do it anyway

  Loaded;

  FStream.Seek( FDataBegin + FDataLength + SizeOf( I ), soBeginning );

end;



function TPersistentTree.Extract( Item: TPersistentTree): TPersistentTree;

begin

  Result := FList.Extract( Item );

  if Assigned( Result ) then begin

    Result.FParent := nil;

    Result.FOwner := nil;

    Result.RecreateStream( Size, True );

  end;

end;





function TPersistentTree.GetSize: Int64;

begin

  if FOwnStream then

    Result := FStream.Size

  else

    Result := FDataLength;

end;



procedure TPersistentTree.WriteString(const Data: string);

var

  I: LongWord;

begin

  I := Length( Data );

  Write( I, SizeOf( I ) );

  Write( Pointer( Data )^, I );

end;



function TPersistentTree.ReadString: string;

var

  I: LongWord;

begin

  Read( I, SizeOf( I ) );

  SetLength( Result, I );

  Read( Pointer( Result )^, I );

end;



procedure TPersistentTree.SetSize(NewSize: Integer);

begin

  SetSize( Int64( NewSize ) );

end;



procedure TPersistentTree.RecreateStream( const Pos: Int64; const Deep: Boolean );

var

  FS: TStream;

  I: Integer;

begin

  if not FOwnStream then

  begin

    FS := GetStream;

    if Pos > 0 then

    begin

      Seek( 0, soBeginning );

      FS.CopyFrom( Self, Pos );

    end;

    FStream := TStreamAdapter.Create( FS );

    FOwnStream := True;

  end;

  if Deep then

    for I := 0 to FList.Count - 1 do

      Self[I].RecreateStream( Self[I].Size, True );

end;



procedure TPersistentTree.ClearData;

begin

  FStream := nil;

  if FOwnStream then

    DeleteFile( FDataFilename );

  Clear;

end;



function TPersistentTree.GetStream: TStream;

begin

  FDataFilename := GetTempFile;

  Result := TFileStream.Create( FDataFilename, fmCreate or fmShareDenyWrite );

end;



function TPersistentTree.Add: TPersistentTree;

begin

  Result := TPersistentTreeClass( FBaseClass ).Create;

  Add( Result );

end;



function TPersistentTree.Add( Item: TPersistentTree): Integer;

begin

  if Import( Item ) then

    Result := FList.Add( Item )

  else

    Result := FList.IndexOf( Item );

end;



procedure TPersistentTree.Delete(const Index: Integer);

begin

  TPersistentTree( FList[Index] ).Free;

  FList.Delete( Index );

end;



procedure TPersistentTree.Insert(const Index: Integer; Item: TPersistentTree);

begin

  if Import( Item ) then

    FList.Insert( Index, Item )

  else

    FList.Move( FList.IndexOf( Item ), Index );

end;



procedure TPersistentTree.Move(const CurIndex, NewIndex: Integer);

begin

  FList.Move( CurIndex, NewIndex );

end;



function TPersistentTree.Truncate: Int64;

begin

  Result := Position;

  Size := Result;

end;



function TPersistentTree.Import(Item: TPersistentTree): Boolean;

begin

  Result := not Assigned( Item.FParent ) or ( ( Item.FParent <> Self ) and Assigned( Item.FParent.Extract( Item ) ) );

  if Result then

  begin

    Item.FParent := Self;

    if FOwner <> nil then

      Item.FOwner := FOwner

    else

      Item.FOwner := Self;

  end;

end;



procedure TPersistentTree.Saving;

begin

//override to provide extra save features

end;



procedure TPersistentTree.Loaded;

begin

//override to provide extra load features

end;



end.