1 # Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
2 # This program is free software; you can redistribute it and/or
3 # modify it under the same terms as Perl itself.
5 package Set::Infinite::_recurrence;
9 use constant INFINITY => 100 ** 100 ** 100 ;
10 use constant NEG_INFINITY => -1 * (100 ** 100 ** 100);
12 use vars qw( @ISA $PRETTY_PRINT $max_iterate );
14 @ISA = qw( Set::Infinite );
15 use Set::Infinite 0.5502;
18 $PRETTY_PRINT = 1; # enable Set::Infinite debug
21 # TODO: inherit %Set::Infinite::_first / _last
22 # in a more "object oriented" way
24 $Set::Infinite::_first{_recurrence} =
27 my ($callback_next, $callback_previous) = @{ $self->{param} };
28 my ($min, $min_open) = $self->{parent}->min_a;
31 $min1 = $callback_next->( $min );
34 $min2 = $callback_previous->( $min1 );
35 $min1 = $min2 if defined $min2 && $min == $min2;
38 my $start = $callback_next->( $min1 );
39 my $end = $self->{parent}->max;
42 #print STDERR $start->datetime
43 # unless $start == INFINITY;
45 #print STDERR $end->datetime
46 # unless $end == INFINITY;
49 return ( $self->new( $min1 ), undef )
52 return ( $self->new( $min1 ),
53 $self->new( $start, $end )->
54 _function( '_recurrence', @{ $self->{param} } ) );
56 $Set::Infinite::_last{_recurrence} =
59 my ($callback_next, $callback_previous) = @{ $self->{param} };
60 my ($max, $max_open) = $self->{parent}->max_a;
63 $max1 = $callback_previous->( $max );
66 $max2 = $callback_next->( $max1 );
67 $max1 = $max2 if $max == $max2;
70 return ( $self->new( $max1 ),
71 $self->new( $self->{parent}->min,
72 $callback_previous->( $max1 ) )->
73 _function( '_recurrence', @{ $self->{param} } ) );
78 # \&callback_next, \&callback_previous )
80 # Generates "recurrences" from a callback.
81 # These recurrences are simple lists of dates.
83 # The recurrence generation is based on an idea from Dave Rolsky.
91 my ( $callback_next, $callback_previous, $delta ) = @_;
93 $delta->{count} = 0 unless defined $delta->{delta};
95 # warn "reusing delta: ". $delta->{count} if defined $delta->{delta};
96 # warn Dumper( $delta );
98 if ( $#{ $set->{list} } != 0 || $set->is_too_complex )
100 return $set->iterate(
103 $callback_next, $callback_previous, $delta )
108 if ($set->min != NEG_INFINITY && $set->max != INFINITY)
110 # print STDERR " finite set\n";
111 my ($min, $min_open) = $set->min_a;
112 my ($max, $max_open) = $set->max_a;
115 $min1 = $callback_next->( $min );
118 $min2 = $callback_previous->( $min1 );
119 $min1 = $min2 if defined $min2 && $min == $min2;
122 $result = $set->new();
124 # get "delta" - abort if this will take too much time.
126 unless ( defined $delta->{max_delta} )
128 for ( $delta->{count} .. 10 )
132 return $result if $min1 >= $max;
136 return $result if $min1 > $max;
138 push @{ $result->{list} },
139 { a => $min1, b => $min1, open_begin => 0, open_end => 0 };
140 $min2 = $callback_next->( $min1 );
142 if ( $delta->{delta} )
144 $delta->{delta} += $min2 - $min1;
148 $delta->{delta} = $min2 - $min1;
154 $delta->{max_delta} = $delta->{delta} * 40;
157 if ( $max < $min + $delta->{max_delta} )
163 return $result if $min1 >= $max;
167 return $result if $min1 > $max;
169 push @{ $result->{list} },
170 { a => $min1, b => $min1, open_begin => 0, open_end => 0 };
171 $min1 = $callback_next->( $min1 );
178 # return a "_function", such that we can backtrack later.
179 my $func = $set->_function( '_recurrence', $callback_next, $callback_previous, $delta );
181 # removed - returning $result doesn't help on speed
182 ## return $func->_function2( 'union', $result ) if $result;
189 $#{ $_[0]->{list} } == 0 &&
190 $_[0]->max == INFINITY &&
191 $_[0]->min == NEG_INFINITY
196 exists $_[0]->{method} &&
197 $_[0]->{method} eq '_recurrence' &&
198 $_[0]->{parent}->is_forever
203 my ($s1, $s2) = (shift,shift);
205 if ( exists $s1->{method} && $s1->{method} eq '_recurrence' )
207 # optimize: recurrence && span
208 return $s1->{parent}->
209 intersection( $s2, @_ )->
210 _recurrence( @{ $s1->{param} } )
211 unless ref($s2) && exists $s2->{method};
213 # optimize: recurrence && recurrence
214 if ( $s1->{parent}->is_forever &&
215 ref($s2) && _is_recurrence( $s2 ) )
217 my ( $next1, $previous1 ) = @{ $s1->{param} };
218 my ( $next2, $previous2 ) = @{ $s2->{param} };
219 return $s1->{parent}->_function( '_recurrence',
221 # intersection of parent 'next' callbacks
224 $n2 = $next2->( $_[0] );
226 $n1 = $next1->( $previous1->( $n2 ) );
227 return $n1 if $n1 == $n2;
228 $n2 = $next2->( $previous2->( $n1 ) );
229 return if $iterate++ == $max_iterate;
233 # intersection of parent 'previous' callbacks
236 $p2 = $previous2->( $_[0] );
238 $p1 = $previous1->( $next1->( $p2 ) );
239 return $p1 if $p1 == $p2;
240 $p2 = $previous2->( $next2->( $p1 ) );
241 return if $iterate++ == $max_iterate;
247 return $s1->SUPER::intersection( $s2, @_ );
252 my ($s1, $s2) = (shift,shift);
253 if ( $s1->_is_recurrence &&
254 ref($s2) && _is_recurrence( $s2 ) )
256 # optimize: recurrence || recurrence
257 my ( $next1, $previous1 ) = @{ $s1->{param} };
258 my ( $next2, $previous2 ) = @{ $s2->{param} };
259 return $s1->{parent}->_function( '_recurrence',
261 my $n1 = $next1->( $_[0] );
262 my $n2 = $next2->( $_[0] );
263 return $n1 < $n2 ? $n1 : $n2;
266 my $p1 = $previous1->( $_[0] );
267 my $p2 = $previous2->( $_[0] );
268 return $p1 > $p2 ? $p1 : $p2;
272 return $s1->SUPER::union( $s2, @_ );
277 Set::Infinite::_recurrence - Extends Set::Infinite with recurrence functions
281 $recurrence = $base_set->_recurrence ( \&next, \&previous );
285 This is an internal class used by the DateTime::Set module.
286 The API is subject to change.
288 It provides all functionality provided by Set::Infinite, plus the ability
289 to define recurrences with arbitrary objects, such as dates.
295 =item * _recurrence ( \&next, \&previous )
297 Creates a recurrence set. The set is defined inside a 'base set'.
299 $recurrence = $base_set->_recurrence ( \&next, \&previous );
301 The recurrence functions take one argument, and return the 'next' or
302 the 'previous' occurence.
304 Example: defines the set of all 'integer numbers':
308 use Set::Infinite::_recurrence;
311 # define the recurrence span
312 my $forever = Set::Infinite::_recurrence->new(
313 Set::Infinite::_recurrence::NEG_INFINITY,
314 Set::Infinite::_recurrence::INFINITY
317 my $recurrence = $forever->_recurrence(
322 my $tmp = floor( $_[0] );
323 $tmp < $_[0] ? $tmp : $_[0] - 1
327 print "sample recurrence ",
328 $recurrence->intersection( -5, 5 ), "\n";
329 # sample recurrence -5,-4,-3,-2,-1,0,1,2,3,4,5
333 print "next occurence after $x = ",
334 $recurrence->{param}[0]->( $x ), "\n"; # 235
335 print "previous occurence before $x = ",
336 $recurrence->{param}[2]->( $x ), "\n"; # 234
341 print "next occurence after $x = ",
342 $recurrence->{param}[0]->( $x ), "\n"; # 235
343 print "previous occurence before $x = ",
344 $recurrence->{param}[2]->( $x ), "\n"; # 233
349 Returns true if the set is a single span,
350 ranging from -Infinity to Infinity.
352 =item * _is_recurrence
354 Returns true if the set is an unbounded recurrence,
355 ranging from -Infinity to Infinity.
365 The C<Infinity> value.
369 The C<-Infinity> value.
375 Support is offered through the C<datetime@perl.org> mailing list.
377 Please report bugs using rt.cpan.org
381 Flavio Soibelmann Glock <fglock@pucrs.br>
383 The recurrence generation algorithm is based on an idea from Dave Rolsky.
387 Copyright (c) 2003 Flavio Soibelmann Glock. All rights reserved.
388 This program is free software; you can distribute it and/or
389 modify it under the same terms as Perl itself.
391 The full text of the license can be found in the LICENSE file
392 included with this module.
400 For details on the Perl DateTime Suite project please see
401 L<http://datetime.perl.org>.