#/bin/perl
# 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.

=head1 NAME

	Set::Infinite::_Simple - an interval of 2 scalars

=head1 SYNOPSIS

	This is a building block for Set::Infinite.
	Please use Set::Infinite instead.

	use Set::Infinite::_Simple;

	$a = Set::Infinite::_simple_new(1,2);
	print Set::Infinite::_simple_union($a, [5,6]);

=head1 USAGE

    # obsolete docs! see Synopsis.

	$a = Set::Infinite::Simple->new();
	$a = Set::Infinite::Simple->new(1);
	$a = Set::Infinite::Simple->new(1,2);
	$a = Set::Infinite::Simple->new('2001-10-10','2001-10-20', 'Set::Infinite::Date'); # 'type' parameter

	$a = Set::Infinite::Simple->new(@b);	
	$a = Set::Infinite::Simple->new($b);	
		parameters can be:
		undef
		SCALAR => means a set like [1]
		SCALAR,SCALAR
		ARRAY of SCALAR
		Set::Infinite::Simple

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

	$i = $a->union($b);	
		NOTE: union returns a list if result is ($a, $b)
	$i = $a->intersection($b);
	$i = $a->complement($b);
	$i = $a->complement;

	print $a;

Global:
	separators(@i)	chooses the separators. 
		default are [ ] ( ) '..' ','.


	inf		returns an 'infinity' number.
	minus_inf	returns '- infinity' number.
	# null			returns 'null'.

Internal:

	$a = Set::Infinite::Simple->fastnew( object_begin, object_end, open_begin, open_end );	

=head1 CHANGES

	'new' parameter 'type'

moved to Set::Infinite.pm in version 0.30:

	tolerance
	real		
	integer		
	type

=head1 TODO

	formatted string input like '[0..1]'

=head1 AUTHOR

	Flavio Soibelmann Glock <fglock@pucrs.br>

=cut

require Exporter;

package Set::Infinite;


use strict;
use warnings;
use Carp;

our $inf = 10**10**10;

our @separators = (
	'[', ']',	# a closed interval 
	'(', ')',	# an open interval 
	'..',		# number separator
	','			# list separator
);

our $simple_null =           undef;  
our $simple_everything =     _simple_fastnew(-$inf,  $inf, 1, 1);
our $simple_inf =            _simple_fastnew( $inf,  $inf, 1, 1);
our $simple_minus_inf =      _simple_fastnew(-$inf, -$inf, 1, 1);

sub _simple_null () { undef }

sub separators {
	return $separators[shift] if $#{@_} == 0;
	@separators = @_ if @_;
	return @separators;
}

sub _simple_intersects {
	my ($tmp1, $tmp2) = (shift, shift);

        return 0 unless defined $tmp1;
        return 0 unless defined $tmp2;

	my ($i_beg, $i_end, $open_beg, $open_end);

	if ($tmp1->{a} < $tmp2->{a}) {
		# print "3";

		# if ($tmp1->{b} > $tmp2->{b}) {
		#	# print "6";
		#	return 1;
		# }

		$i_beg 		= $tmp2->{a};
		$open_beg 	= $tmp2->{open_begin};
	}
	elsif ($tmp1->{a} == $tmp2->{a}) {
		# print "4";
		$i_beg 		= $tmp1->{a};
		$open_beg 	= ($tmp1->{open_begin} or $tmp2->{open_begin});
	}
	else {
		# print "5";
		$i_beg 		= $tmp1->{a};
		$open_beg	= $tmp1->{open_begin};
	}

	if ($tmp1->{b} > $tmp2->{b}) {
		# print "6";
		$i_end 		= $tmp2->{b};
		$open_end 	= $tmp2->{open_end};
	}
	elsif ($tmp1->{b} < $tmp2->{b}) {
		# print "8";
		$i_end 		= $tmp1->{b};
		$open_end	= $tmp1->{open_end};
	}
	else {     # if ($tmp1->{b} == $tmp2->{b}) {
		# print "7";
		$i_end 		= $tmp1->{b};
		$open_end 	= ($tmp1->{open_end} or $tmp2->{open_end});
	}

	return 0 if 
		( $i_beg > $i_end ) or 
		( ($i_beg == $i_end) and ($open_beg or $open_end) ) ;
	return 1;
	
}




sub _simple_complement {
	my $self = shift;
	# do we have a parameter?
	if (@_) {
            carp "_simple_complement no longer accepts parameters";
	}
	# print " [CPL-S:",$self,"] ";
	return $simple_everything unless defined $self->{a};
	my $tmp1 = _simple_fastnew(-$inf, $self->{a}, 1, ! $self->{open_begin} );
	# print " [CPL-S:#1:",$tmp1,"] ";
	my $tmp2 = _simple_fastnew($self->{b}, $inf, ! $self->{open_end}, 1);
	# print " [CPL-S:#2:",__PACKAGE__,":",$tmp2,"=(",$self->{b},", ",inf,")] ";
	if ($tmp2->{a} == $inf) {
		return $simple_null if ($tmp1->{b} == -$inf);
		return $tmp1;
	}
	return $tmp2 if ($tmp1->{b} == -$inf);
	#print " [CPL-S:RES:",$tmp1 ,";", $tmp2,"] ";
	($tmp1 , $tmp2);
}

sub _simple_union {
	my ($tmp2, $tmp1, $tolerance) = @_; 

	#print " [SIM:UNION:@param] \n";
	#print " [SIM:UNION:$tmp1 U $tmp2] \n";

        return $tmp1 unless defined $tmp2;
        return $tmp2 unless defined $tmp1;

    my %tmp1 = %$tmp1;
    my %tmp2 = %$tmp2; 

	# return $tmp1 if Set::Infinite::Element_Inf::is_null($tmp2->{a});
	# return $tmp2 if Set::Infinite::Element_Inf::is_null($tmp1->{a});

    if ($tolerance) {
		# "integer"
		#print " [SIM:UNION:INT ",ref($tmp1->{a}),"=",$tmp1->{a}," <=> ",ref($tmp1->{b}),"=",$tmp1->{b},"] \n";

		my $a1_open =  $tmp1{open_begin} ? -$tolerance : $tolerance ;
		my $b1_open =  $tmp1{open_end}   ? -$tolerance : $tolerance ;
		my $a2_open =  $tmp2{open_begin} ? -$tolerance : $tolerance ;
		my $b2_open =  $tmp2{open_end}   ? -$tolerance : $tolerance ;

		# open_end touching?
		if ((($tmp1{b}+$tmp1{b}) + $b1_open ) < (($tmp2{a}+$tmp2{a}) - $a2_open)) {
			# self disjuncts b
			return ( $tmp1, $tmp2 );
		}
		if ((($tmp1{a}+$tmp1{a}) - $a1_open ) > (($tmp2{b}+$tmp2{b}) + $b2_open)) {
			# self disjuncts b
			return ( $tmp2, $tmp1 );
		}
    }
    else {
        # "real"
        # print " [SIM:UNION:REAL ",ref($tmp1->{a}),"=",$tmp1->{a}," <=> ",ref($tmp1->{b}),"=",$tmp1->{b},"] \n";
        my $cmp1b2a = $tmp1{b} <=> $tmp2{a};
        my $cmp1a2b = $tmp1{a} <=> $tmp2{b};
        if ( $cmp1b2a < 0 ) {
			return ( $tmp1, $tmp2 );
        }
        if ( $cmp1a2b > 0) {
                        return ( $tmp2, $tmp1 );
        }
        if ( ( $cmp1b2a == 0 ) and $tmp1{open_end} and $tmp2{open_begin}) {
			return ( $tmp1, $tmp2 );
        }
        if ( ( $cmp1a2b == 0 ) and $tmp2{open_end} and $tmp1{open_begin}) {
			return ( $tmp2, $tmp1 );
        }
    }

    #print " [SIM:UNION:",ref($tmp1->{a}),"=",$tmp1->{a}," <=> ",ref($tmp1->{b}),"=",$tmp1->{b},"] \n";
    my %tmp;
	if ($tmp1{a} > $tmp2{a}) {
		$tmp{a} = $tmp2{a};
		$tmp{open_begin} = $tmp2{open_begin};
	}
	elsif ($tmp1{a} == $tmp2{a}) {
		$tmp{a} = $tmp1{a};
		$tmp{open_begin} = $tmp1{open_begin} ? $tmp2{open_begin}: 0;
	}
	else {
		$tmp{a} = $tmp1{a};
		$tmp{open_begin} = $tmp1{open_begin};
	}

	if ($tmp1{b} < $tmp2{b}) {
		$tmp{b} = $tmp2{b};
		$tmp{open_end} = $tmp2{open_end};
	}
	elsif ($tmp1{b} == $tmp2{b}) {
		$tmp{b} = $tmp1{b};
		$tmp{open_end} = $tmp1{open_end} ? $tmp2{open_end} : 0;
	}
	else {
		$tmp{b} = $tmp1{b};
		$tmp{open_end} = $tmp1{open_end};
	}
	return \%tmp;
}

sub _simple_spaceship {
	my ($tmp1, $tmp2, $inverted) = @_;
    my $cmp = $tmp1->{a} <=> $tmp2->{a};
	if ($inverted) {
		return $cmp ? - $cmp : $tmp2->{b} <=> $tmp1->{b}; 
	}
	return $cmp ? $cmp : $tmp1->{b} <=> $tmp2->{b};
}

sub _simple_new {
	my $tmp = shift;
 	return undef unless defined($tmp);
	return $tmp if ref($tmp) eq 'HASH';
	my ($tmp2, $type) = @_;
        my $self;
	if ($type and (ref($tmp) ne $type) ) { 
		$tmp = new $type $tmp;
	}
	unless (defined $tmp2) {
		$self->{a} = $self->{b} = $tmp;
	}
	else {
		if ($type and (ref($tmp2) ne $type) ) {
			$tmp2 = new $type $tmp2;
		}
		if ($tmp <= $tmp2) {
			($self->{a}, $self->{b}) = ($tmp, $tmp2);
		}
		else {
			($self->{a}, $self->{b}) = ($tmp2, $tmp);
		}
	}
	$self;	
}


sub _simple_fastnew {
	{ a => $_[0] , b => $_[1] , open_begin => $_[2] , open_end => $_[3] };
}

sub _simple_as_string {
	my $self = shift;
	my $s;
	# print " [simple:string] ";

    return "" unless defined $self;

    $self->{open_begin} = 1 if ($self->{a} == -$inf );
    $self->{open_end}   = 1 if ($self->{b} == $inf );

    my $tmp1 = $self->{a};
    $tmp1 = "$tmp1";

    my $tmp2 = $self->{b};
    $tmp2 = "$tmp2";
    return $tmp1 if $tmp1 eq $tmp2;
	$s = $self->{open_begin} ? $separators[2] : $separators[0];
	$s .= $tmp1 . $separators[4] . $tmp2;
	$s .= $self->{open_end} ? $separators[3] : $separators[1];
    return $s;
}


1;
