package Set::Infinite::Arithmetic;
# 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.
use strict;
# use warnings;
require Exporter;
use Carp;
use Time::Local;
use POSIX qw(floor);
use vars qw( @EXPORT @EXPORT_OK $inf );
@EXPORT = qw();
@EXPORT_OK = qw();
# @EXPORT_OK = qw( %subs_offset2 %Offset_to_value %Value_to_offset %Init_quantizer );
$inf = 100**100**100; # $Set::Infinite::inf; doesn't work! (why?)
=head2 NAME
Set::Infinite::Arithmetic - Scalar operations used by quantize() and offset()
=head2 AUTHOR
Flavio Soibelmann Glock - fglock@pucrs.br
=cut
use vars qw( $day_size $hour_size $minute_size $second_size );
$day_size = timegm(0,0,0,2,3,2001) - timegm(0,0,0,1,3,2001);
$hour_size = $day_size / 24;
$minute_size = $hour_size / 60;
$second_size = $minute_size / 60;
use vars qw( %_MODE %subs_offset2 %Offset_to_value @week_start %Init_quantizer %Value_to_offset %Offset_to_value );
=head2 %_MODE hash of subs
$a->offset ( value => [1,2], mode => 'offset', unit => 'days' );
$a->offset ( value => [1,2, -5,-4], mode => 'offset', unit => 'days' );
note: if mode = circle, then "-5" counts from end (like a Perl negative array index).
$a->offset ( value => [1,2], mode => 'offset', unit => 'days', strict => $a );
option 'strict' will return intersection($a,offset). Default: none.
=cut
# return value = ($this, $next, $cmp)
%_MODE = (
circle => sub {
if ($_[3] >= 0) {
&{ $_[0] } ($_[1], $_[3], $_[4] )
}
else {
&{ $_[0] } ($_[2], $_[3], $_[4] )
}
},
begin => sub { &{ $_[0] } ($_[1], $_[3], $_[4] ) },
end => sub { &{ $_[0] } ($_[2], $_[3], $_[4] ) },
offset => sub {
my ($this, undef) = &{ $_[0] } ($_[1], $_[3], $_[4] );
my (undef, $next) = &{ $_[0] } ($_[2], $_[3], $_[4] );
($this, $next);
}
);
=head2 %subs_offset2($object, $offset1, $offset2)
&{ $subs_offset2{$unit} } ($object, $offset1, $offset2);
A hash of functions that return:
($object+$offset1, $object+$offset2)
in $unit context.
Returned $object+$offset1, $object+$offset2 may be scalars or objects.
=cut
%subs_offset2 = (
weekdays => sub {
# offsets to week-day specified
# 0 = first sunday from today (or today if today is sunday)
# 1 = first monday from today (or today if today is monday)
# 6 = first friday from today (or today if today is friday)
# 13 = second friday from today
# -1 = last saturday from today (not today, even if today were saturday)
# -2 = last friday
my ($self, $index1, $index2) = @_;
return ($self, $self) if $self == $inf;
# my $class = ref($self);
my @date = gmtime( $self );
my $wday = $date[6];
my ($tmp1, $tmp2);
$tmp1 = $index1 - $wday;
if ($index1 >= 0) {
$tmp1 += 7 if $tmp1 < 0; # it will only happen next week
}
else {
$tmp1 += 7 if $tmp1 < -7; # if will happen this week
}
$tmp2 = $index2 - $wday;
if ($index2 >= 0) {
$tmp2 += 7 if $tmp2 < 0; # it will only happen next week
}
else {
$tmp2 += 7 if $tmp2 < -7; # if will happen this week
}
# print " [ OFS:weekday $self $tmp1 $tmp2 ] \n";
# $date[3] += $tmp1;
$tmp1 = $self + $tmp1 * $day_size;
# $date[3] += $tmp2 - $tmp1;
$tmp2 = $self + $tmp2 * $day_size;
($tmp1, $tmp2);
},
years => sub {
my ($self, $index, $index2) = @_;
return ($self, $self) if $self == $inf;
# my $class = ref($self);
# print " [ofs:year:$self -- $index]\n";
my @date = gmtime( $self );
$date[5] += 1900 + $index;
my $tmp = timegm(@date);
$date[5] += $index2 - $index;
my $tmp2 = timegm(@date);
($tmp, $tmp2);
},
months => sub {
my ($self, $index, $index2) = @_;
# carp " [ofs:month:$self -- $index -- $inf]";
return ($self, $self) if $self == $inf;
# my $class = ref($self);
my @date = gmtime( $self );
my $mon = $date[4] + $index;
my $year = $date[5] + 1900;
# print " [OFS: month: from $year$mon ]\n";
if (($mon > 11) or ($mon < 0)) {
my $addyear = floor($mon / 12);
$mon = $mon - 12 * $addyear;
$year += $addyear;
}
my $mon2 = $date[4] + $index2;
my $year2 = $date[5] + 1900;
if (($mon2 > 11) or ($mon2 < 0)) {
my $addyear2 = floor($mon2 / 12);
$mon2 = $mon2 - 12 * $addyear2;
$year2 += $addyear2;
}
# print " [OFS: month: to $year $mon ]\n";
$date[4] = $mon;
$date[5] = $year;
my $tmp = timegm(@date);
$date[4] = $mon2;
$date[5] = $year2;
my $tmp2 = timegm(@date);
($tmp, $tmp2);
},
days => sub {
( $_[0] + $_[1] * $day_size,
$_[0] + $_[2] * $day_size,
)
},
weeks => sub {
( $_[0] + $_[1] * (7 * $day_size),
$_[0] + $_[2] * (7 * $day_size),
)
},
hours => sub {
# carp " [ $_[0]+$_[1] hour = ".( $_[0] + $_[1] * $hour_size )." mode=".($_[0]->{mode})." ]";
( $_[0] + $_[1] * $hour_size,
$_[0] + $_[2] * $hour_size,
)
},
minutes => sub {
( $_[0] + $_[1] * $minute_size,
$_[0] + $_[2] * $minute_size,
)
},
seconds => sub {
( $_[0] + $_[1] * $second_size,
$_[0] + $_[2] * $second_size,
)
},
one => sub {
( $_[0] + $_[1],
$_[0] + $_[2],
)
},
);
@week_start = ( 0, -1, -2, -3, 3, 2, 1, 0, -1, -2, -3, 3, 2, 1, 0 );
=head2 %Offset_to_value($object, $offset)
=head2 %Init_quantizer($object)
$Offset_to_value{$unit} ($object, $offset);
$Init_quantizer{$unit} ($object);
Maps an 'offset value' to a 'value'
A hash of functions that return ( int($object) + $offset ) in $unit context.
Init_quantizer subroutines must be called before using subs_offset1 functions.
int(object)+offset is a scalar.
Offset_to_value is optimized for calling it multiple times on the same object,
with different offsets. That's why there is a separate initialization
subroutine.
$self->{offset} is created on initialization. It is an index used
by the memoization cache.
=cut
%Offset_to_value = (
weekyears => sub {
my ($self, $index) = @_;
my $epoch = timegm( 0,0,0,
1,0,$self->{offset} + $self->{quant} * $index);
my @time = gmtime($epoch);
# print " [QT_D:weekyears:$self->{offset} + $self->{quant} * $index]\n";
# year modulo week
# print " [QT:weekyears: time = ",join(";", @time )," ]\n";
$epoch += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size;
# print " [QT:weekyears: week=",join(";", gmtime($epoch) )," wkst=$self->{wkst} tbl[",$time[6] + 7 - $self->{wkst},"]=",$week_start[$time[6] + 7 - $self->{wkst}]," ]\n\n";
my $epoch2 = timegm( 0,0,0,
1,0,$self->{offset} + $self->{quant} * (1 + $index) );
@time = gmtime($epoch2);
$epoch2 += ( $week_start[$time[6] + 7 - $self->{wkst}] ) * $day_size;
( $epoch, $epoch2 );
},
years => sub {
my $index = $_[0]->{offset} + $_[0]->{quant} * $_[1];
( timegm( 0,0,0, 1, 0, $index),
timegm( 0,0,0, 1, 0, $index + $_[0]->{quant}) )
},
months => sub {
my $mon = $_[0]->{offset} + $_[0]->{quant} * $_[1];
my $year = int($mon / 12);
$mon -= $year * 12;
my $tmp = timegm( 0,0,0, 1, $mon, $year);
$mon += $year * 12 + $_[0]->{quant};
$year = int($mon / 12);
$mon -= $year * 12;
( $tmp, timegm( 0,0,0, 1, $mon, $year) );
},
weeks => sub {
my $tmp = 3 * $day_size + $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
($tmp, $tmp + $_[0]->{quant})
},
days => sub {
my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
($tmp, $tmp + $_[0]->{quant})
},
hours => sub {
my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
($tmp, $tmp + $_[0]->{quant})
},
minutes => sub {
my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
($tmp, $tmp + $_[0]->{quant})
},
seconds => sub {
my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
($tmp, $tmp + $_[0]->{quant})
},
one => sub {
my $tmp = $_[0]->{quant} * ($_[0]->{offset} + $_[1]);
($tmp, $tmp + $_[0]->{quant})
},
);
# Maps an 'offset value' to a 'value'
%Value_to_offset = (
one => sub { floor( $_[1] / $_[0]{quant} ) },
seconds => sub { floor( $_[1] / $_[0]{quant} ) },
minutes => sub { floor( $_[1] / $_[0]{quant} ) },
hours => sub { floor( $_[1] / $_[0]{quant} ) },
days => sub { floor( $_[1] / $_[0]{quant} ) },
weeks => sub { floor( ($_[1] - 3 * $day_size) / $_[0]{quant} ) },
months => sub {
my @date = gmtime( 0 + $_[1] );
my $tmp = $date[4] + 12 * (1900 + $date[5]);
floor( $tmp / $_[0]{quant} );
},
years => sub {
my @date = gmtime( 0 + $_[1] );
my $tmp = $date[5] + 1900;
floor( $tmp / $_[0]{quant} );
},
weekyears => sub {
my ($self, $value) = @_;
my @date;
# find out YEAR number
@date = gmtime( 0 + $value );
my $year = floor( $date[5] + 1900 / $self->{quant} );
# what is the EPOCH for this week-year's begin ?
my $begin_epoch = timegm( 0,0,0, 1,0,$year);
@date = gmtime($begin_epoch);
$begin_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size;
# what is the EPOCH for this week-year's end ?
my $end_epoch = timegm( 0,0,0, 1,0,$year+1);
@date = gmtime($end_epoch);
$end_epoch += ( $week_start[$date[6] + 7 - $self->{wkst}] ) * $day_size;
$year-- if $value < $begin_epoch;
$year++ if $value >= $end_epoch;
# carp " value=$value offset=$year this_epoch=".$begin_epoch;
# carp " next_epoch=".$end_epoch;
$year;
},
);
# Initialize quantizer
%Init_quantizer = (
one => sub {},
seconds => sub { $_[0]->{quant} *= $second_size },
minutes => sub { $_[0]->{quant} *= $minute_size },
hours => sub { $_[0]->{quant} *= $hour_size },
days => sub { $_[0]->{quant} *= $day_size },
weeks => sub { $_[0]->{quant} *= 7 * $day_size },
months => sub {},
years => sub {},
weekyears => sub {
$_[0]->{wkst} = 1 unless defined $_[0]->{wkst};
# select which 'cache' to use
# $_[0]->{memo} .= $_[0]->{wkst};
},
);
1;