package Set::Infinite;

# Copyright (c) 2001 Flavio Soibelmann Glock. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

require 5.005_62;
use strict;
use warnings;

require Exporter;
# use AutoLoader qw(AUTOLOAD);
use Carp;

our @ISA = qw(Exporter);

# This allows declaration	use Set::Infinite ':all';
our %EXPORT_TAGS = ( 'all' => [ qw(type inf new ) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } , qw(type inf new ) );
our @EXPORT = qw();

our $VERSION = '0.32';

our $TRACE = 0;  	# basic trace method execution
our $DEBUG_BT = 0; 	# backtrack tracer

# Preloaded methods go here.

use Set::Infinite::Simple qw(
	infinite minus_infinite separators null inf
); 

our $type = '';
our $tolerance = 0;

sub inf();
sub infinite();
sub minus_infinite();
sub null();

our $too_complex = "Too complex";
our $backtrack_depth = 0;
our $max_backtrack_depth = 10;

use overload
	# '@{}' => \&{ 
	#	return () unless $#_ >= 0;
	#	print " [\@:$_[0]:",caller,":", ref(\$_[0]), "] "; 
	#	# return () if ref(\$_[0]) eq 'SCALAR'; # ???
	#	# return () unless exist $_[0]->{list};
	#	return compact_array($_[0]->{list});
	# },
	'<=>' => \&spaceship,
	qw("" as_string),
;

sub type {
	# this is still a hack - waiting for better ideas
	my $tmp_type = pop;
	my $self = shift || __PACKAGE__;

	# print " [TYPE:$tmp_type -- $self] \n";

	if (defined($tmp_type) and ($tmp_type ne '')) {
		if (ref($self)) {
			# local
			$self->{type} = $tmp_type;
		}
		else {
			# global
			$type = $tmp_type;
		}
		eval "use " . $tmp_type; 
		carp "Warning: can't start $tmp_type : $@" if $@;
 	}
	return $self;
}

sub list {
	my $self = shift;
	my $class = ref($self);
	my @b = ();
	foreach (@{$self->{list}}) {
		push @b, $class->new($_);
	}
	return @b;
}

sub compact {
	my $self = shift;
	my $class = ref($self);

	my $b = $class->new();
	if ($self->{too_complex}) {
		$self->trace(title=>"compact:backtrack"); 
		# print " [compact:backtrack] \n" if $DEBUG_BT;
		$b->{too_complex} = 1;
		$b->{parent} = $self;
		$b->{method} = 'compact';
		$b->{param}  = \@_;
		return $b;
	}
	foreach (@{$self->{list}}) {
		unless ( Set::Infinite::Element_Inf::is_null($_->{a}) ) {
			push @{$b->{list}}, $_;
		}
	}
	$b->{cant_cleanup} = 1; 
	return $b;
}

sub trace { # title=>'aaa'
	return shift unless $TRACE;
	my ($self, %parm) = @_;
	my @caller = caller(1);
	# my $nothing = "$self";
	print " [",$caller[1],":",$caller[2]," \"$parm{title}\" $self ]\n" if $TRACE == 1;
	print " [",sprintf("%4d", $caller[2]),": \"$parm{title}\" ]\n" if $TRACE == 2;
	return $self;
}

sub quantizer { return @_ }   # 'selector, offsetter, quantizer' are obsolete after 0.25

use Set::Infinite::Quantize_Date;
use Set::Infinite::Function; 	# ???
use Set::Infinite::Select;   	# ???
use Set::Infinite::Offset;   	# ???

# quantize: splits in same-size subsets

sub quantize {
	my $self = shift;
	my $class = ref($self);

	# $self->trace(title=>"quantize"); 

	if (($self->{too_complex}) or ($self->min == -&inf) or ($self->max == &inf)) {
		$self->trace(title=>"quantize:backtrack"); 
		# print " [quantize:backtrack] \n" if $DEBUG_BT;
		my $b = $class->new();
		$b->{too_complex} = 1;
		$b->{parent} = $self;
		$b->{method} = 'quantize';
		$b->{param}  = \@_;
		return $b;
	}

	$self->trace(title=>"quantize"); 
	my (@a);
	my %param = @_;
	my @a2;

	# my $quantizer = $self->quantizer or quantizer;
	my $quantizer = 'Set::Infinite::Quantize_Date';
	# print " [QUANT:$quantizer] \n";

	# print " [INF:QUANT ",@_,",$self]\n";
	tie @a, $quantizer, $self, %param;

	# array output: can be used by "foreach"
	# v.029 -- intersection($b->offset) gets wantarray !
	#   if (wantarray) { return compact_array($class, @a); }
	# print " [QUANT:no_ARRAY] ";

	my $b = $class->new();    	# $self); # clone myself

	# if ($param{compact}) {
	#	# print " [COMPACT] ";
	#	@a2 = compact_array($class, @a);
	#	$b->{list} = \@a2;
	#}
	# else {

	$b->{list} = \@a;    	# change data

	# }
	
	# object output: can be further "intersection", "union", etc.
	$b->{cant_cleanup} = 1; 	# quantize output is "virtual" (tied) -- can't splice, sort

	# print " [QUANT:returns:",ref($b),"] \n";
	return $b;
}


# select: position-based selection of subsets

sub select {
	my $self = shift;
	my $class = ref($self);

	$self->trace(title=>"select");

	if ($self->{too_complex}) {
		my $b = $class->new();
		$b->{too_complex} = 1;
		$b->{parent} = $self;
		$b->{method} = 'select';
		$b->{param}  = \@_;
		return $b;
	}

	my (@a);
	my %param = @_;
	my @a2;

	# my $array_ref = shift;
	my $tmp = 'Set::Infinite::Select';  # $self->{list}->[0]->selector or selector;
	# print " [INF:SELECT $tmp,",@_,",$self FROM:", $self->{list}->[0],"]\n";
	tie @a, $tmp, $self, %param;

	# array output: can be used by "foreach"
	# if (wantarray) { print " [wantarray] " }
	# return @a if wantarray; 
	# v.029 -- intersection($b->offset) gets wantarray !
	#   return compact_array($class, @a) if wantarray; 
	
	my $b = $class->new();    	# $self); # clone myself

	# if ($param{compact}) {
	#	# print " [COMPACT] ";
	#	@a2 = compact_array($class, @a);
	#	$b->{list} = \@a2;
	#}
	# else {

	$b->{list} = \@a;    	# change data

	# }

	# object output: can be further "intersection", "union", etc.
	# my $b = $class->new(); # $self); # clone myself
	# $b->{list} = \@a; 	# change data

	$b->{cant_cleanup} = 1; 	# select output is "virtual" (tied) -- can't splice, sort
	return $b;
}

# offset: offsets subsets
sub offset {
	my $self = shift;
	my $class = ref($self);

	$self->trace(title=>"offset");

	if ($self->{too_complex}) {
		my $b = $class->new();
		$b->{too_complex} = 1;
		$b->{parent} = $self;
		$b->{method} = 'offset';
		$b->{param}  = \@_;
		return $b;
	}

	my (@a);
	my %param = @_;
	my @a2;

	# my $array_ref = shift;
	my $tmp = 'Set::Infinite::Offset';   # $self->{list}->[0]->offsetter or offsetter;
	# print " [INF:OFFSET $tmp,",$self,",",join(",",@_),"]\n";
	tie @a, $tmp, $self, %param;

	# print " [ofs]\n";

	# array output: can be used by "foreach"
	# v.029 -- intersection($b->offset) gets wantarray !
	#   return compact_array($class, @a) if wantarray; 

	my $b = $class->new();    	# $self); # clone myself

	# if ($param{compact}) {
	#	# print " [COMPACT] ";
	#	@a2 = compact_array($class, @a);
	#	$b->{list} = \@a2;
	#}
	# else {

	$b->{list} = \@a;    	# change data

	# }

	# print " [ofs:", join(' - ', @a), " ]\n";
	# object output: can be further "intersection", "union", etc.
	# my $b = $class->new();  # $self); # clone myself
	# $b->{list} = \@a;   	# change data

	$b->{cant_cleanup} = 1; 	# offset output is "virtual" (tied) -- can't splice, sort
	return $b;
}


sub is_null {
	my $self = shift;
	return 1 unless $#{$self->{list}} >= 0;
	return 1 if Set::Infinite::Element_Inf::is_null($self->{list}->[0]->{a});
	return 0;
	# return ("$self" eq null) ? 1 : 0;
}

sub backtrack {
	#
	#  NOTICE: set/reset $DEBUG_BT to enable debugging
	#

	$backtrack_depth++;

	if ($backtrack_depth > $max_backtrack_depth) {
		carp (__PACKAGE__ . ": Backtrack too deep (more than " . $max_backtrack_depth . " levels)");
	}

	# print " [BT:depth=",$backtrack_depth,"] \n";
	print " [BT$backtrack_depth-0:",join(";",@_),"] \n" if $DEBUG_BT;

	my ($self, $method, $arg) = @_;

	my $result;

	print " [bt$backtrack_depth-0-1:self=",join(";",%{$self}),"] \n" if $DEBUG_BT;
	# print " [bt$backtrack_depth-1:caller:",join(";",caller),"] \n" if $DEBUG_BT;
	# print " [bt$backtrack_depth-2:parent:",ref($self->{parent})," -- ",join(";",%{$self->{parent}}),"] \n" if $self->{parent} and not (ref($self->{parent}) eq 'ARRAY');

	if ($self->{too_complex}) {
		# print " [bt$backtrack_depth-3:complex:a,b] \n";

		if (ref($self->{parent}) eq 'ARRAY') {
			# has 2 parents (intersection, union, ...)
			# data structure: {method} - method name, {parent} - array, parent list

			# print " [bt$backtrack_depth-3.5:complex: 2-PARENTS ] \n";

			my $result1 = $self->{parent}[0];
			$result1 = $result1->backtrack($method, $arg) if $result1->{too_complex};
			# print " [bt$backtrack_depth-3-6:res1:$result] \n";
			my $result2 = $self->{parent}[1];
			$result2 = $result2->backtrack($method, $arg) if $result2->{too_complex};
			# print " [bt$backtrack_depth-3-7:res2:$result] \n";

			# apply {method}
			# my $expr = 'return $result1->' . $self->{method} . '($result2)';
			# print " [bt$backtrack_depth-3-8:expr: $result1 -- ",$self->{method}," -- $result2 ]\n";

			# $result = $self->intersection($arg);
			# $result = eval $expr;
			# print " [bt$backtrack_depth-3-9:RESULT ",ref($result), "=",join(";",%{$result}),"] \n";
			# print " [bt$backtrack_depth-3-10:end:res:$expr = $result] \n";

			my $the_method = eval '\&' . $self->{method};
			# print "\n\n<eval-2 method:$self->{method} - $the_method \n\n";
			$result = &{$the_method} ($result1, $result2);
			# print "\n\n/eval-2> \n\n";

			$backtrack_depth--;
			return $result;
		}
		# else

			# has 1 parent and parameters (offset, select, quantize)
			# data structure: {method} - method name, {param} - array, param list

			print " [bt$backtrack_depth-3-05: 1-PARENT ] \n" if $DEBUG_BT;
			my $result1 = $self->{parent};
			my @param = @{$self->{param}};
			my $my_method = $self->{method};

			my $backtrack_arg2;

			# print " [bt$backtrack_depth-3-06:res1:before_backtrack:$result1] \n";

			# $backtrack_arg must be modified second to method and param
			print " [bt$backtrack_depth-3-08:BEFORE:$arg;" . $my_method . ";",join(";",@param),"] \n" if $DEBUG_BT;
 
			# default
			# $backtrack_arg2 = $arg;

			# quantize - apply quantization without modifying
			if ($my_method eq 'quantize') {

				# -----------------------
				# (TODO) ????

				if (($arg->{too_complex}) or ($arg->min == -&inf) or ($arg->max == &inf)) {
					$backtrack_arg2 = $arg;
				}
				else {
					$backtrack_arg2 = $arg->quantize(@param, strict=>0); # span/union
				}

				# $backtrack_arg2 = $arg;

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

			}
			# offset - apply offset with negative values
			elsif ($my_method eq 'offset') {

				# -----------------------
				# (TODO) ????

				my %tmp = @param;

				#	unless (ref($tmp{value}) eq 'ARRAY') {
				#		$tmp{value} = [0 + $tmp{value}, 0 + $tmp{value}];
				#	}
				#	# $tmp{value}[0] = - $tmp{value}[0]; -- don't do this!
				#	# $tmp{value}[1] = - $tmp{value}[1]; -- don't do this!

				$backtrack_arg2 = $arg->offset( unit => $tmp{unit}, mode => $tmp{mode}, value => [- $tmp{value}[0], - $tmp{value}[-1]] );

				# $backtrack_arg2 = $arg;
			}
			# select - check "by" behaviour
			else {    # if ($my_method eq 'select') {

				# -----------------------
				# (TODO) ????
				# see: 'BIG, negative select' in backtrack.t

				$backtrack_arg2 = $arg;

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

			}

			print " [bt$backtrack_depth-3-10:AFTER:$backtrack_arg2;" . $my_method . ";",join(";",@param),"] \n" if $DEBUG_BT;
			# print " [bt$backtrack_depth-3-11:  WAS:$arg] \n";

			$result1 = $result1->backtrack($method, $backtrack_arg2); # if $result1->{too_complex};
			# print " [bt$backtrack_depth-3-12:res1:after_backtrack:$result1] \n";
			# apply {method}
			my $expr = 'return $result1->' . $self->{method} . '(@param)';
			# print " [bt$backtrack_depth-3-14:expr: $result1 -- ",$self->{method}," -- $result2 ]\n";
			print " [bt$backtrack_depth-3-15:expr: $expr ; param: ", @param,"]\n" if $DEBUG_BT;
			# $result = $self->intersection($arg);

			my $the_method = eval '\&' . ref($result1) . '::' . $self->{method};
			# print "\n\n<eval-1 method:$self->{method} - $the_method \n\n";
			$result = &{$the_method} ($result1, @param);
			# print "\n\n/eval-1> \n\n";

			# $result = eval $expr;

			print " [bt$backtrack_depth-3-19:RESULT ",ref($result), "=",join(";",%{$result}),"=$result] \n" if $DEBUG_BT;
			# print " [bt$backtrack_depth-3-22:  WAS:$arg] \n";
			# print " [bt$backtrack_depth-3-25:end:res:$expr = $result] \n";
			$backtrack_depth--;
			return $result;

	}

	# change the root parameter

	# my $expr = '$result = $self->' . $method . '($arg)';
	# $expr .= '; print "$arg"; ';
	# print " [bt$backtrack_depth-5:expr: $self -- $method -- $arg ]\n";
	# eval "$expr";

	# my $expr = 'return $self->' . $method . '($arg)';
	# print " [bt$backtrack_depth-6:expr: $self -- $method -- $arg ]\n";
	# $result = $self->intersection($arg);
	# $result = eval $expr;
	# print " [bt$backtrack_depth-6.5:RESULT ",ref($result), "=",join(";",%{$result}),"] \n";
	# print " [bt$backtrack_depth-7:end:res:$expr = $result] \n";

	my $the_method = eval '\&' . $method;
	# print "\n\n<eval-0 method:$method - $the_method \n\n";
	$result = &{$the_method} ($self, $arg);
	# print "\n\n/eval-0> \n\n";

	$backtrack_depth--;
	return $result;
}

sub intersects {
	my $a = shift;
	my $class = ref($a);
	my $b;
	#my @param = @_;
	#my $b = $class->new(@param); 

	# print " [I:", ref ($_[0]), "] ";
	if (ref ($_[0]) eq 'Set::Infinite::Simple') {
		# optimized for "quantize"
		$a->trace(title=>"intersects:simple");
		# print "*";
		# print " n:", $#{$a->{list}}, "=$a ";
		$b = shift;
		foreach my $ia (0 .. $#{$a->{list}}) {
			return 1 if $a->{list}->[$ia]->intersects($b);
		}
		return 0;	
	} 
	elsif (ref ($_[0]) eq $class) {
		$b = shift;
	} 
	else {
		# my @param = @_;
		$b = $class->new(@_);  
	}

	$a->trace(title=>"intersects");
	# print "-";

	if ($a->{too_complex}) {
		print " [inter:complex:a] \n" if $DEBUG_BT;
		$a = $a->backtrack('intersection', $b);
		# print " [int:WAS:b:", $b, "--",ref($b),"] \n";
	}  # don't put 'else' here
	if ($b->{too_complex}) {
		print " [inter:complex:b] \n" if $DEBUG_BT;
		$b = $b->backtrack('intersection', $a);
	}

	if (($a->{too_complex}) or ($b->{too_complex})) {
		print " [inter:backtrack] \n" if $DEBUG_BT;
		my $intersection = $class->new();
		$intersection->{too_complex} = 1;
		$intersection->{parent} = [$a, $b];
		$intersection->{method} = 'intersects';
		return $intersection;
	}


	my ($ia, $ib);
	my ($na, $nb) = (0,0);
	# my $intersection = $class->new();
	B: foreach $ib ($nb .. $#{$b->{list}}) {
		foreach $ia ($na .. $#{$a->{list}}) {
			#next B if Set::Infinite::Element_Inf::is_null($a->{list}->[$ia]->{a});
			#next B if Set::Infinite::Element_Inf::is_null($b->{list}->[$ib]->{a});
		#	if ( $a->{list}->[$ia]->{a} > $b->{list}->[$ib]->{b} ) {
		#		$na = $ia;
		#		next B;
		#	}
			# next B if ($a->{list}->[$ia]->{a} > $b->{list}->[$ib]->{b}) ;
			return 1 if $a->{list}->[$ia]->intersects($b->{list}->[$ib]);
		}
	}
	return 0;	
}

sub iterate {

	# TODO: options 'no-sort', 'no-merge', 'keep-null' ...

	my $a = shift;
	my $class = ref($a);
	my $iterate = $class->new();

	# print " [iterate ",$a,"--",ref($a)," from ", caller, "] \n";

	if ($a->{too_complex}) {
		$a->trace(title=>"iterate:backtrack");
		# print " [iterate:backtrack] \n" if $DEBUG_BT;
		$iterate->{too_complex} = 1;
		$iterate->{parent} = $a;
		$iterate->{method} = 'iterate';
		$iterate->{param} = \@_;
		return $iterate;
	}

	$a->trace(title=>"iterate");

	my ($tmp, $ia);
	my $subroutine = shift;
	foreach $ia (0 .. $#{$a->{list}}) {
		# print " [iterate:$a->{list}->[$ia] -- $subroutine ]\n";
		$tmp = &{$subroutine} ( $class->new($a->{list}->[$ia]) );
		# print " [iterate:result:$tmp]\n";
		$iterate = $iterate->union($tmp) unless Set::Infinite::Element_Inf::is_null($tmp); 
	}
	return $iterate;	
}

sub intersection {
	my $a = shift;
	my $class = ref($a);
	my $b;

	$a->trace(title=>"intersection");

	if (ref ($_[0]) eq $class) {
		$b = shift;
		# print " [inter:as_is] \n";
	} 
	else {
		# my @param = @_;
		# print " [inter:isa:",ref($_[0])," (",$class,")] \n";
		$b = $class->new(@_);  
		# print " [inter:isa:",ref($b)," (",$class,")] \n";
	}

	# my @param = @_;
	# my $b = $class->new(@param);

	my $tmp;
	# print " [intersect ",$a,"--",ref($a)," with ", $b, "--",ref($b)," ", caller, "] \n";

	if ($a->{too_complex}) {
		print " [inter:complex:a] \n" if $DEBUG_BT;
		$a = $a->backtrack('intersection', $b);
		# print " [int:WAS:b:", $b, "--",ref($b),"] \n";
	}  # don't put 'else' here
	if ($b->{too_complex}) {
		print " [inter:complex:b] \n" if $DEBUG_BT;
		$b = $b->backtrack('intersection', $a);
	}

	if (($a->{too_complex}) or ($b->{too_complex})) {
		print " [inter:backtrack] \n" if $DEBUG_BT;
		my $intersection = $class->new();
		$intersection->{too_complex} = 1;
		$intersection->{parent} = [$a, $b];
		$intersection->{method} = 'intersection';
		return $intersection;
	}

	# print " [intersect ",$a,"--",ref($a)," with ", $b, "--",ref($b)," ", caller, "] \n";

	my ($ia, $ib);
	my ($na, $nb) = (0,0);
	my $intersection = $class->new();
	B: foreach $ib ($nb .. $#{$b->{list}}) {
		foreach $ia ($na .. $#{$a->{list}}) {
			#	my ($pa, $pb) = ($a->{list}->[$ia], $b->{list}->[$ib]);
			# print " [intersect ",$ia,"--",$ib," ]\n";
			# print " [intersect   ",$pa,"--",$pb," ]\n";
			# print " [intersect     ",%{$a->{list}->[$ia]},"--",%{$b->{list}->[$ib]}," ]\n";
			#next B if Set::Infinite::Element_Inf::is_null($pa->{a});
			#next B if Set::Infinite::Element_Inf::is_null($pb->{a});
			#	if ( $pa->{a} > $pb->{b} ) {
			#		$na = $ia;
			#		next B;
			#	}
			# print "   [intersect_simple ",$a->{list}->[$ia]," with ", $b->{list}->[$ib], "] \n";
			# unless ($a->{list}->[$ia]->is_null) {

			$tmp = $a->{list}->[$ia]->intersection($b->{list}->[$ib]);
			push @{$intersection->{list}}, $tmp unless Set::Infinite::Element_Inf::is_null($tmp->{a}); # ->{a},$tmp->{b}) if $tmp;

			# $intersection->add($tmp) if defined($tmp); # ->{a},$tmp->{b}) if $tmp;
			# }
		}
	}
	return $intersection;	
}

sub complement {
	my $self = shift;
	my $class = ref($self);

	$self->trace(title=>"complement");

	# do we have a parameter?

	if (@_) {

		if (ref ($_[0]) eq $class) {
			$a = shift;
		} 
		else {
			$a = $class->new(@_);  
			$a->tolerance($self->{tolerance}) if $self->{tolerance};
		}

		$a = $a->complement;
		# print " [CPL:intersect ",$self," with ", $a, "] ";
		return $self->intersection($a);
	}

	my ($ia);
	my $tmp;

	# print " [CPL:",$self,"] ";

	if (($#{$self->{list}} < 0) or (not defined ($self->{list}))) {
		return $class->new(minus_infinite, infinite);
	}

	my $complement = $class->new();
	my @tmp = $self->{list}->[0]->complement;
	# print " [CPL:ADDED:",join(";",@tmp),"] ";

	#foreach(@tmp) {
	# 	$complement->add($_); 
	#}
	push @{$complement->{list}}, @tmp; 

	foreach $ia (1 .. $#{$self->{list}}) {
			@tmp = $self->{list}->[$ia]->complement;
			$tmp = $class->new();
			# foreach(@tmp) { $tmp->add($_); }
			push @{$tmp->{list}}, @tmp; 

			$complement = $complement->intersection($tmp); # if $tmp;
	}

	# print " [CPL:RES:",$complement,"] ";

	return $complement;	
}

# version 0.22.02 - faster union O(n*n) => O(n)
# version 0.30 - sends tolerance
sub union {
	my $a = shift;
	my $class = ref($a);
	my $b;

	$a->trace(title=>"union");

	# print " [UNION] \n";
	# print " [union: new b] \n";
	if (ref ($_[0]) eq $class) {
		$b = shift;
	} 
	else {
		$b = $class->new(@_);  
	}

	if (($a->{too_complex}) or ($b->{too_complex})) {
		print " [union:backtrack] \n" if $DEBUG_BT;
		my $union = $class->new();
		$union->{too_complex} = 1;
		$union->{parent} = [$a, $b];
		$union->{method} = 'union';
		return $union;
	}

	# print " [union: new union] \n";
	# print "\n [union: $a +\n       $b ] \n";
	$a = $class->new($a);
	# print " [union: $a +\n       $b ] \n";
	my ($ia, $ib);
	$ia = 0;
	$ib = 0;
	my $b_list = $b->{list};
	B: foreach $ib ($ib .. $#{$b->{list}}) {
		foreach $ia ($ia .. $#{$a->{list}}) {
			# $self->{list}->[$_ - 1] = $tmp[0];
			# splice (@{$self->{list}}, $_, 1);

			my @tmp = $a->{list}->[$ia]->union($b_list->[$ib], $a->{tolerance});
			# print " [+union: $tmp[0] ; $tmp[1] ] \n";

			if ($#tmp == 0) {
					$a->{list}->[$ia] = $tmp[0];
					next B;
			}

			# print " [union:index-a: ($ia .. ", $#{$a->{list}}, ")  \n";
			# print " [union:index-b: ($ib .. ", $#{$b_list}, ")  \n";
			# print "  a -- ($a->{list}->[$ia]->{a} >= \n";
			# print "  b -- $b_list->[$ib] ref=",ref($b_list->[$ib])," => ",join(" - ", %{$b_list->[$ib]}),"\n";
			my %hash = %{$b_list->[$ib]};
			# print "    -- $hash{a} ]\n";
			# print "    -- $b_list->[$ib]->{a} ]\n";

			# this doesn't always work -- use a temp variable instead:  if ($a->{list}->[$ia]->{a} >= $b->{list}->[$ib]->{a}) 
			if ($a->{list}->[$ia]->{a} >= $hash{a}) 
			{
				# print "+ ";
				# splice(@array,$index,0,$value)
				splice (@{$a->{list}}, $ia, 0, $b_list->[$ib]);
				# $a->add($b->{list}->[$ib]);
				next B;
			}

		}
		# print "- ";
		# $a->add($b->{list}->[$ib]);
		push @{$a->{list}}, $b_list->[$ib];
	}
	# print " [union: done from ", join(" ", caller), " ] \n";
	# print " [union: result = $a ] \n";
	# $a->{cant_cleanup} = 1;

	#	foreach $ia (0 .. $#{$a->{list}}) {
	#		my @tmp = $a->{list}->[$ia];
	#		print " #", $ia, ": ", $a->{list}->[$ia], " is ", join(" ", %{$a->{list}->[$ia]} ) , "\n";
	#	}
	# print " [union: is ", join(" ", %$a) , " ] \n";

	return $a;	
}

sub contains {
	my $a = shift;
	$a->trace(title=>"contains");
	return ($a->union(@_) == $a) ? 1 : 0;
}

sub add {
	my ($self) = shift;
	my $class = ref($self);
	my @param = @_;

	#print " [I:ADD] ";
LOOP:
		my $tmp = shift @param;
		return $self unless defined($tmp);

		# is it an array?
		# print " [INF:ADD:",ref($tmp),"=$tmp ; ",@param,"]\n";
		if (ref($tmp) eq 'ARRAY') {
			my @tmp = @{$tmp};

	
			# print " INF:ADD:ARRAY:",@tmp," ";

			# Allows arrays of arrays
			$tmp = $class->new(@tmp) ;
			foreach (@{$tmp->{list}}) {
				push @{ $self->{list} }, Set::Infinite::Simple->new($_) ;
			}
			goto LOOP;
		}
		# does it have a "{list}"?
		elsif ((ref(\$tmp) eq 'REF')) {
			if (($tmp->isa(__PACKAGE__))) {   # and defined ($tmp->{list})) {
				# print " INF:ADD:",__PACKAGE__,":",$tmp," ";
				foreach (@{$tmp->{list}}) {
					push @{ $self->{list} }, Set::Infinite::Simple->new($_) ;
				}
				goto LOOP;
			}
			# does it have a "{a},{b}"?
			elsif (($tmp->isa("Set::Infinite::Simple")) ) {  # and (not $tmp->is_null)) {
				# print " INF:ADD:SIMPLE:",__PACKAGE__,":",$tmp," ";
				push @{ $self->{list} }, Set::Infinite::Simple->new($tmp) ;
				# print " INF:ADD:SIMPLE:",__PACKAGE__,":",@{ $self->{list} }," \n";
				goto LOOP;
			}
		}
		# else {
			my $tmp2 = shift @param;
			#print " [NEW] " ;

			$tmp = Set::Infinite::Simple->new($tmp,$tmp2, $self->{type} );
			push @{ $self->{list} }, $tmp;

			goto LOOP;
		# }

	return $self;
}

sub min { 
	my ($self) = shift;
	my $tmp;

	$self->trace(title=>"min"); 

	foreach(@{$self->{list}}) {
		# print " <min-$_: ";
		# print "    ", ref($_), " \n";
		# print "    $_->{a} \n";
		$tmp = $_->{a};
		# print " :$tmp /min> ";
		return $tmp unless Set::Infinite::Element_Inf::is_null($tmp) ;
	}
	# print " min:null /min> ";
	return Set::Infinite::Element_Inf::null;  
};

sub max { 
	my ($self) = shift;
	my $tmp;
	my $i;
	my $tmp_ptr;  # perl bug? too deep

	$self->trace(title=>"max"); 

	for($i = $#{$self->{list}}; $i >= 0; $i--) {
		$tmp_ptr = $self->{list}->[$i];
		$tmp = $tmp_ptr->{b};
		#print "max:$tmp ";
		return $tmp unless Set::Infinite::Element_Inf::is_null($tmp) ;
	}
	return Set::Infinite::Element_Inf::null; 
};

sub size { 
	my ($self) = shift;
	my $tmp;
	# $self->cleanup;
	# print " [INF:SIZE:$self->{list}->[0]->{b} - $self->{list}->[0]->{a} ] \n";
	my $size = $self->{list}->[0]->{b} - $self->{list}->[0]->{a};
	foreach(1 .. $#{$self->{list}}) {
		$tmp = $self->{list}->[$_]->{b} - $self->{list}->[$_]->{a};
		$size += $tmp;
	}
	return $size; 
};

sub span { 
	my ($self) = shift;
	my $class = ref($self);
	return $class->new($self->min, $self->max);
};

sub spaceship {
	my ($tmp1, $tmp2, $inverted) = @_;
	my $class = ref($tmp1);

	if ($inverted) {
		if (ref ($tmp1) ne $class) {
			$tmp1 = $class->new($tmp1);  
		}
		($tmp2, $tmp1) = ($tmp1, $tmp2);
	}
	else {
		if (ref ($tmp1) ne $class) {
			$tmp2 = $class->new($tmp2);  
		}
	}

	return $tmp1->min  <=> $tmp2->min  if ($tmp1->min  != $tmp2->min);
	return $tmp1->size <=> $tmp2->size if ($tmp1->size != $tmp2->size);
	return $#{$tmp1->{list}} <=> $#{$tmp2->{list}} if $#{$tmp1->{list}} != $#{$tmp2->{list}};
	foreach(0 .. $#{$tmp1->{list}}) {
		my $this  = $tmp1->{list}->[$_];
		my $other = $tmp2->{list}->[$_];
		return $this <=> $other if $this != $other;
	}
	return 0;
}

sub no_cleanup {
	my ($self) = shift;
	$self->{cant_cleanup} = 1; 
	return $self;
}

sub cleanup {
	my ($self) = shift;
	return $self if $self->{cant_cleanup}; 	# quantize output is "virtual", can't be cleaned
	# print " [cleanup] ";

	# $self->tolerance($self->{tolerance});	# ???

	# my $debug_optimize = __PACKAGE__->new($self);

	# removed in version 0.22.02 after deprecating "add"
	# @{ $self->{list} } = sort @{ $self->{list} };

	$_ = 1;
	while ( $_ <= $#{$self->{list}} ) {
		my @tmp = $self->{list}->[$_]->union($self->{list}->[$_ - 1], $self->{tolerance});
		if ($#tmp == 0) {
			$self->{list}->[$_ - 1] = $tmp[0];
			splice (@{$self->{list}}, $_, 1);
		} 
		else {
			$_ ++;
		}
	}

	# if (join("",@{$debug_optimize->{list}}) ne join("",@{$self->{list}})) {
	#  	print " [CLEANUP:", join(" ",@{$debug_optimize->{list}}), "\n";
	# }

	return $self;
}


#-------- tolerance, integer, real

sub tolerance {
	my $tmp = pop;
	my $self = shift;
	if (ref($self)) {  
		# local
		$self->{tolerance} = $tmp if ($tmp ne '');
		return $self;
	}
	# global
	$tolerance = $tmp if defined($tmp) and ($tmp ne '');
	return $tolerance;
}

sub integer {
	if (@_) {
		my ($self) = shift;
		$self->tolerance (1);
		return $self;
	}
	return tolerance(1);
}

sub real {
	if (@_) {
		my ($self) = shift;
		$self->tolerance (0);
		return $self;
	}
	return tolerance(0);
}


sub new {
	my $class = shift;
	my ($self) = bless {}, $class;
	@{ $self->{list} } = ();

	$self->trace(title=>"new");

	# print " [INF:new:", ref($self)," - ", join(' - ', caller), " ]\n"; # if $TRACE;
	$self->{tolerance} = $tolerance if $tolerance;
	$self->{type} = $type if $type;
	# print " [INF:new:$class ", $tolerance, " ",$type," ",$self->{tolerance}," ",$self->{type}," ]\n"; 
	$self->add(@_);
	return $self;
}

sub as_string {
	my ($self) = shift;
	if ($self->{too_complex}) {
		return $too_complex;
	}
	$self->cleanup;
	# print " [s] ";
	return null unless $#{$self->{list}} >= 0;
	return join(separators(5), @{ $self->{list} } );
}

1;
__END__

=head1 NAME

Set::Infinite - Sets of intervals

=head1 SYNOPSIS

  use Set::Infinite;

  $a = Set::Infinite->new(1,2);
  print $a->union(5,6);

=head1 DESCRIPTION

Set::Infinite is a Set Theory module for infinite sets. 

It works on reals or integers.
You can provide your own objects or let it make them for you
using the `type'.

It works very well on dates, providing schedule checks (intersections)
and unions.

=head2 EXPORT

None by default.

=head1 USAGE

	$a = Set::Infinite->new();
	$a = Set::Infinite->new(1);
	$a = Set::Infinite->new(1,2);
	$a = Set::Infinite->new($b);
	$a = Set::Infinite->new([1], [1,2], [$b]);

Mode functions:	

	$a->real;

	$a->integer;

Logic functions:

	$logic = $a->intersects($b);

	$logic = $a->contains($b);

	$logic = $a->is_null;

Set functions:

	$i = $a->union($b);	

	$i = $a->intersection($b);

	$i = $a->complement;
	$i = $a->complement($b);

	$i = $a->span;   

		result is INTERVAL, (min .. max)

Scalar functions:

	$i = $a->min;

	$i = $a->max;

	$i = $a->size;  

Perl functions:

	@b = sort @a;

	print $a;

Global functions:

	separators(@i)

		chooses the interval separators. 

		default are [ ] ( ) '..' ','.

	null($i)		

		chooses 'null' name. default is ''

	infinite($i)

		chooses 'infinite' name. default is 'inf'

	infinite

		returns an 'infinite' number.

	minus_infinite

		returns '-infinite' number.

	null

		returns the 'null' object.

	quantize( parameters )

		Makes equal-sized subsets.

		In array context: returns a tied reference to the subset list.
		In set context: returns an ordered set of equal-sized subsets.

		The quantization function is external to this module:
		Parameters may vary depending on implementation. 

		Positions for which a subset does not exist may show as null.

		Example: 

			$a = Set::Infinite->new([1,3]);
			print join (" ", $a->quantize( quant => 1 ) );

		Gives: 

			[1..2) [2..3) [3..4)

	select( parameters )

		Selects set members based on their ordered positions.
		Selection is more useful after quantization.

		In array context: returns a tied reference to the array of selected subsets.
		In set context: returns the set of selected subsets.

		Unselected subsets may show as null.

		The selection function is external to this module:
		Parameters may vary depending on implementation. 

			freq     - default=1
			by       - default=[0]
			count    - dafault=infinite

	offset ( parameters )

		Offsets the subsets. Parameters: 

			value   - default=[0,0]
			mode    - default='offset'. Possible values are: 'offset', 'begin', 'end'.
			unit    - type of value. Can be 'days', 'weeks', 'hours', 'minutes', 'seconds'.

	iterate ( sub { } )

		EXPERIMENTAL - may be removed in next release
		Iterates over a subroutine. 
		Returns the union of partial results.

	type($i)

		chooses an object data type. 

		default is none (a normal perl SCALAR).

		examples: 

		type('Math::BigFloat');
		type('Math::BigInt');
		type('Set::Infinite::Date');
			See notes on Set::Infinite::Date below.

	tolerance(0)	defaults to real sets (default)
	tolerance(1)	defaults to integer sets

	real			defaults to real sets (default)

	integer			defaults to integer sets

Internal functions:

	$a->cleanup;

	$a->add($b);  # Use $a = $a->union($b) instead.

	$a->backtrack($b);

=head1 Notes on Dates

Set::Infinite::Date and Set::Infinite::ICal are Date "plugins" for sets.

** NOTE ** Set::Infinite::ICal is still experimental

use:

	type('Set::Infinite::Date');  # 2001-05-02 10:00:00   
	# or
	type('Set::Infinite::ICal');  # 20010502T100000Z


Both require Time::Local.
Set::Infinite::ICal requires Date::ICal.

They change quantize function behaviour to accept time units:

	use Set::Infinite;
	use Set::Infinite::Quantize_Date;
	Set::Infinite->type('Set::Infinite::Date');
	Set::Infinite::Date->date_format("year-month-day");

	$a = Set::Infinite->new('2001-05-02', '2001-05-13');
	print "Weeks in $a: ", join (" ", $a->quantize(unit => 'weeks', quant => 1) );

	$a = Set::Infinite->new('09:30', '10:35');
	print "Quarters of hour in $a: ", join (" ", $a->quantize(unit => 'minutes', quant => 15) );

Quantize units can be years, months, days, weeks, hours, minutes, or seconds.
To quantize the year to first-week-of-year until last-week-of-year, use 'weekyears':

		->quantize( unit => weekyears, wkst => 1 )

'wkst' parameter is '1' for monday (default), '7' for sunday.

max and min functions will also show in date/time format.

=head1 CAVEATS

	$a = Set::Infinite->new(10,1);
		Will be interpreted as [1..10]

	$a = Set::Infinite->new(1,2,3,4);
		Will be interpreted as [1..2],[3..4] instead of [1,2,3,4].
		You probably want ->new([1],[2],[3],[4]) instead,
		or maybe ->new(1,4) 

	$a = Set::Infinite->new(1..3);
		Will be interpreted as [1..2],3 instead of [1,2,3].
		You probably want ->new(1,3) instead.

=head1 AUTHOR

	Flavio Soibelmann Glock <fglock@pucrs.br>

=cut

