package Set::Infinite;

# Copyright (c) 2001, 2002 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.36';

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;

=head1 NAME

Set::Infinite - Sets of intervals

=head1 SYNOPSIS

  use Set::Infinite;

  $a = Set::Infinite->new(1,2);    # [1..2]
  print $a->union(5,6);            # [1..2],[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),
unions, and infinite recurrences.

=head1 METHODS

=cut


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 fixtype {
    my $self = shift;
    foreach (@{$self->{list}}) {
        $_->{a} = $type->new($_->{a}) unless ref($_->{a});
        $_->{b} = $type->new($_->{b}) unless ref($_->{b});
    }
    return $self;
}

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->copy;
        $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->copy;
        $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->copy;
        $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 $b1 = $class->new();
        $b1->{too_complex} = 1;
        $b1->{parent} = $self->copy;
        $b1->{method} = 'offset';
        $b1->{param}  = \@_;
        return $b1;
    }

    # return $self if $#{ $self->{list} } < 0;

    my @a;
    my %param = @_;
    my $b1 = $class->new();        # $self); # clone myself

    unless (ref($param{value}) eq 'ARRAY') {
        #print " [value:scalar:", $param{value} ,"]\n";
        $param{value} = [0 + $param{value}, 0 + $param{value}];
    }
    $param{mode}   =      'offset' unless $param{mode};
    $param{unit}   =      'one'    unless $param{unit};
    $param{parts}  =      ($#{$param{value}}) / 2;
    $param{strict} =      0        unless $param{strict};
    $param{fixtype} =     1        unless exists $param{fixtype};
    # $param{fetchsize} = $param{parts} * (1 + $#{ $self->{list} });
    $param{sub_unit} =    $Set::Infinite::Arithmetic::subs_offset2{$param{unit}};
    $param{sub_mode} =    $Set::Infinite::Offset::_MODE{$param{mode}};
    $param{parent_list} = $self->{list};

    # print " [ofs:$param{mode} $param{unit} value:", join (",", @{$param{value} }),"]\n";

    my ($i, $j);
    my ($cmp, $this, $next, $ib, $part, $open_begin, $open_end, $tmp);
    foreach $i (0 .. $#{ $self->{list} }) {
        my $interval = $self->{list}[$i];
        my $ia = $interval->{a};

        if ( (ref($ia) eq 'Set::Infinite::Element_Inf') and ( $$ia eq '' ) ) {
            # skip if interval is null
        }
        else {
            $ib = $interval->{b};
            $open_begin = $interval->{open_begin};
            $open_end = $interval->{open_end};
            # do offset
            foreach $j (0 .. $param{parts}) {
            # for ( $j = 0; $j <= $param{parts}; $j++) {
                # print " ..[ofs:$param{mode}=$param{sub_mode} $param{unit}=$param{sub_unit} value:", $param{value}[$j+$j], ",", $param{value}[$j+$j + 1],"]\n";

                ($this, $next, $cmp) = &{ $param{sub_mode} } 
                    ( $param{sub_unit}, $ia, $ib, 
                      $param{value}[$j+$j], $param{value}[$j+$j + 1] );

                if ($cmp > 0) { 
                    # skip if a > b
                }
                else {
                    # print " [ofs($this,$next)] ";
                    if ($cmp == 0) {
                        $open_end = $open_begin;
                        $this = $next;  #  make sure to use the same object from cache!
                    }

                    # skip this if don't need to "fixtype"
                    if ($param{fixtype}) {
                        # bless results into 'type' class
                        my $class = ref($ia);
                        # my $class = $Set::Infinite::type;

                        # print " [ofs($this,$next) = $class] ";
                        if (ref($this) ne $class) {
                            $this = $class->new($this);
                            $this->mode($ia->{mode}) if exists $ia->{mode};

                            $next = $class->new($next);
                            $next->mode($ia->{mode}) if exists $ia->{mode};
                        }
                    } # "fixtype"

                    # create subset
                    $tmp = bless { a => $this , b => $next ,
                        open_begin => $open_begin , open_end => $open_end }, 
                        'Set::Infinite::Simple';
                    if (($param{strict} != 0) and not ($param{strict}->intersects($tmp)) ) {
                        # skip
                        # return Set::Infinite::Simple->simple_null;
                    }
                    else {
                        # save it!
                        push @a, $tmp;
                        # return $tmp;
                    }
                }
            }  # parent not null

        }  # parts

    }  # self

    @a = sort { $a->{a} <=> $b->{a} } @a;

    $b1->{list} = \@a;        # change data
    $b1->{cant_cleanup} = 1; 
    # print " N = $#a \n";

    # $b1->_self_sort; # if $param{parts} > 0;

    return $b1;
}


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;
}

=head2 is_too_complex

Sometimes a set might be too complex to print. 
It will happen when you ask for a quantization on a 
set bounded by -inf or inf.

=cut

sub is_too_complex {
    my $self = shift;
    return 1 if $self->{too_complex};
    return 0;
}


# this an internal method
# it's intent is checking some other methods misbehave 
# and return an unordered list
# sub _self_sort {
#    my $self = shift; 
#    my $tmp;
#    $self->{list} = [ sort {
#                    $tmp = ref($a); # doesn't work without this
#                    $a <=> $b
#                } @{$self->{list}} ];
#    return $self;
# }


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}," ]\n" if $DEBUG_BT;
            print " [bt$backtrack_depth-3-15:expr: $expr ; param: ", join(";",@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->copy, $b->copy];
        $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->copy;
        $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 $a1 = shift;
    my $class = ref($a1);
    my $b1;

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

    if (ref ($_[0]) eq $class) {
        $b1 = shift;
        # print " [inter:as_is] \n";
    } 
    else {
        # my @param = @_;
        # print " [inter:isa:",ref($_[0])," (",$class,")] \n";
        $b1 = $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 ($a1->{too_complex}) {
        print " [inter:complex:a] \n" if $DEBUG_BT;
        $a1 = $a1->backtrack('intersection', $b1);
        # print " [int:WAS:b:", $b1, "--",ref($b1),"] \n";
    }  # don't put 'else' here
    if ($b1->{too_complex}) {
        print " [inter:complex:b] \n" if $DEBUG_BT;
        $b1 = $b1->backtrack('intersection', $a1);
    }

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

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

    my ($ia, $ib);
    # my ($na, $nb) = (0,0);
    # $tmp = ref($a1->{list}) . ref($b1->{list}); # instantiate, just in case
    my ($ma, $mb) = ($#{$a1->{list}}, $#{$b1->{list}});
    my $intersection = $class->new();

    # for loop optimization
    if ($ma < $mb) {
        ($ma, $mb) = ($mb, $ma);
        # ($na, $nb) = ($nb, $na);
        ($a1, $b1) = ($b1, $a1);
    }

    my ($tmp1, $tmp2);
    my ($tmp1a, $tmp2a, $tmp1b, $tmp2b);
    my ($i_beg, $i_end, $open_beg, $open_end);

    my ($cmp1);

    B: foreach $ib (0 .. $mb) {
        $tmp2 = $b1->{list}[$ib];
        $tmp2a = $tmp2->{a};
        $tmp2b = $tmp2->{b};
        # my $dummy = ref($pb1);
         A: foreach $ia (0 .. $ma) {
            $tmp1 = $a1->{list}[$ia];
            $tmp1b = $tmp1->{b};

            next A if $tmp1b < $tmp2a; 

            $tmp1a = $tmp1->{a};
            next B if $tmp1a > $tmp2b;

            $cmp1 = $tmp1a <=> $tmp2a;

            if ($cmp1 < 0) {
                $i_beg         = $tmp2a;
                $open_beg     = $tmp2->{open_begin};
            }
            elsif ($cmp1 == 0) {
                $i_beg         = $tmp1a;
                $open_beg     = ($tmp1->{open_begin} or $tmp2->{open_begin});
            }
            else {
                $i_beg         = $tmp1a;
                $open_beg    = $tmp1->{open_begin};
            }

            $cmp1 = $tmp1b <=> $tmp2b;

            if ($cmp1 > 0) {
                $i_end         = $tmp2b;
                $open_end     = $tmp2->{open_end};
            }
            elsif ($cmp1 == 0) {
                $i_end         = $tmp1b;
                $open_end     = ($tmp1->{open_end} or $tmp2->{open_end});
            }
            else {
                $i_end         = $tmp1b;
                $open_end    = $tmp1->{open_end};
            }

            # print "  [ simple: fastnew($i_beg, $i_end, $open_beg, $open_end ) ]\n";
            # return $simple_null if 

            $cmp1 = $i_beg <=> $i_end;

            unless (( $cmp1 > 0 ) or 
                    ( ($cmp1 == 0) and ($open_beg or $open_end) )) {
                push @{$intersection->{list}}, 
                    bless { a => $i_beg, 
                            b => $i_end, 
                            open_begin => $open_beg, 
                            open_end => $open_end }, 'Set::Infinite::Simple';
            }
        }
    }

    # print " [intersect GIVES\n    ",$intersection,"\n\n";

    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
# $a, $b renamed to $a1, $b1 to prevent clashing with 'sort' 
sub union {
    my $a1 = shift;
    my $class = ref($a1);
    my $b1;

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

    # print " [UNION] \n";
    # print " [union: new b] \n";

    return $a1->compact if ($#_ < 0);  # old usage

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

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

    # -- special case: $a1 or $b1 is empty
     # print " A=0 B=$b1 " if $#{$a1->{list}} < 0;
     # print " B=0 A=$a1 " if $#{$b1->{list}} < 0;
    return $a1 if $#{$b1->{list}} < 0;
    return $b1 if $#{$a1->{list}} < 0;

    # print " [union: new union] \n";
    # print "\n [union: $a1 +\n       $b1 ] \n";
    # $a1 = $class->new($a1);
    # print " [union: $a1 +\n       $b1 ] \n";

    my ($ia, $ib);
    $ia = 0;
    $ib = 0;

    # checking if size+order matters on speed - it does
    # my $a_size = $#{$a1->{list}};
    # my $b_size = $#{$b1->{list}};
    # print " [ $a_size <=> $b_size ] \n";
    # if ($b_size > $a_size) {
    #     ($b1,$a1) = ($a1,$b1);
    # }

    # print " [ ",$a1->max," <=> ",$b1->max," ] \n";
 
    $a1 = $class->new($a1);

    # my ($test, $orig);

    # checking: some other methods misbehave and return an unordered list 
    # $b1->_self_sort;

    my $b_list = $b1->{list};

    # -- frequent case - $b1 is after $a1
        if ($b1->min > $a1->max) 
    {
        # if ($#{$b_list} == 0) {
        #    # -- $b is a simple interval
        #    print "#";
        #    push @{$a->{list}}, $b_list->[0];
        # }

         # $test = $class->new($a);

        # print "#";
        # print " [UNION: $a1 \n         $b1 $#{$b_list}\n       ";
         foreach $ib (0 .. $#{$b_list}) {
            # print " -> ",$b_list->[$ib],"\n";
            push @{$a1->{list}}, $b_list->[$ib]; # unless $b_list->[$ib]->is_null;
        }
        # print "= $a1 \n"; 

        return $a1;

        # ($a1, $test) = ($test, $a1);
    }
    # else { print "." }

    # -- end: special case 

    # print " [UNION: NORMAL ] \n";

     B: foreach $ib ($ib .. $#{$b_list}) {
        foreach $ia ($ia .. $#{$a1->{list}}) {
            # $self->{list}->[$_ - 1] = $tmp[0];
            # splice (@{$self->{list}}, $_, 1);

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

            if ($#tmp == 0) {
                    $a1->{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 ($a1->{list}->[$ia]->{a} >= $hash{a}) 
            {
                # print "+ ";
                # splice(@array,$index,0,$value)
                # insert $b[$ib] before $a[$ia] 
                splice (@{$a1->{list}}, $ia, 0, $b_list->[$ib]);
                # $a->add($b->{list}->[$ib]);
                next B;
            }

        }
        # print "- ";
        # $a->add($b->{list}->[$ib]);
        push @{$a1->{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";

    # print "\n TEST: $test\n A:    $a\n ORIG: $a\n B:    $b\n" if $test != $a;

    return $a1;    
}

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


=head2 copy

Makes a new object from the object's data.

=cut

sub copy {
    my $self = shift;
    my $copy = bless {}, ref($self);
    foreach my $key (keys %{$self}) {
        $copy->{$key} = $self->{$key};
    }
    return $copy;
}


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

    # $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->{list} = [];

LOOP:
    my $tmp = shift @_;
    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}"?

    if ((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($_) ;
                    push @{ $self->{list} }, $_; # Set::Infinite::Simple->fastnew($_->{a}, $_->{b}, $_->{open_begin}, $_->{open_end}) ;
                }
                goto LOOP;
            }
            # does it have a "{a},{b}"?
            if (($tmp->isa("Set::Infinite::Simple")) ) {  # and (not $tmp->is_null)) {
                # print " INF:ADD:SIMPLE:",__PACKAGE__,":",$tmp," ";
                # push @{ $self->{list} }, Set::Infinite::Simple->new($tmp) ;
                push @{ $self->{list} }, $tmp; # Set::Infinite::Simple->fastnew($tmp->{a}, $tmp->{b}, $tmp->{open_begin}, $tmp->{open_end}) ;
                # print " INF:ADD:SIMPLE:",__PACKAGE__,":",@{ $self->{list} }," \n";
                goto LOOP;
            }
    }

    # else {

    my $tmp2 = shift @_;
    #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 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__

=head2 Mode functions:    

    $a->real;

    $a->integer;

=head2 Logic functions:

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

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

    $logic = $a->is_null;

=head2 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)

=head2 Scalar functions:

    $i = $a->min;

    $i = $a->max;

    $i = $a->size;  

=head2 Perl functions:

    @b = sort @a;

    print $a;

=head2 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

=head2 Internal functions:

    $a->cleanup;

    $a->backtrack($b);

    $a->fixtype;

=head1 Notes on Dates

See module Date::Set for up-to-date information on date-sets. 

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

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 SEE ALSO

    Date::Set

=head1 AUTHOR

    Flavio Soibelmann Glock <fglock@pucrs.br>

=cut

